blob: 5e426cfc4c167ebf0e4b97708722bc30bc593759 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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?)
|
