forked from kanaka/mal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
reader.in.bas
260 lines (224 loc) · 7.14 KB
/
reader.in.bas
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
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
REM READ_TOKEN(RF=0, A$, RI) -> T$
REM READ_TOKEN(RF=1) -> T$
READ_TOKEN:
IF RF=1 THEN RF=2:T$="(":RETURN
IF RF=2 THEN RF=3:T$="do":RETURN
GOSUB SKIP_SPACES
REM PRINT "READ_TOKEN: "+STR$(RI)+", "+MID$(A$,RI,1)
GOSUB READ_CHAR
IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_TOKEN
T$=C$
IF T$="(" OR T$=")" OR T$="[" OR T$="]" OR T$="{" OR T$="}" OR T$="'" OR T$="`" OR T$="@" THEN RETURN
GOSUB PEEK_CHAR: REM peek at next character
IF T$="~" AND C$<>"@" THEN RETURN
S1=0:S2=0: REM S1: INSTRING?, S2: ESCAPED?
IF T$=CHR$(34) THEN S1=1
READ_TOKEN_LOOP:
GOSUB PEEK_CHAR: REM peek at next character
IF C$="" THEN RETURN
IF S1 THEN GOTO READ_TOKEN_CONT
IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN
IF C$="(" OR C$=")" OR C$="[" OR C$="]" OR C$="{" OR C$="}" THEN RETURN
READ_TOKEN_CONT:
GOSUB READ_CHAR
T$=T$+C$
IF T$="~@" THEN RETURN
IF S1=0 OR S2=1 THEN S2=0:GOTO READ_TOKEN_LOOP
REM S1=1 (INSTRING?) and S2=0 (not ESCAPED?)
IF C$=CHR$(92) THEN S2=1
IF C$=CHR$(34) THEN RETURN
GOTO READ_TOKEN_LOOP
REM READ_CHAR(A$, RI) -> C$
READ_CHAR:
RJ=1:GOSUB DO_READ_CHAR
RETURN
REM PEEK_CHAR(A$, RI) -> C$
PEEK_CHAR:
RJ=0:GOSUB DO_READ_CHAR
RETURN
REM DO_READ_CHAR(RJ, A$, RI):
REM - RI is position in A$
REM - RJ=1 is read, RJ=0 is peek
DO_READ_CHAR:
C$=""
IF RF>0 THEN GOTO READ_FILE_CHAR
IF RI<=LEN(A$) THEN C$=MID$(A$,RI,1):RI=RI+RJ
RETURN
REM READ_FILE_CHAR(RJ) -> C$
REM - RJ=1 is read, RJ=0 is peek
REM - D$ is global used for already read pending character
REM - EZ is global used for end of file state
READ_FILE_CHAR:
IF D$<>"" THEN C$=D$:IF RJ=0 THEN RETURN
IF D$<>"" AND RJ=1 THEN D$="":RETURN
D$=""
IF EZ>2 THEN C$=""
IF EZ=2 THEN C$=")"
IF EZ=1 THEN C$=CHR$(10)
IF EZ>0 THEN EZ=EZ+RJ:RETURN
#cbm GET#2,C$
#qbasic C$=INPUT$(1,2)
#qbasic IF EOF(2) THEN EZ=1:RETURN
IF RJ=0 THEN D$=C$
#cbm IF (ST AND 64) THEN EZ=1:RETURN
#cbm IF (ST AND 255) THEN EZ=1:ER=-1:E$="File read error"+STR$(ST)
RETURN
SKIP_SPACES:
GOSUB PEEK_CHAR: REM peek at next character
IF C$=" " OR C$="," OR C$=CHR$(13) OR C$=CHR$(10) THEN GOSUB READ_CHAR:GOTO SKIP_SPACES
RETURN
SKIP_TO_EOL:
GOSUB READ_CHAR
IF C$="" OR C$=CHR$(13) OR C$=CHR$(10) THEN RETURN
GOTO SKIP_TO_EOL
REM READ_FORM(A$, RI, RF) -> R
SUB READ_FORM
Q=T:GOSUB PUSH_Q: REM save current value of T
READ_FORM_RECUR:
IF ER<>-2 THEN GOTO READ_FORM_RETURN
GOSUB READ_TOKEN
REM PRINT "READ_FORM T$: ["+T$+"]"
IF T$="" THEN R=0:GOSUB INC_REF_R:GOTO READ_FORM_RETURN
IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL
IF T$="false" THEN T=1:GOTO READ_NIL_BOOL
IF T$="true" THEN T=2:GOTO READ_NIL_BOOL
IF T$="'" THEN B$="quote":GOTO READ_MACRO
IF T$="`" THEN B$="quasiquote":GOTO READ_MACRO
IF T$="~" THEN B$="unquote":GOTO READ_MACRO
IF T$="~@" THEN B$="splice-unquote":GOTO READ_MACRO
IF T$="^" THEN B$="with-meta":GOTO READ_MACRO
IF T$="@" THEN B$="deref":GOTO READ_MACRO
C$=MID$(T$,1,1)
REM PRINT "C$: ["+C$+"]("+STR$(ASC(C$))+")"
IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER
IF C$="-" THEN GOTO READ_SYMBOL_MAYBE
IF C$=CHR$(34) THEN GOTO READ_STRING
IF C$=":" THEN GOTO READ_KEYWORD
REM set end character in Q and read the sequence
IF C$="(" THEN T=6:Q=41:GOTO READ_SEQ_START: REM ")"
IF C$="[" THEN T=7:Q=93:GOTO READ_SEQ_START: REM "]"
IF C$="{" THEN T=8:Q=125:GOTO READ_SEQ_START: REM "}"
IF C$=")" OR C$="]" OR C$="}" THEN R=-1:ER=-1:E$="unexpected "+C$:GOTO READ_FORM_RETURN
GOTO READ_SYMBOL
READ_NIL_BOOL:
REM PRINT "READ_NIL_BOOL"
R=T*2
GOSUB INC_REF_R
GOTO READ_FORM_RETURN
READ_NUMBER:
REM PRINT "READ_NUMBER"
T=2:L=VAL(T$):GOSUB ALLOC
GOTO READ_FORM_RETURN
READ_MACRO:
REM push macro type
Q=-1*(T$="^"):GOSUB PUSH_Q
REM B$ is set above
T=5:GOSUB STRING
REM push string
GOSUB PUSH_R
CALL READ_FORM
REM push first form
GOSUB PUSH_R
IF ER>-2 THEN GOTO READ_MACRO_DONE
GOSUB PEEK_Q_2
IF Q THEN GOTO READ_MACRO_3
READ_MACRO_2:
GOSUB PEEK_Q_1:B=Q
GOSUB PEEK_Q:A=Q
GOSUB LIST2
GOTO READ_MACRO_DONE
READ_MACRO_3:
CALL READ_FORM
GOSUB PEEK_Q_1:C=Q
B=R
GOSUB PEEK_Q:A=Q
GOSUB LIST3
AY=C:GOSUB RELEASE
READ_MACRO_DONE:
REM release values, list has ownership
AY=B:GOSUB RELEASE
AY=A:GOSUB RELEASE
REM pop the stack
GOSUB POP_Q: REM pop first form
GOSUB POP_Q: REM pop string
GOSUB POP_Q: REM pop macro type
T$="": REM necessary to prevent unexpected EOF errors
GOTO READ_FORM_RETURN
READ_STRING:
REM PRINT "READ_STRING"
C=ASC(MID$(T$,LEN(T$),1))
IF C<>34 THEN R=-1:ER=-1:E$="expected '"+CHR$(34)+"'":GOTO READ_FORM_RETURN
R$=MID$(T$,2,LEN(T$)-2)
S1$=CHR$(92)+CHR$(92):S2$=CHR$(127):GOSUB REPLACE: REM protect backslashes
S1$=CHR$(92)+CHR$(34):S2$=CHR$(34):GOSUB REPLACE: REM unescape quotes
#cbm S1$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE: REM unescape newlines
#qbasic S1$=CHR$(92)+"n":S2$=CHR$(10):GOSUB REPLACE: REM unescape newlines
S1$=CHR$(127):S2$=CHR$(92):GOSUB REPLACE: REM unescape backslashes
REM intern string value
B$=R$:T=4:GOSUB STRING
GOTO READ_FORM_RETURN
READ_KEYWORD:
R$=CHR$(127)+MID$(T$,2,LEN(T$)-1)
B$=R$:T=4:GOSUB STRING
GOTO READ_FORM_RETURN
READ_SYMBOL_MAYBE:
C$=MID$(T$,2,1)
IF C$>="0" AND C$<="9" THEN GOTO READ_NUMBER
READ_SYMBOL:
REM PRINT "READ_SYMBOL"
B$=T$:T=5:GOSUB STRING
GOTO READ_FORM_RETURN
READ_SEQ_START:
SD=SD+1
GOSUB PUSH_Q: REM push return character
REM setup the stack for the loop, T has type
GOSUB MAP_LOOP_START
READ_SEQ_LOOP:
REM TODO: reduce redundancy with READ_TOKEN
GOSUB SKIP_SPACES
GOSUB PEEK_CHAR: REM peek at next character
IF C$="" THEN ER=-1:E$="unexpected EOF":GOTO READ_SEQ_DONE
IF C$=";" THEN GOSUB SKIP_TO_EOL:GOTO READ_SEQ_LOOP
Q=3:GOSUB PEEK_Q_Q
IF C$=CHR$(Q) THEN GOSUB READ_CHAR:GOTO READ_SEQ_DONE
CALL READ_FORM
M=R: REM value (or key for hash-maps)
REM if error, release the unattached element
IF ER<>-2 THEN AY=R:GOSUB RELEASE:GOTO READ_SEQ_DONE
REM if this is a hash-map, READ_FORM again
IF T=8 THEN GOSUB PUSH_R:CALL READ_FORM
IF T=8 THEN N=R:GOSUB POP_Q:M=Q: REM set key and value
REM update the return sequence structure
REM release N since list takes full ownership
C=1:GOSUB MAP_LOOP_UPDATE
GOTO READ_SEQ_LOOP
READ_SEQ_DONE:
SD=SD-1
REM cleanup stack and get return value
GOSUB MAP_LOOP_DONE
GOSUB POP_Q: REM pop end character ptr
GOTO READ_FORM_RETURN
READ_FORM_RETURN:
GOSUB POP_Q:T=Q: REM restore current value of T
END SUB
REM READ_STR(A$) -> R
READ_STR:
RI=1: REM index into A$
RF=0: REM not reading from file
SD=0: REM sequence read depth
CALL READ_FORM
RETURN
REM READ_FILE(A$) -> R
READ_FILE:
RF=1: REM reading from file
EZ=0: REM file read state (1: EOF)
SD=0: REM sequence read depth
D$="": REM pending read/peek character
#cbm OPEN 2,8,0,A$
#qbasic IF NOT _FILEEXISTS(A$) THEN ER=-1:E$="File not found":RETURN
#qbasic OPEN A$ FOR INPUT AS #2
REM READ_TOKEN adds "(do ... )"
CALL READ_FORM
CLOSE 2
EZ=0
RETURN