From 823185d5d25c1a2dc413fdae54018ff08388dc8d Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 21 Jul 2025 20:26:00 +0200 Subject: [PATCH 1/2] basic: separate evaluation of the function and its arguments This commit is a prerequisite for merging macroexpand into EVAL. It may introduce a memory leak, see #707 and the lines with (?) in steps4-A. --- impls/basic/step2_eval.in.bas | 33 +++++++++++++++++------- impls/basic/step3_env.in.bas | 31 +++++++++++++++------- impls/basic/step4_if_fn_do.in.bas | 43 ++++++++++++++++++++++++------- impls/basic/step5_tco.in.bas | 43 ++++++++++++++++++++++++------- impls/basic/step6_file.in.bas | 43 ++++++++++++++++++++++++------- impls/basic/step7_quote.in.bas | 43 ++++++++++++++++++++++++------- impls/basic/step8_macros.in.bas | 41 ++++++++++++++++++++++------- impls/basic/step9_try.in.bas | 41 ++++++++++++++++++++++------- impls/basic/stepA_mal.in.bas | 41 ++++++++++++++++++++++------- 9 files changed, 271 insertions(+), 88 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..f93d9d1902 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 @@ -263,9 +286,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas index bf56efcf3e..a7740641e6 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 @@ -287,9 +310,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas index ac9c470c46..fec02eb15e 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 @@ -287,9 +310,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas index 8cf109a00b..372f98e9d7 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 @@ -414,9 +437,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas index 60be62305e..8789e529b3 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 @@ -472,9 +493,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas index 47cfc0a8b9..4f42c2dfa1 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 @@ -505,9 +526,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas index 4d06608852..900b5ae614 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 @@ -507,9 +528,9 @@ SUB EVAL REM actually returns (LV+1) LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 - REM pop and release f/args - GOSUB POP_Q:AY=Q - GOSUB RELEASE + REM pop f/args, do not release (?) + GOSUB POP_Q + GOSUB POP_Q REM A set above E=R:GOTO EVAL_TCO_RECUR: REM TCO loop From f4a2b183ce251cebb376cae0bf671abf8858cd0e 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 8789e529b3..f3d1155971 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 4f42c2dfa1..386ba1fada 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 900b5ae614..37996c818c 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