From 8cef22ba5d67573ba3d350c88f6434b1a614f2e2 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sat, 16 Nov 2024 08:43:33 +0100 Subject: [PATCH 1/2] basic: separate evaluation of the function and its arguments This is a prerequisite for merging macroexpand into EVAL. --- impls/basic/step2_eval.in.bas | 33 +++++++++++++++++++-------- impls/basic/step3_env.in.bas | 31 +++++++++++++++++-------- impls/basic/step4_if_fn_do.in.bas | 38 +++++++++++++++++++++++++------ impls/basic/step5_tco.in.bas | 38 +++++++++++++++++++++++++------ impls/basic/step6_file.in.bas | 38 +++++++++++++++++++++++++------ impls/basic/step7_quote.in.bas | 38 +++++++++++++++++++++++++------ impls/basic/step8_macros.in.bas | 36 +++++++++++++++++++++++------ impls/basic/step9_try.in.bas | 36 +++++++++++++++++++++++------ impls/basic/stepA_mal.in.bas | 36 +++++++++++++++++++++++------ impls/basic/variables.txt | 3 +-- 10 files changed, 258 insertions(+), 69 deletions(-) diff --git a/impls/basic/step2_eval.in.bas b/impls/basic/step2_eval.in.bas index 53fd4a4942..755d8bc3db 100755 --- a/impls/basic/step2_eval.in.bas +++ b/impls/basic/step2_eval.in.bas @@ -102,31 +102,46 @@ SUB EVAL GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN + A0=Z%(A+2) + EVAL_INVOKE: - CALL EVAL_AST - W=R - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - AR=Z%(R+1): REM rest - F=Z%(R+2) + REM set F, push it in the stack for release after call + GOSUB PUSH_R + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + GOSUB DO_FUNCTION - EVAL_INVOKE_DONE: REM pop and release f/args - AY=W:GOSUB RELEASE + GOSUB POP_Q:AY=Q:GOSUB RELEASE + GOSUB POP_Q:AY=Q + GOSUB RELEASE EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR diff --git a/impls/basic/step3_env.in.bas b/impls/basic/step3_env.in.bas index e89209be67..c97ba02248 100755 --- a/impls/basic/step3_env.in.bas +++ b/impls/basic/step3_env.in.bas @@ -172,30 +172,43 @@ SUB EVAL A=A2:CALL EVAL: REM eval A2 using let_env GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - W=R - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - AR=Z%(R+1): REM rest - F=Z%(R+2) + REM set F, push it in the stack for release after call + GOSUB PUSH_R + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + GOSUB DO_FUNCTION - EVAL_INVOKE_DONE: REM pop and release f/args - AY=W:GOSUB RELEASE + GOSUB POP_Q:AY=Q:GOSUB RELEASE + GOSUB POP_Q:AY=Q + GOSUB RELEASE EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR diff --git a/impls/basic/step4_if_fn_do.in.bas b/impls/basic/step4_if_fn_do.in.bas index d37898116d..c84e8eed98 100755 --- a/impls/basic/step4_if_fn_do.in.bas +++ b/impls/basic/step4_if_fn_do.in.bas @@ -213,38 +213,61 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -264,6 +287,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas index bf56efcf3e..ceda9f3427 100755 --- a/impls/basic/step5_tco.in.bas +++ b/impls/basic/step5_tco.in.bas @@ -237,38 +237,61 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -288,6 +311,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas index ac9c470c46..c2637f4eb5 100755 --- a/impls/basic/step6_file.in.bas +++ b/impls/basic/step6_file.in.bas @@ -237,38 +237,61 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -288,6 +311,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas index 8cf109a00b..c28b923fb1 100755 --- a/impls/basic/step7_quote.in.bas +++ b/impls/basic/step7_quote.in.bas @@ -364,38 +364,61 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -415,6 +438,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas index 60be62305e..1bffc0c555 100755 --- a/impls/basic/step8_macros.in.bas +++ b/impls/basic/step8_macros.in.bas @@ -422,38 +422,59 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -473,6 +494,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas index 47cfc0a8b9..a8d735f219 100755 --- a/impls/basic/step9_try.in.bas +++ b/impls/basic/step9_try.in.bas @@ -455,38 +455,59 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -506,6 +527,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas index 4d06608852..f3e54954fb 100755 --- a/impls/basic/stepA_mal.in.bas +++ b/impls/basic/stepA_mal.in.bas @@ -455,16 +455,16 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R REM if metadata, get the actual object GOSUB TYPE_F @@ -472,23 +472,44 @@ SUB EVAL T=T-8 IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -508,6 +529,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/variables.txt b/impls/basic/variables.txt index a970a0aae5..92aaf71313 100644 --- a/impls/basic/variables.txt +++ b/impls/basic/variables.txt @@ -86,7 +86,7 @@ I : STRING, REPLACE, SLICE, PR_MEMORY, PR_OBJECT, PR_MEMORY_VALUE J : REPLACE, PR_MEMORY_VALUE U : ALLOC, RELEASE, PR_STR temp V : RELEASE, PR_STR_SEQ temp -W : SLICE, LAST, QUASIQUOTE, DO_HASH_MAP, DO_KEYS_VALS, step2-3 EVAL temp +W : SLICE, LAST, QUASIQUOTE, DO_HASH_MAP, DO_KEYS_VALS P : PR_MEMORY_SUMMARY_SMALL RC : RELEASE remaining number of elements to release RF : reader reading from file flag @@ -105,4 +105,3 @@ O Counting number of times each variable is assigned: sed 's/:/\n /g' readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas stepA_mal.in.bas | grep "[A-Z][A-Z0-9]*[%$]*=" | sed 's/.*[^A-Z]\([A-Z][A-Z0-9]*[%$]*\)=.*/\1/g' | sort | uniq -c | sort -n - From 8ff18f5e02173fb5fe4b4ec29363d97ad50206b8 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Thu, 14 Nov 2024 21:14:59 +0100 Subject: [PATCH 2/2] basic: merge eval_ast and macroexpand into EVAL --- impls/basic/step8_macros.in.bas | 53 +++++++-------------------------- impls/basic/step9_try.in.bas | 53 +++++++-------------------------- impls/basic/stepA_mal.in.bas | 53 +++++++-------------------------- 3 files changed, 30 insertions(+), 129 deletions(-) diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas index 1bffc0c555..61c6720f2e 100755 --- a/impls/basic/step8_macros.in.bas +++ b/impls/basic/step8_macros.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -233,8 +197,6 @@ SUB EVAL IF ER<>-2 THEN GOTO EVAL_RETURN - EVAL_NOT_LIST: - B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR @@ -262,10 +224,6 @@ SUB EVAL GOTO EVAL_RETURN APPLY_LIST: - CALL MACROEXPAND - - GOSUB LIST_Q - IF R<>1 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -435,12 +393,21 @@ SUB EVAL GOSUB TYPE_F T=T-8 - IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas index a8d735f219..e574af4806 100755 --- a/impls/basic/step9_try.in.bas +++ b/impls/basic/step9_try.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -233,8 +197,6 @@ SUB EVAL IF ER<>-2 THEN GOTO EVAL_RETURN - EVAL_NOT_LIST: - B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR @@ -262,10 +224,6 @@ SUB EVAL GOTO EVAL_RETURN APPLY_LIST: - CALL MACROEXPAND - - GOSUB LIST_Q - IF R<>1 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -468,12 +426,21 @@ SUB EVAL GOSUB TYPE_F T=T-8 - IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas index f3e54954fb..18a3cfc366 100755 --- a/impls/basic/stepA_mal.in.bas +++ b/impls/basic/stepA_mal.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -233,8 +197,6 @@ SUB EVAL IF ER<>-2 THEN GOTO EVAL_RETURN - EVAL_NOT_LIST: - B$="DEBUG-EVAL":CALL ENV_GET IF R3=0 OR R=0 OR R=2 THEN GOTO DEBUG_EVAL_DONE AZ=A:B=1:GOSUB PR_STR @@ -262,10 +224,6 @@ SUB EVAL GOTO EVAL_RETURN APPLY_LIST: - CALL MACROEXPAND - - GOSUB LIST_Q - IF R<>1 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -470,12 +428,21 @@ SUB EVAL GOSUB TYPE_F IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F T=T-8 - IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function