blob: c38c3466133206bca2636eb66fb8c7be5473a6cf (
plain) (
blame)
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#| Copyright 2024 Peter McGoron
|
| Licensed under the Apache License, Version 2.0 (the "License");
| you may not use this file except in compliance with the License.
| You may obtain a copy of the License at
|
| http://www.apache.org/licenses/LICENSE-2.0
|
| Unless required by applicable law or agreed to in writing, software
| distributed under the License is distributed on an "AS IS" BASIS,
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
| See the License for the specific language governing permissions and
| limitations under the License.
|#
(define-record-type <iterator-implementation>
(make-iterator-implementation start end
start? end?
advance
ref
to-index from-index
comparator)
iterator-implementation?
(start get-start)
(end get-end)
(start? get-start-predicate)
(end? get-end-predicate)
(advance get-advance)
(ref get-ref)
(to-index get-to-index-procedure)
(from-index get-from-index-procedure)
(comparator get-comparator))
(define-record-type <iterator>
(make-iterator implementation data)
iterator?
(implementation get-implementation)
(data get-data))
;;; Define a function that invokes a field of the iterator on the data
;;; object inside the iterator and any other arguments supplied to the
;;; function.
(define-syntax define-invoke-field-of-iterator
(syntax-rules ()
((define-invoker name field-accessor emsg args ...)
(define (name iterator args ...)
(let ((proc (field-accessor (get-implementation iterator))))
(if (not proc)
(error emsg iterator)
(proc (get-data iterator) args ...)))))))
;;; Define a constructor (something that makes an iterator from something
;;; that is not an iterator).
;;;
;;; The constructor can take as arguments either
;;;
;;; 1) The implementation and any data objects necessary to make the
;;; iterator, or
;;; 2) The iterator and any objects necessary to make the iterator, where
;;; the data in the iterator is the first such object.
;;;
;;; This is implemented as a macro to catch arity issues.
(define-syntax define-constructor-for-iterator-or-implementation
(syntax-rules ()
((_ name field emsg args ...)
(define name
(case-lambda
((iterator args ...)
(name (get-implementation iterator)
(get-data iterator)
args ...))
((implementation data args ...)
(let ((constructor (field implementation)))
(if (not constructor)
(error emsg implementation data args ...)
(constructor data args ...)))))))))
(define-constructor-for-iterator-or-implementation iterator-at-start
get-start
"no start constructor")
(define-constructor-for-iterator-or-implementation iterator-at-end
get-end
"no end")
(define-invoke-field-of-iterator iterator-at-start?
get-start-predicate
"no start predicate")
(define-invoke-field-of-iterator iterator-at-end?
get-end-predicate
"no end predicate")
(define-invoke-field-of-iterator iterator-advance
get-advance
"no procedure to move iterator"
spaces)
(define-invoke-field-of-iterator iterator-ref
get-ref
"no procedure to access value at iterator")
(define-invoke-field-of-iterator iterator->index
get-to-index-procedure
"no procedure to convert iterator->index")
(define-constructor-for-iterator-or-implementation index->iterator
get-from-index-procedure
"no procedure to convert index->iterator"
index)
;;; Create a procedure that calls COMPARISON on all (ITER1 . ITER-REST).
;;; COMPARATOR-TYPE? is a predicate against the comparator, and if the
;;; comparator fails the predicate an error message with string EMSG
;;; will thrown.
(define (generate-comparison comparison comparator-type? emsg)
(lambda (iter1 . iter-rest)
(let ((comparator (get-comparator (get-implementation iter1))))
(if (not (comparator-type? comparator))
(apply error emsg iter1 iter-rest)
(apply comparison comparator
(map get-data (cons iter1 iter-rest)))))))
(define iterator=?
(generate-comparison =? comparator? "no comparator"))
(define iterator<?
(generate-comparison <? comparator-ordered? "no ordered comparator"))
(define iterator>?
(generate-comparison >? comparator-ordered? "no ordered comparator"))
(define iterator<=?
(generate-comparison <=? comparator-ordered? "no ordered comparator"))
(define iterator>=?
(generate-comparison >=? comparator-ordered? "no ordered comparator"))
|
