scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

sequence= etc.

This commit is contained in:
Rolf-Thomas Happe 2003-03-13 18:38:28 +00:00
parent 7e87daaa4d
commit 85539d1d46
5 changed files with 76 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
s48/sequences/README
View File

@ -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

5
s48/sequences/composeqs.scm
View File

@ -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)

46
s48/sequences/genseqs.scm
View File

@ -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)))))

12
s48/sequences/interfaces.scm
View File

@ -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=
))

16
s48/sequences/packages.scm
View File

@ -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))))))
))