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

interface changes, examples

This commit is contained in:
Rolf-Thomas Happe 2003-02-16 00:32:31 +00:00
parent c294d73444
commit d662cc90e4
7 changed files with 387 additions and 291 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

382
s48/sequences/README
View File

@ -7,21 +7,24 @@ A sequence library in various structures dealing with
[ for list and string libraries ,open srfi-1 resp. srfi-13 ] [ for list and string libraries ,open srfi-1 resp. srfi-13 ]
The library comes in three structures: The library comes in three structures:
* BEHAVED-SEQUENCES -- basic procedures for abstract sequences * ABSEQUENCES -- basic procedures for abstract sequences, contained in
* SEQUENCE-LIB -- B.S. + procedures for general sequences * SEQUENCE-LIB -- procedures for general (and abstract) sequences
* VECTOR-LIB -- procedures for vectors * VECTOR-LIB -- procedures for vectors
The VECTOR-LIB exports some SCHEME bindings such as VECTOR-REF, but The VECTOR-LIB exports some SCHEME bindings such as VECTOR-REF, redefines
consists mainly of generic sequence code compiled with the basic some SCHEME procedures such as VECTOR-FILL! (to accept optional [start:end)
sequence operation names bound to the corresponding vector procedures. parameters) and consists mainly of generic sequence code compiled with
The library is neither complete nor tweaked. (The idea to recycle parts the basic sequence operation names bound to the corresponding vector
of the srfi-13 code came too late.) It contains the folllowing procedures procedures. The library is neither complete nor tweaked nor tested
(in the categories of srfi-13): 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.
VECTOR-LIB SEQUENCE-LIB BEHAVED-SEQUENCES, also SL
VECTOR-LIB SEQUENCE-LIB ABSEQUENCES, also SL
* Predicates or so * Predicates or so
vector? sequence? behaved-sequence? vector? sequence? absequence?
sequence-type? sequence-behavior?
[ versions with 1 sequence and optional start & end parameters ] [ versions with 1 sequence and optional start & end parameters ]
vector-every sequence-every vector-every sequence-every
vector-any sequence-any vector-any sequence-any
@ -30,317 +33,364 @@ vectors-every sequences-every
vectors-any sequences-any vectors-any sequences-any
* Constructors * Constructors
make-vector make-another-sequence make-behaved-sequence/type make-vector make-another-sequence make-absequence/behavior
vector behaved-sequence/type vector absequence/behavior
make-sequence-type make-sequence-behavior
make-behaved-sequence-record make-absequence-record
* List & Sequence Conversion * List & Sequence Conversion
list->vector list->behaved-sequence/type list->vector list->absequence/behavior
vector->list sequence->list vector->list sequence->list
* Selection * Selection
vector-length sequence-length behaved-sequence-length vector-length sequence-length absequence-length
vector-ref sequence-ref behaved-sequence-ref vector-ref sequence-ref absequence-ref
behaved-sequence:type absequence:behavior
vector-copy sequence-copy vector-copy sequence-copy
subvector subsequence subvector subsequence
* Modification * Modification
vector-set! sequence-set! behaved-sequence-set! vector-set! sequence-set! absequence-set!
sequence-fill! vector-fill! behaved-sequence-fill! sequence-fill! vector-fill! absequence-fill!
* Reverse & Append * Reverse & Append
vector-append sequence-append vector-append sequence-append
* Fold, Unfold & Map * Fold, Unfold & Map
[ versions with 1 sequence and optional start & end parameters ] [ versions with 1 sequence and optional start & end parameters ]
vector-map sequence-map vector-map sequence-map [ SM with optional MAKER ]
vector-for-each sequence-for-each vector-for-each sequence-for-each
vector-fold sequence-fold vector-fold sequence-fold
vector-fold-right sequence-fold-right vector-fold-right sequence-fold-right
[ versions with >1 sequence but no start & end parameters ] [ versions with >1 sequence but no start & end parameters ]
vectors-map sequences-map vectors-map sequences-map
sequences-map/maker
vectors-for-each sequences-for-each vectors-for-each sequences-for-each
vectors-fold sequences-fold vectors-fold sequences-fold
vectors-fold-right sequences-fold-right vectors-fold-right sequences-fold-right
NOTE -- Some procedures take several sequence arguments and create a
new sequence with the concrete type of the first one: SEQUENCE-APPEND
and the SEQUENCES-procedures in the Map etc. category. Problem: the
target sequence may accept only elemens of a particular type (think
of strings and characters). Solution: Provide a vector, say, as first
arg sequence:
(sequence-append "aber" '(1) '#(3 3)) breaks, but
(sequence-append '#() "aber" '(1) '#(3 3)) succeeds.
I concede, that's not totally satisfying. A shallow aftertaste of cat
pee remains in my mouth.
* *
Prelude Prelude
For our purposes, (each valid state of) a sequence with length n maps a For our purposes, (each valid state of) a sequence with length n maps a
bounded segment of integers [0:n) into a set of Scheme values, typically bounded segment of integers [0:n) into a set of Scheme values, typically
Anything or Character. Any kind Se of sequences with elements in T Anything or Character. Any kind Sq of sequences with elements in T
supports the following basic operations: supports the following basic operations, whatever the names, with the
obvious jobs:
maker : make n [x] ==> s maker : (make-sq n [e]) --> s
n in [0:oo), optional x : T, s : Se predicate : (sq? x) --> b
The fresh sequence s represents a sequence of length n (mapping to x) getter : (sq-ref s k) --> s[k]
predicate : x ==> b setter : (sq-set! s k x) --> unspec
x : Anything, b : Boolean meter : (sq-length s) --> n
the type predicate `x in Se'
getter : ref s k ==> s[k]
s in Se, k in [0:n) with n = length s, s[k] in T
setter : set! s k x ==> unspec
s in Se, x in T, k in [0:n) with n = length s
effect: s[k] = x, s[other] as before
meter : length s ==> n
s in ST, n in [0:oo) length of sequence
This sequence facility supports the following kinds of sequences: The following kinds of sequences are supported by this facility:
Vector Vector
Behaved-Sequence := a record type (record packages data + behaviour) Absequence := a record type (record packages data + behaviour)
Sequence := Vector | Byte-Vector | String | Proper-List | Behaved-Sequence Sequence := Vector | Byte-Vector | String | Proper-List | Absequence
Behaved-Sequences carry a SEQUENCE-TYPE record that contains MAKER, Absequences carry a SEQUENCE-BEHAVIOR record that contains MAKER,
PREDICATE, etc. procedures with the properties sketched above. PREDICATE, etc. procedures. They are the official backdoor where
They are the official backdoor where user-defined sequence types enter user-defined sequence types enter the general sequence lib. There are
the general sequence lib. There are Examples. Examples.
[ Wouldn't ABSEQUENCE have been much more beautiful than BEHAVED-SEQUENCE? ]
* *
The Procedures The Procedures
Optional [START END] (abbreviating [START [END]]) arguments default to 0 Optional [START END] (abbreviating [START [END]]) parameters default to 0
resp. the sequence length. resp. the sequence length. An optional MAKER parameter defaults to
the maker of the actual type of the (first) sequence argument.
Sequence arguments of vector and absequence procedures must be vectors
resp. absequences, notwithstanding the generic parameter name S used below.
Sequence arguments of general sequence procedures may have different
actual sequence types, e.g. (SEQUENCE-EVERY CHAR=? "abc" '#(#\a)) is
ok since both String and Vector <= Sequence.
* Predicates * Predicates
(vector? x) ==> b (vector? x) --> b0
(sequence? x) ==> b (sequence? x) --> b1
(behaved-sequence? x) ==> b (absequence? x) --> b2
(sequence-type? x) ==> b (sequence-behavior? x) --> b
Synopsis: The obvious type predicates. Note that behaved-sequences Synopsis: The obvious type predicates. Note that by the type
are sequences and carry a sequence-type with them. Sequence-types inclusions the boolean B0 ==> B1 and B2 ==> B1.
are not sequences but package the behaviour of concrete sequence types.
* *
(vector-every foo? s [start end]) ==> x (vector-every foo? s [start end]) --> x
(sequence-every foo? s [start end]) ==> x (sequence-every foo? s [start end]) --> x
Synopsis: Return the value x of (and (foo? s[start]) ... (foo? s[end-1])). Synopsis: Return the value x of (and (foo? s[start]) ... (foo? s[end-1])).
* *
(vector-any foo? s [start end]) ==> x (vector-any foo? s [start end]) --> x
(sequence-any foo? s [start end]) ==> x (sequence-any foo? s [start end]) --> x
Synopsis: Return the value x of (or (foo? s[start]) ... (foo? s[end-1])). Synopsis: Return the value x of (or (foo? s[start]) ... (foo? s[end-1])).
* *
(vectors-every foo? s0 ...) ==> b (vectors-every foo? s0 s1 ...) --> b
(sequences-every foo? s [start end]) ==> b (sequences-every foo? s0 s1 ...) --> b
Synopsis: Return the value x of (and[0<=i<n] (foo? s0[i] ...)) with Synopsis: Return the value x of (and[0<=i<n] (foo? s0[i] s1[i] ...)) with
n := min.k sequence-length sk. n := min.k sequence-length sk.
* *
(vectors-any foo? s0 ...) ==> b (vectors-any foo? s0 s1 ...) --> b
(sequences-any foo? s [start end]) ==> b (sequences-any foo? s0 s1 ...) --> b
Synopsis: Return the value x of (or[0<=i<n] (foo? s0[i] ...)) with Synopsis: Return the value x of (or[0<=i<n] (foo? s0[i] s1[i] ...)) with
n := min.k sequence-length sk. n := min.k sequence-length sk.
* *
Constructors Constructors
(make-vector len [fill]) ==> v (make-vector len [fill]) --> s
(make-behaved-sequence/type st len [fill]) ==> bs (make-absequence/behavior sb len [fill]) --> s
Synopsis: Make a fresh vector V (behaved-sequence BS with sequence-type Synopsis: Make a fresh vector resp. absequence S (with sequence-behavior
ST) of length LEN (and all elements = FILL). SB) of length LEN (and all elements = FILL).
* *
(vector x0 ...) ==> v (vector x0 ...) --> s
(behaved-sequence/type st x0 ...) ==> bs (absequence/behavior sb x0 ...) --> s
Synopsis: Make a fresh vector V (behaved-sequence BS with sequence-type Synopsis: Make a fresh vector (absequence with sequence-behavior SB)
ST) of minimal length with the elements V[0] = X0, ... (BS[0] = X0, ...). of minimal length with the elements S[0] = X0, ...
* *
(make-sequence-type maker predicate getter setter meter) ==> st (make-sequence-behavior maker predicate getter setter meter) --> sb
Synopsis: Package the concrete sequence behaviour (basic procedures Synopsis: Package the concrete sequence behaviour (basic procedures
described in the prelude) in the sequence-type record ST. listed in the prelude) in the sequence-behavior record SB.
(make-behaved-sequence-record st data) ==> bs (make-absequence-record sb data) --> abs
Synopsis: Package the sequence-type ST and the concrete sequence DATA Synopsis: Package the sequence-behavior SB and the concrete sequence DATA
in the behaved-sequence record BS. in the absequence record ABS.
* *
List & Sequence Conversion List & Sequence Conversion
(list->vector xs [start end]) ==> v (list->vector xs [sbart end]) --> s
(list->behaved-sequence/type st xs [start end]) ==> bs (list->absequence/behavior sb xs [start end]) --> s
Synopsis: Make a new vector V (behaved-sequence BS with sequence-type ST) Synopsis: Make a new vector (absequence with sequence-behavior SB) S
representing the sequence xs[start],..,xs[end-1]. representing the sequence xs[start],..,xs[end-1].
* *
(vector->list v [start end]) ==> xs (vector->list s [start end]) --> xs
(sequence->list s [start end]) ==> xs (sequence->list s [start end]) --> xs
Synopsis: Return xs = (list v[start] ... v[end-1]) etc. Synopsis: Return xs = (list s[start] ... s[end-1]).
* *
(vector-length v) ==> n (vector-length s) --> n
(sequence-length s) ==> n (sequence-length s) --> n
(behaved-sequence-length bs) ==> n (absequence-length s) --> n
Synopsis: Return length N of sequence represented by V : Vector, S : Synopsis: Return length N of vector / sequence / absequence S.
Sequence, BS : Behaved-Sequence. You knew that, didn't you?
* *
(vector-ref v k) ==> v[k] (vector-ref v k) --> v[k]
(sequence-ref s k) ==> s[k] (sequence-ref s k) --> s[k]
(behaved-sequence-ref bs k) ==> bs[k] (absequence-ref abs k) --> abs[k]
* *
(behaved-sequence:type bs) ==> st (absequence:behavior abs) --> sb
Synopsis: Return sequence-type ST for concrete sequence packaged in Synopsis: Return sequence-behavior SB for the concrete sequence
behaved-sequence BS. packaged in absequence ABS.
* *
(vector-copy v0 [start end]) ==> v1 (vector-copy s0 [start end]) --> s1
(sequence-copy s0 [start end]) ==> s1 (sequence-copy s0 [start end]) --> s1
(sequence-copy/maker maker s0 [start end]) -- s1
Synopsis: Copy v0[start],..,v0[end-1] into a new vector v1 of minimal Synopsis: Make new vector resp. sequence (with MAKER)
length. Resp. represent s0[start],...,s0[end-1] as a new sequence S1 of S1 = < s0[start+i] : i in [0:end-start) >.
the same type. [ MAKER intentionally not made third optional arg. ]
* *
(subvector v0 start end) ==> v1 (subvector s0 start end) --> s1
(subsequence s0 start end) ==> s1 (subsequence s0 start end) --> s1
Synopsis: Like xxx-copy with obligatory source index bounds. Synopsis: s1 := (sequence-copy s0 start end)
* *
Modification Modification
(vector-set! v i x) ==> unspec (vector-set! s i x) --> unspec
(sequence-set! s i x) ==> unspec (sequence-set! s i x) --> unspec
(behaved-sequence-set! bs i x) ==> unspec (absequence-set! s i x) --> unspec
Synopsis: Set v[i] := x etc. Synopsis: Set s[i] := x.
* *
(vector-fill! v x [start end]) ==> unspec (vector-fill! s x [start end]) --> unspec
(sequence-fill! s x [start end]]) ==> unspec (sequence-fill! s x [start end]]) --> unspec
(behaved-sequence-fill! bs x [start end]) ==> unspec (absequence-fill! s x [start end]) --> unspec
Synopsis: Set v[i] := x for all i in [start:end) etc. Synopsis: Set s[i] := x for all i in [start:end) etc.
* *
Reverse & Append Reverse & Append
(vector-append v0 ...) ==> v (vector-append s0 ...) --> s
(sequence-append s0 s1 ...) ==> s (sequence-append s0 ...) --> s
Synoposis: Make a new vector V (sequence S of type(S0)) representing Synoposis: Make a new vector resp. sequence S = `s0 o ...'. If there
you know what. See the NOTE above. is no argument, make S a vector, otherwise type(S) = type(S0). [ You
can force the result type by choosing a suitable empty sequence S0.
E.g. (sequence-append (vector) "sloty" '(5 5)) works.
Of course, VECTOR-APPEND always produces vectors from vectors. ]
* *
Fold, Unfold & Map Fold, Unfold & Map
(vector-map f v [start end]) ==> fv (vector-map f s [start end]) --> fs
(vectors-map f v0 ...) ==> fv* (vectors-map f s0 ...) --> fs
(sequence-map f s [start end]) ==> fs (sequence-map f s [start end]) --> fs
(sequences-map f s0 s1 ...) ==> fs* (sequence-map/maker maker f s [start end]) --> fs
(sequences-map f s0 s1 ...) --> fs
(sequences-map/maker maker f s0 s1 ...) --> fs
Synopsis: Make new vector FV (FV*, sequence FS of type(S), FS* of type(S0)) Synopsis: Make new vector / sequence FS representing the sequence
representing the sequence f(v[start]),...,f(v[end-1]), resp. the f(s[start]),...,f(s[end-1]) resp.
sequence (f(v0[i],...) : 0<=i<n) with n = min.k sequence-length sk, etc. (f(s0[i],...) : 0<=i<n) with n = min.k sequence-length sk.
See the NOTE above. Use the MAKER, if supplied, otherwise the maker of the first sequence
arg's concrete type. [ MAKER intentionally not made third optional
arg. ]
* *
(vector-for-each proc v [start end]) ==> unspec (vector-for-each proc s [start end]) --> unspec
(vectors-for-each f v0 ...) ==> unspec (vectors-for-each f s0 s1 ...) --> unspec
(sequence-for-each proc s [start end]) ==> unspec (sequence-for-each proc s [start end]) --> unspec
(sequences-for-each proc v0 ...) ==> unspec (sequences-for-each proc s0 s1 ...) --> unspec
Synopsis: Call (proc v[i]) for all i in [start:end) in some order, resp. Synopsis: Call (proc v[i]) for all i in [start:end) in some order, resp.
call (proc v0[i] ...) for all i in [0:n) in some order with call (proc v0[i] v1[i] ...) for all i in [0:n) in some order with
n = min.k sequence-length vk, etc. n = min.k sequence-length sk.
* *
(vector-fold kons nil v [start end]) ==> w (vector-fold kons nil s [start end]) --> sq
(vectors-fold kons nil v0 ...) ==> w (vectors-fold kons nil s0 s1 ...) --> sq
(sequence-fold kons nil s0 [start end]) ==> s (sequence-fold kons nil s0 [start end]) --> sq
(sequences-fold kons nil s0 ...) ==> s (sequences-fold kons nil s0 s1 ...) --> sq
Synopsis: Let y o x := (kons x y) resp. Synopsis: Let y o x := (kons x y) resp.
y o (x0 ...) := (kons x0 ... y), y o (x0, x1, ...) := (kons x0 ... y),
and let o be left-associative (so that we can spare us the brackets). and let o be left-associative (so that we can spare us the brackets).
Compute Compute
w = nil o v[start] o ... o v[end-1], resp. sq = nil o s[start] o ... o s[end-1], resp.
w = nil o (v0[0] ...) o ... o (v0[n-1] ...) sq = nil o (s0[0],s1[0],...) o ... o (s0[n-1],s1[n-1],...)
with with
n := min.k sequence-length vk; n := min.k sequence-length sk.
etc., and see the NOTE above.
* *
(vector-fold-right kons nil v [start end]) ==> w (vector-fold-right kons nil s [start end]) --> sq
(vectors-fold-right kons nil v0 ...) ==> w (vectors-fold-right kons nil s0 s1 ...) --> sq
(sequence-fold-right kons nil s0 [start end]) ==> s (sequence-fold-right kons nil s [start end]) --> sq
(sequences-fold-right kons nil s0 ...) ==> s (sequences-fold-right kons nil s0 s1 ...) --> sq
Synopsis: Let x o y := (kons x y) resp. Synopsis: Let x o y := (kons x y) resp.
(x0 ...) o y := (kons x0 ... y), (x0,x1,...) o y := (kons x0 ... y),
and let o be right-associative (so that we can spare us the brackets). and let o be right-associative (so that we can spare us the brackets).
Compute Compute
w = v[start] o ... o v[end-1] o nil, resp. sq = s[start] o ... o s[end-1] o nil, resp.
w = (v0[0] ...) o ... o (v0[n-1] ...) o nil sq = (s0[0] ...) o ... o (s0[n-1] ...) o nil
with with
n := min.k sequence-length vk; n := min.k sequence-length sk.
etc., and see the NOTE above.
* *
Examples: forthcoming Examples:
; Demo implementation of partial sequences
; ,open sequence-lib srfi-9 krims
(define-record-type :shaseq
(make-shaseq-record sequence start end)
shaseq?
(sequence shaseq:sequence)
(start shaseq:start)
(end shaseq:end))
(define (share-sequence s start end)
(assert (<= 0 start end (sequence-length s)))
(make-shaseq-record s start end))
(define (displace-index shas k)
(let ((start (shaseq:start shas)))
(+ start k)))
;; maker -- dummyish
(define (make-shaseq len . maybe-fill)
(make-shaseq-record (apply make-vector len maybe-fill)
0 len))
;; getter
(define (shaseq-ref shas k)
(sequence-ref (shaseq:sequence shas)
(displace-index shas k)))
;; setter
(define (shaseq-set! shas k x)
(sequence-set! (shaseq:sequence shas)
(displace-index shas k)
x))
;; meter
(define (shaseq-length shas)
(- (shaseq:end shas)
(shaseq:start shas)))
(define shaseq-behavior
(make-sequence-behavior make-shaseq shaseq?
shaseq-ref shaseq-set!
shaseq-length))
(define a-string (string-copy "brachman foo gratz bladotzky"))
(define an-abs (make-absequence-record shaseq-behavior
(share-sequence a-string 3 11)))
;; prints ``(c h m a n f o)''
(display (sequence-fold-right cons '() an-abs))
;; prints ``>>> chman fo <<<''
(display (sequence-append ">>> " an-abs '#(#\ #\< #\< #\<)))
(sequence-fill! an-abs #\X 4)
;; prints ``brachmaXXXXo gratz bladotzky''
(display a-string)
; EOF
* *
Sela (for now). Sela (for now).

14
s48/sequences/baseqs.scm
View File

@ -10,7 +10,7 @@
(byte-vector? s) (byte-vector? s)
(vector? s) (vector? s)
(list? s) (list? s)
(behaved-sequence? s))) (absequence? s)))
(define (sequence-length s) (define (sequence-length s)
(gen-dispatch (gen-dispatch
@ -18,7 +18,7 @@
(byte-vector? byte-vector-length) (byte-vector? byte-vector-length)
(vector? vector-length) (vector? vector-length)
(list? length) (list? length)
(behaved-sequence? behaved-sequence-length)) (absequence? absequence-length))
s)) s))
@ -28,7 +28,7 @@
(byte-vector? byte-vector-ref) (byte-vector? byte-vector-ref)
(vector? vector-ref) (vector? vector-ref)
(list? list-ref) (list? list-ref)
(behaved-sequence? behaved-sequence-ref)) (absequence? absequence-ref))
s k)) s k))
@ -38,7 +38,7 @@
(byte-vector? byte-vector-set!) (byte-vector? byte-vector-set!)
(vector? vector-set!) (vector? vector-set!)
(list? list-set!) (list? list-set!)
(behaved-sequence? behaved-sequence-set!)) (absequence? absequence-set!))
s k x)) s k x))
@ -49,9 +49,9 @@
(:optional maybe-fill 0))) (:optional maybe-fill 0)))
((vector? s) (apply make-vector len maybe-fill)) ((vector? s) (apply make-vector len maybe-fill))
((list? s) (apply make-list len maybe-fill)) ((list? s) (apply make-list len maybe-fill))
((behaved-sequence? s) ((absequence? s)
(apply make-behaved-sequence/type (apply make-absequence/behavior
(behaved-sequence:type s) len maybe-fill)) (absequence:behavior s) len maybe-fill))
(else (error "make-another-sequence : first arg not a sequence?" (else (error "make-another-sequence : first arg not a sequence?"
s)))) s))))

86
s48/sequences/composeqs.scm
View File

@ -4,26 +4,26 @@
;;; sequence operations definABLE in terms of the elementary operations ;;; sequence operations definABLE in terms of the elementary operations
;;; with no regard to the concrete sequence type ;;; with no regard to the concrete sequence type
(define (ident x) x) (define (sequence->list s . opts)
(cond ((vector? s)
(define (sequence->list s) (apply vector->list s opts))
(gen-dispatch ((string? s)
((string? string->list) (apply string->list s opts))
(byte-vector? contiguous-sequence->list) ((pair? s)
(vector? vector->list) (apply list-copy s opts))
(pair? ident) (else
(behaved-sequence? contiguous-sequence->list)) (apply contiguous-sequence->list s opts))))
s))
(define (sequence-fill! s x) (define (sequence-fill! s x . opts)
(gen-dispatch (cond ((vector? s)
((vector? vector-fill!) (apply vector-fill! s x opts))
(string? string-fill!) ((string? s)
(byte-vector? contiguous-sequence-fill!) (apply string-fill! s x opts))
(pair? ident) ((pair? s)
(behaved-sequence? contiguous-sequence-fill!)) (apply list-fill! s x opts))
s x)) (else
(apply contiguous-sequence-fill! s x opts))))
(define (subsequence s start end) (define (subsequence s start end)
@ -36,21 +36,29 @@
(else (contiguous-subsequence s start end)))) (else (contiguous-subsequence s start end))))
(define (sequence-copy s) (define (sequence-copy s . opts)
(gen-dispatch (cond
((vector? vector-copy) ((vector? s)
(string? string-copy) (apply vector-copy s opts))
(byte-vector? contiguous-sequence-copy) ((string? s)
(pair? list-copy) (apply string-copy s opts))
(behaved-sequence? contiguous-sequence-copy)) ((byte-vector? s)
s)) (apply contiguous-sequence-copy s opts))
((pair? s)
(apply list-copy s opts))
(else
(apply contiguous-sequence-copy s opts))))
(define (sequence-append seq . seqs) (define (sequence-append seq . seqs)
(cond ((vector? seq) (apply vector-append seq seqs)) (cond ((vector? seq)
((string? seq) (apply string-append seq seqs)) (apply vector-append seq seqs))
((pair? seq) (apply append seq seqs)) ((string? seq)
(else (apply contiguous-sequence-append seq seqs)))) (apply string-append seq seqs))
((pair? seq)
(apply append seq seqs))
(else
(apply contiguous-sequence-append seq seqs))))
(define (sequence-map proc s . opts) (define (sequence-map proc s . opts)
@ -60,7 +68,8 @@
(apply string-map proc s opts)) (apply string-map proc s opts))
((and (pair? s) (null? opts)) ((and (pair? s) (null? opts))
(map proc s)) (map proc s))
(else (apply contiguous-sequence-map proc s opts)))) (else
(apply contiguous-sequence-map proc s opts))))
(define (sequence-for-each proc s . opts) (define (sequence-for-each proc s . opts)
@ -70,7 +79,8 @@
(apply string-for-each proc s opts)) (apply string-for-each proc s opts))
((and (pair? s) (null? opts)) ((and (pair? s) (null? opts))
(for-each proc s)) (for-each proc s))
(else (apply contiguous-sequence-for-each proc s opts)))) (else
(apply contiguous-sequence-for-each proc s opts))))
(define (sequence-fold kons nil s . opts) (define (sequence-fold kons nil s . opts)
@ -80,7 +90,8 @@
(apply string-fold kons nil s opts)) (apply string-fold kons nil s opts))
((and (pair? s) (null? opts)) ((and (pair? s) (null? opts))
(fold kons nil s)) (fold kons nil s))
(else (apply contiguous-sequence-fold kons nil s opts)))) (else
(apply contiguous-sequence-fold kons nil s opts))))
(define (sequence-fold-right kons nil s . opts) (define (sequence-fold-right kons nil s . opts)
@ -118,13 +129,12 @@
;; may support mixed sequences: (sequence-append (vector) "abc" '(anton)) ;; may support mixed sequences: (sequence-append (vector) "abc" '(anton))
(define sequence-append contiguous-sequence-append) (define sequence-append contiguous-sequence-append)
(define sequences-map contiguous-sequences-map) (define sequences-map contiguous-sequences-map)
(define sequences-map/maker contiguous-sequences-map/maker)
(define sequences-for-each contiguous-sequences-for-each) (define sequences-for-each contiguous-sequences-for-each)
(define sequences-fold contiguous-sequences-fold) (define sequences-fold contiguous-sequences-fold)
(define sequences-fold-right contiguous-sequences-fold-right) (define sequences-fold-right contiguous-sequences-fold-right)
(define sequences-any contiguous-sequences-any) (define sequences-any contiguous-sequences-any)
(define sequences-every contiguous-sequences-every) (define sequences-every contiguous-sequences-every)
;; the MAKER parameter works only with general sequences
(define sequence-copy/maker contiguous-sequence-copy/maker)
(define sequence-map/maker contiguous-sequence-map/maker)

78
s48/sequences/genseqs.scm
View File

@ -12,7 +12,7 @@
;;; subsequence ;;; subsequence
;;; sequence-copy ;;; sequence-copy
;;; sequence-append ;;; sequence-append
;;; sequence-map sequences-map ;;; sequence-map sequences-map sequences-map/maker
;;; sequence-for-each sequences-for-each ;;; sequence-for-each sequences-for-each
;;; sequence-fold sequences-fold ;;; sequence-fold sequences-fold
;;; sequence-fold-right sequence-fold-right ;;; sequence-fold-right sequence-fold-right
@ -21,6 +21,13 @@
(define (id x) x) (define (id x) x)
;; seqs : nonempty proper list of sequences
;; compute min sequence-length
(define (sequences-length seqs)
;; we got the time, we got the space ...
(apply min (map sequence-length seqs)))
(define (sequence->list s . opts) (define (sequence->list s . opts)
(let-optionals opts ((start 0) (end (sequence-length s))) (let-optionals opts ((start 0) (end (sequence-length s)))
(assert (<= 0 start end)) (assert (<= 0 start end))
@ -32,26 +39,33 @@
(define (sequence-fill! s x . opts) (define (sequence-fill! s x . opts)
(let-optionals opts ((start 0) (end (sequence-length s))) (let-optionals opts ((start 0) (end (sequence-length s)))
(assert (<= 0 start end)) (assert (<= 0 start end))
(let loop ((i 0)) (let loop ((i start))
(if (< i end) (if (< i end)
(begin (begin
(sequence-set! s i x) (sequence-set! s i x)
(loop (+ i 1))))))) (loop (+ i 1)))))))
(define (subsequence s start end) (define (sequence-copy/maker maker s . opts)
(assert (<= 0 start end)) (let-optionals opts ((start 0)
(let* ((len (- end start)) (end (sequence-length s)))
(ss (make-another-sequence s len))) (assert (<= 0 start end))
(do ((i 0 (+ i 1))) (let* ((len (- end start))
((= i len) ss) (ss (maker len)))
(sequence-set! ss i (sequence-ref s (+ start i)))))) (do ((i 0 (+ i 1)))
((= i len) ss)
(sequence-set! ss i (sequence-ref s (+ start i)))))))
(define (sequence-copy s . opts) (define (sequence-copy s . opts)
(let-optionals opts ((start 0) (end (sequence-length s))) (apply sequence-copy/maker
(assert (<= 0 start end)) (lambda (n) (make-another-sequence s n))
(subsequence s start end))) s opts))
;; ...
(define (subsequence s start end)
(sequence-copy s start end))
(define (sequence-fold kons nil s . opts) (define (sequence-fold kons nil s . opts)
@ -68,7 +82,7 @@
(sequence-fold kons nil seq) (sequence-fold kons nil seq)
(let* ((ss (cons seq seqs)) (let* ((ss (cons seq seqs))
;; are we morally obliged to use FOLD here? ;; are we morally obliged to use FOLD here?
(end (apply min (map sequence-length ss)))) (end (sequences-length ss)))
(let loop ((subtotal nil) (i 0)) (let loop ((subtotal nil) (i 0))
(if (= i end) subtotal (if (= i end) subtotal
(loop (apply kons (append! (map (lambda (s) (loop (apply kons (append! (map (lambda (s)
@ -92,7 +106,7 @@
(sequence-fold-right kons nil seq) (sequence-fold-right kons nil seq)
(let* ((ss (cons seq seqs)) (let* ((ss (cons seq seqs))
;; are we morally obliged to use FOLD here? ;; are we morally obliged to use FOLD here?
(end (apply min (map sequence-length ss)))) (end (sequences-length ss)))
(let loop ((subtotal nil) (i (- end 1))) (let loop ((subtotal nil) (i (- end 1)))
(if (= i -1) subtotal (if (= i -1) subtotal
(loop (apply kons (append! (map (lambda (s) (loop (apply kons (append! (map (lambda (s)
@ -125,30 +139,44 @@
(define (sequences-for-each proc seq . seqs) (define (sequences-for-each proc seq . seqs)
(let* ((ss (cons seq seqs)) (let* ((ss (cons seq seqs))
(end (apply min (map sequence-length ss)))) (end (sequences-length ss)))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((= i end) (unspecific)) ((= i end) (unspecific))
(apply proc (map (lambda (s) (sequence-ref s i)) ss))))) (apply proc (map (lambda (s) (sequence-ref s i)) ss)))))
(define (sequence-map proc seq . opts) (define (sequence-map/maker maker proc seq . opts)
(let-optionals opts ((start 0) (end (sequence-length seq))) (let-optionals opts ((start 0)
(assert (<= start end)) (end (sequence-length seq)))
(let ((res (make-another-sequence seq end))) (assert (<= 0 start end))
(let ((res (maker (- end start))))
(do ((i start (+ i 1))) (do ((i start (+ i 1)))
((= i end) res) ((= i end) res)
(sequence-set! res i (proc (sequence-ref seq i))))))) (sequence-set! res (- i start)
(proc (sequence-ref seq i)))))))
(define (sequences-map proc seq . seqs) (define (sequence-map proc seq . opts)
(apply sequences-map/maker
(lambda (n) (make-another-sequence seq n))
seq opts))
(define (sequences-map/maker maker proc seq . seqs)
(let* ((ss (cons seq seqs)) (let* ((ss (cons seq seqs))
(end (apply min (map sequence-length ss))) (end (sequences-length ss))
(res (make-another-sequence seq end))) (res (maker end)))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((= i end) res) ((= i end) res)
(sequence-set! res i (apply proc (map (lambda (s) (sequence-ref s i)) (sequence-set! res i (apply proc (map (lambda (s) (sequence-ref s i))
ss)))))) ss))))))
(define (sequences-map proc seq . seqs)
(apply sequences-map/maker (lambda (n) (make-another-sequence seq n))
proc seq seqs))
(define (sequence-any foo? seq . opts) (define (sequence-any foo? seq . opts)
(let-optionals opts ((start 0) (end (sequence-length seq))) (let-optionals opts ((start 0) (end (sequence-length seq)))
(assert (<= 0 start end)) (assert (<= 0 start end))
@ -160,7 +188,7 @@
(define (sequences-any foo? . seqs) (define (sequences-any foo? . seqs)
(if (null? seqs) #f (if (null? seqs) #f
(let ((end (apply min (map sequence-length seqs)))) (let ((end (sequences-length seqs)))
(let loop ((i 0)) (let loop ((i 0))
(cond ((= i end) #f) (cond ((= i end) #f)
((apply foo? (map (lambda (seq) (sequence-ref seq i)) ((apply foo? (map (lambda (seq) (sequence-ref seq i))
@ -181,7 +209,7 @@
(define (sequences-every foo? . seqs) (define (sequences-every foo? . seqs)
(if (null? seqs) #t (if (null? seqs) #t
(let ((end (apply min (map sequence-length seqs)))) (let ((end (sequences-length seqs)))
(let loop ((i 0)) (let loop ((i 0))
(cond ((= i end) #t) (cond ((= i end) #t)
((apply foo? (map (lambda (seq) (sequence-ref seq i)) ((apply foo? (map (lambda (seq) (sequence-ref seq i))

30
s48/sequences/interfaces.scm
View File

@ -15,8 +15,10 @@
sequence-fill! sequence-fill!
subsequence subsequence
sequence-copy sequence-copy
sequence-copy/maker
sequence-append sequence-append
sequence-map sequences-map sequence-map sequences-map
sequence-map/maker sequences-map/maker
sequence-for-each sequences-for-each sequence-for-each sequences-for-each
sequence-fold sequences-fold sequence-fold sequences-fold
sequence-fold-right sequences-fold-right sequence-fold-right sequences-fold-right
@ -31,18 +33,18 @@
)) ))
;; the sequence ADT etc. ;; the sequence ADT etc.
(define-interface behaved-sequences-face (define-interface absequences-face
(export make-sequence-type (export make-sequence-behavior
sequence-type? sequence-behavior?
make-behaved-sequence-record make-absequence-record
behaved-sequence:type absequence:behavior
make-behaved-sequence/type make-absequence/behavior
behaved-sequence/type absequence/behavior
list->behaved-sequence/type list->absequence/behavior
behaved-sequence? absequence?
behaved-sequence-ref absequence-ref
behaved-sequence-set! absequence-set!
behaved-sequence-length)) absequence-length))
;; the basic + extra sequence procedures ;; 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
@ -63,13 +65,13 @@
subvector subvector
vector-copy vector-copy
vector-append vector-append
vector-map vector-map ; forget the optional MAKER arg
vector-for-each vector-for-each
vector-fold vector-fold
vector-fold-right vector-fold-right
vector-any vector-any
vector-every vector-every
vectors-map vectors-map ; but not vectors-map/maker
vectors-for-each vectors-for-each
vectors-fold vectors-fold
vectors-fold-right vectors-fold-right

15
s48/sequences/packages.scm
View File

@ -4,8 +4,8 @@
;;; refers to structure KRIMS from sunterlib/s48/krims ;;; refers to structure KRIMS from sunterlib/s48/krims
;; sequences as data + behaviour ;; sequences as data + behaviour
(define-structure behaved-sequences behaved-sequences-face (define-structure absequences absequences-face
(open srfi-9 ; define-record-type (open srfi-9+ ; define-record-type -discloser
krims ; assert krims ; assert
let-opt ; let-optionals [ from scsh ] let-opt ; let-optionals [ from scsh ]
scheme) scheme)
@ -23,7 +23,7 @@
(open krims ; gen-dispatch (open krims ; gen-dispatch
let-opt ; :optional [ from scsh ] let-opt ; :optional [ from scsh ]
sequence-specifics ; list-set! make-list sequence-specifics ; list-set! make-list
behaved-sequences absequences
byte-vectors byte-vectors
srfi-1 ; make-list srfi-1 ; make-list
srfi-23 ; error srfi-23 ; error
@ -93,16 +93,15 @@
;; code (notably for lists) ;; code (notably for lists)
(define-structure sequence-lib (compound-interface sequence-basics-face (define-structure sequence-lib (compound-interface sequence-basics-face
sequence-extras-face sequence-extras-face
behaved-sequences-face) absequences-face)
(open krims ; gen-dispatch (open (with-prefix sequence-extras contiguous-)
(with-prefix sequence-extras contiguous-)
sequence-basics sequence-basics
behaved-sequences absequences
sequence-specifics sequence-specifics
byte-vectors
vector-lib vector-lib
srfi-1 ; list procs srfi-1 ; list procs
srfi-13 ; string procs srfi-13 ; string procs
byte-vectors
let-opt ; let-optionals [ from scsh ] let-opt ; let-optionals [ from scsh ]
scheme) scheme)
(files composeqs)) (files composeqs))

73
s48/sequences/uniseqs.scm
View File

@ -10,51 +10,58 @@
;; getter : S integer --> any -- like VECTOR-REF ;; getter : S integer --> any -- like VECTOR-REF
;; setter : S integer any --> unspecified -- like VECTOR-SET! ;; setter : S integer any --> unspecified -- like VECTOR-SET!
;; meter : S --> integer -- like VECTOR-LENGTH ;; meter : S --> integer -- like VECTOR-LENGTH
(define-record-type :sequence-type (define-record-type :sequence-behavior
(make-sequence-type maker predicate getter setter meter) (make-sequence-behavior maker predicate getter setter meter)
sequence-type? sequence-behavior?
(maker sequence-type:maker) (maker sequence-behavior:maker)
(predicate sequence-type:predicate) (predicate sequence-behavior:predicate)
(getter sequence-type:getter) (getter sequence-behavior:getter)
(setter sequence-type:setter) (setter sequence-behavior:setter)
(meter sequence-type:meter)) (meter sequence-behavior:meter))
;; underlying sequence data + behavioural sequence type ;; underlying sequence data + behavioral sequence type
(define-record-type :behaved-sequence (define-record-type :absequence
;; avoiding the make-behaved-sequence namning pattern for good reason ;; avoiding the make-absequence namning pattern for good reason
(make-behaved-sequence-record type instance) (make-absequence-record behavior data)
behaved-sequence? absequence?
(type behaved-sequence:type) (behavior absequence:behavior)
(instance behaved-sequence:instance)) (data absequence:data))
(define (behaved-sequence-ref s k) (define (absequence-ref s k)
((sequence-type:getter (behaved-sequence:type s)) ((sequence-behavior:getter (absequence:behavior s))
(behaved-sequence:instance s) k)) (absequence:data s) k))
(define (behaved-sequence-set! s k x) (define (absequence-set! s k x)
((sequence-type:setter (behaved-sequence:type s)) ((sequence-behavior:setter (absequence:behavior s))
(behaved-sequence:instance s) k x)) (absequence:data s) k x))
(define (behaved-sequence-length s) (define (absequence-length s)
((sequence-type:meter (behaved-sequence:type s)) ((sequence-behavior:meter (absequence:behavior s))
(behaved-sequence:instance s))) (absequence:data s)))
(define (make-behaved-sequence/type st k . maybe-fill) (define (make-absequence/behavior sb k . maybe-fill)
(make-behaved-sequence-record st (make-absequence-record sb
(apply (sequence-type:maker st) (apply (sequence-behavior:maker sb)
k maybe-fill))) k maybe-fill)))
(define (list->behaved-sequence/type st xs . opts) (define (list->absequence/behavior sb xs . opts)
(let-optionals opts ((start 0) (end (length xs))) (let-optionals opts ((start 0) (end (length xs)))
(assert (<= 0 start end)) (assert (<= 0 start end))
(let ((s (make-behaved-sequence/type st (- end start)))) (let ((s (make-absequence/behavior sb (- end start))))
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
(xs xs (cdr xs))) (xs xs (cdr xs)))
((= i end) s) ((= i end) s)
(behaved-sequence-set! s (- i start) (car xs)))))) (absequence-set! s (- i start) (car xs))))))
(define (behaved-sequence/type st . args)
(list->behaved-sequence/type st args))
(define (absequence/behavior sb . args)
(list->absequence/behavior sb args))
(define-record-discloser :absequence
(lambda (r)
(let ((sq (absequence:data r)))
(if (or (vector? sq)
(string? sq)
(pair? sq))
`(absequence:data ,sq)
`(absequence)))))