blob: ef13c5ce6e8f4a6ab9192bb27c531dd86c778413 (
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
; a simple line editor for reading lisp s-expressions
; colors strings and comments. nested parens get different colors.
;
; needs to do its own raw keyboard/screen management since we need to decide
; how to color each key right as it is printed
; lots of logic devoted to handling backspace correctly
(function read-sexp [
(default-space:space-address <- new space:literal 30:literal)
(result:buffer-address <- init-buffer 30:literal)
(open-parens:integer <- copy 0:literal) ; for balancing parens and tracking nesting depth
; test: 34<enter>
{ begin
next-key
(c:character <- $wait-for-key-from-host)
(len:integer-address <- get-address result:buffer-address/deref length:offset)
; handle backspace
; test: 3<backspace>4<enter>
; todo: backspace into comment or string; backspace past newline
{ begin
(backspace?:boolean <- equal c:character ((#\backspace literal)))
(break-unless backspace?:boolean)
($print-key-to-host c:character)
; but only if we need to
{ begin
(zero?:boolean <- lesser-or-equal len:integer-address/deref 0:literal)
(break-if zero?:boolean)
(len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
}
(jump next-key:offset)
}
(result:buffer-address <- append result:buffer-address c:character)
; record backslash and one additional character
; test: (prn #\()
{ begin
(backslash?:boolean <- equal c:character ((#\\ literal)))
(break-unless backslash?:boolean)
($print-key-to-host c:character 7:literal/white)
(result:buffer-address <- slurp-escaped-character result:buffer-address 7:literal/white)
(jump next-key:offset)
}
; parse comment
{ begin
(comment?:boolean <- equal c:character ((#\; literal)))
(break-unless comment?:boolean)
($print-key-to-host c:character 4:literal/fg/blue)
(skip-comment result:buffer-address)
; comment slurps newline, so check if we should return
(end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal)
(break-if end-sexp?:boolean 2:blocks)
(jump next-key:offset)
}
; parse string
{ begin
(string-started?:boolean <- equal c:character ((#\" literal))) ; for vim: "
(break-unless string-started?:boolean)
($print-key-to-host c:character 6:literal/fg/cyan)
(slurp-string result:buffer-address)
(jump next-key:offset)
}
; balance parens
; test: (+ 1 1)<enter>
; test: (def foo () (+ 1 (* 2 3)))<enter>
{ begin
(open-paren?:boolean <- equal c:character ((#\( literal)))
(break-unless open-paren?:boolean)
(_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal)
(color-code:integer <- add color-code:integer 1:literal)
($print-key-to-host c:character color-code:integer)
(open-parens:integer <- add open-parens:integer 1:literal)
(jump next-key:offset)
}
{ begin
(close-paren?:boolean <- equal c:character ((#\) literal)))
(break-unless close-paren?:boolean)
(open-parens:integer <- subtract open-parens:integer 1:literal)
(_ color-code:integer <- divide-with-remainder open-parens:integer 3:literal) ; 3 distinct colors for parens
(color-code:integer <- add color-code:integer 1:literal)
($print-key-to-host c:character color-code:integer)
(jump next-key:offset)
}
{ begin
(newline?:boolean <- equal c:character ((#\newline literal)))
(break-unless newline?:boolean)
($print-key-to-host c:character)
(end-sexp?:boolean <- lesser-or-equal open-parens:integer 0:literal)
(jump-if end-sexp?:boolean end:offset)
(jump next-key:offset)
}
($print-key-to-host c:character)
; todo: error on space outside parens, like python
; []
; don't return if there's no non-whitespace in result
(jump next-key:offset)
}
end
(s:string-address <- get result:buffer-address/deref data:offset)
(reply s:string-address)
])
(function skip-comment [
(default-space:space-address <- new space:literal 30:literal)
(result:buffer-address <- next-input)
(orig-len:integer <- get result:buffer-address/deref length:offset)
; test: ; abc<enter>
{ begin
next-key-in-comment
(c:character <- $wait-for-key-from-host)
($print-key-to-host c:character 4:literal/fg/blue)
; handle backspace
; test: ; abc<backspace><backspace>def<enter>
; todo: how to exit comment?
{ begin
(backspace?:boolean <- equal c:character ((#\backspace literal)))
(break-unless backspace?:boolean)
(len:integer-address <- get-address result:buffer-address/deref length:offset)
; buffer has to have at least the semi-colon so can't be empty
(len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
; if we erase start of comment, return
(comment-deleted?:boolean <- lesser-or-equal len:integer-address/deref orig-len:integer)
(jump-unless comment-deleted?:boolean end:offset)
(jump next-key-in-comment:offset)
}
(result:buffer-address <- append result:buffer-address c:character)
(newline?:boolean <- equal c:character ((#\newline literal)))
(jump-unless newline?:boolean next-key-in-comment:offset)
}
end
])
(function slurp-string [
(default-space:space-address <- new space:literal 30:literal)
(result:buffer-address <- next-input)
(orig-len:integer <- get result:buffer-address/deref length:offset)
; test: "abc"
{ begin
next-key-in-string
(c:character <- $wait-for-key-from-host)
($print-key-to-host c:character 6:literal/fg/cyan)
; handle backspace
; test: "abc<backspace>d"
; todo: how to exit string?
{ begin
(backspace?:boolean <- equal c:character ((#\backspace literal)))
(break-unless backspace?:boolean)
(len:integer-address <- get-address result:buffer-address/deref length:offset)
; typed a quote before calling slurp-string, so can't be empty
(len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
; if we erase start of string, return
; test: "<backspace>34
(string-deleted?:boolean <- lesser-or-equal len:integer-address/deref orig-len:integer)
;? (print-primitive-to-host string-deleted?:boolean) ;? 1
(jump-if string-deleted?:boolean end:offset)
(jump next-key-in-string:offset)
}
(result:buffer-address <- append result:buffer-address c:character)
; break on quote -- unless escaped by backslash
; test: "abc\"ef"
{ begin
(backslash?:boolean <- equal c:character ((#\\ literal)))
(break-unless backslash?:boolean)
(result:buffer-address <- slurp-escaped-character result:buffer-address 6:literal/cyan)
(jump next-key-in-string:offset)
}
; if not backslash
(end-quote?:boolean <- equal c:character ((#\" literal))) ; for vim: "
(jump-unless end-quote?:boolean next-key-in-string:offset)
}
end
])
(function slurp-escaped-character [
(default-space:space-address <- new space:literal 30:literal)
(result:buffer-address <- next-input)
(color-code:integer <- next-input)
(c2:character <- $wait-for-key-from-host)
($print-key-to-host c2:character color-code:integer)
; handle backspace
; test: "abc\<backspace>def"
{ begin
(backspace?:boolean <- equal c2:character ((#\backspace literal)))
(break-unless backspace?:boolean)
(len:integer-address <- get-address result:buffer-address/deref length:offset)
; just typed a backslash, so buffer can't be empty
(len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
(reply result:buffer-address/same-as-arg:0)
}
; if not backspace
(result:buffer-address <- append result:buffer-address c2:character)
(reply result:buffer-address/same-as-arg:0)
])
(function main [
(default-space:space-address <- new space:literal 30:literal)
(cursor-mode)
{ begin
(print-primitive-to-host (("anarki> " literal)))
(s:string-address <- read-sexp)
(retro-mode) ; print errors cleanly
(t:string-address <- $eval s:string-address)
(cursor-mode)
(print-string nil:literal/terminal t:string-address)
(print-character nil:literal/terminal ((#\newline literal)))
(loop)
}
])
|