Adjust step2 tests to keep values within 2 byte int range.
./qb2cbm.sh $< > $@
step0_repl.bas: readline.in.bas
-
step1_read_print.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas
+step2_eval.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas
+
+tests/%.bas: tests/%.in.bas readline.in.bas types.in.bas reader.in.bas printer.in.bas
+ ./qb2cbm.sh $< > $@
+
-REM PR_STR(A%) -> R$
-PR_STR:
- T%=ZT%(A%)
- REM PRINT "A%: " + STR$(A%) + ", T%: " + STR$(T%)
- IF T%=0 THEN R$="nil": RETURN
- IF T%=1 THEN R$="false": RETURN
- IF T%=2 THEN R$="true": RETURN
- IF T%=3 THEN PR_INTEGER
- IF T%=5 THEN PR_STRING
- IF T%=6 THEN PR_KEYWORD
- IF T%=7 THEN PR_SYMBOL
- IF T%=8 THEN PR_LIST
- R$="#<unknown>"
- RETURN
-
- PR_INTEGER:
- T%=ZV%(A%)
- R$=STR$(T%)
- IF T%<0 THEN RETURN
- REM Remove initial space
- R$=RIGHT$(R$, LEN(R$)-1)
- RETURN
- PR_STRING:
- R$=CHR$(34) + ZS$(ZV%(A%)) + CHR$(34)
- RETURN
- PR_KEYWORD:
- R$=":keyword"
- RETURN
- PR_SYMBOL:
- R$=ZS$(ZV%(A%))
- RETURN
- PR_LIST:
- IF PT%=-1 THEN RR$=""
- RR$=RR$+"("
- REM keep track of where we are in the list
- PT%=PT%+1
- PS%(PT%)= A%
- PR_LIST_LOOP:
- IF ZV%(A%) = 0 THEN PR_LIST_DONE
- A%=A%+1
- REM Push whether we are rendering a list on stack
- PT%=PT%+1
- IF ZT%(A%) = 8 THEN PS%(PT%) = 1
- IF ZT%(A%) <> 8 THEN PS%(PT%) = 0
- GOSUB PR_STR
- REM check append then pop off stack
- IF PS%(PT%) = 1 THEN RR$=RR$
- IF PS%(PT%) = 0 THEN RR$=RR$+R$
- PT%=PT%-1
- REM Go to next list element
- A%=ZV%(PS%(PT%))
- PS%(PT%) = A%
- IF ZV%(A%) <> 0 THEN RR$=RR$+" "
- GOTO PR_LIST_LOOP
- PR_LIST_DONE:
- PT%=PT%-1
- RR$=RR$+")"
- IF PT%=-1 THEN R$=RR$
- RETURN
-
-
-PR_MEMORY:
- PRINT "Memory:"
- FOR I=0 TO ZI%-1
- PRINT " " + STR$(I) + ": type: " + STR$(ZT%(I)) + ", value: " + STR$(ZV%(I))
- NEXT I
- RETURN
+REM PR_STR(AZ%) -> R$
+PR_STR:
+ T%=Z%(AZ%,0)
+ REM PRINT "AZ%: " + STR$(AZ%) + ", T%: " + STR$(T%)
+ IF T%=15 THEN AZ%=Z%(AZ%,1): GOTO PR_STR
+ IF T%=0 THEN R$="nil": RETURN
+ IF (T%=1) AND (Z%(AZ%,1)=0) THEN R$="false": RETURN
+ IF (T%=1) AND (Z%(AZ%,1)=1) THEN R$="true": RETURN
+ IF T%=2 THEN PR_INTEGER
+ IF T%=4 THEN PR_STRING
+ IF T%=5 THEN PR_SYMBOL
+ IF T%=6 THEN PR_SEQ
+ IF T%=8 THEN PR_SEQ
+ IF T%=10 THEN PR_SEQ
+ IF T%=12 THEN PR_FUNCTION
+ R$="#<unknown>"
+ RETURN
+
+ PR_INTEGER:
+ T%=Z%(AZ%,1)
+ R$=STR$(T%)
+ IF T%<0 THEN RETURN
+ REM Remove initial space
+ R$=RIGHT$(R$, LEN(R$)-1)
+ RETURN
+ PR_STRING:
+ R$=CHR$(34) + ZS$(Z%(AZ%,1)) + CHR$(34)
+ RETURN
+ PR_SYMBOL:
+ R$=ZS$(Z%(AZ%,1))
+ RETURN
+ PR_SEQ:
+ IF PT%=-1 THEN RR$=""
+ IF T%=6 THEN RR$=RR$+"("
+ IF T%=8 THEN RR$=RR$+"["
+ IF T%=10 THEN RR$=RR$+"{"
+ REM push where we are in the sequence
+ PT%=PT%+1
+ PS%(PT%)= AZ%
+ PR_SEQ_LOOP:
+ IF Z%(AZ%,1) = 0 THEN PR_SEQ_DONE
+ AZ%=AZ%+1
+ REM Push type we are rendering on the stack
+ PT%=PT%+1
+ PS%(PT%) = Z%(AZ%,0)
+ GOSUB PR_STR
+ REM check type and pop off stack
+ T%=PS%(PT%)
+ IF (T% >= 6) AND (T% <= 11) THEN RR$=RR$
+ IF (T% < 6) OR (T% > 11) THEN RR$=RR$+R$
+ PT%=PT%-1
+ REM Go to next list element
+ AZ%=Z%(PS%(PT%),1)
+ PS%(PT%) = AZ%
+ IF Z%(AZ%,1) <> 0 THEN RR$=RR$+" "
+ GOTO PR_SEQ_LOOP
+ PR_SEQ_DONE:
+ T%=Z%(PS%(PT%),0)
+ PT%=PT%-1
+ IF T%=6 THEN RR$=RR$+")"
+ IF T%=8 THEN RR$=RR$+"]"
+ IF T%=10 THEN RR$=RR$+"}"
+ IF PT%=-1 THEN R$=RR$
+ RETURN
+ PR_FUNCTION:
+ T1%=Z%(AZ%,1)
+ R$="#<function" + STR$(T1%) + ">"
+ RETURN
+
+
+
+PR_MEMORY:
+ PRINT "Value Memory (Z%):"
+ FOR I=0 TO ZI%-1
+ PRINT " " + STR$(I) + ": type: " + STR$(Z%(I,0)) + ", value: " + STR$(Z%(I,1))
+ NEXT I
+ PRINT "String Memory (ZS%):"
+ FOR I=0 TO ZJ%-1
+ PRINT " " + STR$(I) + ": '" + ZS$(I) + "'"
+ NEXT I
+ RETURN
set -e
DEBUG=${DEBUG:-}
+KEEP_REM=${KEEP_REM:-}
+KEEP_REM_LABELS=${KEEP_REM_LABELS:-}
infile=$1
fi
[ "${DEBUG}" ] && echo >&2 "including: ${include}"
included[${include}]="done"
- full="${full}\nREM vvv BEGIN '${include}' vvv\n$(cat ${include})\nREM vvv END '${include}' vvv\n"
+ if [ "${KEEP_REM}" ]; then
+ full="${full}\nREM vvv BEGIN '${include}' vvv\n$(cat ${include})\nREM vvv END '${include}' vvv\n"
+ else
+ full="${full}\n$(cat ${include})\n"
+ fi
else
full="${full}${line}\n"
fi
lnum=10
while read -r line; do
if [[ ${line} =~ ^\ *# ]]; then
- [ "${DEBUG}" ] && echo >&2 "ignoring # style comment after $lnum"
+ [ "${DEBUG}" ] && echo >&2 "ignoring # style comment at $lnum"
+ continue
+ elif [[ -z "${KEEP_REM}" && ${line} =~ ^\ *REM ]]; then
+ [ "${DEBUG}" ] && echo >&2 "dropping REM comment: ${line}"
continue
elif [[ ${line} =~ ^\ *$ ]]; then
- [ "${DEBUG}" ] && echo >&2 "found blank line after $lnum"
+ [ "${DEBUG}" ] && echo >&2 "found blank line at $lnum"
data="${data}\n"
continue
- elif [[ ${line} =~ ^[A-Za-z_]*:$ ]]; then
+ elif [[ ${line} =~ ^[A-Za-z_][A-Za-z0-9_]*:$ ]]; then
label=${line%:}
[ "${DEBUG}" ] && echo >&2 "found label ${label} at $lnum"
labels[${label}]=$lnum
- data="${data}${lnum} REM ${label}:\n"
+ if [ -n "${KEEP_REM_LABELS}" ]; then
+ data="${data}${lnum} REM ${label}:\n"
+ else
+ continue
+ fi
else
data="${data}${lnum} ${line}\n"
fi
lnum=$(( lnum + 10 ))
done < <(echo -e "${input}")
+if [[ -z "${KEEP_REM}" ]]; then
+ [ "${DEBUG}" ] && echo >&2 "Dropping line ending REMs"
+ data=$(echo -e "${data}" | sed "s/: REM [^\n]*$//")
+fi
+
for label in "${!labels[@]}"; do
[ "${DEBUG}" ] && echo >&2 "Updating label: ${label}"
lnum=${labels[${label}]}
- data=$(echo "${data}" | sed "s/\(THEN\|GOTO\|GOSUB\) ${label}\>/\1 ${lnum}: REM \1 ${label}/g")
+ if [ -n "${KEEP_REM_LABELS}" ]; then
+ data=$(echo "${data}" | sed "s/\(THEN\|GOTO\|GOSUB\) ${label}\>/\1 ${lnum}: REM ${label}/g")
+ else
+ data=$(echo "${data}" | sed "s/\(THEN\|GOTO\|GOSUB\) ${label}\>/\1 ${lnum}/g")
+ fi
done
-echo -en "${data}"
+echo -e "${data}"
IF (T$="true") THEN R%=2: GOTO READ_FORM_DONE
CH$=MID$(T$,1,1)
REM PRINT "CH$: [" + CH$ + "](" + STR$(ASC(CH$)) + ")"
- IF (CH$ >= "0") AND (CH$ <= "9") OR (CH$ = "-") THEN READ_NUMBER
+ IF (CH$ >= "0") AND (CH$ <= "9") THEN READ_NUMBER
+ IF (CH$ = "-") THEN READ_SYMBOL_MAYBE
+
IF (CH$ = CHR$(34)) THEN READ_STRING
- IF (CH$ = "(") THEN READ_LIST
- IF (CH$ = ")") THEN READ_LIST_END
+ IF (CH$ = "(") THEN T%=6: GOTO READ_SEQ
+ IF (CH$ = ")") THEN T%=6: GOTO READ_SEQ_END
+ IF (CH$ = "[") THEN T%=8: GOTO READ_SEQ
+ IF (CH$ = "]") THEN T%=8: GOTO READ_SEQ_END
+ IF (CH$ = "{") THEN T%=10: GOTO READ_SEQ
+ IF (CH$ = "}") THEN T%=10: GOTO READ_SEQ_END
GOTO READ_SYMBOL
READ_NUMBER:
REM PRINT "READ_NUMBER"
- ZT%(ZI%) = 3
- ZV%(ZI%) = VAL(T$)
+ Z%(ZI%,0) = 2
+ Z%(ZI%,1) = VAL(T$)
R%=ZI%
ZI%=ZI%+1
GOTO READ_FORM_DONE
READ_STRING:
REM PRINT "READ_STRING"
- ZT%(ZI%) = 5
- ZV%(ZI%) = ZJ%
+ Z%(ZI%,0) = 4
+ Z%(ZI%,1) = ZJ%
R%=ZI%
ZI%=ZI%+1
ZS$(ZJ%) = MID$(T$, 2, LEN(T$)-2)
REM ZS$(ZJ%) = T$
ZJ%=ZJ%+1
GOTO READ_FORM_DONE
+ READ_SYMBOL_MAYBE:
+ CH$=MID$(T$,2,1)
+ IF (CH$ >= "0") AND (CH$ <= "9") THEN READ_NUMBER
READ_SYMBOL:
REM PRINT "READ_SYMBOL"
- ZT%(ZI%) = 7
- ZV%(ZI%) = ZJ%
+ Z%(ZI%,0) = 5
+ Z%(ZI%,1) = ZJ%
R%=ZI%
ZI%=ZI%+1
ZS$(ZJ%) = T$
ZJ%=ZJ%+1
GOTO READ_FORM_DONE
- READ_LIST:
- REM PRINT "READ_LIST"
+ READ_SEQ:
+ REM PRINT "READ_SEQ"
REM push start ptr on the stack
PT%=PT%+1
PS%(PT%) = ZI%
+ REM push current sequence type
+ PT%=PT%+1
+ PS%(PT%) = T%
REM push current ptr on the stack
PT%=PT%+1
PS%(PT%) = ZI%
GOTO READ_FORM_DONE
- READ_LIST_END:
- REM PRINT "READ_LIST_END"
+ READ_SEQ_END:
+ REM PRINT "READ_SEQ_END"
IF PT%=-1 THEN ER%=1: ER$="unexpected ')'": RETURN
- REM Set return value to current list
- PT%=PT%-1: REM pop current ptr off the stack
- R%=PS%(PT%): REM start ptr to list
+ REM Set return value to current sequence
+ PT%=PT%-2: REM pop current ptr and type off the stack
+ R%=PS%(PT%): REM ptr to start of sequence to return
PT%=PT%-1: REM pop start ptr off the stack
+ IF (PS%(PT%+2)) <> T% THEN ER%=1: ER$="sequence mismatch": RETURN
GOTO READ_FORM_DONE
IF T$="" THEN ER%=1: ER$="unexpected EOF": RETURN
REM add list end entry (next pointer is 0 for now)
REM PRINT "READ_FORM_DONE next list entry"
- ZT%(ZI%) = 8
- ZV%(ZI%) = 0
+ Z%(ZI%,0) = PS%(PT%- 1)
+ Z%(ZI%,1) = 0
REM update prior pointer if not first
- IF PS%(PT%)<>ZI% THEN ZV%(PS%(PT%)) = ZI%
+ IF PS%(PT%)<>ZI% THEN Z%(PS%(PT%),1) = ZI%
REM update previous pointer to outself
PS%(PT%) = ZI%
ZI%=ZI%+1: REM slot for list element
-GOTO MAIN
-
-REM $INCLUDE: 'readline.in.bas'
-
-REM /* READ(A$) -> R$ */
-MAL_READ:
- R$=A$
- RETURN
-
-REM /* EVAL(A$, E%) -> R$ */
-EVAL:
- GOSUB MAL_READ: REM /* call READ */
- RETURN
-
-REM /* PRINT(A$) -> R$ */
-MAL_PRINT:
- GOSUB EVAL: REM /* call EVAL */
- RETURN
-
-REM /* REP(A$) -> R$ */
-REP:
- GOSUB MAL_PRINT: REM /* call PRINT */
- PRINT R$
- RETURN
-
-REM /* main program loop */
-MAIN:
- A$="user> "
- GOSUB READLINE: REM /* call input parser */
- IF EOF=1 THEN END
- A$=R$
- GOSUB REP: REM /* call REP */
- GOTO MAIN
-
+GOTO MAIN
+
+REM $INCLUDE: 'readline.in.bas'
+
+REM READ(A$) -> R$
+MAL_READ:
+ R$=A$
+ RETURN
+
+REM EVAL(A$, E%) -> R$
+EVAL:
+ R$=A$
+ RETURN
+
+REM PRINT(A$) -> R$
+MAL_PRINT:
+ R$=A$
+ RETURN
+
+REM REP(A$) -> R$
+REP:
+ GOSUB MAL_READ
+ A%=R%: GOSUB EVAL
+ A%=R%: GOSUB MAL_PRINT
+ RETURN
+
+REM MAIN program
+MAIN:
+ MAIN_LOOP:
+ A$="user> "
+ GOSUB READLINE: REM /* call input parser */
+ IF EOF=1 THEN GOTO MAIN_DONE
+ A$=R$: GOSUB REP: REM /* call REP */
+ PRINT R$
+ GOTO MAIN_LOOP
+
+ MAIN_DONE:
+ PRINT "Free: " + STR$(FRE(0))
+ END
+
REM $INCLUDE: 'reader.in.bas'
REM $INCLUDE: 'printer.in.bas'
-REM /* READ(A$) -> R% */
+REM READ(A$) -> R%
MAL_READ:
GOSUB READ_STR
RETURN
-REM /* EVAL(A%, E%) -> R% */
+REM EVAL(A%, E%) -> R%
EVAL:
R%=A%
RETURN
-REM /* PRINT(A%) -> R$ */
+REM PRINT(A%) -> R$
MAL_PRINT:
- GOSUB PR_STR
+ AZ%=A%: GOSUB PR_STR
RETURN
-REM /* REP(A$) -> R$ */
+REM REP(A$) -> R$
REP:
GOSUB MAL_READ
IF ER% THEN RETURN
- A%=R%
- GOSUB EVAL
+ A%=R%: GOSUB EVAL
IF ER% THEN RETURN
- A%=R%
- GOSUB MAL_PRINT
+ A%=R%: GOSUB MAL_PRINT
IF ER% THEN RETURN
- PRINT R$
RETURN
-REM /* main program loop */
+REM MAIN program
MAIN:
GOSUB INIT_MEMORY
+
MAIN_LOOP:
A$="user> "
GOSUB READLINE: REM /* call input parser */
- IF EOF=1 THEN END
- A$=R$
- GOSUB REP: REM /* call REP */
+ IF EOF=1 THEN GOTO MAIN_DONE
+ A$=R$: GOSUB REP: REM /* call REP */
IF ER% THEN GOTO ERROR
+ PRINT R$
GOTO MAIN_LOOP
ERROR:
ER$=""
GOTO MAIN_LOOP
+ MAIN_DONE:
+ PRINT "Free: " + STR$(FRE(0))
+ END
+
--- /dev/null
+GOTO MAIN
+
+REM $INCLUDE: 'readline.in.bas'
+REM $INCLUDE: 'types.in.bas'
+REM $INCLUDE: 'reader.in.bas'
+REM $INCLUDE: 'printer.in.bas'
+
+REM READ(A$) -> R%
+MAL_READ:
+ GOSUB READ_STR
+ RETURN
+
+REM EVAL_AST(A%, E%) -> R%
+EVAL_AST:
+ ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
+ IF ER%=1 THEN GOTO EVAL_AST_RETURN
+
+ REM AZ%=A%: GOSUB PR_STR
+ REM PRINT "EVAL_AST: " + R$ + "(" + STR$(R%) + ")"
+
+ T%=Z%(A%,0)
+ IF T%=5 THEN EVAL_AST_SYMBOL
+ IF T%=6 THEN EVAL_AST_LIST
+ R%=A%
+ GOTO EVAL_AST_RETURN
+
+ EVAL_AST_SYMBOL:
+ HM%=E%: K%=A%: GOSUB HASHMAP_GET
+ IF T3%=0 THEN ER%=1: ER$="'" + ZS$(Z%(A%,1)) + "' not found"
+ GOTO EVAL_AST_RETURN
+
+ EVAL_AST_LIST:
+ REM push future return value (new list)
+ ZL%=ZL%+1
+ ZZ%(ZL%)=ZI%
+ REM push previous new list entry
+ ZL%=ZL%+1
+ ZZ%(ZL%)=ZI%
+
+ EVAL_AST_LIST_LOOP:
+ REM create new list entry
+ Z%(ZI%,0)=6
+ Z%(ZI%,1)=0
+ ZI%=ZI%+1
+
+ REM check if we are done evaluating the list
+ IF Z%(A%,1)=0 THEN GOTO EVAL_AST_LIST_LOOP_DONE
+
+ REM create value ptr placeholder
+ Z%(ZI%,0)=15
+ Z%(ZI%,1)=0
+ ZI%=ZI%+1
+
+ REM call EVAL for each entry
+ A%=A%+1: GOSUB EVAL
+ A%=A%-1
+
+ REM update previous list entry to point to current entry
+ Z%(ZZ%(ZL%),1)=ZI%
+ REM update previous value pointer to evaluated entry
+ Z%(ZZ%(ZL%)+1,1)=R%
+ REM update previous ptr to current entry
+ ZZ%(ZL%)=ZI%
+
+ REM process the next list entry
+ A%=Z%(A%,1)
+
+ GOTO EVAL_AST_LIST_LOOP
+ EVAL_AST_LIST_LOOP_DONE:
+ REM pop previous new list entry value
+ ZL%=ZL%-1
+ REM pop return value (new list)
+ R%=ZZ%(ZL%)
+ ZL%=ZL%-1
+ GOTO EVAL_AST_RETURN
+
+ EVAL_AST_RETURN:
+ E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2
+ RETURN
+
+REM EVAL(A%, E%)) -> R%
+EVAL:
+ ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
+ IF ER%=1 THEN GOTO EVAL_RETURN
+
+ REM AZ%=A%: GOSUB PR_STR
+ REM PRINT "EVAL: " + R$ + "(" + STR$(R%) + ")"
+
+ GOSUB LIST_Q
+ IF R% THEN GOTO APPLY_LIST
+ REM ELSE
+ GOSUB EVAL_AST
+ GOTO EVAL_RETURN
+
+ APPLY_LIST:
+ GOSUB EMPTY_Q
+ IF R% THEN R%=A%: GOTO EVAL_RETURN
+
+ GOSUB EVAL_AST
+ IF ER%=1 THEN GOTO EVAL_RETURN
+ F%=R%+1
+ AR%=Z%(R%,1): REM REST
+ R%=F%: GOSUB DEREF
+ F%=R%
+ IF Z%(F%,0)<>12 THEN ER%=1: ER$="apply of non-function": GOTO EVAL_RETURN
+ GOSUB DO_FUNCTION
+
+ GOTO EVAL_RETURN
+
+ EVAL_RETURN:
+ E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2
+ RETURN
+
+REM DO_FUNCTION(F%, AR%)
+DO_FUNCTION:
+ AZ%=F%: GOSUB PR_STR
+ F$=R$
+ AZ%=AR%: GOSUB PR_STR
+ AR$=R$
+
+ REM Get the function number
+ FF%=Z%(F%,1)
+
+ REM Get argument values
+ R%=AR%+1: GOSUB DEREF
+ AA%=Z%(R%,1)
+ R%=Z%(AR%,1)+1: GOSUB DEREF
+ AB%=Z%(R%,1)
+
+ REM Allocate the return value
+ R%=ZI%
+ ZI%=ZI%+1
+
+ REM Switch on the function number
+ IF FF%=1 THEN DO_ADD
+ IF FF%=2 THEN DO_SUB
+ IF FF%=3 THEN DO_MULT
+ IF FF%=4 THEN DO_DIV
+ ER%=1: ER$="unknown function" + STR$(FF%): RETURN
+
+ DO_ADD:
+ Z%(R%,0)=2
+ Z%(R%,1)=AA%+AB%
+ GOTO DO_FUNCTION_DONE
+ DO_SUB:
+ Z%(R%,0)=2
+ Z%(R%,1)=AA%-AB%
+ GOTO DO_FUNCTION_DONE
+ DO_MULT:
+ Z%(R%,0)=2
+ Z%(R%,1)=AA%*AB%
+ GOTO DO_FUNCTION_DONE
+ DO_DIV:
+ Z%(R%,0)=2
+ Z%(R%,1)=AA%/AB%
+ GOTO DO_FUNCTION_DONE
+
+ DO_FUNCTION_DONE:
+ RETURN
+
+REM PRINT(A%) -> R$
+MAL_PRINT:
+ AZ%=A%: GOSUB PR_STR
+ RETURN
+
+REM REP(A$) -> R$
+REM Assume RE% has repl_env
+REP:
+ GOSUB MAL_READ
+ IF ER% THEN RETURN
+ A%=R%: E%=RE%: GOSUB EVAL
+ IF ER% THEN RETURN
+ A%=R%: GOSUB MAL_PRINT
+ IF ER% THEN RETURN
+ RETURN
+
+REM MAIN program
+MAIN:
+ GOSUB INIT_MEMORY
+
+ REM repl_env
+ GOSUB HASHMAP
+ RE%=R%
+
+ REM + function
+ A%=1: GOSUB NATIVE_FUNCTION
+ HM%=RE%: K$="+": V%=R%: GOSUB ASSOC1_S
+ RE%=R%
+
+ REM - function
+ A%=2: GOSUB NATIVE_FUNCTION
+ HM%=RE%: K$="-": V%=R%: GOSUB ASSOC1_S
+ RE%=R%
+
+ REM * function
+ A%=3: GOSUB NATIVE_FUNCTION
+ HM%=RE%: K$="*": V%=R%: GOSUB ASSOC1_S
+ RE%=R%
+
+ REM / function
+ A%=4: GOSUB NATIVE_FUNCTION
+ HM%=RE%: K$="/": V%=R%: GOSUB ASSOC1_S
+ RE%=R%
+
+ AZ%=RE%: GOSUB PR_STR
+ PRINT "env: " + R$ + "(" + STR$(RE%) + ")"
+
+ MAIN_LOOP:
+ A$="user> "
+ GOSUB READLINE: REM /* call input parser */
+ IF EOF=1 THEN GOTO MAIN_DONE
+ A$=R$: GOSUB REP: REM /* call REP */
+ IF ER% THEN GOTO ERROR
+ PRINT R$
+ GOTO MAIN_LOOP
+
+ ERROR:
+ PRINT "Error: " + ER$
+ ER%=0
+ ER$=""
+ GOTO MAIN_LOOP
+
+ MAIN_DONE:
+ PRINT "Free: " + STR$(FRE(0)): REM abc
+ END
+
-REM TYPE% -> VALUE%
-REM nil 0 -> (unused)
-REM false 1 -> (unused)
-REM true 2 -> (unused)
-REM integer 3 -> int value
-REM float 4 -> ???
-REM string 5 -> ZS$ index
-REM keyword 6 -> ZS$ index
-REM symbol 7 -> ZS$ index
-REM list next 8 -> ZT% index / or 0
-REM followed by value unless empty
-REM vector next 9 -> ZT% index / or 0
-REM followed by value unless empty
-REM hashmap 12 -> ???
-REM mal function 13 -> ???
-REM atom 14 -> TYPE% index
-
-INIT_MEMORY:
- REM global error state
- ER%=0
- ER$=""
-
- REM boxes memory elements
- SZ%=4096
- DIM ZT%(SZ%): REM TYPE ARRAY
- DIM ZV%(SZ%): REM VALUE ARRAY
-
- REM Predefine nil, false, true
- ZT%(0) = 0
- ZT%(1) = 1
- ZT%(2) = 2
- ZI%=3
-
- REM string memory
- ZJ%=0
- DIM ZS$(1024)
-
- REM logic stack
- PT%=-1: REM index of top of PS% stack
- DIM PS%(128): REM stack of ZT% indexes
-
- REM environment
- REM DIM EKEYS$(1024)
- REM DIM EVALS%(1024)
- RETURN
+REM Z 0 -> 1
+REM nil 0 -> (unused)
+REM boolean 1 -> 0: false, 1: true
+REM integer 2 -> int value
+REM float 3 -> ???
+REM string/kw 4 -> ZS$ index
+REM symbol 5 -> ZS$ index
+REM list next/val 6 -> next Z% index / or 0
+REM followed by value (unless empty)
+REM vector next/val 8 -> next Z% index / or 0
+REM followed by value (unless empty)
+REM hashmap next/val 10 -> next Z% index / or 0
+REM followed by key or value (alternating)
+REM function 12 -> function index
+REM mal function 13 -> ???
+REM atom 14 -> Z% index
+REM reference/ptr 15 -> Z% index / or 0
+
+INIT_MEMORY:
+ T%=FRE(0)
+
+ S1%=4096: REM Z% (boxed memory) size (X2)
+ S2%=512: REM ZS% (string memory) size
+ S3%=64: REM PS% (logic stack) size
+ S4%=256: REM ZE% (environments) size
+ S5%=512: REM ZZ% (call stack) size
+
+ REM global error state
+ ER%=0
+ ER$=""
+
+ REM boxed element memory
+ DIM Z%(S1%,1): REM TYPE ARRAY
+
+ REM Predefine nil, false, true
+ Z%(0,0) = 0
+ Z%(1,0) = 1
+ Z%(1,1) = 0
+ Z%(2,0) = 1
+ Z%(2,1) = 1
+ ZI%=3
+
+ REM string memory storage
+ ZJ%=0
+ DIM ZS$(S2%)
+
+ REM environments
+ ZK%=0
+ DIM ZE%(S4%): REM data hashmap Z% index
+ DIM ZO%(S4%): REM outer ZE% index (or -1)
+
+ REM call stack
+ ZL%=-1
+ DIM ZZ%(S5%): REM stack of Z% indexes
+
+ REM logic stack
+ PT%=-1: REM index of top of PS% stack
+ DIM PS%(S3%): REM stack of Z% indexes
+
+ REM PRINT "Lisp data memory: " + STR$(T%-FRE(0))
+ REM PRINT "Interpreter working memory: " + STR$(FRE(0))
+ RETURN
+
+REM DEREF(R%) -> R%
+DEREF:
+ IF Z%(R%,0)=15 THEN R%=Z%(R%,1): GOTO DEREF
+ RETURN
+
+
+REM LIST functions
+
+LIST_Q:
+ R%=0
+ IF Z%(A%,0)=6 THEN R%=1
+ RETURN
+
+EMPTY_Q:
+ R%=0
+ IF Z%(A%,1)=0 THEN R%=1
+ RETURN
+
+REM HASHMAP functions
+
+REM HASHMAP() -> R%
+HASHMAP:
+ Z%(ZI%,0) = 10
+ Z%(ZI%,1) = 0
+ R%=ZI%
+ ZI%=ZI%+1
+ RETURN
+
+REM ASSOC1(HM%, K%, V%) -> R%
+ASSOC1:
+ R%=ZI%
+ REM key ptr
+ Z%(ZI%,0) = 10
+ Z%(ZI%,1) = ZI%+2: REM value
+ ZI%=ZI%+1
+ Z%(ZI%,0) = 15
+ Z%(ZI%,1) = K%
+ ZI%=ZI%+1
+ REM value ptr
+ Z%(ZI%,0) = 10
+ Z%(ZI%,1) = HM%: REM hashmap to assoc onto
+ ZI%=ZI%+1
+ Z%(ZI%,0) = 15
+ Z%(ZI%,1) = V%
+ ZI%=ZI%+1
+ RETURN
+
+REM ASSOC1(HM%, K$, V%) -> R%
+ASSOC1_S:
+ REM add the key string, then call ASSOC1
+ K%=ZI%
+ ZS$(ZJ%) = K$
+ Z%(ZI%,0) = 4
+ Z%(ZI%,1) = ZJ%
+ ZI%=ZI%+1
+ ZJ%=ZJ%+1
+ GOSUB ASSOC1
+ RETURN
+
+REM HASHMAP_GET(HM%, K%) -> R%
+HASHMAP_GET:
+ H2%=HM%
+ T1$=ZS$(Z%(K%,1)): REM search key string
+ T3%=0: REM whether found or not (for HASHMAP_CONTAINS)
+ R%=0
+ HASHMAP_GET_LOOP:
+ REM no matching key found
+ IF Z%(H2%,1)=0 THEN R%=0: RETURN
+ REM follow value ptrs
+ T2%=H2%+1
+ HASHMAP_GET_DEREF:
+ IF Z%(T2%,0)=15 THEN T2%=Z%(T2%,1): GOTO HASHMAP_GET_DEREF
+ REM get key string
+ T2$=ZS$(Z%(T2%,1))
+ REM if they are equal, we found it
+ IF T1$=T2$ THEN T3%=1: R%=Z%(H2%,1)+1: RETURN
+ REM skip to next key
+ H2%=Z%(Z%(H2%,1),1)
+ GOTO HASHMAP_GET_LOOP
+
+REM HASHMAP_CONTAINS(HM%, K%) -> R%
+HASHMAP_CONTAINS:
+ GOSUB HASHMAP_GET
+ R%=1: REM false
+ IF T3%=1 THEN R%=2: REM true
+ RETURN
+
+REM NATIVE_FUNCTION(A%) -> R%
+NATIVE_FUNCTION:
+ Z%(ZI%,0) = 12
+ Z%(ZI%,1) = A%
+ R%=ZI%
+ ZI%=ZI%+1
+ RETURN
+
+MAL_FUNCTION:
+ RETURN
(/ (- (+ 5 (* 2 3)) 3) 4)
;=>2
-(/ (- (+ 515 (* 222 311)) 302) 27)
-;=>2565
+(/ (- (+ 515 (* 87 311)) 302) 27)
+;=>1010
(* -3 6)
;=>-18
-(/ (- (+ 515 (* -222 311)) 296) 27)
-;=>-2549
+(/ (- (+ 515 (* -87 311)) 296) 27)
+;=>-994
(abc 1 2 3)
; .*\'abc\' not found.*
HCoop / jackhill / mal.git / commitdiff