blob: 6a7730a031aaf7efc03815d9a103a2325fdf6e2c (
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
|
#| 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)) (error "can only move by exact integer"
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)
(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)
(let loop ((rest other-iterators)
(current cursor))
(if (null? rest)
#t
(let* ((next-private (iterator-get-private (car rest)))
(next-str (get-str next-private))
(next (get-cursor next-private)))
;; All comparisons are to STR, the string in the first
;; iterator, since they all must be equal.
(if (or (not (eq? next-str str))
(not (predicate? string-cursor-comparator
current
next)))
#f
(loop (cdr rest) next))))))
(raw-fat-cursor str cursor)))
(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 (error "invalid type of object" 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)))
|
