From cc1ebff5e85de1803969de482bd589b4052aeb19 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Fri, 20 Sep 2024 10:01:08 -0400 Subject: [PATCH] hy: merge eval_ast/macroexpand into EVAL. Add DEBUG-EVAL. Original issue describing the change and converting the first set of implementations: https://github.com/kanaka/mal/pull/592 Tracking issue for other implementations: https://github.com/kanaka/mal/issues/657 --- impls/hy/step2_eval.hy | 39 +++++++++-------- impls/hy/step3_env.hy | 43 +++++++++++-------- impls/hy/step4_if_fn_do.hy | 45 ++++++++++--------- impls/hy/step5_tco.hy | 47 +++++++++++--------- impls/hy/step6_file.hy | 47 +++++++++++--------- impls/hy/step7_quote.hy | 50 +++++++++++----------- impls/hy/step8_macros.hy | 80 ++++++++++++++-------------------- impls/hy/step9_try.hy | 88 ++++++++++++++++---------------------- impls/hy/stepA_mal.hy | 88 ++++++++++++++++---------------------- 9 files changed, 250 insertions(+), 277 deletions(-) diff --git a/impls/hy/step2_eval.hy b/impls/hy/step2_eval.hy index 80894b1ffb..adfc2a16a6 100755 --- a/impls/hy/step2_eval.hy +++ b/impls/hy/step2_eval.hy @@ -9,33 +9,34 @@ (read-str str)) ;; eval -(defn eval-ast [ast env] - (if - (symbol? ast) (if (.has_key env ast) (get env ast) - (raise (Exception (+ ast " not found")))) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] ;; indented to match later steps - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (if (.has_key env ast) (get env ast) + (raise (Exception (+ ast " not found")))) - ;; apply list - (if - (empty? ast) - ast + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + (not (instance? tuple ast)) + ast + + (empty? ast) + ast + + ;; apply list ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) - (apply f args))))) + (apply f args)))) ;; print (defn PRINT [exp] diff --git a/impls/hy/step3_env.hy b/impls/hy/step3_env.hy index d46a87ba6e..26fca8fa7a 100755 --- a/impls/hy/step3_env.hy +++ b/impls/hy/step3_env.hy @@ -4,37 +4,42 @@ (import sys traceback) (import [reader [read-str Blank]]) (import [printer [pr-str]]) -(import [env [env-new env-get env-set]]) +(import [env [env-new env-get env-set env-find]]) ;; read (defn READ [str] (read-str str)) ;; eval -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast)) ;; indented to match later steps - (if (not (instance? tuple ast)) - (eval-ast ast env) + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -47,7 +52,7 @@ ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (apply f args)))))) diff --git a/impls/hy/step4_if_fn_do.hy b/impls/hy/step4_if_fn_do.hy index dbe574cd5c..ae01bf32a5 100755 --- a/impls/hy/step4_if_fn_do.hy +++ b/impls/hy/step4_if_fn_do.hy @@ -5,7 +5,7 @@ (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) -(import [env [env-new env-get env-set]]) +(import [env [env-new env-get env-set env-find]]) (import core) ;; read @@ -13,30 +13,35 @@ (read-str str)) ;; eval -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast)) ;; indented to match later steps - (if (not (instance? tuple ast)) - (eval-ast ast env) + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -48,7 +53,7 @@ (EVAL a2 env)) (= (Sym "do") a0) - (last (eval-ast (list (rest ast)) env)) + (last (list (map (fn [x] (EVAL x env)) (list (rest ast))))) (= (Sym "if") a0) (do @@ -66,7 +71,7 @@ ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (apply f args)))))) diff --git a/impls/hy/step5_tco.hy b/impls/hy/step5_tco.hy index 352732326f..6b364657ab 100755 --- a/impls/hy/step5_tco.hy +++ b/impls/hy/step5_tco.hy @@ -5,7 +5,7 @@ (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) -(import [env [env-new env-get env-set]]) +(import [env [env-new env-get env-set env-find]]) (import core) ;; read @@ -13,33 +13,37 @@ (read-str str)) ;; eval -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast)) - ;; indented to match later steps (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -52,7 +56,8 @@ (continue)) ;; TCO (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -77,7 +82,7 @@ ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") diff --git a/impls/hy/step6_file.hy b/impls/hy/step6_file.hy index f5cb1a4cba..9cf4c7380a 100755 --- a/impls/hy/step6_file.hy +++ b/impls/hy/step6_file.hy @@ -5,7 +5,7 @@ (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) -(import [env [env-new env-get env-set]]) +(import [env [env-new env-get env-set env-find]]) (import core) ;; read @@ -13,33 +13,37 @@ (read-str str)) ;; eval -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) - ;; indented to match later steps (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -52,7 +56,8 @@ (continue)) ;; TCO (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -77,7 +82,7 @@ ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") diff --git a/impls/hy/step7_quote.hy b/impls/hy/step7_quote.hy index 247d59af3a..757852db5f 100755 --- a/impls/hy/step7_quote.hy +++ b/impls/hy/step7_quote.hy @@ -5,7 +5,7 @@ (import [mal_types [MalException]]) (import [reader [read-str Blank]]) (import [printer [pr-str]]) -(import [env [env-new env-get env-set]]) +(import [env [env-new env-get env-set env-find]]) (import core) ;; read @@ -31,33 +31,37 @@ (= (first ast) (Sym "unquote")) (get ast 1) True (qq-foldr ast))) -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) - ;; indented to match later steps (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) + + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -72,14 +76,12 @@ (= (Sym "quote") a0) a1 - (= (Sym "quasiquoteexpand") a0) - (QUASIQUOTE a1) - (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -104,7 +106,7 @@ ;; apply (do - (setv el (eval-ast ast env) + (setv el (list (map (fn [x] (EVAL x env)) ast)) f (first el) args (list (rest el))) (if (hasattr f "ast") diff --git a/impls/hy/step8_macros.hy b/impls/hy/step8_macros.hy index bd9898db9a..97ee0ee46c 100755 --- a/impls/hy/step8_macros.hy +++ b/impls/hy/step8_macros.hy @@ -31,53 +31,37 @@ (= (first ast) (Sym "unquote")) (get ast 1) True (qq-foldr ast))) -(defn macro? [ast env] - (when (and (coll? ast) - (symbol? (first ast)) - (env-find env (first ast))) - (setv mac (env-get env (first ast))) - (and (hasattr mac "macro") - mac.macro))) - -(defn macroexpand [ast env] - (while (macro? ast env) - (setv mac (env-get env (first ast)) - ast (apply mac (tuple (rest ast))))) - ast) - - - -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (eval-ast ast env) + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -92,9 +76,6 @@ (= (Sym "quote") a0) a1 - (= (Sym "quasiquoteexpand") a0) - (QUASIQUOTE a1) - (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO @@ -103,11 +84,9 @@ 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) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -132,14 +111,17 @@ ;; apply (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO - (apply f args))))))))) + (apply f args))))))) (break)) res) diff --git a/impls/hy/step9_try.hy b/impls/hy/step9_try.hy index 46e6dad50b..5dc44a0cf0 100755 --- a/impls/hy/step9_try.hy +++ b/impls/hy/step9_try.hy @@ -31,53 +31,37 @@ (= (first ast) (Sym "unquote")) (get ast 1) True (qq-foldr ast))) -(defn macro? [ast env] - (when (and (coll? ast) - (symbol? (first ast)) - (env-find env (first ast))) - (setv mac (env-get env (first ast))) - (and (hasattr mac "macro") - mac.macro))) - -(defn macroexpand [ast env] - (while (macro? ast env) - (setv mac (env-get env (first ast)) - ast (apply mac (tuple (rest ast))))) - ast) - - - -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (eval-ast ast env) + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -92,9 +76,6 @@ (= (Sym "quote") a0) a1 - (= (Sym "quasiquoteexpand") a0) - (QUASIQUOTE a1) - (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO @@ -103,9 +84,6 @@ func.macro True) (env-set env a1 func)) - (= (Sym "macroexpand") a0) - (macroexpand a1 env) - (= (Sym "try*") a0) (if (and a2 (= (Sym "catch*") (nth a2 0))) (try @@ -114,12 +92,15 @@ (if (instance? MalException e) (setv exc e.val) (setv exc (Str (get e.args 0)))) - (EVAL (nth a2 2) (env-new env [(nth a2 1)] - [exc])))) - (EVAL a1 env)) + (do (setv ast (nth a2 2) + env (env-new env [(nth a2 1)] + [exc])) + (continue)))) ;; TCO + (do (setv ast a1) (continue))) ;; TCO (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -144,14 +125,17 @@ ;; apply (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO - (apply f args))))))))) + (apply f args))))))) (break)) res) diff --git a/impls/hy/stepA_mal.hy b/impls/hy/stepA_mal.hy index dcb7e6d063..3e881fdab6 100755 --- a/impls/hy/stepA_mal.hy +++ b/impls/hy/stepA_mal.hy @@ -31,53 +31,37 @@ (= (first ast) (Sym "unquote")) (get ast 1) True (qq-foldr ast))) -(defn macro? [ast env] - (when (and (coll? ast) - (symbol? (first ast)) - (env-find env (first ast))) - (setv mac (env-get env (first ast))) - (and (hasattr mac "macro") - mac.macro))) - -(defn macroexpand [ast env] - (while (macro? ast env) - (setv mac (env-get env (first ast)) - ast (apply mac (tuple (rest ast))))) - ast) - - - -(defn eval-ast [ast env] - ;;(print "eval-ast:" ast (type ast)) - (if - (symbol? ast) (env-get env ast) - (instance? dict ast) (dict (map (fn [k] - [k (EVAL (get ast k) env)]) - ast)) - (instance? tuple ast) (tuple (map (fn [x] (EVAL x env)) ast)) - (instance? list ast) (list (map (fn [x] (EVAL x env)) ast)) - True ast)) - (defn EVAL [ast env] - ;;(print "EVAL:" ast (type ast) (instance? tuple ast)) (setv res None) (while True + (setv [dbgevalenv] [(env-find env (Sym "DEBUG-EVAL"))]) + (if dbgevalenv + (do (setv [dbgevalsym] [(env-get dbgevalenv (Sym "DEBUG-EVAL"))]) + (if (not (none? dbgevalsym)) + (print "EVAL:" (pr-str ast True))))) (setv res - (if (not (instance? tuple ast)) - (eval-ast ast env) + (if + (symbol? ast) + (env-get env ast) - ;; apply list - (do - (setv ast (macroexpand ast env)) - (if (not (instance? tuple ast)) - (eval-ast ast env) + (instance? dict ast) + (dict (map (fn [k] + [k (EVAL (get ast k) env)]) + ast)) + (instance? list ast) + (list (map (fn [x] (EVAL x env)) ast)) + + (not (instance? tuple ast)) + ast + + (empty? ast) + 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)) @@ -92,9 +76,6 @@ (= (Sym "quote") a0) a1 - (= (Sym "quasiquoteexpand") a0) - (QUASIQUOTE a1) - (= (Sym "quasiquote") a0) (do (setv ast (QUASIQUOTE a1)) (continue)) ;; TCO @@ -103,9 +84,6 @@ func.macro True) (env-set env a1 func)) - (= (Sym "macroexpand") a0) - (macroexpand a1 env) - (= (Sym "try*") a0) (if (and a2 (= (Sym "catch*") (nth a2 0))) (try @@ -114,12 +92,15 @@ (if (instance? MalException e) (setv exc e.val) (setv exc (Str (get e.args 0)))) - (EVAL (nth a2 2) (env-new env [(nth a2 1)] - [exc])))) - (EVAL a1 env)) + (do (setv ast (nth a2 2) + env (env-new env [(nth a2 1)] + [exc])) + (continue)))) ;; TCO + (do (setv ast a1) (continue))) ;; TCO (= (Sym "do") a0) - (do (eval-ast (list (butlast (rest ast))) env) + (do (list (map (fn [x] (EVAL x env)) + (list (butlast (rest ast))))) (setv ast (last ast)) (continue)) ;; TCO @@ -144,14 +125,17 @@ ;; apply (do - (setv el (eval-ast ast env) - f (first el) - args (list (rest el))) + (setv f (EVAL a0 env)) + (if (and (hasattr f "macro") f.macro) + (do (setv ast (apply f (list (rest ast)))) + (continue))) ;; TCO + (setv args (list (map (fn [x] (EVAL x env)) + (list (rest ast))))) (if (hasattr f "ast") (do (setv ast f.ast env (env-new f.env f.params args)) (continue)) ;; TCO - (apply f args))))))))) + (apply f args))))))) (break)) res)