mirror of
https://github.com/kanaka/mal.git
synced 2024-10-26 14:22:25 +03:00
Basic: step8 basics. Fix def!, let*, concat, scalars.
- Move apply logic in swap! to APPLY function in types and use that for macroexpand - Abort def! if error before updating the environment - let* wasn't properly saving A2% for the final eval. Also, the environment release check should be against the top-level EVAL env, not the root repl env. - (concat (list) ...) was broken so fix it to ignore empty lists that aren't in the trailing position. - nil, false and true in the reader were always being returned as references (with an ref cnt) but we have the assumption that references (14) are not ref cnt'd and are always part of a compound type so fix the reader to just return the interned addresses.
This commit is contained in:
Joel Martin
parent
60ef223c3c
commit
70f29a2b3c
@ -15,13 +15,10 @@ STEP3_DEPS = $(STEP1_DEPS) env.in.bas
|
||||
STEP4_DEPS = $(STEP3_DEPS) core.in.bas
|
||||
|
||||
step0_repl.bas: $(STEP0_DEPS)
|
||||
step1_read_print.bas: $(STEP1_DEPS)
|
||||
step2_eval.bas: $(STEP1_DEPS)
|
||||
step1_read_print.bas step2_eval.bas: $(STEP1_DEPS)
|
||||
step3_env.bas: $(STEP3_DEPS)
|
||||
step4_if_fn_do.bas: $(STEP4_DEPS)
|
||||
step5_tco.bas: $(STEP4_DEPS)
|
||||
step6_file.bas: $(STEP4_DEPS)
|
||||
step7_quote.bas: $(STEP4_DEPS)
|
||||
step4_if_fn_do.bas step5_tco.bas step6_file.bas step7_quote.bas: $(STEP4_DEPS)
|
||||
step8_macros.bas: $(STEP4_DEPS)
|
||||
|
||||
tests/%.bas: tests/%.in.bas
|
||||
./basicpp.py $(BASICPP_OPTS) $< > $@
|
||||
@ -31,10 +28,10 @@ tests/%.prg: tests/%.bas
|
||||
petcat -text -w2 -o $@ $<.tmp
|
||||
rm $<.tmp
|
||||
|
||||
mal.prg: step7_quote.prg
|
||||
mal.prg: step8_macros.prg
|
||||
cp $< $@
|
||||
|
||||
SOURCES_LISP = env.in.bas core.in.bas step7_quote.in.bas
|
||||
SOURCES_LISP = env.in.bas core.in.bas step8_macros.in.bas
|
||||
SOURCES = readline.in.bas types.in.bas reader.in.bas printer.in.bas $(SOURCES_LISP)
|
||||
|
||||
.PHONY: stats
|
||||
|
||||
@ -153,6 +153,7 @@ DO_FUNCTION:
|
||||
Z%(R%,1)=Z%(AA%,1)/Z%(AB%,1)
|
||||
RETURN
|
||||
DO_TIME_MS:
|
||||
R%=0
|
||||
RETURN
|
||||
|
||||
DO_LIST:
|
||||
@ -202,6 +203,7 @@ DO_FUNCTION:
|
||||
DO_CONCAT_LOOP:
|
||||
IF ZL%=CZ% THEN R%=AB%:RETURN
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1: REM pop off next seq to prepend
|
||||
IF Z%(AA%,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
|
||||
A%=AA%:B%=0:C%=-1:GOSUB SLICE
|
||||
|
||||
REM release the terminator of new list (we skip over it)
|
||||
@ -213,7 +215,18 @@ DO_FUNCTION:
|
||||
AB%=R%
|
||||
GOTO DO_CONCAT_LOOP
|
||||
DO_NTH:
|
||||
RETURN
|
||||
B%=Z%(AB%,1)
|
||||
A%=AA%:GOSUB COUNT
|
||||
IF R%<=B% THEN R%=0:ER%=1:ER$="nth: index out of range":RETURN
|
||||
DO_NTH_LOOP:
|
||||
IF B%=0 THEN GOTO DO_NTH_DONE
|
||||
B%=B%-1
|
||||
AA%=Z%(AA%,1)
|
||||
GOTO DO_NTH_LOOP
|
||||
DO_NTH_DONE:
|
||||
R%=Z%(AA%+1,1)
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
RETURN
|
||||
DO_FIRST:
|
||||
IF Z%(AA%,1)=0 THEN R%=0
|
||||
IF Z%(AA%,1)<>0 THEN R%=AA%+1:GOSUB DEREF_R
|
||||
@ -268,53 +281,24 @@ DO_FUNCTION:
|
||||
REM push args for release after
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AR%
|
||||
|
||||
REM TODO: break this out into APPLY
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO DO_SWAP_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO DO_SWAP_MAL_FUNCTION
|
||||
REM push atom
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AA%
|
||||
|
||||
DO_SWAP_FUNCTION:
|
||||
REM push atom
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AA%
|
||||
GOSUB APPLY
|
||||
|
||||
GOSUB DO_FUNCTION
|
||||
REM pop atom
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
|
||||
REM pop atom
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
REM pop and release args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
|
||||
REM pop and release args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
|
||||
GOTO DO_SWAP_DONE
|
||||
REM use reset to update the value
|
||||
AB%=R%:GOSUB DO_RESET_BANG
|
||||
|
||||
DO_SWAP_MAL_FUNCTION:
|
||||
REM push current environment for later release
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%
|
||||
REM but decrease ref cnt of return by 1 (not sure why)
|
||||
AY%=R%:GOSUB RELEASE
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM push atom
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AA%
|
||||
|
||||
A%=Z%(F%,1):E%=R%:GOSUB EVAL
|
||||
|
||||
REM pop atom
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
|
||||
REM pop and release args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
|
||||
REM pop and release previous env
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
|
||||
GOTO DO_SWAP_DONE
|
||||
|
||||
DO_SWAP_DONE:
|
||||
REM use reset to update the value
|
||||
AB%=R%:GOSUB DO_RESET_BANG
|
||||
REM but decrease ref cnt of return by 1 (not sure why)
|
||||
AY%=R%:GOSUB RELEASE
|
||||
RETURN
|
||||
RETURN
|
||||
|
||||
DO_PR_MEMORY:
|
||||
P1%=ZT%:P2%=-1:GOSUB PR_MEMORY
|
||||
|
||||
@ -55,25 +55,25 @@ REM NEXT I
|
||||
REM PR_MEMORY_SKIP_STACK:
|
||||
REM PRINT "^^^^^^"
|
||||
REM RETURN
|
||||
|
||||
REM PR_OBJECT(P1%) -> nil
|
||||
PR_OBJECT:
|
||||
RC%=0
|
||||
|
||||
RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=P1%
|
||||
|
||||
PR_OBJ_LOOP:
|
||||
IF RC%=0 THEN RETURN
|
||||
I=ZZ%(ZL%):RC%=RC%-1:ZL%=ZL%-1
|
||||
|
||||
P2%=Z%(I,0)AND15
|
||||
PRINT " "+STR$(I);
|
||||
PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16);
|
||||
PRINT ", type: "+STR$(P2%)+", value: "+STR$(Z%(I,1));
|
||||
IF P2%=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'";
|
||||
IF P2%=5 THEN PRINT " "+ZS$(Z%(I,1))+"";
|
||||
PRINT
|
||||
IF P2%<=5 OR P2%=9 THEN GOTO PR_OBJ_LOOP
|
||||
IF Z%(I,1)<>0 THEN RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(I,1)
|
||||
IF P2%>=6 AND P2%<=8 THEN RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=I+1
|
||||
GOTO PR_OBJ_LOOP
|
||||
REM
|
||||
REM REM PR_OBJECT(P1%) -> nil
|
||||
REM PR_OBJECT:
|
||||
REM RD%=0
|
||||
REM
|
||||
REM RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=P1%
|
||||
REM
|
||||
REM PR_OBJ_LOOP:
|
||||
REM IF RD%=0 THEN RETURN
|
||||
REM I=ZZ%(ZL%):RD%=RD%-1:ZL%=ZL%-1
|
||||
REM
|
||||
REM P2%=Z%(I,0)AND15
|
||||
REM PRINT " "+STR$(I);
|
||||
REM PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16);
|
||||
REM PRINT ", type: "+STR$(P2%)+", value: "+STR$(Z%(I,1));
|
||||
REM IF P2%=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'";
|
||||
REM IF P2%=5 THEN PRINT " "+ZS$(Z%(I,1))+"";
|
||||
REM PRINT
|
||||
REM IF P2%<=5 OR P2%=9 THEN GOTO PR_OBJ_LOOP
|
||||
REM IF Z%(I,1)<>0 THEN RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(I,1)
|
||||
REM IF P2%>=6 AND P2%<=8 THEN RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=I+1
|
||||
REM GOTO PR_OBJ_LOOP
|
||||
|
||||
@ -69,6 +69,8 @@ ENV_SET_S:
|
||||
RETURN
|
||||
|
||||
REM ENV_FIND(E%, K%) -> R%
|
||||
REM Returns environment (R%) containing K%. If found, value found is
|
||||
REM in T4%
|
||||
ENV_FIND:
|
||||
EF%=E%
|
||||
ENV_FIND_LOOP:
|
||||
|
||||
@ -5,7 +5,7 @@ PR_STR:
|
||||
T%=Z%(AZ%,0)AND15
|
||||
REM PRINT "AZ%: "+STR$(AZ%)+", T%: "+STR$(T%)+", V%: "+STR$(Z%(AZ%,1))
|
||||
IF T%=0 THEN R$="nil":RETURN
|
||||
ON T% GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_UNKNOWN,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE
|
||||
ON T% GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_MAL_FUNCTION,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE
|
||||
|
||||
PR_UNKNOWN:
|
||||
R$="#<unknown>"
|
||||
|
||||
@ -74,9 +74,8 @@ READ_FORM:
|
||||
GOTO READ_TO_EOL
|
||||
READ_NIL_BOOL:
|
||||
REM PRINT "READ_NIL_BOOL"
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=14+16
|
||||
Z%(R%,1)=T%
|
||||
R%=T%
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
GOTO READ_FORM_DONE
|
||||
READ_NUMBER:
|
||||
REM PRINT "READ_NUMBER"
|
||||
|
||||
@ -124,8 +124,8 @@ EVAL:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
|
||||
REM AZ%=A%: GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
@ -169,6 +169,8 @@ EVAL:
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
@ -176,18 +178,18 @@ EVAL:
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
REM push A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
REM pop A1%
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
@ -196,7 +198,9 @@ EVAL:
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
GOTO EVAL_RETURN
|
||||
EVAL_INVOKE:
|
||||
|
||||
@ -129,8 +129,8 @@ EVAL:
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%: GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
@ -181,6 +181,8 @@ EVAL:
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
@ -188,18 +190,18 @@ EVAL:
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
REM push A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
REM pop A1%
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
@ -208,7 +210,9 @@ EVAL:
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
GOTO EVAL_RETURN
|
||||
EVAL_DO:
|
||||
|
||||
@ -129,8 +129,8 @@ EVAL:
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%: GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
@ -181,6 +181,8 @@ EVAL:
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
@ -189,7 +191,8 @@ EVAL:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
E4%=E%: REM save the current environment for release
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
@ -197,12 +200,10 @@ EVAL:
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
REM push A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
REM pop A1%
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
@ -211,12 +212,14 @@ EVAL:
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
EVAL_LET_LOOP_DONE:
|
||||
REM release previous env (if not root repl_env) because our
|
||||
REM new env refers to it and we no longer need to track it
|
||||
REM (since we are TCO recurring)
|
||||
IF E4%<>RE% THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
|
||||
@ -129,8 +129,8 @@ EVAL:
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%: GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
@ -181,6 +181,8 @@ EVAL:
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
@ -189,7 +191,8 @@ EVAL:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
E4%=E%: REM save the current environment for release
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
@ -197,12 +200,10 @@ EVAL:
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
REM push A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
REM pop A1%
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
@ -211,12 +212,14 @@ EVAL:
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
EVAL_LET_LOOP_DONE:
|
||||
REM release previous env (if not root repl_env) because our
|
||||
REM new env refers to it and we no longer need to track it
|
||||
REM (since we are TCO recurring)
|
||||
IF E4%<>RE% THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
|
||||
@ -202,8 +202,8 @@ EVAL:
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%: GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
@ -256,6 +256,8 @@ EVAL:
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
@ -264,7 +266,8 @@ EVAL:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
E4%=E%: REM save the current environment for release
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
@ -272,12 +275,10 @@ EVAL:
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
REM push A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
REM pop A1%
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
@ -286,12 +287,14 @@ EVAL:
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
EVAL_LET_LOOP_DONE:
|
||||
REM release previous env (if not root repl_env) because our
|
||||
REM new env refers to it and we no longer need to track it
|
||||
REM (since we are TCO recurring)
|
||||
IF E4%<>RE% THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
|
||||
613
basic/step8_macros.in.bas
Executable file
613
basic/step8_macros.in.bas
Executable file
@ -0,0 +1,613 @@
|
||||
REM POKE 1, PEEK(1)AND248: REM enable all ROM areas as RAM
|
||||
REM POKE 55,0: POKE 56,192: CLR: REM move BASIC end from $A000 to $C000
|
||||
GOTO MAIN
|
||||
|
||||
REM $INCLUDE: 'readline.in.bas'
|
||||
REM $INCLUDE: 'types.in.bas'
|
||||
REM $INCLUDE: 'reader.in.bas'
|
||||
REM $INCLUDE: 'printer.in.bas'
|
||||
REM $INCLUDE: 'env.in.bas'
|
||||
REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM PAIR_Q(B%) -> R%
|
||||
PAIR_Q:
|
||||
R%=0
|
||||
IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B%,1)=0) THEN RETURN
|
||||
R%=1
|
||||
RETURN
|
||||
|
||||
REM QUASIQUOTE(A%) -> R%
|
||||
QUASIQUOTE:
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=1 THEN GOTO QQ_UNQUOTE
|
||||
REM ['quote, ast]
|
||||
AS$="quote":T%=5:GOSUB STRING
|
||||
B2%=R%:B1%=A%:GOSUB LIST2
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R%=A%+1:GOSUB DEREF_R
|
||||
IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
REM push A% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A%=Z%(A%,1):GOSUB QUASIQUOTE:T6%=R%
|
||||
REM pop A% off the stack
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
|
||||
REM set A% to ast[0] for last two cases
|
||||
A%=A%+1:GOSUB DEREF_A
|
||||
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=0 THEN GOTO QQ_DEFAULT
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
|
||||
B%=Z%(A%,1)+1:GOSUB DEREF_B:B2%=B%
|
||||
AS$="concat":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
|
||||
REM push T6% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=T6%
|
||||
REM A% set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R%
|
||||
REM pop T6% off the stack
|
||||
T6%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
|
||||
AS$="cons":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY%=B2%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
REM MACROEXPAND(A%, E%) -> A%:
|
||||
MACROEXPAND:
|
||||
REM push original A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
|
||||
MACROEXPAND_LOOP:
|
||||
REM list?
|
||||
IF (Z%(A%,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
REM non-empty?
|
||||
IF Z%(A%,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
REM symbol? in first position
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
REM defined in environment?
|
||||
K%=B%:GOSUB ENV_FIND
|
||||
IF R%=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B%=T4%:GOSUB DEREF_B
|
||||
REM macro?
|
||||
IF (Z%(B%,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
|
||||
REM apply
|
||||
F%=B%:AR%=Z%(A%,1):GOSUB APPLY
|
||||
A%=R%
|
||||
|
||||
AY%=ZZ%(ZL%)
|
||||
REM if previous A% was not the first A% into macroexpand (i.e. an
|
||||
REM intermediate form) then free it
|
||||
IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
|
||||
|
||||
IF ER%<>0 THEN GOTO MACROEXPAND_DONE
|
||||
GOTO MACROEXPAND_LOOP
|
||||
|
||||
MACROEXPAND_DONE:
|
||||
ZL%=ZL%-1: REM pop original A%
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
|
||||
REM scalar: deref to actual value and inc ref cnt
|
||||
R%=A%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
REM create value ptr placeholder
|
||||
Z%(R%+1,0)=14
|
||||
Z%(R%+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=0 THEN R%=ZZ%(ZL%-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
EVAL_NOT_LIST:
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB MACROEXPAND
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R%<>1 THEN GOTO EVAL_NOT_LIST
|
||||
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
IF A$="quote" THEN GOTO EVAL_QUOTE
|
||||
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
|
||||
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
|
||||
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
|
||||
IF A$="do" THEN GOTO EVAL_DO
|
||||
IF A$="if" THEN GOTO EVAL_IF
|
||||
IF A$="fn*" THEN GOTO EVAL_FN
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB QUASIQUOTE
|
||||
REM add quasiquote result to pending release queue to free when
|
||||
REM next lower EVAL level returns (LV%)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R%:ZR%(ZM%,1)=LV%
|
||||
|
||||
A%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DEFMACRO:
|
||||
REM PRINT "defmacro!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
|
||||
REM change function to macro
|
||||
Z%(R%,0)=Z%(R%,0)+1
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_MACROEXPAND:
|
||||
REM PRINT "macroexpand"
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB MACROEXPAND:R%=A%
|
||||
|
||||
REM since we are returning it unevaluated, inc the ref cnt
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
|
||||
F%=R%+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>0 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>0 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>0 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)"
|
||||
A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of"
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL_LOOP
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>0 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
IF EOF=1 THEN GOTO QUIT
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
QUIT:
|
||||
REM P1%=ZT%: P2%=-1: GOSUB PR_MEMORY
|
||||
GOSUB PR_MEMORY_SUMMARY
|
||||
END
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=0:ER$=""
|
||||
RETURN
|
||||
|
||||
@ -14,6 +14,8 @@ REM followed by key or value (alternating)
|
||||
REM function 9 -> function index
|
||||
REM mal function 10 -> body AST Z% index
|
||||
REM followed by param and env Z% index
|
||||
REM macro (same as 10) 11 -> body AST Z% index
|
||||
REM followed by param and env Z% index
|
||||
REM atom 12 -> Z% index
|
||||
REM environment 13 -> data/hashmap Z% index
|
||||
REM followed by 13 and outer Z% index (-1 for none)
|
||||
@ -130,6 +132,7 @@ RELEASE:
|
||||
|
||||
REM sanity check not already freed
|
||||
IF (U6%)=15 THEN ER%=1:ER$="Free of free memory: "+STR$(AY%):RETURN
|
||||
IF U6%=14 THEN GOTO RELEASE_REFERENCE
|
||||
IF Z%(AY%,0)<15 THEN ER%=1:ER$="Free of freed object: "+STR$(AY%):RETURN
|
||||
|
||||
REM decrease reference count by one
|
||||
@ -142,9 +145,9 @@ RELEASE:
|
||||
IF (U6%<=5) OR (U6%=9) THEN GOTO RELEASE_SIMPLE
|
||||
IF (U6%>=6) AND (U6%<=8) THEN GOTO RELEASE_SEQ
|
||||
IF U6%=10 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6%=11 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6%=12 THEN GOTO RELEASE_ATOM
|
||||
IF U6%=13 THEN GOTO RELEASE_ENV
|
||||
IF U6%=14 THEN GOTO RELEASE_REFERENCE
|
||||
IF U6%=15 THEN ER%=1:ER$="RELEASE of already freed: "+STR$(AY%):RETURN
|
||||
ER%=1:ER$="RELEASE not defined for type "+STR$(U6%):RETURN
|
||||
|
||||
@ -509,3 +512,31 @@ MAL_FUNCTION:
|
||||
Z%(R%+1,0)=P%
|
||||
Z%(R%+1,1)=E%
|
||||
RETURN
|
||||
|
||||
REM APPLY(F%, AR%) -> R%
|
||||
REM restores E%
|
||||
APPLY:
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO DO_APPLY_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=11 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
|
||||
DO_APPLY_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
RETURN
|
||||
|
||||
DO_APPLY_MAL_FUNCTION:
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM save the current environment
|
||||
|
||||
REM create new environ using env and params stored in the
|
||||
REM function and bind the params to the apply arguments
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
|
||||
A%=Z%(F%,1):E%=R%:GOSUB EVAL
|
||||
|
||||
AY%=E%:GOSUB RELEASE: REM release the new environment
|
||||
|
||||
E%=ZZ%(ZL%):ZL%=ZL%-1: REM pop/restore the saved environment
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
@ -32,7 +32,11 @@ MYNUM
|
||||
;; Check env lookup non-fatal error
|
||||
(abc 1 2 3)
|
||||
; .*\'abc\' not found.*
|
||||
|
||||
;; Check that error aborts def!
|
||||
(def! w 123)
|
||||
(def! w (abc))
|
||||
w
|
||||
;=>123
|
||||
|
||||
;; Testing let*
|
||||
(let* (z 9) z)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user