HCoop
/
jackhill
/
mal.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Change quasiquote algorithm
[jackhill/mal.git]
/
impls
/
basic
/
step8_macros.in.bas
diff --git
a/impls/basic/step8_macros.in.bas
b/impls/basic/step8_macros.in.bas
index
347ebf6
..
0e7418a
100755
(executable)
--- a/
impls/basic/step8_macros.in.bas
+++ b/
impls/basic/step8_macros.in.bas
@@
-17,74
+17,114
@@
MAL_READ:
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
- REM pair?
GOSUB TYPE_A
GOSUB TYPE_A
- IF T<6 OR T>7 THEN GOTO QQ_QUOTE
- IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
+ IF T<5 OR T>8 THEN GOTO QQ_UNCHANGED
+ IF T=5 OR T=8 THEN GOTO QQ_QUOTE
+ IF T=7 THEN GOTO QQ_VECTOR
+ IF (Z%(A+1)=0) THEN GOTO QQ_LIST
+ R=Z%(A+2)
+ IF (Z%(R)AND 31)<>5 THEN GOTO QQ_LIST
+ IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_LIST
GOTO QQ_UNQUOTE
GOTO QQ_UNQUOTE
+ QQ_UNCHANGED:
+ R=A
+ GOSUB INC_REF_R
+
+ GOTO QQ_DONE
+
QQ_QUOTE:
REM ['quote, ast]
B$="quote":T=5:GOSUB STRING
QQ_QUOTE:
REM ['quote, ast]
B$="quote":T=5:GOSUB STRING
- B=R:A=A:GOSUB LIST2
+ B=R:GOSUB LIST2
+ AY=B:GOSUB RELEASE
+
+ GOTO QQ_DONE
+
+ QQ_VECTOR:
+ REM ['vec, (qq_foldr ast)]
+ CALL QQ_FOLDR
+ A=R
+ B$="vec":T=5:GOSUB STRING:B=R
+ GOSUB LIST2
+ AY=A:GOSUB RELEASE
AY=B:GOSUB RELEASE
GOTO QQ_DONE
QQ_UNQUOTE:
AY=B:GOSUB RELEASE
GOTO QQ_DONE
QQ_UNQUOTE:
- R=Z%(A+2)
- IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
- IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
- REM [ast[1]]
- R=Z%(Z%(A+1)+2)
- GOSUB INC_REF_R
+ REM [ast[1]]
+ R=Z%(Z%(A+1)+2)
+ GOSUB INC_REF_R
+
+ GOTO QQ_DONE
+
+ QQ_LIST:
+ CALL QQ_FOLDR
+
+QQ_DONE:
+END SUB
- GOTO QQ_DONE
+REM Quasiquote right fold (A) -> R.
+REM Used for unquoted lists (GOTO), vectors (GOSUB),
+REM and recursively (GOSUB).
+SUB QQ_FOLDR
+ IF A=0 THEN GOTO QQ_EMPTY
+ IF Z%(A+1)=0 THEN GOTO QQ_EMPTY
+ GOTO QQ_NOTEMPTY
- QQ_SPLICE_UNQUOTE:
+ QQ_EMPTY:
+ REM empty list/vector -> empty list
+ R=6
+ GOSUB INC_REF_R
+
+ GOTO QQ_FOLDR_DONE
+
+ QQ_NOTEMPTY:
+ REM Execute QQ_FOLDR recursively with (rest A)
GOSUB PUSH_A
GOSUB PUSH_A
- REM rest of cases call quasiquote on ast[1..]
- A=Z%(A+1):CALL QUASIQUOTE
- W=R
+ A=Z%(A+1):CALL QQ_FOLDR
GOSUB POP_A
GOSUB POP_A
- REM
set A to ast[0] for last two cases
+ REM
Set A to elt = (first A)
A=Z%(A+2)
A=Z%(A+2)
- REM pair?
+ REM Quasiquote transition function:
+ REM A: current element, R: accumulator -> R: new accumulator
+
+ REM check if A is a list starting with splice-unquote
GOSUB TYPE_A
GOSUB TYPE_A
- IF T<
6 OR T>7
THEN GOTO QQ_DEFAULT
+ IF T<
>6
THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
-
B=Z%(A+2)
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
B=Z%(A+2)
IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT
- IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT
- REM ['concat, ast[0][1], quasiquote(ast[1..])]
+ IF S$(Z%(B+1))<>"splice-unquote" THEN GOTO QQ_DEFAULT
+ REM ('concat, A[1], R)
B=Z%(Z%(A+1)+2)
B=Z%(Z%(A+1)+2)
+ A=R
B$="concat":T=5:GOSUB STRING:C=R
B$="concat":T=5:GOSUB STRING:C=R
-
A=W:
GOSUB LIST3
+ GOSUB LIST3
REM release inner quasiquoted since outer list takes ownership
AY=A:GOSUB RELEASE
AY=C:GOSUB RELEASE
REM release inner quasiquoted since outer list takes ownership
AY=A:GOSUB RELEASE
AY=C:GOSUB RELEASE
- GOTO QQ_DONE
- QQ_DEFAULT:
- REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
+ GOTO QQ_FOLDR_DONE
- Q=W:GOSUB PUSH_Q
- REM A set above to ast[0]
- CALL QUASIQUOTE
- B=R
- GOSUB POP_Q:W=Q
+ QQ_DEFAULT:
+ REM ('cons, quasiquote(A), R)
+ GOSUB PUSH_R
+ CALL QUASIQUOTE
+ B=R
+ B$="cons":T=5:GOSUB STRING:C=R
+ GOSUB POP_A
+ GOSUB LIST3
+ REM release inner quasiquoted since outer list takes ownership
+ AY=A:GOSUB RELEASE
+ AY=B:GOSUB RELEASE
+ AY=C:GOSUB RELEASE
- B$="cons":T=5:GOSUB STRING:C=R
- A=W:GOSUB LIST3
- REM release inner quasiquoted since outer list takes ownership
- AY=A:GOSUB RELEASE
- AY=B:GOSUB RELEASE
- AY=C:GOSUB RELEASE
- QQ_DONE:
+QQ_FOLDR_DONE:
END SUB
REM MACROEXPAND(A, E) -> A:
END SUB
REM MACROEXPAND(A, E) -> A:
@@
-238,6
+278,7
@@
SUB EVAL
IF A$="def!" THEN GOTO EVAL_DEF
IF A$="let*" THEN GOTO EVAL_LET
IF A$="quote" THEN GOTO EVAL_QUOTE
IF A$="def!" THEN GOTO EVAL_DEF
IF A$="let*" THEN GOTO EVAL_LET
IF A$="quote" THEN GOTO EVAL_QUOTE
+ IF A$="quasiquoteexpand" THEN GOTO EVAL_QUASIQUOTEEXPAND
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
@@
-332,6
+373,11
@@
SUB EVAL
GOSUB INC_REF_R
GOTO EVAL_RETURN
GOSUB INC_REF_R
GOTO EVAL_RETURN
+ EVAL_QUASIQUOTEEXPAND:
+ R=Z%(Z%(A+1)+2)
+ A=R:CALL QUASIQUOTE
+ GOTO EVAL_RETURN
+
EVAL_QUASIQUOTE:
R=Z%(Z%(A+1)+2)
A=R:CALL QUASIQUOTE
EVAL_QUASIQUOTE:
R=Z%(Z%(A+1)+2)
A=R:CALL QUASIQUOTE
@@
-415,9
+461,9
@@
SUB EVAL
EVAL_DO_FUNCTION:
REM regular function
EVAL_DO_FUNCTION:
REM regular function
- IF Z%(F+1)<6
0
THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+ IF Z%(F+1)<6
5
THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
REM for recur functions (apply, map, swap!), use GOTO
REM for recur functions (apply, map, swap!), use GOTO
- IF Z%(F+1)>6
0
THEN CALL DO_TCO_FUNCTION
+ IF Z%(F+1)>6
4
THEN CALL DO_TCO_FUNCTION
EVAL_DO_FUNCTION_SKIP:
REM pop and release f/args
EVAL_DO_FUNCTION_SKIP:
REM pop and release f/args