blob: 762b79d7eb346d1d6951776b8f51294cf418fc96 (
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
|
#| 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 (string-cursor-valid-movement? str cursor spaces)
;; Return #T if moving CURSOR forwards or backwards SPACES is well
;; defined.
(cond
((zero? spaces) #t)
((negative? spaces)
(<= (- spaces)
(string-cursor-diff str (string-cursor-start str) cursor)))
((positive? spaces)
(<= spaces
(string-cursor-diff str cursor (string-cursor-end str))))
(else #f)))
(define-invocation string-iterator-str)
(define-invocation string-iterator->cursor)
(define (string-iterator? x)
(and (iterator? x) (eq? (iterator-type x) 'string-iterator)))
(define (string-cursor-advance str cursor spaces)
;; Move CURSOR SPACES forward or backward.
(cond
((negative? spaces)
(string-cursor-back str cursor (- spaces)))
(else (string-cursor-forward str cursor spaces))))
(define-iterator-implementation (string-iterator str cursor) self
((iterator-at-start?)
(string-cursor=? (string-cursor-start str) cursor))
((iterator-at-end?)
(string-cursor=? (string-cursor-end str) cursor))
((iterator-advance spaces)
(cond
((not (integer? spaces))
(raise (non-integer-movement-exception self spaces)))
((string-cursor-valid-movement? str cursor spaces)
(let ((cursor (string-cursor-advance str cursor spaces)))
(string-iterator str cursor)))
(else #f)))
((iterator-ref)
(if (iterator-at-end? self)
(raise (ref-at-end-exception self))
(string-ref/cursor str cursor)))
((iterator->index)
(string-cursor->index str cursor))
((string-iterator-str) str)
((string-iterator->cursor) cursor)
((get-iterator-comparator)
(make-comparator
(lambda (x)
(and (string-iterator? x)
(let ((x-str (string-iterator-str str)))
(eq? str x-str))))
(lambda (x y)
(let ((x-cur (string-iterator->cursor x))
(y-cur (string-iterator->cursor y)))
(string-cursor=? x-cur y-cur)))
(lambda (x y)
(let ((x-cur (string-iterator->cursor x))
(y-cur (string-iterator->cursor y)))
(string-cursor<? x-cur y-cur)))
#f)))
(define-syntax define-for-iterator-or-string
;; Define a function such that the first argument can either be a string
;; or a string iterator. The string iterator has its string extracted
;; before use.
(syntax-rules ()
((_ (name str args ...) body ...)
(define (name object args ...)
(define (internal str args ...)
body ...)
(cond
((string? object) (internal object args ...))
((string-iterator? object) (internal (string-iterator-str object)
args ...))
(else (raise (string-iterator-constructor-exception
object))))))))
(define-for-iterator-or-string (string-iterator-start str)
(string-iterator str (string-cursor-start str)))
(define-for-iterator-or-string (string-iterator-end str)
(string-iterator str (string-cursor-end str)))
(define-for-iterator-or-string (string-index->iterator str idx)
(string-iterator str (string-index->cursor str idx)))
|
