blob: b92689f2179678f59f87d9360ec59cf378ec60fa (
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
|
#| 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.
|-------------------------------------------------------------------------
| This is a list iterator that allows for mutation list and improper
| lists.
|
| The list iterator is made up of
| * the `signifier`: the head of the list.
| * the `previous` values, which is a list of all cons cells prior to the
| current cons cell, in reverse.
| * the index, which is the index of the current element in the list. This
| is updated internally but not used internally, so the root index does
| not have to be 0.
| * the `next` list, which is either empty or has as it's car the current
| item.
|#
;;; TODO: handle IMPROPER-REST? properly
(define (forward num signifier previous idx rest)
(cond
((= num 0)
(make-list-iterator signifier previous idx rest))
((not (pair? rest)) #f)
(else
(forward (- num 1) (cons rest previous) (+ idx 1) (cdr rest)))))
(define (backward num signifier previous idx rest)
(cond
((= num 0)
(make-list-iterator signifier previous idx rest))
((not (pair? rest)) #f)
(else
(backward (+ num 1) (cdr previous) (- idx 1) (car previous)))))
(define (list-iterator? itr)
(eq? (iterator-type itr) 'list-iterator))
(define-invocation list-iterator-signifier)
(define (make-list-iterator signifier previous idx rest)
(if (not (or (pair? rest) (null? rest)))
(list-iterator signifier (cdr previous) idx (car previous) #t)
(list-iterator signifier previous idx rest #f)))
(define-iterator-implementation (list-iterator signifier
previous
idx
rest
improper-rest?)
self
((iterator-at-start?) (null? previous))
((iterator-at-end?) (or improper-rest? (null? rest)))
((iterator-advance spaces)
(cond
((not (integer? spaces))
(raise (non-integer-movement-exception spaces)))
((negative? spaces)
(backward spaces signifier previous idx rest))
(else (forward spaces signifier previous idx rest))))
((iterator-ref)
(cond
((null? rest)
(raise (ref-at-end-exception self)))
(improper-rest? (cdr rest))
(else (car rest))))
((iterator-set! x)
(cond
((null? rest)
(raise (ref-at-end-exception self)))
(improper-rest? (set-cdr! rest x))
(else (set-car! rest x))))
((iterator->index) idx)
((get-signifier) signifier)
((get-iterator-comparator)
(make-comparator
(lambda (x)
(and (list-iterator? itr)
(eq? signifier (list-iterator-signifier x))))
(lambda (x y)
(= (iterator->index x) (iterator->index y)))
(lambda (x y)
(< (iterator->index x) (iterator->index y)))
#f)))
(define-syntax define-with-list-or-iterator
(syntax-rules ()
((_ (name first rest ...) body ...)
(define (name first rest ...)
(let ((first (cond
((pair? first) first)
((list-iterator? first)
(list-iterator-signifier first))
(else (raise (list-constructor-exception
first))))))
body ...)))))
(define (list-constructor-exception obj)
(make-iterator-exception #f
'list-constructor
(list (cons 'obj obj))))
(define-with-list-or-iterator (list-iterator-start lst)
(make-list-iterator lst '() 0 lst))
(define (list-iterator-to-end itr)
(if (iterator-end? itr)
itr
(list-iterator-to-end (iterator-next itr))))
(define (list-iterator-end obj)
(list-iterator-to-end (list-iterator-start obj)))
|
