From 8e998f4e5be326a2bc91220e86d555ce79d2890e Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Wed, 11 Feb 2009 14:31:28 -0500
Subject: ps02 files

---
 ps02_generics/generic-sequences.scm | 114 +++++++
 ps02_generics/generic-specs.scm     | 121 ++++++++
 ps02_generics/ghelper.scm           |  84 +++++
 ps02_generics/ps.txt                | 593 ++++++++++++++++++++++++++++++++++++
 4 files changed, 912 insertions(+)
 create mode 100644 ps02_generics/generic-sequences.scm
 create mode 100644 ps02_generics/generic-specs.scm
 create mode 100644 ps02_generics/ghelper.scm
 create mode 100644 ps02_generics/ps.txt

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))))))
-- 
cgit v1.2.3