r4668: *** empty log message ***

[kmrcl.git] / seqs.lisp

diff --git a/seqs.lisp b/seqs.lisp
new file mode 100644 (file)
index 0000000..92a4aa0
--- /dev/null
+++ b/seqs.lisp
@@ -0,0 +1,70 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          seqs.lisp
+;;;; Purpose:       Sequence functions for KMRCL package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: seqs.lisp,v 1.1 2003/04/29 00:26:21 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+
+(defun mapappend (func seq)
+  (apply #'append (mapcar func seq)))
+
+(defun mapcar-append-string-nontailrec (func v)
+  "Concatenate results of mapcar lambda calls"  
+  (aif (car v)
+       (concatenate 'string (funcall func it)
+                   (mapcar-append-string-nontailrec func (cdr v)))
+       ""))
+
+
+(defun mapcar-append-string (func v &optional (accum ""))
+  "Concatenate results of mapcar lambda calls"  
+  (aif (car v)
+       (mapcar-append-string 
+       func 
+       (cdr v) 
+       (concatenate 'string accum (funcall func it)))
+       accum))
+
+(defun mapcar2-append-string-nontailrec (func la lb)
+  "Concatenate results of mapcar lambda call's over two lists"  
+  (let ((a (car la))
+       (b (car lb)))
+    (if (and a b)
+      (concatenate 'string (funcall func a b)
+                  (mapcar2-append-string-nontailrec func (cdr la) (cdr lb)))
+      "")))
+  
+(defun mapcar2-append-string (func la lb &optional (accum ""))
+  "Concatenate results of mapcar lambda call's over two lists"  
+  (let ((a (car la))
+       (b (car lb)))
+    (if (and a b)
+       (mapcar2-append-string 
+        func 
+        (cdr la) 
+        (cdr lb)
+        (concatenate 'string accum (funcall func a b)))
+      accum)))
+  
+
+
+(defun nsubseq (sequence start &optional (end (length sequence)))
+  "Return a subsequence by pointing to location in original sequence"
+  (make-array (- end start)
+             :element-type (array-element-type sequence)
+             :displaced-to sequence
+             :displaced-index-offset start))