GOSUB READ_STR
RETURN
-REM PAIR_Q(B) -> R
-PAIR_Q:
- R=0
- IF (Z%(B,0)AND31)<>6 AND (Z%(B,0)AND31)<>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
+SUB QUASIQUOTE
+ REM pair?
+ IF (Z%(A,0)AND31)<6 OR (Z%(A,0)AND31)>7 THEN GOTO QQ_QUOTE
+ IF (Z%(A,1)=0) THEN GOTO QQ_QUOTE
+ GOTO QQ_UNQUOTE
+
+ QQ_QUOTE:
REM ['quote, ast]
AS$="quote":T=5:GOSUB STRING
B2=R:B1=A:GOSUB LIST2
AY=B2:GOSUB RELEASE
- RETURN
+ GOTO QQ_DONE
QQ_UNQUOTE:
R=A+1:GOSUB DEREF_R
R=Z%(A,1)+1:GOSUB DEREF_R
Z%(R,0)=Z%(R,0)+32
- RETURN
+ GOTO QQ_DONE
QQ_SPLICE_UNQUOTE:
REM push A on the stack
X=X+1:X%(X)=A
REM rest of cases call quasiquote on ast[1..]
- A=Z%(A,1):GOSUB QUASIQUOTE:T6=R
+ A=Z%(A,1):CALL QUASIQUOTE
+ T6=R
REM pop A off the stack
A=X%(X):X=X-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
+ REM pair?
+ IF (Z%(A,0)AND31)<6 OR (Z%(A,0)AND31)>7 THEN GOTO QQ_DEFAULT
+ IF (Z%(A,1)=0) THEN GOTO QQ_DEFAULT
+
B=A+1:GOSUB DEREF_B
IF (Z%(B,0)AND31)<>5 THEN GOTO QQ_DEFAULT
IF S$(Z%(B,1))<>"splice-unquote" THEN QQ_DEFAULT
REM release inner quasiquoted since outer list takes ownership
AY=B1:GOSUB RELEASE
AY=B3:GOSUB RELEASE
- RETURN
+ GOTO QQ_DONE
QQ_DEFAULT:
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
REM push T6 on the stack
X=X+1:X%(X)=T6
REM A set above to ast[0]
- GOSUB QUASIQUOTE:B2=R
+ CALL QUASIQUOTE
+ B2=R
REM pop T6 off the stack
T6=X%(X):X=X-1
AY=B1:GOSUB RELEASE
AY=B2:GOSUB RELEASE
AY=B3:GOSUB RELEASE
- RETURN
+ QQ_DONE:
+END SUB
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:
+SUB EVAL_AST
REM push A and E on the stack
X=X+2:X%(X-1)=E:X%(X)=A
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
- K=A:GOSUB ENV_GET
+ K=A:GOTO ENV_GET
+ ENV_GET_RETURN:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
REM check if we are done evaluating the source sequence
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
+ REM if we are returning to DO, then skip last element
+ IF X%(X-6)=2 AND Z%(Z%(A,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
+
REM if hashmap, skip eval of even entries (keys)
- IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+ IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
GOTO EVAL_AST_DO_EVAL
EVAL_AST_DO_REF:
EVAL_AST_DO_EVAL:
REM call EVAL for each entry
- A=A+1:GOSUB EVAL
+ A=A+1:CALL EVAL
A=A-1
GOSUB DEREF_R: REM deref to target of evaluated entry
EVAL_AST_RETURN:
REM pop A and E off the stack
E=X%(X-1):A=X%(X):X=X-2
+END SUB
- REM pop EVAL AST return label/address
- RN=X%(X):X=X-1
- ON RN GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
- RETURN
-
-REM EVAL(A, E)) -> R
-EVAL:
+REM EVAL(A, E) -> R
+SUB EVAL
LV=LV+1: REM track basic return stack level
REM push A and E on the stack
X=X+2:X%(X-1)=E:X%(X)=A
+ REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0))
+
EVAL_TCO_RECUR:
+ IF ER<>-2 THEN GOTO EVAL_RETURN
+
REM AZ=A:PR=1:GOSUB PR_STR
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
GOSUB LIST_Q
IF R THEN GOTO APPLY_LIST
REM ELSE
- REM push EVAL_AST return label/address
- X=X+1:X%(X)=1
- GOTO EVAL_AST
- EVAL_AST_RETURN_1:
-
+ CALL EVAL_AST
GOTO EVAL_RETURN
APPLY_LIST:
GOSUB EVAL_GET_A2: REM set A1 and A2
X=X+1:X%(X)=A1: REM push A1
- A=A2:GOSUB EVAL: REM eval a2
+ A=A2:CALL EVAL: REM eval a2
A1=X%(X):X=X-1: REM pop A1
IF ER<>-2 THEN GOTO EVAL_RETURN
X=X+1:X%(X)=A1: REM push A1
REM eval current A1 odd element
- A=Z%(A1,1)+1:GOSUB EVAL
+ A=Z%(A1,1)+1:CALL EVAL
A1=X%(X):X=X-1: REM pop A1
+ IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
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
EVAL_DO:
A=Z%(A,1): REM rest
+ X=X+1:X%(X)=A: REM push/save A
- REM TODO: TCO
+ CALL EVAL_AST
- REM push EVAL_AST return label/address
- X=X+1:X%(X)=2
- GOTO EVAL_AST
- EVAL_AST_RETURN_2:
+ REM cleanup
+ AY=R: REM get eval'd list for release
- X=X+1:X%(X)=R: REM push eval'd list
- A=R:GOSUB LAST: REM return the last element
- AY=X%(X):X=X-1: REM pop eval'd list
- GOSUB RELEASE: REM release the eval'd list
- GOTO EVAL_RETURN
+ A=X%(X):X=X-1: REM pop/restore original A for LAST
+ GOSUB LAST: REM get last element for return
+ A=R: REM new recur AST
+
+ REM cleanup
+ GOSUB RELEASE: REM release eval'd list
+ AY=A:GOSUB RELEASE: REM release LAST value (not sure why)
+
+ GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_QUOTE:
R=Z%(A,1)+1:GOSUB DEREF_R
EVAL_QUASIQUOTE:
R=Z%(A,1)+1:GOSUB DEREF_R
- A=R:GOSUB QUASIQUOTE
+ A=R:CALL QUASIQUOTE
REM add quasiquote result to pending release queue to free when
REM next lower EVAL level returns (LV)
Y=Y+1:Y%(Y,0)=R:Y%(Y,1)=LV
GOSUB EVAL_GET_A1: REM set A1
REM push A
X=X+1:X%(X)=A
- A=A1:GOSUB EVAL
+ A=A1:CALL EVAL
REM pop A
A=X%(X):X=X-1
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
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
+ B=A:GOSUB COUNT
+ IF R<4 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
GOTO EVAL_RETURN
EVAL_INVOKE:
- REM push EVAL_AST return label/address
- X=X+1:X%(X)=3
- GOTO EVAL_AST
- EVAL_AST_RETURN_3:
+ CALL EVAL_AST
REM if error, return f/args for release by caller
IF ER<>-2 THEN GOTO EVAL_RETURN
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
- GOSUB DO_FUNCTION
+ REM regular function
+ IF Z%(F,1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
+ REM for recur functions (apply, map, swap!), use GOTO
+ IF Z%(F,1)>60 THEN CALL DO_TCO_FUNCTION
+ EVAL_DO_FUNCTION_SKIP:
REM pop and release f/args
AY=X%(X):X=X-1:GOSUB RELEASE
REM pop A and E off the stack
E=X%(X-1):A=X%(X):X=X-2
- RETURN
+END SUB
REM PRINT(A) -> R$
MAL_PRINT:
R1=0
GOSUB MAL_READ
R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ IF ER<>-2 THEN GOTO RE_DONE
- A=R:E=D:GOSUB EVAL
+ A=R:E=D:CALL EVAL
- REP_DONE:
+ RE_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 D has repl_env
-REP:
+SUB REP
R1=0:R2=0
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO REP_DONE
- A=R:E=D:GOSUB EVAL
+ A=R:E=D:CALL EVAL
R2=R
IF ER<>-2 THEN GOTO REP_DONE
IF R2<>0 THEN AY=R2:GOSUB RELEASE
IF R1<>0 THEN AY=R1:GOSUB RELEASE
R$=RT$
- RETURN
+END SUB
REM MAIN program
MAIN:
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)+")))))"
+ A$="(def! load-file (fn* (f) (eval (read-file f))))"
GOSUB RE:AY=R:GOSUB RELEASE
REM load the args file
A$="(load-file (first -*ARGS*-))"
GOSUB RE
IF ER<>-2 THEN GOSUB PRINT_ERROR
- END
+ GOTO QUIT
REPL_LOOP:
A$="user> ":GOSUB READLINE: REM call input parser
IF EOF=1 THEN GOTO QUIT
- A$=R$:GOSUB REP: REM call REP
+ A$=R$:CALL REP: REM call REP
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
HCoop / jackhill / mal.git / blobdiff