sequence= etc.

s48/sequences/README

@@ -18,7 +18,7 @@ the basic sequence operation names bound to the corresponding vector
 procedures.  The library is neither complete nor tweaked nor tested
 sytematically.  (The idea to recycle parts of the srfi-13 code came
 too late.)  It contains the folllowing procedures, arranged in
-columns=structures and `* categories' from SRFI-13.
+columns=structures and `* categories' from SRFI-13 and -1.
 
 
 VECTOR-LIB            SEQUENCE-LIB             ABSEQUENCES, also SL
@@ -31,6 +31,10 @@ vector-any            sequence-any
 [ versions with >1 sequence but no optional start & end parameters ]
 vectors-every         sequences-every
 vectors-any           sequences-any
+[ 2 seq. args and opt. start & end parms for both seqs ]
+vector=               sequence=
+[ >=0 sequence args, no start & end parameters ]
+vectors=              sequences=
 
 * Constructors
 make-vector           make-another-sequence    make-absequence/behavior
@@ -133,6 +137,7 @@ library grows, but please report deviations anyway.
   the respective srfi, the result complies with the srfi spec.
   E.g. ``sequences-fold = fold'' on lists,
        ``sequence-fold = string-fold'' on strings.
+  Exception:  SEQUENCE= vs. STRING= -- parameter lists don't match (ELT=)
 
 
 * Predicates
@@ -177,6 +182,24 @@ n := min.k sequence-length sk.
 
                                   *
 
+(vector= elt= s0 s1 [start0 end0 start1 end1]) --> b
+(sequence= elt= s0 s1 [start0 end0 start1 end1]) --> b
+
+Synopsis:  Return boolean(S0 and S1 represent the same sequence), i.e.
+B = (and (elt= s0[start0] s1[start1]) ...)
+[ deviates from STRING= in SRFI-13 due to ELT= parameter ]
+
+                                  *
+
+(vectors= elt= s0 ...) --> b
+(sequences= elt= s0 ...) --> b
+
+Synopsis:  Return B = boolean(S0, ... represent the same sequence), i.e.
+B = #t given <2 sequence args, and
+  = (and[k=0,...) (sequence= elt= s(k) s(k+1))) otherwise.
+
+                                  *
+
 Constructors
 
 (make-vector len [fill]) --> s

s48/sequences/composeqs.scm

@@ -135,6 +135,9 @@
 (define sequences-fold-right contiguous-sequences-fold-right)
 (define sequences-any contiguous-sequences-any)
 (define sequences-every contiguous-sequences-every)
+(define sequence= contiguous-sequence=)
+(define sequences= contiguous-sequences=)
 ;; the MAKER parameter works only with general sequences
 (define sequence-copy/maker contiguous-sequence-copy/maker)
 (define sequence-map/maker contiguous-sequence-map/maker)
+

s48/sequences/genseqs.scm

@@ -18,6 +18,7 @@
 ;;; sequence-fold-right sequence-fold-right
 ;;; sequence-any sequences-any
 ;;; sequence-every sequences-every
+;;; sequence= sequences=
 
 (define (id x) x)
 
@@ -218,10 +219,25 @@
                 (else #f))))))
 
 
+(define (sequence= elt= s0 s1 . opts)
+  (assert (procedure? elt=))
+  (let-optionals opts ((start0 0) (end0 (sequence-length s0))
+                       (start1 0) (end1 (sequence-length s1)))
+    (and (= (- end0 start0)
+            (- end1 start1))
+         (let loop ((i0 start0) (i1 start1))
+           (cond ((= i0 end0) #t)
+                 ((elt= (sequence-ref s0 i0)
+                        (sequence-ref s1 i1))
+                  (loop (+ i0 1) (+ i1 1)))
+                 (else #f))))))
 
 
-
+(define (sequences= elt= . seqs)
-
+  (assert (procedure? elt=))
-
+  (if (null? seqs) #t
-
+      (let loop ((s (first seqs)) (ss (rest seqs)))
-
+        (cond ((null? ss) #t)
+              ((sequence= elt= s (first ss))
+               (loop (first ss) (rest ss)))
+              (else #f)))))

s48/sequences/interfaces.scm

@@ -23,7 +23,9 @@
           sequence-fold sequences-fold
           sequence-fold-right sequences-fold-right
           sequence-any sequences-any
-          sequence-every sequences-every))
+          sequence-every sequences-every
+          sequence= sequences=
+          ))
 
 ;; specialised sequence operations (for lists, actually)
 (define-interface sequence-specifics-face
@@ -71,11 +73,13 @@
           vector-fold-right
           vector-any
           vector-every
+          vector=
           vectors-map  ; but not vectors-map/maker
           vectors-for-each
           vectors-fold
           vectors-fold-right
           vectors-any
           vectors-every
+          vectors=
           ))
 

s48/sequences/packages.scm

@@ -35,7 +35,7 @@
   (open sequence-basics
         krims                           ; assert
         util                            ; unspecific
-        srfi-1                          ; append!
+        srfi-1+                         ; append! rest
         srfi-23                         ; error
         let-opt                         ; let-optionals [ from scsh ]
         scheme)
@@ -71,12 +71,14 @@
     (define vector-fold-right sequence-fold-right)
     (define vector-any sequence-any)
     (define vector-every sequence-every)
+    (define vector= sequence=)
     (define vectors-map sequences-map)
     (define vectors-for-each sequences-for-each)
     (define vectors-fold sequences-fold)
     (define vectors-fold-right sequences-fold-right)
     (define vectors-any sequences-any)
     (define vectors-every sequences-every)
+    (define vectors= sequences=)
     (define (list->vector xs . opts)
       (let-optionals opts ((start 0) (end (length xs)))
         (assert (<= 0 start end))