blob: cd8e775f6787b73a620d92c97bb85623b0978a2e (
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
|
#| 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>
(make-iterator start? end?
advance
ref
to-index
comparison
private)
iterator?
(start? get-start-predicate)
(end? get-end-predicate)
(advance get-advance)
(ref get-ref)
(to-index get-to-index-procedure)
(comparison get-comparison-procedure)
(private iterator-get-private))
(define-syntax define-with-field-of-iterator
(syntax-rules ()
((_ (name field args ...) body ...)
(define (name iterator args ...)
(let ((field (field iterator)))
(if (not field)
(raise (field-not-found-exception
(quote field)
iterator))
(begin body ...)))))))
;;; 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 ()
((_ name field-accessor args ...)
(define-with-field-of-iterator (name field-accessor args ...)
(field-accessor args ...)))))
(define-invoke-field-of-iterator iterator-at-start? get-start-predicate)
(define-invoke-field-of-iterator iterator-at-end? get-end-predicate)
(define-invoke-field-of-iterator iterator-advance get-advance
spaces)
(define-invoke-field-of-iterator iterator-ref get-ref)
(define-invoke-field-of-iterator iterator->index get-to-index-procedure)
(define-syntax define-comparison
(syntax-rules ()
((_ name comparison-function)
(define (name itr1 . itr-rest)
(let ((impl (get-comparison-procedure itr1)))
(if (not impl)
(raise (field-not-found-exception (quote comparison-function)
itr1))
(impl comparison-function itr-rest)))))))
(define (iteratively-apply-predicate predicate? seed lst)
(cond
((null? lst) #t)
((predicate? seed (car lst))
(iteratively-apply-predicate predicate? (car lst) (cdr lst)))
(else #f)))
(define-comparison iterator=? =?)
(define-comparison iterator<=? <=?)
(define-comparison iterator>=? >=?)
(define-comparison iterator<? <?)
(define-comparison iterator>? >?)
|