1 REM READ_TOKEN(A$, RI, RF) -> T$
4 IF RF
=1 THEN GOSUB READ_FILE_CHUNK
5 REM PRINT "READ_TOKEN: "+STR$(RJ)+", "+MID$(A$,RJ,1)
7 IF T
$="(" OR T
$=")" OR T
$="[" OR T
$="]" OR T
$="{" OR T
$="}" THEN RETURN
8 IF T
$="'" OR T
$="`" OR T
$="@" THEN RETURN
9 IF T
$="~" AND NOT MID$(A$,RJ+1,1)="@" THEN RETURN
10 S1
=0:S2
=0: REM S1: INSTRING?, S2: ESCAPED?
11 IF T
$=CHR$(34) THEN S1
=1
14 IF RF
=1 THEN GOSUB READ_FILE_CHUNK
15 IF RJ
>LEN(A
$) THEN RETURN
17 IF S2
THEN GOTO READ_TOKEN_CONT
18 IF S1
THEN GOTO READ_TOKEN_CONT
19 IF CH
$=" " OR CH$="," THEN RETURN
20 IF CH$=" " OR CH
$="," OR CH
$=CHR$(13) OR CH
$=CHR$(10) THEN RETURN
21 IF CH
$="(" OR CH
$=")" OR CH
$="[" OR CH
$="]" OR CH
$="{" OR CH
$="}" THEN RETURN
24 IF T
$="~@" THEN RETURN
26 IF S1
AND S2
THEN S2
=0:GOTO READ_TOKEN_LOOP
27 IF S1
AND S2
=0 AND CH
$=CHR$(92) THEN S2
=1:GOTO READ_TOKEN_LOOP
28 IF S1
AND S2
=0 AND CH
$=CHR$(34) THEN RETURN
33 IF RI
>1 THEN A
$=MID$(A$,RI,LEN(A$)-RI+1):RI=1:RJ=RJ-RI+1
35 IF LEN(A
$)>RJ+9 THEN RETURN
37 IF (ST
AND 64) THEN RS
=1:A
$=A$+CHR$(10)+")":RETURN
38 IF (ST
AND 255) THEN RS
=1:ER
=-1:ER
$="File read
error "+STR$(ST):RETURN
39 GOTO READ_FILE_CHUNK_LOOP
42 IF RF=1 THEN GOSUB READ_FILE_CHUNK
44 IF CH$<>" " AND CH
$<>"," AND CH
$<>CHR$(13) AND CH
$<>CHR$(10) THEN RETURN
49 IF RF
=1 THEN GOSUB READ_FILE_CHUNK
52 IF CH
$="" OR CH
$=CHR$(13) OR CH
$=CHR$(10) THEN RETURN
60 REM READ_FORM(A$, RI, RF) -> R
65 IF T
$="" AND SD
>0 THEN ER
$="unexpected EOF
":GOTO READ_FORM_ABORT
66 REM PRINT "READ_FORM T
$: ["+T$+"]"
67 IF T$="" THEN R=0:GOTO READ_FORM_DONE
68 IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL
69 IF T$="false" THEN T=1:GOTO READ_NIL_BOOL
70 IF T$="true" THEN T=2:GOTO READ_NIL_BOOL
71 IF T$="'" THEN AS$="quote":GOTO READ_MACRO
72 IF T$="`" THEN AS$="quasiquote":GOTO READ_MACRO
73 IF T$="~" THEN AS$="unquote":GOTO READ_MACRO
74 IF T$="~@" THEN AS$="splice-unquote":GOTO READ_MACRO
75 IF T$="^" THEN AS$="with-meta":GOTO READ_MACRO
76 IF T$="@" THEN AS$="deref":GOTO READ_MACRO
78 REM PRINT "CH
$: ["+CH$+"]("+STR$(ASC(CH$))+")"
79 IF (CH$=";") THEN R=0:GOSUB SKIP_TO_EOL:GOTO READ_FORM
80 IF CH$>="0" AND CH$<="9" THEN GOTO READ_NUMBER
81 IF CH$="-" THEN GOTO READ_SYMBOL_MAYBE
83 IF CH$=CHR$(34) THEN GOTO READ_STRING
84 IF CH$=":" THEN GOTO READ_KEYWORD
85 IF CH$="(" THEN T=6:GOTO READ_SEQ
86 IF CH$=")" THEN T=6:GOTO READ_SEQ_END
87 IF CH$="[" THEN T=7:GOTO READ_SEQ
88 IF CH$="]" THEN T=7:GOTO READ_SEQ_END
89 IF CH$="{" THEN T=8:GOTO READ_SEQ
90 IF CH$="}" THEN T=8:GOTO READ_SEQ_END
94 REM PRINT "READ_NIL_BOOL
"
99 REM PRINT "READ_NUMBER
"
100 T=2:L=VAL(T$):GOSUB ALLOC
104 REM to call READ_FORM recursively, SD needs to be saved, set to
105 REM 0 for the call and then restored afterwards.
106 X=X+2:X%(X-1)=(T$="^"):X%(X)=SD: REM push macro type and SD
109 T=5:GOSUB STRING:X=X+1:X%(X)=R
111 SD=0:GOSUB READ_FORM:X=X+1:X%(X)=R
113 IF X%(X-3) THEN GOTO READ_MACRO_3
116 B2=X%(X-1):B1=X%(X):GOSUB LIST2
121 B3=X%(X-1):B2=R:B1=X%(X):GOSUB LIST3
125 REM release values, list has ownership
129 SD=X%(X-2):X=X-4: REM get SD and pop the stack
130 T$="": REM necessary to prevent unexpected EOF errors
133 REM PRINT "READ_STRING
"
134 T7$=MID$(T$,LEN(T$),1)
135 IF T7$<>CHR$(34) THEN ER$="expected '"+CHR
$(34)+"'":GOTO READ_FORM_ABORT
136 R
$=MID$(T$,2,LEN(T$)-2)
137 S1
$=CHR$(92)+CHR$(34):S2$=CHR$(34):GOSUB REPLACE
: REM unescape quotes
138 S1
$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE
: REM unescape newlines
139 S1
$=CHR$(92)+CHR$(92):S2$=CHR$(92):GOSUB REPLACE
: REM unescape backslashes
140 REM intern string value
141 AS$=R$:T=4:GOSUB STRING
144 R
$=CHR$(127)+MID$(T$,2,LEN(T$)-1)
145 AS$=R$:T=4:GOSUB STRING
149 IF CH
$>="0" AND CH
$<="9" THEN GOTO READ_NUMBER
151 REM PRINT "READ_SYMBOL"
152 AS$=T$:T=5:GOSUB STRING
157 SD
=SD
+1: REM increase read sequence depth
159 REM point to empty sequence to start off
160 R
=(T
-5)*2+1: REM calculate location of empty seq
163 REM push start ptr on the stack
166 REM push current sequence type
169 REM push previous ptr on the stack
177 REM PRINT "READ_SEQ_END"
178 IF SD
=0 THEN ER
$="unexpected '"+CH$+"'":GOTO READ_FORM_ABORT
179 IF X
%(X
-1)<>T
THEN ER
$="sequence mismatch
":GOTO READ_FORM_ABORT
180 SD=SD-1: REM decrease read sequence depth
181 R=X%(X-2): REM ptr to start of sequence to return
182 T=X%(X-1): REM type prior to recur
183 X=X-3: REM pop start, type and previous off the stack
190 REM check read sequence depth
196 REM allocate new sequence entry, set type to previous type, set
197 REM next to previous next or previous (if first)
200 T8=R: REM save previous value for release
201 T=X%(X-1):N=R:GOSUB ALLOC
202 REM list takes ownership
203 IF L<9 THEN AY=L:GOSUB RELEASE
206 REM if previous element is the first element then set
207 REM the first to the new element
208 IF T7<9 THEN X%(X-2)=R:GOTO READ_FORM_SKIP_FIRST
209 REM set previous list element to point to new element
212 READ_FORM_SKIP_FIRST:
214 REM update previous pointer to current element
221 READ_FORM_ABORT_UNWIND:
223 X=X-3: REM pop previous, type, and start off the stack
225 IF SD=0 THEN AY=X%(X+1):GOSUB RELEASE
226 GOTO READ_FORM_ABORT_UNWIND
229 REM READ_STR(A$) -> R
231 RI=1: REM index into A$
232 RF=0: REM not reading from file
233 SD=0: REM sequence read depth
237 REM READ_FILE(A$) -> R
239 RI=1: REM index into A$
240 RJ=1: REM READ_TOKEN sub-index
241 RF=1: REM reading from file
242 RS=0: REM file read state (1: EOF)
243 SD=0: REM sequence read depth
245 REM READ_FILE_CHUNK adds terminating ")"
246 A$="(do ":GOSUB READ_FORM