summaryrefslogtreecommitdiffstats
path: root/ps02_generics
diff options
context:
space:
mode:
authorbnewbold <bnewbold@eta.mit.edu>2009-02-11 14:31:28 -0500
committerbnewbold <bnewbold@eta.mit.edu>2009-02-11 14:31:28 -0500
commit8e998f4e5be326a2bc91220e86d555ce79d2890e (patch)
tree6d9ac0090ed8c1f2648934ee8a79b6d6bf01c4fc /ps02_generics
parent2b7db5b23df55e3a1ac0639494bea750d0797c9d (diff)
download6.945-8e998f4e5be326a2bc91220e86d555ce79d2890e.tar.gz
6.945-8e998f4e5be326a2bc91220e86d555ce79d2890e.zip
ps02 files
Diffstat (limited to 'ps02_generics')
-rw-r--r--ps02_generics/generic-sequences.scm114
-rw-r--r--ps02_generics/generic-specs.scm121
-rw-r--r--ps02_generics/ghelper.scm84
-rw-r--r--ps02_generics/ps.txt593
4 files changed, 912 insertions, 0 deletions
diff --git a/ps02_generics/generic-sequences.scm b/ps02_generics/generic-sequences.scm
new file mode 100644
index 0000000..5e426cf
--- /dev/null
+++ b/ps02_generics/generic-sequences.scm
@@ -0,0 +1,114 @@
+;;;; Generic sequence operator definitions
+
+;;; First we declare the operators we want to be generic.
+;;; Each declaration specifies the arity (number of arguments)
+;;; and the default operation, if necessary.
+
+(define sequence:null
+ (make-generic-operator 1 #f))
+
+
+(define sequence:ref
+ (make-generic-operator 2 #f))
+
+(define sequence:size
+ (make-generic-operator 1 #f))
+
+(define sequence:type
+ (make-generic-operator 1 #f))
+
+(define sequence:null?
+ (make-generic-operator 1 #f))
+
+(define sequence:equal?
+ (make-generic-operator 2 #f))
+
+(define sequence:set!
+ (make-generic-operator 3 #f))
+
+(define sequence:subsequence
+ (make-generic-operator 3 #f))
+
+
+;;; sequence:append takes multiple arguments. It is defined in terms
+;;; of a binary generic append that takes a sequence and a list of sequences.
+
+(define (sequence:append . sequences)
+ (if (null? sequences)
+ (error "Need at least one sequence for append"))
+ (let ((type? (sequence:type (car sequences))))
+ (if (not (for-all? (cdr sequences) type?))
+ (error "All sequences for append must be of the same type"
+ sequences))
+ (fold-right generic:binary-append
+ (sequence:null (sequence:type (car sequences)))
+ sequences)))
+
+(define generic:binary-append (make-generic-operator 2 #f))
+
+;;; Implementations of the generic operators.
+
+(define (any? x) #t)
+(define (constant val) (lambda (x) val))
+(define (is-exactly val) (lambda (x) (eq? x val)))
+
+(assign-operation sequence:null (constant "") (is-exactly string?))
+(assign-operation sequence:null (constant '()) (is-exactly list?))
+(assign-operation sequence:null (constant #()) (is-exactly vector?))
+
+(assign-operation sequence:ref string-ref string? exact-integer?)
+(assign-operation sequence:ref list-ref list? exact-integer?)
+(assign-operation sequence:ref vector-ref vector? exact-integer?)
+
+(assign-operation sequence:size string-length string?)
+(assign-operation sequence:size length list?)
+(assign-operation sequence:size vector-length vector?)
+
+(assign-operation sequence:type (constant string?) string?)
+(assign-operation sequence:type (constant list?) list?)
+(assign-operation sequence:type (constant vector?) vector?)
+
+
+(define (vector-null? v) (= (vector-length v) 0))
+
+(assign-operation sequence:null? string-null? string?)
+(assign-operation sequence:null? null? list?)
+(assign-operation sequence:null? vector-null? vector?)
+
+
+;;; To assign to the ith element of a list:
+
+(define (list-set! list i val)
+ (cond ((null? list)
+ (error "List does not have enough elements" i))
+ ((= i 0) (set-car! list val))
+ (else (list-set! (cdr list) (- i 1) val))))
+
+(assign-operation sequence:set! string-set! string? exact-integer? any?)
+(assign-operation sequence:set! list-set! list? exact-integer? any?)
+(assign-operation sequence:set! vector-set! vector? exact-integer? any?)
+
+
+(assign-operation sequence:subsequence
+ substring
+ string? exact-integer? exact-integer?)
+(assign-operation sequence:subsequence
+ sublist
+ list? exact-integer? exact-integer?)
+(assign-operation sequence:subsequence
+ subvector
+ vector? exact-integer? exact-integer?)
+
+
+(define (vector-append v1 v2)
+ (let ((n1 (vector-length v1))
+ (n2 (vector-length v2)))
+ (make-initialized-vector (+ n1 n2)
+ (lambda (i)
+ (if (< i n1)
+ (vector-ref v1 i)
+ (vector-ref v2 (- i n1)))))))
+
+(assign-operation generic:binary-append string-append string? string?)
+(assign-operation generic:binary-append append list? list?)
+(assign-operation generic:binary-append vector-append vector? vector?)
diff --git a/ps02_generics/generic-specs.scm b/ps02_generics/generic-specs.scm
new file mode 100644
index 0000000..ad07d96
--- /dev/null
+++ b/ps02_generics/generic-specs.scm
@@ -0,0 +1,121 @@
+;;;; Generic sequence operations
+
+;;; There are many kinds of data that can be used to represent sequences:
+;;; examples include strings, lists, and vectors.
+
+;;; There are operations that can be defined for all sequence types.
+
+;;; Constructing
+;;;
+;;; (sequence:construct <sequence-type> <item-1> ... <item-n>)
+;;; Constructs a new sequence of the given type and of size n with
+;;; the given elements: item-1 ... item-n
+
+;;; (sequence:null <sequence-type>)
+;;; Produces the null sequence of the given type
+
+
+;;; Selecting
+;;;
+;;; (sequence:ref <sequence> <i>)
+;;; Returns the ith element of the sequence. We use zero-based
+;;; indexing, so for a sequence of length n the ith item is
+;;; referenced by (sequence:ref <sequence> <i-1>).
+
+;;; (sequence:size <sequence>)
+;;; Returns the number of elements in the sequence.
+
+;;; (sequence:type <sequence>)
+;;; Returns the predicate defining the type of the sequence given.
+
+
+;;; Testing
+;;;
+;;; (sequence:null? <sequence>)
+;;; Returns #t if the sequence is null, otherwise returns #f.
+
+;;; (sequence:equal? <sequence-1> <sequence-2>)
+;;; Returns #t if the sequences are of the same type and have equal
+;;; elements in the same order, otherwise returns #f.
+
+
+;;; Mutation
+;;;
+;;; Some sequences are immutable, while others can be changed.
+;;;
+;;; For those that can be modified we can change an element:
+;;;
+;;; (sequence:set! <sequence> <i> <v>)
+;;; Sets the ith element of the sequence to v.
+
+;;; Cutting and Pasting
+;;;
+;;; (sequence:subsequence <sequence> <start> <end>)
+;;; The arguments start and end must be exact integers such that
+;;; 0 <= start <= end <= (sequence:size <sequence>).
+;;; Returns a new sequence of the same type as the given sequence,
+;;; of size end-start with elements selected from the given sequence.
+;;; The new sequence starts with the element of the given sequence
+;;; referenced by start. It ends with the element of the given
+;;; sequence referenced by end-1.
+
+;;; (sequence:append <sequence-1> ... <sequence-n>)
+;;; Requires that the sequences are all of the same type. Returns
+;;; a new sequence of the type, formed by concatenating the
+;;; elements of the given sequences. The size of the new sequence
+;;; is the sum of the sizes of the given sequences.
+
+;;; Iterators
+;;;
+;;; (sequence:generate <sequence-type> <n> <function>)
+;;; Makes a new sequence of the given sequence type, of size n.
+;;; The ith element of the new sequence is the value of the
+;;; function at the index i.
+
+;;; (sequence:map <function> <seq-1> ... <seq-n>)
+;;; Requires that the sequences given are of the same size and
+;;; type, and that the arity of the function is n. The ith element
+;;; of the new sequence is the value of the function applied to the
+;;; n ith elements of the given sequences.
+
+;;; (sequence:for-each <procedure> <seq-1> ... <seq-n>)
+;;; Requires that the sequences given are of the same size and
+;;; type, and that the arity of the procedure is n. Applies the
+;;; procedure to the n ith elements of the given sequences;
+;;; discards the value. This is done for effect.
+
+;;; Filtration and Search
+;;;
+;;; (sequence:filter <sequence> <predicate>)
+;;; Returns a new sequence with exactly those elements of the given
+;;; sequence for which the predicate is true (does not return #f).
+;;;
+;;; (sequence:get-index <sequence> <predicate>)
+;;; Returns the index of the first element of the sequence that
+;;; satisfies the predicate. Returns #f if no element of the
+;;; sequence satisfies the predicate.
+;;;
+;;; (sequence:get-element <sequence> <predicate>)
+;;; Returns the first element of the sequence that satisfies the
+;;; predicate. Returns #f if no element of the sequence satisfies
+;;; the predicate.
+
+;;; Accumulation
+;;;
+;;; (sequence:fold-right <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; from the right, starting with the initial value.
+;;; For example,
+;;; (sequence:fold-right list 'end '(a b c))
+;;; => (a (b (c end)))
+
+;;;
+;;; (sequence:fold-left <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; starting with the initial value, from the left.
+;;; For example,
+;;; (sequence:fold-left list 'start '(a b c))
+;;; => (((start a) b) c)
+
+
+
diff --git a/ps02_generics/ghelper.scm b/ps02_generics/ghelper.scm
new file mode 100644
index 0000000..c6a7f85
--- /dev/null
+++ b/ps02_generics/ghelper.scm
@@ -0,0 +1,84 @@
+;;;; Most General Generic-Operator Dispatch
+
+(declare (usual-integrations))
+
+;;; Generic-operator dispatch is implemented here by a discrimination
+;;; list, where the arguments passed to the operator are examined by
+;;; predicates that are supplied at the point of attachment of a
+;;; handler (by ASSIGN-OPERATION).
+
+;;; To be the correct branch all arguments must be accepted by
+;;; the branch predicates, so this makes it necessary to
+;;; backtrack to find another branch where the first argument
+;;; is accepted if the second argument is rejected. Here
+;;; backtracking is implemented by OR.
+
+(define (make-generic-operator arity default-operation)
+ (let ((record (make-operator-record arity)))
+
+ (define (operator . arguments)
+ (if (not (= (length arguments) arity))
+ (error:wrong-number-of-arguments operator arity arguments))
+ (apply (or (let per-arg
+ ((tree (operator-record-tree record))
+ (args arguments))
+ (let per-pred ((tree tree))
+ (and (pair? tree)
+ (if ((caar tree) (car args))
+ (if (pair? (cdr args))
+ (or (per-arg (cdar tree) (cdr args))
+ (per-pred (cdr tree)))
+ (cdar tree))
+ (per-pred (cdr tree))))))
+ default-operation
+ (error:no-applicable-methods operator arguments))
+ arguments))
+
+ (hash-table/put! *generic-operator-table* operator record)
+ operator))
+
+(define *generic-operator-table*
+ (make-eq-hash-table))
+
+(define (make-operator-record arity) (cons arity '()))
+(define (operator-record-arity record) (car record))
+(define (operator-record-tree record) (cdr record))
+(define (set-operator-record-tree! record tree) (set-cdr! record tree))
+
+(define (assign-operation operator handler . argument-predicates)
+ (let ((record
+ (let ((record (hash-table/get *generic-operator-table* operator #f))
+ (arity (length argument-predicates)))
+ (if record
+ (begin
+ (if (not (= arity (operator-record-arity record)))
+ (error "Incorrect operator arity:" operator))
+ record)
+ (let ((record (make-operator-record arity)))
+ (hash-table/put! *generic-operator-table* operator record)
+ record)))))
+ (set-operator-record-tree! record
+ (bind-in-tree argument-predicates
+ handler
+ (operator-record-tree record))))
+ operator)
+
+(define (bind-in-tree keys handler tree)
+ (let loop ((keys keys) (tree tree))
+ (let ((p.v (assq (car keys) tree)))
+ (if (pair? (cdr keys))
+ (if p.v
+ (begin
+ (set-cdr! p.v
+ (loop (cdr keys) (cdr p.v)))
+ tree)
+ (cons (cons (car keys)
+ (loop (cdr keys) '()))
+ tree))
+ (if p.v
+ (begin
+ (warn "Replacing a handler:" (cdr p.v) handler)
+ (set-cdr! p.v handler)
+ tree)
+ (cons (cons (car keys) handler)
+ tree))))))
diff --git a/ps02_generics/ps.txt b/ps02_generics/ps.txt
new file mode 100644
index 0000000..82dfa2a
--- /dev/null
+++ b/ps02_generics/ps.txt
@@ -0,0 +1,593 @@
+
+ MASSACHVSETTS INSTITVTE OF TECHNOLOGY
+ Department of Electrical Engineering and Computer Science
+
+ 6.945 Spring 2009
+ Problem Set 2
+
+ Issued: Wed. 11 Feb. 2009 Due: Wed. 18 Feb. 2009
+
+Reading:
+ SICP sections 2.4 and 2.5
+ (Tagged data, Data-directed programming, Generic Operations)
+
+ If you are really interested in generic dispatch see the paper
+ by Ernst, et al. Do not obsess over the formal semantics, what
+ is really interesting here is the way predicate dispatch can be
+ used to subsume other kinds of dispatch.
+http://pag.csail.mit.edu/~mernst/pubs/dispatching-ecoop98-abstract.html
+
+Code: ghelper.scm, generic-specs.scm, generic-sequences.scm, attached.
+
+Documentation:
+ The MIT/GNU Scheme documentation
+ online at http://www.gnu.org/software/mit-scheme/
+
+
+ Generic Operations
+
+In this problem set we will explore a variety of methods we can use for
+implementing and exploiting generic operations.
+
+The procedures in the file ghelper.scm are an elegant mechanism for
+implementing generic-operator dispatch, where the handlers for the
+generic operators are specified by the predicates that the arguments
+satisfy.
+
+The file generic-specs.scm is an informal programmer's specification
+of generic operations that can be defined over a variety of ordered
+linear data structures, such as lists, vectors, and strings.
+
+The file, generic-sequences.scm is a beginning implementation of the
+generic operators specified in generic-specs.scm.
+
+-------------
+Problem 2.1:
+
+Complete the implementation started in generic-sequences.scm to match
+the specifications in generic-specs.scm. Demonstrate that each of
+your generic operators works as specified, by showing examples. You
+should insert your tests as comments in the code you hand in.
+
+Notice that the types in the underlying Scheme are not uniformly
+specified, so this is not entirely trivial: in our seed file, for
+example, we had to define vector-null?, list-set!, and vector-append
+just to fill out things a bit.
+-------------
+
+Operations like sequence:append can be extended to allow the
+combination of unlike sequences. For example, we might expect to be
+able to write
+
+ (sequence:append (list 'a 'b 'c) (vector 'd 'e 'f))
+
+and get back the list (a b c d e f), assuming that we want a sequence
+of the first argument type to be the sequence type of the result.
+
+One way to implement this sort of thing is to write specific handlers
+for all the combinations of types we might want. This may be a large
+problem. However, the problem can be mitigated by using coercions,
+such as vector->list, list->vector, etc. The cost of doing the
+coercions is the construction of a new intermediate data structure
+that is not needed in the result. This may or may not be important,
+depending on the application. With coercions, we make up and use new
+combinators to help construct the generic operator entries:
+
+ (define (compose-1st-arg f g)
+ (lambda (x y) (f (g x) y)))
+
+ (define (compose-2nd-arg f g)
+ (lambda (x y) (f x (g y))))
+
+Using these we can write such things as:
+
+ (assign-operation generic:binary-append
+ (compose-2nd-arg vector-append list->vector)
+ vector? list?)
+
+ (assign-operation generic:binary-append
+ (compose-2nd-arg append vector->list)
+ list? vector?)
+
+
+-------------
+Problem 2.2:
+
+Examine the generic specifications. What generalizations that mix
+combinations of sequence types may be useful? Amend the specification
+document so as to include the generalization. (Turn in the amended
+specification sheet with your changes clearly indicated.) Amend your
+implementation to make these generalizations.
+
+Some of the coercions that you may need are provided by Scheme, but
+others may need to be written, such as vector->string. (Consult the
+online MIT/GNU Scheme reference manual to see what is and is not
+provided.)
+-------------
+
+The code for sequence:append illustrates an interesting problem. Our
+generic dispatch program does not allow us to make generic operations
+with unspecified arity -- that take many arguments -- such as
+addition. We programmed around that restriction by defining a binary
+generic operation and then using a folding reduction (fold-right) to
+extend the binary operation to take an arbitrary number of arguments.
+However, the folding reduction needs to know the null sequence of the
+type being constructed. Alternatively, we could have extended the
+generic dispatch to allow creation of procedures with unspecified
+arity. This would allow us to move the folding to the type-specific
+procedures rather than make it a wrapper around the binary generic
+procedure.
+
+
+-------------
+Problem 2.3
+
+Is this a good idea? (Please state and argue your opinion.)
+
+Assuming that we want to do this, what changes would you have to make
+in the ghelper.scm file? For example, how would make-generic-operator
+have to change? assign-operation?
+
+We do not want you to actually implement these changes, just think
+about what would have to be done and informally describe your
+conclusions.
+-------------
+
+
+Ben Bitdiddle is pleased with our generic sequences but notes that,
+beyond generic N-tuples, it is useful also to have generic sets. He
+proposes that we further extend our language with:
+
+ (generic:sequence->set <sequence>)
+ Returns a list corresponding to <sequence> with no duplicates.
+ Duplication is determined using EQUAL? (not EQ? nor EQV?).
+
+ The remaining traditional set operations are straightforward:
+
+ (set:equal? <set-1> <set-2>)
+ (set:union <set-1> <set-2>)
+ (set:intersection <set-1> <set-2>)
+ (set:difference <set-1> <set-2>) - E.g. {A,B,C}\{9,B,D}={A,C}
+ (set:strict-subset? <set-1> <set-2>)
+
+Alyssa P. Hacker is quick to point out that an efficient way to
+implement sets is as sorted, irredundant lists. She adds, ``Of
+course, this would require a generic:less? predicate to induce a total
+order on the potential set elements.''
+
+To that end, Alyssa proposes the following ordering on types of objects:
+
+ null < Boolean < char < number < symbol < string < vector < list
+
+She notes that MIT Scheme already provides handy implementations of
+each of: char<?, <, symbol<? and string<?. Adding that null<? and
+boolean<? are straightforward to define and that vector<? can just
+cheat and resort to list<? (for now), she cautions that list<?, on the
+other hand, must take special care to ensure that:
+
+ (generic:less? x y)
+ implies (not (generic:less? y x))
+
+...in order to be well defined (and, thus, well behaved), although
+list<? can, of course, leverage generic:less? in any recursive
+subexpression predications.
+
+Louis Reasoner, ignoring this advice, proposes the following
+implementation of list<?:
+
+(define (list<? list-1 list-2)
+ (let ((len-1 (length list-1))
+ (len-2 (length list-2)))
+ (cond ((< len-1 len-2) #t)
+ ((> len-1 len-2) #f)
+ ;; Invariant: equal lengths
+ ((null? list-1) #f) ; same
+ (else
+ (or (generic:less? (car list-1) (car list-2))
+ (generic:less? (cdr list-1) (cdr list-2)))))))
+
+Alyssa counters that the following is more appropriate:
+
+(define (list<? list-1 list-2)
+ (let ((len-1 (length list-1))
+ (len-2 (length list-2)))
+ (cond ((< len-1 len-2) #t)
+ ((> len-1 len-2) #f)
+ ;; Invariant: equal lengths
+ (else
+ (let prefix<? ((list-1 list-1)
+ (list-2 list-2))
+ (cond ((null? list-1) #f) ; same
+ ((generic:less? (car list-1) (car list-2)) #t)
+ ((generic:less? (car list-2) (car list-1)) #f)
+ (else (prefix<? (cdr list-1) (cdr list-2)))))))))
+
+As a parting shot, Alyssa also advises that entering N^2 items into the
+generic dispatch table can be avoided by just defining generic:less?
+outright, as per:
+
+(define (generic:less? x y)
+ (cond ((null? x) (if (null? y) (null<? x y) #t))
+ ((null? y) #f)
+ ((boolean? x) (if (boolean? y) (boolean<? x y) #t))
+ ((boolean? y) #f)
+ ...
+ (else (error "Unrecognized data type" x))))
+
+-------------
+Problem 2.4:
+
+A. What's wrong with Louis' implementation of the list<? predicate?
+ Give a simple example and a brief explanation of what problems
+ this would cause if it were used in generic:less? to sort sets.
+
+B. Briefly critique Alyssa's suggesting for implementing generic:less?
+ as an explicit case analysis versus using the dispatch table.
+
+C. Implement and demonstrate Ben's specification for set operations
+ using Alyssa's total ordering of data types (and her list<? code).
+ (Feel free to use MIT Scheme's native SORT procedure.)
+
+D. Critique how your implementation would change had we not taken
+ Alyssa's recommendation of implementing sets as sorted lists.
+ Consider both the code size as well as its run-time complexity.
+-------------
+
+
+The system for implementing generic operations that we have looked at
+so far in this problem set is extremely general and flexible: the
+dispatch to a handler is based on arbitrary predicates applied to
+the arguments. Most generic operation systems are more constrained,
+in that the arguments are presumed to have types that are determined
+either statically by some declaration mechanism or by a type tag that
+is associated with the argument data. For example, in the SICP
+readings for this problem set, the data is tagged and the dispatch is
+based on these tags. Such a tagged-data system has important
+advantages of efficiency, but it gives up some flexibility.
+
+
+-------------
+Problem 2.5:
+
+How much does dispatch on predicates cost? What is the fundamental
+efficiency problem here? Imagine that we have a system with tagged
+data, but that we test for the tags with predicates. What can be done
+with the data tags that can eliminate much of the work of the
+predicate-based system?
+
+On the other hand, what do we give up in a more conventional system,
+such as the one outlined in SICP, by contrast to the predicate-based
+system? What is an example of lost flexibility?
+
+Write a few clear paragraphs expounding on these ideas. Try to
+separate accident from essence. (Some aspects of a system are
+consequences of accidental choices--ones that could easily be
+changed--such as the use of a hash table rather than an association
+list. Other aspects are essential in that no local modifications can
+significantly change the behavior.)
+-------------
+
+;;;; Generic sequence operations
+;;; generic-specs.scm
+
+;;; There are many kinds of data that can be used to represent sequences:
+;;; examples include strings, lists, and vectors.
+
+;;; There are operations that can be defined for all sequence types.
+
+;;; Constructing
+;;;
+;;; (sequence:construct <sequence-type> <item-1> ... <item-n>)
+;;; Constructs a new sequence of the given type and of size n with
+;;; the given elements: item-1 ... item-n
+
+;;; (sequence:null <sequence-type>)
+;;; Produces the null sequence of the given type
+
+
+;;; Selecting
+;;;
+;;; (sequence:ref <sequence> <i>)
+;;; Returns the ith element of the sequence. We use zero-based
+;;; indexing, so for a sequence of length n the ith item is
+;;; referenced by (sequence:ref <sequence> <i-1>).
+
+;;; (sequence:size <sequence>)
+;;; Returns the number of elements in the sequence.
+
+;;; (sequence:type <sequence>)
+;;; Returns the predicate defining the type of the sequence given.
+
+
+;;; Testing
+;;;
+;;; (sequence:null? <sequence>)
+;;; Returns #t if the sequence is null, otherwise returns #f.
+
+;;; (sequence:equal? <sequence-1> <sequence-2>)
+;;; Returns #t if the sequences are of the same type and have equal
+;;; elements in the same order, otherwise returns #f.
+
+
+;;; Mutation
+;;;
+;;; Some sequences are immutable, while others can be changed.
+;;;
+;;; For those that can be modified we can change an element:
+;;;
+;;; (sequence:set! <sequence> <i> <v>)
+;;; Sets the ith element of the sequence to v.
+
+;;; Cutting and Pasting
+;;;
+;;; (sequence:subsequence <sequence> <start> <end>)
+;;; The arguments start and end must be exact integers such that
+;;; 0 <= start <= end <= (sequence:size <sequence>).
+;;; Returns a new sequence of the same type as the given sequence,
+;;; of size end-start with elements selected from the given sequence.
+;;; The new sequence starts with the element of the given sequence
+;;; referenced by start. It ends with the element of the given
+;;; sequence referenced by end-1.
+
+;;; (sequence:append <sequence-1> ... <sequence-n>)
+;;; Requires that the sequences are all of the same type. Returns
+;;; a new sequence of the type, formed by concatenating the
+;;; elements of the given sequences. The size of the new sequence
+;;; is the sum of the sizes of the given sequences.
+
+;;; Iterators
+;;;
+;;; (sequence:generate <sequence-type> <n> <function>)
+;;; Makes a new sequence of the given sequence type, of size n.
+;;; The ith element of the new sequence is the value of the
+;;; function at the index i.
+
+;;; (sequence:map <function> <seq-1> ... <seq-n>)
+;;; Requires that the sequences given are of the same size and
+;;; type, and that the arity of the function is n. The ith element
+;;; of the new sequence is the value of the function applied to the
+;;; n ith elements of the given sequences.
+
+;;; (sequence:for-each <procedure> <seq-1> ... <seq-n>)
+;;; Requires that the sequences given are of the same size and
+;;; type, and that the arity of the procedure is n. Applies the
+;;; procedure to the n ith elements of the given sequences;
+;;; discards the value. This is done for effect.
+
+;;; Filtration and Search
+;;;
+;;; (sequence:filter <sequence> <predicate>)
+;;; Returns a new sequence with exactly those elements of the given
+;;; sequence for which the predicate is true (does not return #f).
+;;;
+;;; (sequence:get-index <sequence> <predicate>)
+;;; Returns the index of the first element of the sequence that
+;;; satisfies the predicate. Returns #f if no element of the
+;;; sequence satisfies the predicate.
+;;;
+;;; (sequence:get-element <sequence> <predicate>)
+;;; Returns the first element of the sequence that satisfies the
+;;; predicate. Returns #f if no element of the sequence satisfies
+;;; the predicate.
+
+;;; Accumulation
+;;;
+;;; (sequence:fold-right <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; from the right, starting with the initial value.
+;;; For example,
+;;; (sequence:fold-right list 'end '(a b c))
+;;; => (a (b (c end)))
+
+;;;
+;;; (sequence:fold-left <function> <initial> <sequence>)
+;;; Returns the result of applying the given binary function,
+;;; starting with the initial value, from the left.
+;;; For example,
+;;; (sequence:fold-left list 'start '(a b c))
+;;; => (((start a) b) c)
+
+;;;; Generic sequence operator definitions
+;;; generic-sequences.scm
+
+;;; First we declare the operators we want to be generic.
+;;; Each declaration specifies the arity (number of arguments)
+;;; and the default operation, if necessary.
+
+(define sequence:null
+ (make-generic-operator 1 #f))
+
+
+(define sequence:ref
+ (make-generic-operator 2 #f))
+
+(define sequence:size
+ (make-generic-operator 1 #f))
+
+(define sequence:type
+ (make-generic-operator 1 #f))
+
+(define sequence:null?
+ (make-generic-operator 1 #f))
+
+(define sequence:equal?
+ (make-generic-operator 2 #f))
+
+(define sequence:set!
+ (make-generic-operator 3 #f))
+
+(define sequence:subsequence
+ (make-generic-operator 3 #f))
+
+
+;;; sequence:append takes multiple arguments. It is defined in terms
+;;; of a binary generic append that takes a sequence and a list of
+;;; sequences.
+
+(define (sequence:append . sequences)
+ (if (null? sequences)
+ (error "Need at least one sequence for append"))
+ (let ((type? (sequence:type (car sequences))))
+ (if (not (for-all? (cdr sequences) type?))
+ (error "All sequences for append must be of the same type"
+ sequences))
+ (fold-right generic:binary-append (sequence:null type?) sequences)))
+
+(define generic:binary-append (make-generic-operator 2 #f))
+
+;;; Implementations of the generic operators.
+
+(define (any? x) #t)
+(define (constant val) (lambda (x) val))
+(define (is-exactly val) (lambda (x) (eq? x val)))
+
+(assign-operation sequence:null (constant "") (is-exactly string?))
+(assign-operation sequence:null (constant '()) (is-exactly list?))
+(assign-operation sequence:null (constant #()) (is-exactly vector?))
+
+(assign-operation sequence:ref string-ref string? exact-nonnegative-integer?)
+(assign-operation sequence:ref list-ref list? exact-nonnegative-integer?)
+(assign-operation sequence:ref vector-ref vector? exact-nonnegative-integer?)
+
+(assign-operation sequence:size string-length string?)
+(assign-operation sequence:size length list?)
+(assign-operation sequence:size vector-length vector?)
+
+(assign-operation sequence:type (constant string?) string?)
+(assign-operation sequence:type (constant list?) list?)
+(assign-operation sequence:type (constant vector?) vector?)
+
+
+(define (vector-null? v) (= (vector-length v) 0))
+
+(assign-operation sequence:null? string-null? string?)
+(assign-operation sequence:null? null? list?)
+(assign-operation sequence:null? vector-null? vector?)
+
+
+;;; To assign to the ith element of a list:
+
+(define (list-set! list i val)
+ (cond ((null? list)
+ (error "List does not have enough elements" i))
+ ((= i 0) (set-car! list val))
+ (else (list-set! (cdr list) (- i 1) val))))
+
+(assign-operation sequence:set! string-set!
+ string? exact-nonnegative-integer? any?)
+(assign-operation sequence:set! list-set!
+ list? exact-nonnegative-integer? any?)
+(assign-operation sequence:set! vector-set!
+ vector? exact-nonnegative-integer? any?)
+
+(assign-operation sequence:subsequence substring
+ string? exact-nonnegative-integer? exact-nonnegative-integer?)
+
+(assign-operation sequence:subsequence sublist
+ list? exact-nonnegative-integer? exact-nonnegative-integer?)
+
+(assign-operation sequence:subsequence subvector
+ vector? exact-nonnegative-integer? exact-nonnegative-integer?)
+
+
+(define (vector-append v1 v2)
+ (let ((n1 (vector-length v1))
+ (n2 (vector-length v2)))
+ (make-initialized-vector (+ n1 n2)
+ (lambda (i)
+ (if (< i n1)
+ (vector-ref v1 i)
+ (vector-ref v2 (- i n1)))))))
+
+(assign-operation generic:binary-append string-append string? string?)
+(assign-operation generic:binary-append append list? list?)
+(assign-operation generic:binary-append vector-append vector? vector?)
+
+;;;; Most General Generic-Operator Dispatch
+;;; ghelper.scm
+
+(declare (usual-integrations))
+
+;;; Generic-operator dispatch is implemented here by a discrimination
+;;; list, where the arguments passed to the operator are examined by
+;;; predicates that are supplied at the point of attachment of a
+;;; handler (by ASSIGN-OPERATION).
+
+;;; To be the correct branch all arguments must be accepted by
+;;; the branch predicates, so this makes it necessary to
+;;; backtrack to find another branch where the first argument
+;;; is accepted if the second argument is rejected. Here
+;;; backtracking is implemented by OR.
+
+(define (make-generic-operator arity default-operation)
+ (let ((record (make-operator-record arity)))
+
+ (define (operator . arguments)
+ (if (not (= (length arguments) arity))
+ (error:wrong-number-of-arguments operator arity arguments))
+ (apply (or (let per-arg
+ ((tree (operator-record-tree record))
+ (args arguments))
+ (let per-pred ((tree tree))
+ (and (pair? tree)
+ (if ((caar tree) (car args))
+ (if (pair? (cdr args))
+ (or (per-arg (cdar tree) (cdr args))
+ (per-pred (cdr tree)))
+ (cdar tree))
+ (per-pred (cdr tree))))))
+ default-operation
+ (error:no-applicable-methods operator arguments))
+ arguments))
+
+ (hash-table/put! *generic-operator-table* operator record)
+ operator))
+
+(define *generic-operator-table*
+ (make-eq-hash-table))
+
+(define (make-operator-record arity) (cons arity '()))
+(define (operator-record-arity record) (car record))
+(define (operator-record-tree record) (cdr record))
+(define (set-operator-record-tree! record tree) (set-cdr! record tree))
+
+(define (assign-operation operator handler . argument-predicates)
+ (let ((record
+ (let ((record
+ (hash-table/get *generic-operator-table* operator #f))
+ (arity (length argument-predicates)))
+ (if record
+ (begin
+ (if (not (= arity (operator-record-arity record)))
+ (error "Incorrect operator arity:" operator))
+ record)
+ (let ((record (make-operator-record arity)))
+ (hash-table/put! *generic-operator-table*
+ operator
+ record)
+ record)))))
+ (set-operator-record-tree! record
+ (bind-in-tree argument-predicates
+ handler
+ (operator-record-tree record))))
+ operator)
+
+(define (bind-in-tree keys handler tree)
+ (let loop ((keys keys) (tree tree))
+ (let ((p.v (assq (car keys) tree)))
+ (if (pair? (cdr keys))
+ (if p.v
+ (begin
+ (set-cdr! p.v
+ (loop (cdr keys) (cdr p.v)))
+ tree)
+ (cons (cons (car keys)
+ (loop (cdr keys) '()))
+ tree))
+ (if p.v
+ (begin
+ (warn "Replacing a handler:" (cdr p.v) handler)
+ (set-cdr! p.v handler)
+ tree)
+ (cons (cons (car keys) handler)
+ tree))))))