From 1872f735e440719c6134d16557592ba0f0fe79d5 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Thu, 21 Sep 2017 23:58:14 -0500 Subject: [PATCH] Hy: simplify main eval loop. Dockerfile cleanup. --- hy/Dockerfile | 4 +- hy/step2_eval.hy | 26 ++++---- hy/step3_env.hy | 48 +++++++------- hy/step4_if_fn_do.hy | 90 ++++++++++++------------- hy/step5_tco.hy | 110 +++++++++++++++--------------- hy/step6_file.hy | 108 +++++++++++++++--------------- hy/step7_quote.hy | 120 +++++++++++++++++---------------- hy/step8_macros.hy | 144 ++++++++++++++++++++-------------------- hy/step9_try.hy | 155 ++++++++++++++++++++++--------------------- hy/stepA_mal.hy | 155 ++++++++++++++++++++++--------------------- 10 files changed, 485 insertions(+), 475 deletions(-) diff --git a/hy/Dockerfile b/hy/Dockerfile index c984900b5f..4d977ee8b2 100644 --- a/hy/Dockerfile +++ b/hy/Dockerfile @@ -22,7 +22,7 @@ WORKDIR /mal ########################################################## # Hy -RUN apt-get -y install python-pip -RUN pip install hy && \ +RUN apt-get -y install python-pip && \ + pip install hy && \ mkdir /.cache && \ chmod uog+rwx /.cache diff --git a/hy/step2_eval.hy b/hy/step2_eval.hy index 6eb4b0f324..7d8b8fe7a0 100755 --- a/hy/step2_eval.hy +++ b/hy/step2_eval.hy @@ -21,21 +21,21 @@ True ast)) (defn EVAL [ast env] - (if (not (instance? tuple ast)) - (eval-ast ast env) + ;; indented to match later steps + (if (not (instance? tuple ast)) + (eval-ast ast env) - ;; apply list - ;; indented to match later steps - (if - (empty? ast) - ast + ;; apply list + (if + (empty? ast) + ast - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (rest el)) - (apply f args))))) + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (apply f args))))) ;; print (defn PRINT [exp] diff --git a/hy/step3_env.hy b/hy/step3_env.hy index 2e46c3cfc3..94c9fad380 100755 --- a/hy/step3_env.hy +++ b/hy/step3_env.hy @@ -23,34 +23,34 @@ True ast)) (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) - (if (not (instance? tuple ast)) - (eval-ast ast env) + ;;(print "EVAL:" ast (type ast)) + ;; indented to match later steps + (if (not (instance? tuple ast)) + (eval-ast ast env) - ;; apply list - ;; indented to match later steps - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - ast + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast - (= (Sym "def!") a0) - (env-set env a1 (EVAL a2 env)) + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (EVAL a2 env)) + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (EVAL a2 env)) - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (rest el)) - (apply f args)))))) + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (apply f args)))))) ;; print (defn PRINT [exp] diff --git a/hy/step4_if_fn_do.hy b/hy/step4_if_fn_do.hy index 0fd04c442b..b75831d08d 100755 --- a/hy/step4_if_fn_do.hy +++ b/hy/step4_if_fn_do.hy @@ -24,51 +24,51 @@ True ast)) (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) - (if (not (instance? tuple ast)) - (eval-ast ast env) - - ;; apply list - ;; indented to match later steps - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - ast - - (= (Sym "def!") a0) - (env-set env a1 (EVAL a2 env)) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (EVAL a2 env)) - - (= (Sym "do") a0) - (last (eval-ast (list (rest ast)) env)) - - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (EVAL (nth ast 3) env) - None) - (EVAL a2 env))) - - (= (Sym "fn*") a0) - (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (apply f args)))))) + ;;(print "EVAL:" ast (type ast)) + ;; indented to match later steps + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (EVAL a2 env)) + + (= (Sym "do") a0) + (last (eval-ast (list (rest ast)) env)) + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (EVAL (nth ast 3) env) + None) + (EVAL a2 env))) + + (= (Sym "fn*") a0) + (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (apply f args)))))) ;; print (defn PRINT [exp] diff --git a/hy/step5_tco.hy b/hy/step5_tco.hy index 8e6ec056c1..55e07d67aa 100755 --- a/hy/step5_tco.hy +++ b/hy/step5_tco.hy @@ -24,64 +24,66 @@ True ast)) (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) + ;;(print "EVAL:" ast (type ast)) + ;; indented to match later steps (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - ;; indented to match later steps - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) (continue)) ;; TCO - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))) + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) (break)) res) diff --git a/hy/step6_file.hy b/hy/step6_file.hy index 8bd4d696d0..e74ec2dc17 100755 --- a/hy/step6_file.hy +++ b/hy/step6_file.hy @@ -25,63 +25,65 @@ (defn EVAL [ast env] ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) + ;; indented to match later steps (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - ;; indented to match later steps - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) (continue)) ;; TCO - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))) + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) (break)) res) diff --git a/hy/step7_quote.hy b/hy/step7_quote.hy index 532e970c53..c78259a730 100755 --- a/hy/step7_quote.hy +++ b/hy/step7_quote.hy @@ -43,69 +43,71 @@ (defn EVAL [ast env] ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) + ;; indented to match later steps (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - ;; indented to match later steps - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "quote") a0) - (setv res a1) - - (= (Sym "quasiquote") a0) - (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) (continue)) ;; TCO - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))) + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))) (break)) res) diff --git a/hy/step8_macros.hy b/hy/step8_macros.hy index d0574ccda9..68832345d4 100755 --- a/hy/step8_macros.hy +++ b/hy/step8_macros.hy @@ -61,79 +61,81 @@ ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "quote") a0) - (setv res a1) - - (= (Sym "quasiquote") a0) - (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO - - (= (Sym "defmacro!") a0) - (do (setv func (EVAL a2 env) - func.macro True) - (setv res (env-set env a1 func))) - - (= (Sym "macroexpand") a0) - (setv res (macroexpand a1 env)) - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv ast (macroexpand ast env)) + (if (not (instance? tuple ast)) + (eval-ast ast env) + + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) (continue)) ;; TCO - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))))) + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "macroexpand") a0) + (macroexpand a1 env) + + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))))) (break)) res) diff --git a/hy/step9_try.hy b/hy/step9_try.hy index ae5f936f93..b1a7d50ced 100755 --- a/hy/step9_try.hy +++ b/hy/step9_try.hy @@ -62,48 +62,48 @@ ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "quote") a0) - (setv res a1) - - (= (Sym "quasiquote") a0) - (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO - - (= (Sym "defmacro!") a0) - (do (setv func (EVAL a2 env) - func.macro True) - (setv res (env-set env a1 func))) - - (= (Sym "macroexpand") a0) - (setv res (macroexpand a1 env)) - - (= (Sym "try*") a0) - (setv res + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv ast (macroexpand ast env)) + (if (not (instance? tuple ast)) + (eval-ast ast env) + + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "macroexpand") a0) + (macroexpand a1 env) + + (= (Sym "try*") a0) (if (= (Sym "catch*") (nth a2 0)) (try (EVAL a1 env) @@ -113,41 +113,42 @@ (setv exc (Str (get e.args 0)))) (EVAL (nth a2 2) (env-new env [(nth a2 1)] [exc])))) - (EVAL a1 env))) - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) - (continue)) ;; TCO - - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))))) + (EVAL a1 env)) + + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))))) (break)) res) diff --git a/hy/stepA_mal.hy b/hy/stepA_mal.hy index 5d9a9fb4fe..67c9943417 100755 --- a/hy/stepA_mal.hy +++ b/hy/stepA_mal.hy @@ -62,48 +62,48 @@ ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (setv res (eval-ast ast env)) - - (do - (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) - (if - (none? a0) - (setv res ast) - - (= (Sym "def!") a0) - (setv res (env-set env a1 (EVAL a2 env))) - - (= (Sym "let*") a0) - (do - (setv env (env-new env)) - (for [[b e] (partition a1 2)] - (env-set env b (EVAL e env))) - (setv ast a2) - (continue)) ;; TCO - - (= (Sym "quote") a0) - (setv res a1) - - (= (Sym "quasiquote") a0) - (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO - - (= (Sym "defmacro!") a0) - (do (setv func (EVAL a2 env) - func.macro True) - (setv res (env-set env a1 func))) - - (= (Sym "macroexpand") a0) - (setv res (macroexpand a1 env)) - - (= (Sym "try*") a0) - (setv res + (setv res + (if (not (instance? tuple ast)) + (eval-ast ast env) + + ;; apply list + (do + (setv ast (macroexpand ast env)) + (if (not (instance? tuple ast)) + (eval-ast ast env) + + (do + (setv [a0 a1 a2] [(nth ast 0) (nth ast 1) (nth ast 2)]) + (if + (none? a0) + ast + + (= (Sym "def!") a0) + (env-set env a1 (EVAL a2 env)) + + (= (Sym "let*") a0) + (do + (setv env (env-new env)) + (for [[b e] (partition a1 2)] + (env-set env b (EVAL e env))) + (setv ast a2) + (continue)) ;; TCO + + (= (Sym "quote") a0) + a1 + + (= (Sym "quasiquote") a0) + (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO + + (= (Sym "defmacro!") a0) + (do (setv func (EVAL a2 env) + func.macro True) + (env-set env a1 func)) + + (= (Sym "macroexpand") a0) + (macroexpand a1 env) + + (= (Sym "try*") a0) (if (= (Sym "catch*") (nth a2 0)) (try (EVAL a1 env) @@ -113,41 +113,42 @@ (setv exc (Str (get e.args 0)))) (EVAL (nth a2 2) (env-new env [(nth a2 1)] [exc])))) - (EVAL a1 env))) - - (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) - (setv ast (last ast)) - (continue)) ;; TCO - - (= (Sym "if") a0) - (do - (setv cond (EVAL a1 env)) - (if (or (none? cond) (and (instance? bool cond) - (= cond False))) - (if (> (len ast) 2) - (do (setv ast (nth ast 3)) (continue)) ;; TCO - (setv res None)) - (do (setv ast a2) (continue)))) ;; TCO - - (= (Sym "fn*") a0) - (setv func (fn [&rest args] - (EVAL a2 (env-new env a1 (or args [])))) - func.ast a2 - func.env env - func.params a1 - res func) - - ;; apply - (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) - (if (hasattr f "ast") - (do (setv ast f.ast - env (env-new f.env f.params args)) - (continue)) ;; TCO - (setv res (apply f args))))))))) + (EVAL a1 env)) + + (= (Sym "do") a0) + (do (eval-ast (list (butlast (rest ast))) env) + (setv ast (last ast)) + (continue)) ;; TCO + + (= (Sym "if") a0) + (do + (setv cond (EVAL a1 env)) + (if (or (none? cond) (and (instance? bool cond) + (= cond False))) + (if (> (len ast) 2) + (do (setv ast (nth ast 3)) (continue)) ;; TCO + None) + (do (setv ast a2) (continue)))) ;; TCO + + (= (Sym "fn*") a0) + (do + (setv func (fn [&rest args] + (EVAL a2 (env-new env a1 (or args [])))) + func.ast a2 + func.env env + func.params a1) + func) + + ;; apply + (do + (setv el (eval-ast ast env) + f (first el) + args (list (rest el))) + (if (hasattr f "ast") + (do (setv ast f.ast + env (env-new f.env f.params args)) + (continue)) ;; TCO + (apply f args))))))))) (break)) res)