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

@@ -24,7 +24,7 @@
          (apply list-fill! s x opts))
         (else
          (apply contiguous-sequence-fill! s x opts))))
-   
+
 
 (define (subsequence s start end)
   (cond ((vector? s)
@@ -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

@@ -2,11 +2,11 @@
 ; See the file COPYING distributed with the Scheme Untergrund Library
 
 ;;; generic sequence procedures -- no explicit dispatch on sequence type
-;;; 
+;;;
-;;; The code should work with the names of the elementary sequence 
+;;; The code should work with the names of the elementary sequence
 ;;; operations bound to the umbrella procedures that dispatch on the
 ;;; sequence type, or to the specific procedures of a particular type,
-;;; 
+;;;
 ;;; sequence->list
 ;;; sequence-fill!
 ;;; subsequence
@@ -18,6 +18,7 @@
 ;;; sequence-fold-right sequence-fold-right
 ;;; sequence-any sequences-any
 ;;; sequence-every sequences-every
+;;; sequence= sequences=
 
 (define (id x) x)
 
@@ -41,10 +42,10 @@
     (assert (<= 0 start end))
     (let loop ((i start))
       (if (< i end)
-          (begin 
+          (begin
             (sequence-set! s i x)
             (loop (+ i 1)))))))
-        
+
 
 (define (sequence-copy/maker maker s . opts)
   (let-optionals opts ((start 0)
@@ -61,7 +62,7 @@
   (apply sequence-copy/maker
          (lambda (n) (make-another-sequence s n))
          s opts))
-  
+
 
 ;; ...
 (define (subsequence s start end)
@@ -90,8 +91,8 @@
                                               ss)
                                          (list subtotal)))
                     (+ i 1)))))))
-                                         
+
-                           
+
 (define (sequence-fold-right kons nil s . opts)
   (let-optionals opts ((start 0)
                  (end (sequence-length s)))
@@ -186,7 +187,7 @@
             (else (loop (+ i 1)))))))
 
 
-(define (sequences-any foo? . seqs) 
+(define (sequences-any foo? . seqs)
   (if (null? seqs) #f
       (let ((end (sequences-length seqs)))
         (let loop ((i 0))
@@ -207,7 +208,7 @@
             (else #f)))))
 
 
-(define (sequences-every foo? . seqs) 
+(define (sequences-every foo? . seqs)
   (if (null? seqs) #t
       (let ((end (sequences-length seqs)))
         (let loop ((i 0))
@@ -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
@@ -47,8 +49,8 @@
           absequence-length))
 
 ;; the basic + extra sequence procedures
-;; [ extends the union of SEQUENCE-BASICS- and -EXTRAS-INTERFACE with 
+;; [ extends the union of SEQUENCE-BASICS- and -EXTRAS-INTERFACE with
-;;   `VECTOR' replacing `SEQUENCE' ] 
+;;   `VECTOR' replacing `SEQUENCE' ]
 (define-interface vector-lib-face
   (export ;; std constructors
           vector
@@ -65,17 +67,19 @@
           subvector
           vector-copy
           vector-append
-          vector-map   ; forget the optional MAKER arg 
+          vector-map   ; forget the optional MAKER arg
           vector-for-each
           vector-fold
           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

@@ -17,7 +17,7 @@
         srfi-13                         ; string procs
         scheme)
   (files specseqs))
-        
+
 ;; basic sequence accessors etc.
 (define-structure sequence-basics sequence-basics-face
   (open krims                           ; gen-dispatch
@@ -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)
@@ -69,14 +69,16 @@
     (define vector-for-each sequence-for-each)
     (define vector-fold sequence-fold)
     (define vector-fold-right sequence-fold-right)
-    (define vector-any sequence-any) 
+    (define vector-any sequence-any)
-    (define vector-every sequence-every) 
+    (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-any sequences-any)
-    (define vectors-every sequences-every) 
+    (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))
@@ -84,7 +86,7 @@
           (do ((i start (+ i 1))
                (ys xs (rest ys)))
               ((= i end) v)
-            (vector-set! v (- i start) (first ys))))))             
+            (vector-set! v (- i start) (first ys))))))
     ))