mal/basic/reader.in.bas

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