1 files changed, 114 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?)