diff --git a/s48/sequences/README b/s48/sequences/README index 594e0a1..7e7aa75 100644 --- a/s48/sequences/README +++ b/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 diff --git a/s48/sequences/composeqs.scm b/s48/sequences/composeqs.scm index 43a435a..2a788e2 100644 --- a/s48/sequences/composeqs.scm +++ b/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) + diff --git a/s48/sequences/genseqs.scm b/s48/sequences/genseqs.scm index 59d1b4a..56535a3 100644 --- a/s48/sequences/genseqs.scm +++ b/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))))) diff --git a/s48/sequences/interfaces.scm b/s48/sequences/interfaces.scm index 9f20d07..f9c5ed7 100644 --- a/s48/sequences/interfaces.scm +++ b/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 -;; `VECTOR' replacing `SEQUENCE' ] +;; [ extends the union of SEQUENCE-BASICS- and -EXTRAS-INTERFACE with +;; `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= )) diff --git a/s48/sequences/packages.scm b/s48/sequences/packages.scm index 7c2451e..435b11b 100644 --- a/s48/sequences/packages.scm +++ b/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-every sequence-every) + (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-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)) @@ -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)))))) ))