blob: 1294a8be0e260e460e91eb55c5344b9b6d204ca4 (
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
|
#| 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 <fat-cursor>
(raw-fat-cursor str cursor)
fat-cursor?
(str get-str)
(cursor get-cursor))
(define string-cursor-comparator
(make-comparator
string-cursor?
string-cursor=?
string-cursor<?
#f))
(define (string-cursor-valid-movement? str cursor spaces)
(cond
((not (integer? spaces))
(raise (non-integer-movement-exception spaces)))
((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 #t)))
(define (cursor->iterator str cursor)
(define iterator
(make-iterator
(lambda ()
(string-cursor=? cursor (string-cursor-start str)))
(lambda ()
(string-cursor=? cursor (string-cursor-end str)))
(lambda (spaces)
(cond
((not (string-cursor-valid-movement? str cursor spaces))
#f)
((negative? spaces)
(cursor->iterator str
(string-cursor-back str
cursor
(- spaces))))
(else
(cursor->iterator str
(string-cursor-forward str
cursor
spaces)))))
(lambda ()
(string-ref/cursor str cursor))
(lambda ()
(string-cursor->index str cursor))
(lambda (predicate? other-iterators)
(iteratively-apply-predicate
(lambda (x y)
(let ((x (iterator-get-private x))
(y (iterator-get-private y)))
(and (eq? (get-str x) (get-str y))
(predicate? string-cursor-comparator
(get-cursor x)
(get-cursor y)))))
iterator
other-iterators))
(raw-fat-cursor str cursor)))
iterator)
(define-record-type <string-iterator-constructor-exception>
(string-iterator-constructor-exception obj)
string-iterator-constructor-exception?
(obj string-iterator-constructor-exception:obj))
(define-syntax define-for-iterator-or-string
(syntax-rules ()
((_ (name str args ...) body ...)
(define (name object args ...)
(define (internal str args ...)
body ...)
(cond
((string? object) (internal object args ...))
((iterator? object) (internal (get-str (iterator-get-private
object))
args ...))
(else (raise (string-iterator-constructor-exception
object))))))))
(define-for-iterator-or-string (string-iterator-start str)
(cursor->iterator str (string-cursor-start str)))
(define-for-iterator-or-string (string-iterator-end str)
(cursor->iterator str (string-cursor-end str)))
(define-for-iterator-or-string (string-index->iterator str idx)
(cursor->iterator str (string-index->cursor str idx)))
|
