aboutsummaryrefslogtreecommitdiffstats
path: root/mcgoron.iterator.base.scm
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>? >?)