basic/reader.in.bas

   1 REM READ_TOKEN(A$, RI, RF) -> T$
   2 READ_TOKEN:
   3   RJ=RI
   4   IF RF=1 THEN GOSUB READ_FILE_CHUNK
   5   REM PRINT "READ_TOKEN: "+STR$(RJ)+", "+MID$(A$,RJ,1)
   6   T$=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
  12   RJ=RJ+1
  13   READ_TOKEN_LOOP:
  14     IF RF=1 THEN GOSUB READ_FILE_CHUNK
  15     IF RJ>LEN(A$) THEN RETURN
  16     CH$=MID$(A$,RJ,1)
  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
  22     READ_TOKEN_CONT:
  23     T$=T$+CH$
  24     IF T$="~@" THEN RETURN
  25     RJ=RJ+1
  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
  29     GOTO READ_TOKEN_LOOP
  30
  31 READ_FILE_CHUNK:
  32   IF RS=1 THEN RETURN
  33   IF RI>1 THEN A$=MID$(A$,RI,LEN(A$)-RI+1):RI=1:RJ=RJ-RI+1
  34   READ_FILE_CHUNK_LOOP:
  35     IF LEN(A$)>RJ+9 THEN RETURN
  36     GET#2,C$:A$=A$+C$
  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
  40
  41 SKIP_SPACES:
  42   IF RF=1 THEN GOSUB READ_FILE_CHUNK
  43   CH$=MID$(A$,RI,1)
  44   IF CH$<>" " AND CH$<>"," AND CH$<>CHR$(13) AND CH$<>CHR$(10) THEN RETURN
  45   RI=RI+1
  46   GOTO SKIP_SPACES
  47
  48 SKIP_TO_EOL:
  49   IF RF=1 THEN GOSUB READ_FILE_CHUNK
  50   CH$=MID$(A$,RI+1,1)
  51   RI=RI+1
  52   IF CH$="" OR CH$=CHR$(13) OR CH$=CHR$(10) THEN RETURN
  53   GOTO SKIP_TO_EOL
  54
  55
  56 READ_ATOM:
  57   R=0
  58   RETURN
  59
  60 REM READ_FORM(A$, RI, RF) -> R
  61 READ_FORM:
  62   IF ER<>-2 THEN RETURN
  63   GOSUB SKIP_SPACES
  64   GOSUB READ_TOKEN
  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
  77   CH$=MID$(T$,1,1)
  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
  82
  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
  91   GOTO READ_SYMBOL
  92
  93   READ_NIL_BOOL:
  94     REM PRINT "READ_NIL_BOOL"
  95     R=T
  96     Z%(R,0)=Z%(R,0)+32
  97     GOTO READ_FORM_DONE
  98   READ_NUMBER:
  99     REM PRINT "READ_NUMBER"
 100     T=2:L=VAL(T$):GOSUB ALLOC
 101     GOTO READ_FORM_DONE
 102   READ_MACRO:
 103     RI=RI+LEN(T$)
 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
 107
 108     REM AS$ is set above
 109     T=5:GOSUB STRING:X=X+1:X%(X)=R
 110
 111     SD=0:GOSUB READ_FORM:X=X+1:X%(X)=R
 112
 113     IF X%(X-3) THEN GOTO READ_MACRO_3
 114
 115     READ_MACRO_2:
 116       B2=X%(X-1):B1=X%(X):GOSUB LIST2
 117       GOTO READ_MACRO_DONE
 118
 119     READ_MACRO_3:
 120       SD=0:GOSUB READ_FORM
 121       B3=X%(X-1):B2=R:B1=X%(X):GOSUB LIST3
 122       AY=B3:GOSUB RELEASE
 123
 124     READ_MACRO_DONE:
 125       REM release values, list has ownership
 126       AY=B2:GOSUB RELEASE
 127       AY=B1:GOSUB RELEASE
 128
 129       SD=X%(X-2):X=X-4: REM get SD and pop the stack
 130       T$="": REM necessary to prevent unexpected EOF errors
 131       GOTO READ_FORM_DONE
 132   READ_STRING:
 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
 142     GOTO READ_FORM_DONE
 143   READ_KEYWORD:
 144     R$=CHR$(127)+MID$(T$,2,LEN(T$)-1)
 145     AS$=R$:T=4:GOSUB STRING
 146     GOTO READ_FORM_DONE
 147   READ_SYMBOL_MAYBE:
 148     CH$=MID$(T$,2,1)
 149     IF CH$>="0" AND CH$<="9" THEN GOTO READ_NUMBER
 150   READ_SYMBOL:
 151     REM PRINT "READ_SYMBOL"
 152     AS$=T$:T=5:GOSUB STRING
 153     GOTO READ_FORM_DONE
 154
 155   READ_SEQ:
 156     REM PRINT "READ_SEQ"
 157     SD=SD+1: REM increase read sequence depth
 158
 159     REM point to empty sequence to start off
 160     R=(T-5)*2+1: REM calculate location of empty seq
 161     Z%(R,0)=Z%(R,0)+32
 162
 163     REM push start ptr on the stack
 164     X=X+1
 165     X%(X)=R
 166     REM push current sequence type
 167     X=X+1
 168     X%(X)=T
 169     REM push previous ptr on the stack
 170     X=X+1
 171     X%(X)=R
 172
 173     RI=RI+LEN(T$)
 174     GOTO READ_FORM
 175
 176   READ_SEQ_END:
 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
 184     GOTO READ_FORM_DONE
 185
 186
 187   READ_FORM_DONE:
 188     RI=RI+LEN(T$)
 189
 190     REM check read sequence depth
 191     IF SD=0 THEN RETURN
 192
 193     REM previous element
 194     T7=X%(X)
 195
 196     REM allocate new sequence entry, set type to previous type, set
 197     REM next to previous next or previous (if first)
 198     L=Z%(T7,1)
 199     IF T7<9 THEN L=T7
 200     T8=R: REM save previous value for release
 201     T=X%(X-1):N=R:GOSUB ALLOC
 202     AY=T8:GOSUB RELEASE: REM list takes ownership
 203
 204     REM if previous element is the first element then set
 205     REM the first to the new element
 206     IF T7<9 THEN X%(X-2)=R:GOTO READ_FORM_SKIP_FIRST
 207     REM set previous list element to point to new element
 208     Z%(T7,1)=R
 209
 210     READ_FORM_SKIP_FIRST:
 211
 212     REM update previous pointer to current element
 213     X%(X)=R
 214     GOTO READ_FORM
 215
 216   READ_FORM_ABORT:
 217     ER=-1
 218     R=0
 219     READ_FORM_ABORT_UNWIND:
 220       IF SD=0 THEN RETURN
 221       X=X-3: REM pop previous, type, and start off the stack
 222       SD=SD-1
 223       IF SD=0 THEN AY=X%(X+1):GOSUB RELEASE
 224       GOTO READ_FORM_ABORT_UNWIND
 225
 226
 227 REM READ_STR(A$) -> R
 228 READ_STR:
 229   RI=1: REM index into A$
 230   RF=0: REM not reading from file
 231   SD=0: REM sequence read depth
 232   GOSUB READ_FORM
 233   RETURN
 234
 235 REM READ_FILE(A$) -> R
 236 READ_FILE:
 237   RI=1: REM index into A$
 238   RJ=1: REM READ_TOKEN sub-index
 239   RF=1: REM reading from file
 240   RS=0: REM file read state (1: EOF)
 241   SD=0: REM sequence read depth
 242   OPEN 2,8,0,A$
 243   REM READ_FILE_CHUNK adds terminating ")"
 244   A$="(do ":GOSUB READ_FORM
 245   CLOSE 2
 246   RETURN