From e6121016a68e4cf577eb51aa397c38479da3d115 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Sun, 12 Dec 2021 15:51:30 +0100 Subject: [PATCH] Merge eval-ast and macro expansion into EVAL See issue #587. * Merge eval-ast and eval into a single conditional. * Print "EVAL: $ast" at the top of EVAL. * Expand macros during the apply phase, removing lots of duplicate tests, and increasing the overall consistency by allowing the macro to be computed instead of referenced by name (`((defmacro! cond (...)))` is currently illegal for example). * Remove macroexpand and quasiquoteexpand special forms. These tests fail: * objpascal: I have no such error with a more recent compiler * groovy: stack overflow during test of recursive functions. Did work after first push. * elm: most probably unrelated, this directory is unchanged While reformatting process/step*.txt, use a pseudo-syntax inspired by pattern matching. The changes have not been propagated to: * ada 2-9 * awk 2-9 * bash 2-9 * basic 2-A * bbc-basic 2-9 * chuck 2-A * clojure 2-9 * coffee 2-9 * common-lisp 2-9 * cpp 2-9 * crystal 2-A * cs 2-9 * d 2-9 * dart 2-9 * elixir 2-9 * elm 2-9 * erlang 2-9 * es6 2-9 * factor 2-9 * fantom 2-9 * fennel 2-9 * forth 2-A * fsharp 2-9 * gnu-smalltalk 2-9 * go 2-9 * groovy 2-9 * guile 2-9 * haxe 2-9 * hy 2-A * io 2-A * janet 2-A * java 2-9 * java-truffle 2-A * jq 2-A * js 2-9 * julia 2-9 * kotlin 2-9 * livescript 2-A * logo 2-9 * lua 2-A * make 2-9 * matlab 2-A * miniMAL 2-9 * nasm 2-9 * nim 2-9 * objc 2-A * objpascal 2-9 * perl6 2-9 * php 2-9 * picolisp 2-9 * pike 2-9 * plpgsql 2-A * plsql 2-A * powershell 2-A * ps 2-9 * python.2 2-9 * r 2-9 * racket 2-9 * rexx 2-A * rpython 2-9 * rust 2-9 * scala 2-A * scheme 2-9 * skew 2-9 * sml 2-9 * swift 2-A * swift3 2-A * swift4 2-A * swift5 2-A * tcl 2-9 * ts 2-9 * vala 2-A * vb 2-9 * vhdl 2-9 * vimscript 2-9 * wasm 2-A * wren 2-9 * xslt 2-A * yorick 2-9 * zig 2-A --- impls/ada.2/step7_quote.adb | 3 - impls/ada.2/step8_macros.adb | 37 +- impls/ada.2/step9_try.adb | 37 +- impls/ada.2/stepa_mal.adb | 37 +- impls/ada/stepa_mal.adb | 159 +++------ impls/awk/stepA_mal.awk | 159 ++++----- impls/bash/stepA_mal.sh | 93 ++--- impls/bbc-basic/stepA_mal.bas | 73 ++-- impls/c.2/step2_eval.c | 98 ++---- impls/c.2/step3_env.c | 99 ++---- impls/c.2/step4_if_fn_do.c | 103 +++--- impls/c.2/step5_tco.c | 103 +++--- impls/c.2/step6_file.c | 105 +++--- impls/c.2/step7_quote.c | 113 +++---- impls/c.2/step8_macros.c | 195 +++-------- impls/c.2/step9_try.c | 193 +++-------- impls/c.2/stepA_mal.c | 193 +++-------- impls/c/step2_eval.c | 20 +- impls/c/step3_env.c | 19 +- impls/c/step4_if_fn_do.c | 21 +- impls/c/step5_tco.c | 25 +- impls/c/step6_file.c | 32 +- impls/c/step7_quote.c | 28 +- impls/c/step8_macros.c | 66 +--- impls/c/step9_try.c | 66 +--- impls/c/stepA_mal.c | 69 +--- impls/clojure/src/mal/stepA_mal.cljc | 66 ++-- impls/coffee/stepA_mal.coffee | 48 +-- impls/common-lisp/src/stepA_mal.lisp | 74 ++-- impls/cpp/stepA_mal.cpp | 57 +--- impls/cs/stepA_mal.cs | 90 ++--- impls/d/stepA_mal.d | 95 ++---- impls/dart/stepA_mal.dart | 77 +---- impls/elisp/step2_eval.el | 28 +- impls/elisp/step3_env.el | 40 ++- impls/elisp/step4_if_fn_do.el | 36 +- impls/elisp/step5_tco.el | 40 +-- impls/elisp/step6_file.el | 39 ++- impls/elisp/step7_quote.el | 41 ++- impls/elisp/step8_macros.el | 71 ++-- impls/elisp/step9_try.el | 71 ++-- impls/elisp/stepA_mal.el | 71 ++-- impls/elixir/lib/mix/tasks/stepA_mal.ex | 54 +-- impls/erlang/src/stepA_mal.erl | 69 ++-- impls/es6/stepA_mal.mjs | 38 +-- impls/factor/stepA_mal/stepA_mal.factor | 52 ++- impls/fennel/stepA_mal.fnl | 95 ++---- impls/fsharp/stepA_mal.fs | 46 +-- impls/gnu-smalltalk/stepA_mal.st | 92 ++--- impls/go/src/stepA_mal/stepA_mal.go | 123 +++---- impls/groovy/stepA_mal.groovy | 57 +--- impls/guile/stepA_mal.scm | 47 +-- impls/haskell/step7_quote.hs | 3 - impls/haskell/step8_macros.hs | 14 - impls/haskell/step9_try.hs | 14 - impls/haskell/stepA_mal.hs | 14 - impls/haxe/StepA_mal.hx | 69 ++-- impls/java/src/main/java/mal/stepA_mal.java | 97 ++---- impls/js/stepA_mal.js | 55 +-- impls/julia/stepA_mal.jl | 61 ++-- impls/kotlin/src/mal/stepA_mal.kt | 55 ++- impls/logo/stepA_mal.lg | 65 +--- impls/make/stepA_mal.mk | 69 ++-- impls/mal/step2_eval.mal | 40 +-- impls/mal/step3_env.mal | 36 +- impls/mal/step4_if_fn_do.mal | 38 +-- impls/mal/step6_file.mal | 38 +-- impls/mal/step7_quote.mal | 41 +-- impls/mal/step8_macros.mal | 101 +++--- impls/mal/step9_try.mal | 147 ++++---- impls/mal/stepA_mal.mal | 147 ++++---- impls/miniMAL/stepA_mal.json | 59 +--- impls/nasm/stepA_mal.asm | 357 ++++++++------------ impls/nim/stepA_mal.nim | 123 +++---- impls/objpascal/stepA_mal.pas | 141 +++----- impls/ocaml/step2_eval.ml | 16 +- impls/ocaml/step3_env.ml | 19 +- impls/ocaml/step4_if_fn_do.ml | 23 +- impls/ocaml/step6_file.ml | 23 +- impls/ocaml/step7_quote.ml | 25 +- impls/ocaml/step8_macros.ml | 46 +-- impls/ocaml/step9_try.ml | 46 +-- impls/ocaml/stepA_mal.ml | 46 +-- impls/perl/step2_eval.pl | 24 +- impls/perl/step3_env.pl | 26 +- impls/perl/step4_if_fn_do.pl | 28 +- impls/perl/step5_tco.pl | 25 +- impls/perl/step6_file.pl | 25 +- impls/perl/step7_quote.pl | 28 +- impls/perl/step8_macros.pl | 63 +--- impls/perl/step9_try.pl | 64 +--- impls/perl/stepA_mal.pl | 63 +--- impls/perl6/stepA_mal.pl | 49 ++- impls/php/stepA_mal.php | 60 +--- impls/picolisp/stepA_mal.l | 52 +-- impls/pike/stepA_mal.pike | 54 +-- impls/prolog/step7_quote.pl | 4 - impls/prolog/step8_macros.pl | 20 +- impls/prolog/step9_try.pl | 20 +- impls/prolog/stepA_mal.pl | 20 +- impls/ps/stepA_mal.ps | Bin 9655 -> 8752 bytes impls/python.2/stepA_mal.py | 74 +--- impls/python/step2_eval.py | 22 +- impls/python/step3_env.py | 20 +- impls/python/step4_if_fn_do.py | 25 +- impls/python/step5_tco.py | 27 +- impls/python/step6_file.py | 27 +- impls/python/step7_quote.py | 29 +- impls/python/step8_macros.py | 47 +-- impls/python/step9_try.py | 52 +-- impls/python/stepA_mal.py | 49 +-- impls/r/stepA_mal.r | 60 +--- impls/racket/stepA_mal.rkt | 50 +-- impls/rpython/stepA_mal.py | 61 +--- impls/ruby/step2_eval.rb | 30 +- impls/ruby/step3_env.rb | 30 +- impls/ruby/step4_if_fn_do.rb | 34 +- impls/ruby/step5_tco.rb | 39 +-- impls/ruby/step6_file.rb | 39 +-- impls/ruby/step7_quote.rb | 41 +-- impls/ruby/step8_macros.rb | 70 ++-- impls/ruby/step9_try.rb | 70 ++-- impls/ruby/stepA_mal.rb | 70 ++-- impls/rust/stepA_mal.rs | 142 +++----- impls/scheme/stepA_mal.scm | 65 +--- impls/skew/stepA_mal.sk | 53 +-- impls/sml/stepA_mal.sml | 19 +- impls/tcl/stepA_mal.tcl | 83 ++--- impls/tests/step7_quote.mal | 70 ---- impls/tests/step8_macros.mal | 18 - impls/ts/stepA_mal.ts | 81 +---- impls/vb/stepA_mal.vb | 80 ++--- impls/vhdl/stepA_mal.vhdl | 136 ++++---- impls/vimscript/stepA_mal.vim | 85 ++--- impls/wren/stepA_mal.wren | 54 +-- impls/yorick/stepA_mal.i | 88 ++--- process/guide.md | 126 ++++--- process/step2_eval.txt | 21 +- process/step3_env.txt | 30 +- process/step4_if_fn_do.txt | 41 ++- process/step5_tco.txt | 45 +-- process/step6_file.txt | 45 +-- process/step7_quote.txt | 49 +-- process/step8_macros.txt | 60 ++-- process/step9_try.txt | 65 ++-- process/stepA_mal.txt | 65 ++-- 146 files changed, 2958 insertions(+), 5945 deletions(-) diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb index 94182fb1b7..879a3df9d6 100644 --- a/impls/ada.2/step7_quote.adb +++ b/impls/ada.2/step7_quote.adb @@ -167,9 +167,6 @@ procedure Step7_Quote is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb index 1f7951b2d4..5d79c20ca7 100644 --- a/impls/ada.2/step8_macros.adb +++ b/impls/ada.2/step8_macros.adb @@ -59,7 +59,6 @@ procedure Step8_Macros is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> @@ -183,14 +182,6 @@ procedure Step8_Macros is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -217,24 +208,10 @@ procedure Step8_Macros is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; when Types.Kind_Function => null; when others => @@ -260,11 +237,7 @@ procedure Step8_Macros is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb index 333c7adf12..b484c6f363 100644 --- a/impls/ada.2/step9_try.adb +++ b/impls/ada.2/step9_try.adb @@ -59,7 +59,6 @@ procedure Step9_Try is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> @@ -183,14 +182,6 @@ procedure Step9_Try is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -247,24 +238,10 @@ procedure Step9_Try is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; when Types.Kind_Function => null; when others => @@ -290,11 +267,7 @@ procedure Step9_Try is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index 59a1ad7fd1..8695d2e768 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -60,7 +60,6 @@ procedure StepA_Mal is -- True when the environment has been created in this recursion -- level, and has not yet been referenced by a closure. If so, -- we can reuse it instead of creating a subenvironment. - Macroexpanding : Boolean := False; First : Types.T; begin <> @@ -184,14 +183,6 @@ procedure StepA_Mal is Ast => Ast.Sequence.all.Data (3), Env => Env)); end; - elsif First.Str.all = "macroexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - Macroexpanding := True; - Ast := Ast.Sequence.all.Data (2); - goto Restart; - elsif First.Str.all = "quasiquoteexpand" then - Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); - return Quasiquote (Ast.Sequence.all.Data (2)); elsif First.Str.all = "quasiquote" then Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter"); Ast := Quasiquote (Ast.Sequence.all.Data (2)); @@ -248,24 +239,10 @@ procedure StepA_Mal is case First.Kind is when Kind_Macro => -- Use the unevaluated arguments. - if Macroexpanding then - -- Evaluate the macro with tail call optimization. - if not Env_Reusable then - Env := Envs.New_Env (Outer => First.Fn.all.Env); - Env_Reusable := True; - end if; - Env.all.Set_Binds - (Binds => First.Fn.all.Params.all.Data, - Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - Ast := First.Fn.all.Ast; - goto Restart; - else - -- Evaluate the macro normally. - Ast := First.Fn.all.Apply - (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); - -- Then evaluate the result with TCO. - goto Restart; - end if; + Ast := First.Fn.all.Apply + (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length)); + -- Then evaluate the result with TCO. + goto Restart; when Types.Kind_Function => null; when others => @@ -296,11 +273,7 @@ procedure StepA_Mal is end; exception when Err.Error => - if Macroexpanding then - Err.Add_Trace_Line ("macroexpand", Ast); - else - Err.Add_Trace_Line ("eval", Ast); - end if; + Err.Add_Trace_Line ("eval", Ast); raise; end Eval; diff --git a/impls/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb index 1d0b71fd60..b24c94f5ef 100644 --- a/impls/ada/stepa_mal.adb +++ b/impls/ada/stepa_mal.adb @@ -58,54 +58,6 @@ procedure StepA_Mal is return Res; end Def_Macro; - - function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - Res : Mal_Handle; - E : Envs.Env_Handle; - LMT : List_Mal_Type; - LP : Lambda_Ptr; - begin - - Res := Ast; - - loop - - if Deref (Res).Sym_Type /= List then - exit; - end if; - - LMT := Deref_List (Res).all; - - -- Get the macro in the list from the env - -- or return null if not applicable. - LP := Get_Macro (Res, Env); - - exit when LP = null or else not LP.Get_Is_Macro; - - declare - Fn_List : Mal_Handle := Cdr (LMT); - Params : List_Mal_Type; - begin - E := Envs.New_Env (LP.Get_Env); - - Params := Deref_List (LP.Get_Params).all; - - if Envs.Bind (E, Params, Deref_List (Fn_List).all) then - - Res := Eval (LP.Get_Expr, E); - - end if; - - end; - - end loop; - - return Res; - - end Macro_Expand; - - function Eval_As_Boolean (MH : Mal_Handle) return Boolean is Res : Boolean; begin @@ -128,45 +80,6 @@ procedure StepA_Mal is end Eval_As_Boolean; - function Eval_Ast - (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - - function Call_Eval (A : Mal_Handle) return Mal_Handle is - begin - return Eval (A, Env); - end Call_Eval; - - begin - - case Deref (Ast).Sym_Type is - - when Sym => - - declare - Sym : Mal_String := Deref_Sym (Ast).Get_Sym; - begin - -- if keyword, return it. Otherwise look it up in the environment. - if Sym(1) = ':' then - return Ast; - else - return Envs.Get (Env, Sym); - end if; - exception - when Envs.Not_Found => - raise Envs.Not_Found with ("'" & Sym & "' not found"); - end; - - when List => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; - function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is A0 : Mal_Handle; begin @@ -276,6 +189,12 @@ procedure StepA_Mal is Env : Envs.Env_Handle; First_Param, Rest_Params : Mal_Handle; Rest_List, Param_List : List_Mal_Type; + + function Call_Eval (A : Mal_Handle) return Mal_Handle is + begin + return Eval (A, Env); + end Call_Eval; + begin Param := AParam; @@ -287,14 +206,30 @@ procedure StepA_Mal is Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); end if; - Param := Macro_Expand (Param, Env); + case Deref (Param).Sym_Type is + when Sym => - if Debug then - Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String); - end if; + declare + Sym : Mal_String := Deref_Sym (Param).Get_Sym; + begin + -- if keyword, return it. Otherwise look it up in the environment. + if Sym(1) = ':' then + return Param; + else + return Envs.Get (Env, Sym); + end if; + exception + when Envs.Not_Found => + raise Envs.Not_Found with ("'" & Sym & "' not found"); + end; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => + + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); + + when List_List => Param_List := Deref_List (Param).all; @@ -313,9 +248,6 @@ procedure StepA_Mal is elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "defmacro!" then return Def_Macro (Rest_List, Env); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "macroexpand" then - return Macro_Expand (Car (Rest_List), Env); elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "let*" then declare @@ -410,11 +342,6 @@ procedure StepA_Mal is return Car (Rest_List); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "quasiquoteexpand" then - - return Quasi_Quote_Processing (Car (Rest_List)); - elsif Deref (First_Param).Sym_Type = Sym and then Deref_Sym (First_Param).Get_Sym = "quasiquote" then @@ -451,18 +378,11 @@ procedure StepA_Mal is else -- The APPLY section. - declare - Evaled_H : Mal_Handle; - begin - Evaled_H := Eval_Ast (Param, Env); - Param_List := Deref_List (Evaled_H).all; - - First_Param := Car (Param_List); - Rest_Params := Cdr (Param_List); - Rest_List := Deref_List (Rest_Params).all; + First_Param := Eval (First_Param, Env); if Deref (First_Param).Sym_Type = Func then + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then declare @@ -475,6 +395,16 @@ procedure StepA_Mal is begin L := Deref_Lambda (First_Param).all; + + if L.Get_Is_Macro then + -- Apply to *unevaluated* arguments + Param := L.Apply (Rest_Params); + -- then EVAL the result. + goto Tail_Call_Opt; + end if; + + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); + E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; @@ -498,15 +428,14 @@ procedure StepA_Mal is raise Runtime_Exception with "Deref called on non-Func/Lambda"; end if; - end; - end if; - else -- not a List_List + end case; + when others => -- not a list, map, symbol or vector - return Eval_Ast (Param, Env); + return Param; - end if; + end case; end Eval; diff --git a/impls/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk index 045d483a98..26b449bbff 100644 --- a/impls/awk/stepA_mal.awk +++ b/impls/awk/stepA_mal.awk @@ -88,52 +88,21 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) return "(" new_idx } -function is_macro_call(ast, env, idx, len, sym, f) -{ - if (ast !~ /^\(/) return 0 - idx = substr(ast, 2) - len = types_heap[idx]["len"] - if (len == 0) return 0 - sym = types_heap[idx][0] - if (sym !~ /^'/) return 0 - f = env_get(env, sym) - return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] -} - -function macroexpand(ast, env, idx, f_idx, new_env) -{ - while (is_macro_call(ast, env)) { - idx = substr(ast, 2) - f_idx = substr(env_get(env, types_heap[idx][0]), 2) - new_env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) - types_release(ast) - if (new_env ~ /^!/) { - return new_env - } - types_addref(ast = types_heap[f_idx]["body"]) - ast = EVAL(ast, new_env) - env_release(new_env) - if (ast ~ /^!/) { - return ast - } - } - return ast -} - function eval_ast(ast, env, i, idx, len, new_idx, ret) +# This function has two distinct purposes. +# non empty list: a0 a1 .. an -> list: nil (eval a1) .. (eval an) +# vector: a0 a1 .. an -> vector: (eval a0) (eval a1) .. (eval an) { - switch (ast) { - case /^'/: - ret = env_get(env, ast) - if (ret !~ /^!/) { - types_addref(ret) - } - return ret - case /^[([]/: idx = substr(ast, 2) len = types_heap[idx]["len"] new_idx = types_allocate() - for (i = 0; i < len; ++i) { + if (ast ~ /^\(/) { + types_heap[new_idx][0] = "#nil" + i = 1 + } else { + i = 0 + } + for (; i < len; ++i) { ret = EVAL(types_addref(types_heap[idx][i]), env) if (ret ~ /^!/) { types_heap[new_idx]["len"] = i @@ -144,7 +113,10 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } types_heap[new_idx]["len"] = len return substr(ast, 1, 1) new_idx - case /^\{/: +} + +function eval_map(ast, env, i, idx, new_idx, ret) +{ idx = substr(ast, 2) new_idx = types_allocate() for (i in types_heap[idx]) { @@ -158,9 +130,6 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL_def(ast, env, idx, sym, ret, len) @@ -426,29 +395,37 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret { env_addref(env) for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, env) + # print "EVAL: " printer_pr_str(substr(ast, 2)) + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } types_release(ast) env_release(env) return ret - } - if (types_heap[substr(ast, 2)]["len"] == 0) { - env_release(env) - return ast - } - ast = macroexpand(ast, env) - if (ast ~ /^!/) { - env_release(env) - return ast - } - if (ast !~ /^\(/) { + case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) env_release(env) return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + env_release(env) + return ret + case /^[^(]/: # not a list + types_release(ast) + env_release(env) + return ast } idx = substr(ast, 2) len = types_heap[idx]["len"] + if (len == 0) { + env_release(env) + return ast + } switch (types_heap[idx][0]) { case "'def!": return EVAL_def(ast, env) @@ -469,15 +446,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret types_release(ast) env_release(env) return body - case "'quasiquoteexpand": - env_release(env) - if (len != 2) { - types_release(ast) - return "!\"Invalid argument length for 'quasiquoteexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - return quasiquote(body) case "'quasiquote": if (len != 2) { types_release(ast) @@ -494,17 +462,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret continue case "'defmacro!": return EVAL_defmacro(ast, env) - case "'macroexpand": - if (len != 2) { - types_release(ast) - env_release(env) - return "!\"Invalid argument length for 'macroexpand'. Expects exactly 1 argument, supplied " (len - 1) "." - } - types_addref(body = types_heap[idx][1]) - types_release(ast) - ret = macroexpand(body, env) - env_release(env) - return ret case "'try*": ret = EVAL_try(ast, env, ret_body, ret_env) if (ret != "") { @@ -529,34 +486,64 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret case "'fn*": return EVAL_fn(ast, env) default: - new_ast = eval_ast(ast, env) - types_release(ast) - env_release(env) - if (new_ast ~ /^!/) { - return new_ast + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f } - idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: + if (types_heap[f_idx]["is_macro"]) { + idx = substr(ast, 2) + ret = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) + types_release(ast) + if (ret ~ /^!/) { + types_release(f) + types_release(env) + return ret + } + ast = EVAL(types_addref(types_heap[f_idx]["body"]), ret) + types_release(ret) + types_release(f) + continue + } + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) env = env_new(types_heap[f_idx]["env"], types_heap[f_idx]["params"], idx) if (env ~ /^!/) { types_release(new_ast) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^%/: f_idx = types_heap[f_idx]["func"] + types_release(f) case /^&/: + new_ast = eval_ast(ast, env) + types_release(ast) + env_release(env) + if (new_ast ~ /^!/) { + return new_ast + } + idx = substr(new_ast, 2) ret = @f_idx(idx) types_release(new_ast) return ret default: types_release(new_ast) - return "!\"First element of list must be function, supplied " types_typename(f) "." + ret = "!\"First element of list must be function, supplied " types_typename(f) "." + types_release(f) + return ret } } } diff --git a/impls/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh index df1543cfa5..0e151fe3cf 100755 --- a/impls/bash/stepA_mal.sh +++ b/impls/bash/stepA_mal.sh @@ -55,45 +55,22 @@ qqIter () { fi } -IS_MACRO_CALL () { - if ! _list? "${1}"; then return 1; fi - _nth "${1}" 0; local a0="${r}" - if _symbol? "${a0}"; then - ENV_FIND "${2}" "${a0}" - if [[ "${r}" ]]; then - ENV_GET "${2}" "${a0}" - [ "${ANON["${r}_ismacro_"]}" ] - return $? - fi - fi - return 1 -} - -MACROEXPAND () { +EVAL () { local ast="${1}" env="${2}" - while IS_MACRO_CALL "${ast}" "${env}"; do - _nth "${ast}" 0; local a0="${r}" - ENV_GET "${env}" "${a0}"; local mac="${ANON["${r}"]}" - _rest "${ast}" - ${mac%%@*} ${ANON["${r}"]} - ast="${r}" - done - r="${ast}" -} - + while true; do + r= + #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" -EVAL_AST () { - local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type "${ast}"; local ot="${r}" case "${ot}" in symbol) ENV_GET "${env}" "${ast}" return ;; list) - _map_with_type _list EVAL "${ast}" "${env}" ;; + ;; vector) - _map_with_type _vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" + return ;; hash_map) local res="" key= val="" hm="${ANON["${ast}"]}" _hash_map; local new_hm="${r}" @@ -103,30 +80,14 @@ EVAL_AST () { EVAL "${val}" "${env}" _assoc! "${new_hm}" "${key}" "${r}" done - r="${new_hm}" ;; + r="${new_hm}" + return ;; *) - r="${ast}" ;; + r="${ast}" + return ;; esac -} - -EVAL () { - local ast="${1}" env="${2}" - while true; do - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list - MACROEXPAND "${ast}" "${env}" - ast="${r}" - if ! _list? "${ast}"; then - EVAL_AST "${ast}" "${env}" - return - fi _empty? "${ast}" && r="${ast}" && return _nth "${ast}" 0; local a0="${r}" @@ -153,9 +114,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,9 +128,6 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; sh__STAR__) EVAL "${a1}" "${env}" local output="" local line="" @@ -198,7 +153,7 @@ EVAL () { return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${ast}" ast="${r}" @@ -225,11 +180,27 @@ EVAL () { EVAL \"${a2}\" \"\${r}\"" \ "${a2}" "${env}" "${a1}" return ;; - *) EVAL_AST "${ast}" "${env}" + *) EVAL "${a0}" "${env}" + [[ "${__ERROR}" ]] && return 1 + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + if [ "${ANON["${f}_ismacro_"]}" ]; then + f="${ANON["${f}"]}" + ${f%%@*} ${ANON["${args}"]} + ast="${r}" + continue + fi + + f="${ANON["${f}"]}" + + _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${ANON["${r}"]}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: [${f}] ${args}" if [[ "${f//@/ }" != "${f}" ]]; then set -- ${f//@/ } diff --git a/impls/bbc-basic/stepA_mal.bas b/impls/bbc-basic/stepA_mal.bas index 2ca19477fb..b4f27a3db3 100644 --- a/impls/bbc-basic/stepA_mal.bas +++ b/impls/bbc-basic/stepA_mal.bas @@ -84,27 +84,6 @@ DEF FNquasiquote(ast%) ENDIF =ast% -DEF FNis_macro_call(ast%, env%) - LOCAL car%, val% - IF NOT FNis_list(ast%) THEN =FALSE - car% = FNfirst(ast%) - IF NOT FNis_symbol(car%) THEN =FALSE - IF FNis_nil(FNenv_find(env%, car%)) THEN =FALSE - val% = FNenv_get(env%, car%) -=FNis_macro(val%) - -DEF FNmacroexpand(ast%, env%) - LOCAL mac%, macenv%, macast% - WHILE FNis_macro_call(ast%, env%) - REM PRINT "expanded ";FNpr_str(ast%, TRUE); - mac% = FNenv_get(env%, FNfirst(ast%)) - macenv% = FNnew_env(FNfn_env(mac%), FNfn_params(mac%), FNrest(ast%)) - macast% = FNfn_ast(mac%) - ast% = FNEVAL(macast%, macenv%) - REM PRINT " to ";FNpr_str(ast%, TRUE) - ENDWHILE -=ast% - DEF FNtry_catch(ast%, env%) LOCAL is_error%, ret% REM If there's no 'catch*' clause then we just evaluate the 'try*'. @@ -152,14 +131,25 @@ DEF FNEVAL(ast%, env%) =FNgc_exit(FNEVAL_(ast%, env%)) DEF FNEVAL_(ast%, env%) - LOCAL car%, specialform%, val%, bindings% + LOCAL car%, specialform%, val%, bindings%, key$ REPEAT PROCgc_keep_only2(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) + REM PRINT "EVAL: " + FNPRINT(ast%) + IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) + IF FNis_hashmap(ast%) THEN + val% = FNempty_hashmap + bindings% = FNhashmap_keys(ast%) + WHILE NOT FNis_empty(bindings%) + key$ = FNunbox_string(FNfirst(bindings%)) + val% = FNhashmap_set(val%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) + bindings% = FNrest(bindings%) + ENDWHILE + =val% + ENDIF + IF NOT FNis_seq(ast%) THEN =ast% IF FNis_empty(ast%) THEN =ast% - ast% = FNmacroexpand(ast%, env%) - IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%) car% = FNfirst(ast%) + IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%)) specialform% = FALSE IF FNis_symbol(car%) THEN specialform% = TRUE @@ -205,13 +195,9 @@ DEF FNEVAL_(ast%, env%) =FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%) WHEN "quote" =FNnth(ast%, 1) - WHEN "quasiquoteexpand" - = FNquasiquote(FNnth(ast%, 1)) WHEN "quasiquote" ast% = FNquasiquote(FNnth(ast%, 1)) REM Loop round for tail-call optimisation - WHEN "macroexpand" - =FNmacroexpand(FNnth(ast%, 1), env%) WHEN "try*" =FNtry_catch(ast%, env%) OTHERWISE @@ -220,18 +206,24 @@ DEF FNEVAL_(ast%, env%) ENDIF IF NOT specialform% THEN REM This is the "apply" part. + car% = FNEVAL(car%, env%) + ast% = FNrest(ast%) + IF FNis_macro(car%) THEN + ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)) + REM Loop round for tail-call optimisation. + ELSE ast% = FNeval_ast(ast%, env%) - car% = FNfirst(ast%) IF FNis_corefn(car%) THEN - =FNcore_call(FNunbox_corefn(car%), FNrest(ast%)) + =FNcore_call(FNunbox_corefn(car%), ast%) ENDIF IF FNis_fn(car%) THEN - env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%)) + env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%) ast% = FNfn_ast(car%) REM Loop round for tail-call optimisation. ELSE ERROR &40E80918, "Not a function" ENDIF + ENDIF ENDIF UNTIL FALSE @@ -242,26 +234,11 @@ DEF FNrep(a$) =FNPRINT(FNEVAL(FNREAD(a$), repl_env%)) DEF FNeval_ast(ast%, env%) - LOCAL val%, car%, cdr%, map%, keys%, key$ - IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%) - IF FNis_seq(ast%) THEN + LOCAL car%, cdr% IF FNis_empty(ast%) THEN =ast% car% = FNEVAL(FNfirst(ast%), env%) cdr% = FNeval_ast(FNrest(ast%), env%) - IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, cdr%) =FNalloc_pair(car%, cdr%) - ENDIF - IF FNis_hashmap(ast%) THEN - map% = FNempty_hashmap - keys% = FNhashmap_keys(ast%) - WHILE NOT FNis_empty(keys%) - key$ = FNunbox_string(FNfirst(keys%)) - map% = FNhashmap_set(map%, key$, FNEVAL(FNhashmap_get(ast%, key$), env%)) - keys% = FNrest(keys%) - ENDWHILE - =map% - ENDIF -=ast% DEF FNget_argv PROCgc_enter diff --git a/impls/c.2/step2_eval.c b/impls/c.2/step2_eval.c index 0b0d6424d9..57da063c98 100644 --- a/impls/c.2/step2_eval.c +++ b/impls/c.2/step2_eval.c @@ -21,30 +21,54 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); + + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = hashmap_get(env->data, ast->value.mal_symbol); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } - /* NULL */ - if (!ast) { return make_nil(); } + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ + MalType* first = lst->data; + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } - /* evaluate the list */ - MalType* evaluated_list = eval_ast(ast, env); + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else { return make_error_fmt("Error: first item in list is not callable: %s.", \ @@ -112,58 +136,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = hashmap_get(env->data, ast->value.mal_symbol); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - list evaluate_list(list lst, Env* env) { list evlst = NULL; diff --git a/impls/c.2/step3_env.c b/impls/c.2/step3_env.c index bebfdb4989..1b92432af5 100644 --- a/impls/c.2/step3_env.c +++ b/impls/c.2/step3_env.c @@ -24,21 +24,44 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env* env); MalType* eval_letstar(MalType* ast, Env* env); - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -52,16 +75,18 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } - if (is_error(evaluated_list)) { return evaluated_list; } + lst = lst->next; + + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else { return make_error_fmt("Error: first item in list is not callable: %s.", \ @@ -122,58 +147,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env* env) { list lst = (ast->value.mal_list)->next; diff --git a/impls/c.2/step4_if_fn_do.c b/impls/c.2/step4_if_fn_do.c index 93cdf63e25..f51ba26c1a 100644 --- a/impls/c.2/step4_if_fn_do.c +++ b/impls/c.2/step4_if_fn_do.c @@ -28,24 +28,47 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env* env); MalType* eval_letstar(MalType* ast, Env* env); MalType* eval_if(MalType* ast, Env* env); MalType* eval_fnstar(MalType* ast, Env* env); MalType* eval_do(MalType* ast, Env* env); - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -68,16 +91,18 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } - if (is_error(evaluated_list)) { return evaluated_list; } + lst = lst->next; + + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -85,7 +110,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -95,7 +120,7 @@ MalType* EVAL(MalType* ast, Env* env) { } else { - Env* new_env = env_make(closure->env, params, evlst->next, closure->more_symbol); + Env* new_env = env_make(closure->env, params, evlst, closure->more_symbol); return EVAL(closure->definition, new_env); } } @@ -166,58 +191,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env* env) { list lst = (ast->value.mal_list)->next; diff --git a/impls/c.2/step5_tco.c b/impls/c.2/step5_tco.c index 78fbf40535..ee9eb11d25 100644 --- a/impls/c.2/step5_tco.c +++ b/impls/c.2/step5_tco.c @@ -28,7 +28,9 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,17 +40,38 @@ MalType* EVAL(MalType* ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -86,14 +109,18 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; + + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -101,7 +128,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -112,7 +139,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -186,58 +213,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; diff --git a/impls/c.2/step6_file.c b/impls/c.2/step6_file.c index 4e73fb78b2..c0a6fe24ff 100644 --- a/impls/c.2/step6_file.c +++ b/impls/c.2/step6_file.c @@ -28,7 +28,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,17 +41,38 @@ MalType* EVAL(MalType* ast, Env* env) { /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -86,16 +110,18 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } - if (is_error(evaluated_list)) { return evaluated_list; } + lst = lst->next; + + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -103,7 +129,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -114,7 +140,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -147,6 +173,7 @@ MalType* mal_eval(list args) { return EVAL(ast, global_env); } + int main(int argc, char** argv) { Env* repl_env = env_make(NULL, NULL, NULL, NULL); @@ -218,58 +245,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; diff --git a/impls/c.2/step7_quote.c b/impls/c.2/step7_quote.c index 27cbd53721..14f6da788b 100644 --- a/impls/c.2/step7_quote.c +++ b/impls/c.2/step7_quote.c @@ -19,7 +19,6 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" @@ -33,7 +32,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -41,22 +43,42 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -102,24 +124,20 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } } - /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -127,7 +145,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -138,7 +156,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -171,6 +189,7 @@ MalType* mal_eval(list args) { return EVAL(ast, global_env); } + int main(int argc, char** argv) { Env* repl_env = env_make(NULL, NULL, NULL, NULL); @@ -242,58 +261,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; diff --git a/impls/c.2/step8_macros.c b/impls/c.2/step8_macros.c index 06c8097f91..a0724f9335 100644 --- a/impls/c.2/step8_macros.c +++ b/impls/c.2/step8_macros.c @@ -19,11 +19,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define PROMPT_STRING "user> " @@ -35,7 +33,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -43,29 +44,43 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } + + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -111,30 +126,28 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } } - /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + if (func->is_macro) { + ast = apply(func, lst); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -142,7 +155,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -153,7 +166,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -186,6 +199,7 @@ MalType* mal_eval(list args) { return EVAL(ast, global_env); } + int main(int argc, char** argv) { Env* repl_env = env_make(NULL, NULL, NULL, NULL); @@ -257,58 +271,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -673,46 +635,6 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - list evaluate_list(list lst, Env* env) { list evlst = NULL; @@ -866,32 +788,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c.2/step9_try.c b/impls/c.2/step9_try.c index 5bcf328973..72189e261b 100644 --- a/impls/c.2/step9_try.c +++ b/impls/c.2/step9_try.c @@ -19,11 +19,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define SYMBOL_TRYSTAR "try*" #define SYMBOL_CATCHSTAR "catch*" @@ -37,7 +35,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -45,30 +46,44 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); void eval_try(MalType** ast, Env** env); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -114,17 +129,9 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) { /* TCE - modify ast and env directly and jump back to eval */ @@ -135,16 +142,23 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + if (func->is_macro) { + ast = apply(func, lst); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -152,7 +166,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -163,7 +177,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -268,58 +282,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -684,46 +646,6 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - void eval_try(MalType** ast, Env** env) { list lst = (*ast)->value.mal_list; @@ -937,32 +859,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c.2/stepA_mal.c b/impls/c.2/stepA_mal.c index 8cd1a51d3d..2a9a621521 100644 --- a/impls/c.2/stepA_mal.c +++ b/impls/c.2/stepA_mal.c @@ -20,11 +20,9 @@ #define SYMBOL_FNSTAR "fn*" #define SYMBOL_QUOTE "quote" #define SYMBOL_QUASIQUOTE "quasiquote" -#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand" #define SYMBOL_UNQUOTE "unquote" #define SYMBOL_SPLICE_UNQUOTE "splice-unquote" #define SYMBOL_DEFMACROBANG "defmacro!" -#define SYMBOL_MACROEXPAND "macroexpand" #define SYMBOL_TRYSTAR "try*" #define SYMBOL_CATCHSTAR "catch*" @@ -38,7 +36,10 @@ MalType* READ(char* str) { MalType* EVAL(MalType* ast, Env* env) { /* forward references */ - MalType* eval_ast(MalType* ast, Env* env); + MalType* apply(MalType* fn, list args); + list evaluate_list(list lst, Env* env); + list evaluate_vector(list lst, Env* env); + list evaluate_hashmap(list lst, Env* env); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -46,30 +47,44 @@ MalType* EVAL(MalType* ast, Env* env) { MalType* eval_do(MalType* ast, Env* env); MalType* eval_quote(MalType* ast); MalType* eval_quasiquote(MalType* ast); - MalType* eval_quasiquoteexpand(MalType* ast); MalType* eval_defmacrobang(MalType*, Env** env); - MalType* eval_macroexpand(MalType* ast, Env* env); - MalType* macroexpand(MalType* ast, Env* env); void eval_try(MalType** ast, Env** env); /* Use goto to jump here rather than calling eval for tail-call elimination */ TCE_entry_point: - /* NULL */ - if (!ast) { return make_nil(); } + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast); + if (!symbol_value) + return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); + return symbol_value; + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_vector(result); + } - /* macroexpansion */ - ast = macroexpand(ast, env); - if (is_error(ast)) { return ast; } + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) return result->data; + return make_hashmap(result); + } /* not a list */ - if (!is_list(ast)) { return eval_ast(ast, env); } + if (!is_list(ast)) { return ast; } + + list lst = ast->value.mal_list; /* empty list */ - if (ast->value.mal_list == NULL) { return ast; } + if (lst == NULL) { return ast; } /* list */ - MalType* first = (ast->value.mal_list)->data; + MalType* first = lst->data; char* symbol = first->value.mal_symbol; if (is_symbol(first)) { @@ -115,17 +130,9 @@ MalType* EVAL(MalType* ast, Env* env) { if (is_error(ast)) { return ast; } goto TCE_entry_point; } - else if (strcmp(symbol, SYMBOL_QUASIQUOTEEXPAND) == 0) { - - list lst = ast->value.mal_list; - return eval_quasiquote(make_list(lst)); - } else if (strcmp(symbol, SYMBOL_DEFMACROBANG) == 0) { return eval_defmacrobang(ast, &env); } - else if (strcmp(symbol, SYMBOL_MACROEXPAND) == 0) { - return eval_macroexpand(ast, env); - } else if (strcmp(symbol, SYMBOL_TRYSTAR) == 0) { /* TCE - modify ast and env directly and jump back to eval */ @@ -136,16 +143,23 @@ MalType* EVAL(MalType* ast, Env* env) { } } /* first element is not a special symbol */ - MalType* evaluated_list = eval_ast(ast, env); + MalType* func = EVAL(first, env); + if (is_error(func)) { return func; } + + lst = lst->next; - if (is_error(evaluated_list)) { return evaluated_list; } + if (func->is_macro) { + ast = apply(func, lst); + if (is_error(ast)) { return ast; } + goto TCE_entry_point; + } + list evlst = evaluate_list(lst, env); + if (evlst && is_error(evlst->data)) { return evlst->data; } /* apply the first element of the list to the arguments */ - list evlst = evaluated_list->value.mal_list; - MalType* func = evlst->data; if (is_function(func)) { - return (*func->value.mal_function)(evlst->next); + return (*func->value.mal_function)(evlst); } else if (is_closure(func)) { @@ -153,7 +167,7 @@ MalType* EVAL(MalType* ast, Env* env) { list params = (closure->parameters)->value.mal_list; long param_count = list_count(params); - long arg_count = list_count(evlst->next); + long arg_count = list_count(evlst); if (param_count > arg_count) { return make_error("too few arguments supplied to function"); @@ -164,7 +178,7 @@ MalType* EVAL(MalType* ast, Env* env) { else { /* TCE - modify ast and env directly and jump back to eval */ - env = env_make(closure->env, params, evlst->next, closure->more_symbol); + env = env_make(closure->env, params, evlst, closure->more_symbol); ast = func->value.mal_closure->definition; if (is_error(ast)) { return ast; } @@ -293,58 +307,6 @@ int main(int argc, char** argv) { return 0; } -MalType* eval_ast(MalType* ast, Env* env) { - - /* forward references */ - list evaluate_list(list lst, Env* env); - list evaluate_vector(list lst, Env* env); - list evaluate_hashmap(list lst, Env* env); - - if (is_symbol(ast)) { - - MalType* symbol_value = env_get(env, ast); - - if (symbol_value) { - return symbol_value; - } else { - return make_error_fmt("var '%s' not found", pr_str(ast, UNREADABLY)); - } - } - else if (is_list(ast)) { - - list result = evaluate_list(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_list(result); - } else { - return result->data; - } - } - else if (is_vector(ast)) { - - list result = evaluate_vector(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_vector(result); - } else { - return result->data; - } - } - else if (is_hashmap(ast)) { - - list result = evaluate_hashmap(ast->value.mal_list, env); - - if (!result || !is_error(result->data)) { - return make_hashmap(result); - } else { - return result->data; - } - } - else { - return ast; - } -} - MalType* eval_defbang(MalType* ast, Env** env) { list lst = (ast->value.mal_list)->next; @@ -709,46 +671,6 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { return result; } -MalType* eval_macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - MalType* macroexpand(MalType* ast, Env* env); - - list lst = ast->value.mal_list; - - if (!lst->next) { - return make_nil(); - } - else if (lst->next->next) { - return make_error("'macroexpand': expected exactly one argument"); - } - else { - return macroexpand(lst->next->data, env); - } -} - -MalType* macroexpand(MalType* ast, Env* env) { - - /* forward reference */ - int is_macro_call(MalType* ast, Env* env); - - while(is_macro_call(ast, env)) { - - list lst = ast->value.mal_list; - - MalType* macro_fn = env_get(env, lst->data); - MalClosure* cls = macro_fn->value.mal_closure; - MalType* more_symbol = cls->more_symbol; - - list params_list = (cls->parameters)->value.mal_list; - list args_list = lst->next; - - env = env_make(cls->env, params_list, args_list, more_symbol); - ast = EVAL(cls->definition, env); - } - return ast; -} - void eval_try(MalType** ast, Env** env) { list lst = (*ast)->value.mal_list; @@ -961,32 +883,3 @@ MalType* apply(MalType* fn, list args) { } } } - -int is_macro_call(MalType* ast, Env* env) { - - /* not a list */ - if (!is_list(ast)) { - return 0; - } - - /* empty list */ - list lst = ast->value.mal_list; - if (!lst) { - return 0; - } - - /* first item not a symbol */ - MalType* first = lst->data; - if (!is_symbol(first)) { - return 0; - } - - /* lookup symbol */ - MalType* val = env_get(env, first); - if (is_error(val)) { - return 0; - } - else { - return (val->is_macro); - } -} diff --git a/impls/c/step2_eval.c b/impls/c/step2_eval.c index 8c54184c05..b0b786e807 100644 --- a/impls/c/step2_eval.c +++ b/impls/c/step2_eval.c @@ -29,15 +29,19 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, GHashTable *env) { +MalVal *EVAL(MalVal *ast, GHashTable *env) { if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); // TODO: check if not found MalVal *res = g_hash_table_lookup(env, ast->val.string); assert(res, "'%s' not found", ast->val.string); return res; - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -62,22 +66,12 @@ MalVal *eval_ast(MalVal *ast, GHashTable *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, GHashTable *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); if (_count(ast) == 0) { return ast; } MalVal *a0 = _nth(ast, 0); assert_type(a0, MAL_SYMBOL, "Cannot invoke %s", _pr_str(a0,1)); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); //g_print("eval_invoke el: %s\n", _pr_str(el,1)); diff --git a/impls/c/step3_env.c b/impls/c/step3_env.c index d51704e053..daccb711f6 100644 --- a/impls/c/step3_env.c +++ b/impls/c/step3_env.c @@ -29,12 +29,16 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +MalVal *EVAL(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -59,15 +63,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); @@ -102,7 +97,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return EVAL(a2, let_env); } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *(*f)(void *, void*) = (MalVal *(*)(void*, void*))_first(el); return f(_nth(el, 1), _nth(el, 2)); diff --git a/impls/c/step4_if_fn_do.c b/impls/c/step4_if_fn_do.c index c6628c16c2..994e483505 100644 --- a/impls/c/step4_if_fn_do.c +++ b/impls/c/step4_if_fn_do.c @@ -30,12 +30,16 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +MalVal *EVAL(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -60,15 +64,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); @@ -105,7 +100,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - MalVal *el = eval_ast(_rest(ast), env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _rest(ast), env); return _last(el); } else if ((a0->type & MAL_SYMBOL) && strcmp("if", a0->val.string) == 0) { @@ -136,7 +131,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); diff --git a/impls/c/step5_tco.c b/impls/c/step5_tco.c index 917e3e3807..abe8b7547b 100644 --- a/impls/c/step5_tco.c +++ b/impls/c/step5_tco.c @@ -30,12 +30,18 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -60,17 +66,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); @@ -109,7 +104,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast) - 1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -141,7 +136,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); diff --git a/impls/c/step6_file.c b/impls/c/step6_file.c index e7388c878b..e7161ab587 100644 --- a/impls/c/step6_file.c +++ b/impls/c/step6_file.c @@ -30,12 +30,18 @@ MalVal *READ(char prompt[], char *str) { } // eval -MalVal *eval_ast(MalVal *ast, Env *env) { +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -60,17 +66,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); @@ -109,7 +104,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -141,10 +136,11 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _slice(ast, 1, _count(ast)); + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { diff --git a/impls/c/step7_quote.c b/impls/c/step7_quote.c index a42f978041..1771198346 100644 --- a/impls/c/step7_quote.c +++ b/impls/c/step7_quote.c @@ -68,12 +68,18 @@ MalVal *quasiquote(MalVal *ast) { } } -MalVal *eval_ast(MalVal *ast, Env *env) { +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { + if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); + if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -98,17 +104,6 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); @@ -148,9 +143,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -160,7 +152,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -192,7 +184,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) { return NULL; } MalVal *f = _first(el), *args = _rest(el); diff --git a/impls/c/step8_macros.c b/impls/c/step8_macros.c index ac5a3b0f02..743ce0ec22 100644 --- a/impls/c/step8_macros.c +++ b/impls/c/step8_macros.c @@ -11,7 +11,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -69,31 +68,18 @@ MalVal *quasiquote(MalVal *ast) { } } -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST || _count(ast) == 0) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -MalVal *macroexpand(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} + //g_print("EVAL: %s\n", _pr_str(ast,1)); -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -118,25 +104,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } if (_count(ast) == 0) { return ast; } int i, len; @@ -174,9 +143,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -193,15 +159,10 @@ MalVal *EVAL(MalVal *ast, Env *env) { res->ismacro = TRUE; env_set(env, a1, res); return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -234,10 +195,15 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { diff --git a/impls/c/step9_try.c b/impls/c/step9_try.c index 61ac91f784..ce54b65096 100644 --- a/impls/c/step9_try.c +++ b/impls/c/step9_try.c @@ -12,7 +12,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -70,31 +69,18 @@ MalVal *quasiquote(MalVal *ast) { } } -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST || _count(ast) == 0) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -MalVal *macroexpand(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} + //g_print("EVAL: %s\n", _pr_str(ast,1)); -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -119,25 +105,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } if (_count(ast) == 0) { return ast; } int i, len; @@ -175,9 +144,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -194,11 +160,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { res->ismacro = TRUE; env_set(env, a1, res); return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); } else if ((a0->type & MAL_SYMBOL) && strcmp("try*", a0->val.string) == 0) { //g_print("eval apply try*\n"); @@ -226,7 +187,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -259,10 +220,15 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c index 75051170f3..197a8d6adb 100644 --- a/impls/c/stepA_mal.c +++ b/impls/c/stepA_mal.c @@ -12,7 +12,6 @@ // Declarations MalVal *EVAL(MalVal *ast, Env *env); MalVal *quasiquote(MalVal *ast); -MalVal *macroexpand(MalVal *ast, Env *env); // read MalVal *READ(char prompt[], char *str) { @@ -70,31 +69,18 @@ MalVal *quasiquote(MalVal *ast) { } } -int is_macro_call(MalVal *ast, Env *env) { - if (!ast || ast->type != MAL_LIST || _count(ast) == 0) { return 0; } - MalVal *a0 = _nth(ast, 0); - return (a0->type & MAL_SYMBOL) && - env_find(env, a0) && - env_get(env, a0)->ismacro; -} +MalVal *EVAL(MalVal *ast, Env *env) { + while (TRUE) { -MalVal *macroexpand(MalVal *ast, Env *env) { if (!ast || mal_error) return NULL; - while (is_macro_call(ast, env)) { - MalVal *a0 = _nth(ast, 0); - MalVal *mac = env_get(env, a0); - // TODO: this is weird and limits it to 20. FIXME - ast = _apply(mac, _rest(ast)); - } - return ast; -} + //g_print("EVAL: %s\n", _pr_str(ast,1)); -MalVal *eval_ast(MalVal *ast, Env *env) { - if (!ast || mal_error) return NULL; if (ast->type == MAL_SYMBOL) { //g_print("EVAL symbol: %s\n", ast->val.string); return env_get(env, ast); - } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { + } else if (ast->type == MAL_LIST) { + // Proceed after this conditional. + } else if (ast->type == MAL_VECTOR) { //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); if (!el || mal_error) return NULL; @@ -119,25 +105,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); return ast; } -} - -MalVal *EVAL(MalVal *ast, Env *env) { - while (TRUE) { - - if (!ast || mal_error) return NULL; - //g_print("EVAL: %s\n", _pr_str(ast,1)); - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } - if (!ast || mal_error) return NULL; // apply list - //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); - ast = macroexpand(ast, env); - if (!ast || mal_error) return NULL; - if (ast->type != MAL_LIST) { - return eval_ast(ast, env); - } if (_count(ast) == 0) { return ast; } int i, len; @@ -175,9 +144,6 @@ MalVal *EVAL(MalVal *ast, Env *env) { strcmp("quote", a0->val.string) == 0) { //g_print("eval apply quote\n"); return _nth(ast, 1); - } else if ((a0->type & MAL_SYMBOL) && - strcmp("quasiquoteexpand", a0->val.string) == 0) { - return quasiquote(_nth(ast, 1)); } else if ((a0->type & MAL_SYMBOL) && strcmp("quasiquote", a0->val.string) == 0) { //g_print("eval apply quasiquote\n"); @@ -194,15 +160,11 @@ MalVal *EVAL(MalVal *ast, Env *env) { res->ismacro = TRUE; env_set(env, a1, res); return res; - } else if ((a0->type & MAL_SYMBOL) && - strcmp("macroexpand", a0->val.string) == 0) { - //g_print("eval apply macroexpand\n"); - MalVal *a1 = _nth(ast, 1); - return macroexpand(a1, env); } else if ((a0->type & MAL_SYMBOL) && strcmp(".", a0->val.string) == 0) { //g_print("eval apply .\n"); - MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); + MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)), env); + if (!el || mal_error) return NULL; return invoke_native(el); } else if ((a0->type & MAL_SYMBOL) && strcmp("try*", a0->val.string) == 0) { @@ -231,7 +193,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { } else if ((a0->type & MAL_SYMBOL) && strcmp("do", a0->val.string) == 0) { //g_print("eval apply do\n"); - eval_ast(_slice(ast, 1, _count(ast)-1), env); + _map2((MalVal *(*)(void*, void*))EVAL, _slice(ast, 1, _count(ast)-1), env); ast = _last(ast); // Continue loop } else if ((a0->type & MAL_SYMBOL) && @@ -264,10 +226,15 @@ MalVal *EVAL(MalVal *ast, Env *env) { return mf; } else { //g_print("eval apply\n"); - MalVal *el = eval_ast(ast, env); - if (!el || mal_error) { return NULL; } - MalVal *f = _first(el), - *args = _rest(el); + MalVal *f = EVAL(a0, env); + if (!f || mal_error) { return NULL; } + MalVal *rest = _rest(ast); + if (f->ismacro) { + ast = _apply(f, rest); + continue; + } + MalVal *args = _map2((MalVal *(*)(void*, void*))EVAL, rest, env); + if (!args || mal_error) { return NULL; } assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); if (f->type & MAL_FUNCTION_MAL) { diff --git a/impls/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc index d6203ef4e8..8eb0628b90 100644 --- a/impls/clojure/src/mal/stepA_mal.cljc +++ b/impls/clojure/src/mal/stepA_mal.cljc @@ -1,5 +1,4 @@ (ns mal.stepA-mal - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -34,45 +33,22 @@ (or (symbol? ast) (map? ast)) (list 'quote ast) :else ast)) -(defn is-macro-call [ast env] - (and (seq? ast) - (symbol? (first ast)) - (env/env-find env (first ast)) - (:ismacro (meta (env/env-get env (first ast)))))) - -(defn macroexpand [ast env] - (loop [ast ast] - (if (is-macro-call ast env) - ;; Get original unadorned function because ClojureScript (1.10) - ;; limits functions with meta on them to arity 20 - (let [mac (:orig (meta (env/env-get env (first ast))))] - (recur (apply mac (rest ast)))) - ast))) - -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) - - (vector? ast) (vec (doall (map #(EVAL % env) ast))) - - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) - - :else ast)) - (defn EVAL [ast env] (loop [ast ast env env] ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env/env-get env ast) + (vector? ast) + (vec (map #(EVAL % env) ast)) + + (map? ast) + (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + + (seq? ast) ;; apply list - (let [ast (macroexpand ast env)] - (if (not (seq? ast)) - (eval-ast ast env) (let [[a0 a1 a2 a3] ast] (condp = a0 @@ -91,9 +67,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +78,6 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'clj* #?(:clj (eval (reader/read-string a1)) :cljs (throw (ex-info "clj* unsupported in ClojureScript mode" {}))) @@ -134,7 +104,7 @@ (EVAL a1 env)) 'do - (do (eval-ast (->> ast (drop-last) (drop 1)) env) + (do (doall (map #(EVAL % env) (->> ast (drop-last) (drop 1)))) (recur (last ast) env)) 'if @@ -158,13 +128,19 @@ :parameters a1})) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (let [f (EVAL a0 env) + unevaluated_args (rest ast)] + (if (:ismacro (meta f)) + (recur (apply (:orig (meta f)) unevaluated_args) env) + (let [args (map #(EVAL % env) unevaluated_args) {:keys [expression environment parameters]} (meta f)] (if expression (recur expression (env/env environment parameters args)) - (apply f args)))))))))) + (apply f args))))))) + + :else ;; not a list, map, symbol or vector + ast))) + ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/coffee/stepA_mal.coffee b/impls/coffee/stepA_mal.coffee index 504c81eaaf..b48de25cba 100644 --- a/impls/coffee/stepA_mal.coffee +++ b/impls/coffee/stepA_mal.coffee @@ -23,36 +23,21 @@ quasiquote = (ast) -> else if types._symbol_Q(ast) || types._hash_map_Q(ast) then [types._symbol('quote'), ast] else ast -is_macro_call = (ast, env) -> - return types._list_Q(ast) && types._symbol_Q(ast[0]) && - env.find(ast[0]) && env.get(ast[0]).__ismacro__ - -macroexpand = (ast, env) -> - while is_macro_call(ast, env) - ast = env.get(ast[0])(ast[1..]...) - ast - - - -eval_ast = (ast, env) -> - if types._symbol_Q(ast) then env.get ast - else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env)) +EVAL = (ast, env) -> + loop + #console.log "EVAL:", printer._pr_str ast + if types._symbol_Q(ast) + return env.get ast else if types._vector_Q(ast) - types._vector(ast.map((a) -> EVAL(a, env))...) + return types._vector(ast.map((a) -> EVAL(a, env))...) else if types._hash_map_Q(ast) new_hm = {} new_hm[k] = EVAL(v, env) for k,v of ast - new_hm - else ast - -EVAL = (ast, env) -> - loop - #console.log "EVAL:", printer._pr_str ast - if !types._list_Q ast then return eval_ast ast, env + return new_hm + else if !types._list_Q(ast) + return ast # apply list - ast = macroexpand ast, env - if !types._list_Q ast then return eval_ast ast, env if ast.length == 0 then return ast [a0, a1, a2, a3] = ast @@ -67,8 +52,6 @@ EVAL = (ast, env) -> env = let_env when "quote" return a1 - when "quasiquoteexpand" - return quasiquote(a1) when "quasiquote" ast = quasiquote(a1) when "defmacro!" @@ -76,8 +59,6 @@ EVAL = (ast, env) -> f = types._clone(f) f.__ismacro__ = true return env.set(a1, f) - when "macroexpand" - return macroexpand(a1, env) when "try*" try return EVAL(a1, env) catch exc @@ -91,10 +72,10 @@ EVAL = (ast, env) -> res = eval(a1.toString()) return if typeof(res) == 'undefined' then null else res when "." - el = eval_ast(ast[2..], env) + el = ast[2..].map((a) -> EVAL(a, env)) return eval(a1.toString())(el...) when "do" - eval_ast(ast[1..-2], env) + ast[1..-2].map((a) -> EVAL(a, env)) ast = ast[ast.length-1] when "if" cond = EVAL(a1, env) @@ -105,14 +86,17 @@ EVAL = (ast, env) -> when "fn*" return types._function(EVAL, a2, env, a1) else - [f, args...] = eval_ast ast, env + f = EVAL(a0, env) + if f.__ismacro__ + ast = EVAL(f.__ast__, f.__gen_env__(ast[1..])) + continue + args = ast[1..].map((a) -> EVAL(a, env)) if types._function_Q(f) ast = f.__ast__ env = f.__gen_env__(args) else return f(args...) - # print PRINT = (exp) -> printer._pr_str exp, true diff --git a/impls/common-lisp/src/stepA_mal.lisp b/impls/common-lisp/src/stepA_mal.lisp index 6e360faa3e..99ca5fe183 100644 --- a/impls/common-lisp/src/stepA_mal.lisp +++ b/impls/common-lisp/src/stepA_mal.lisp @@ -42,14 +42,12 @@ (defvar mal-fn* (make-mal-symbol "fn*")) (defvar mal-quote (make-mal-symbol "quote")) (defvar mal-quasiquote (make-mal-symbol "quasiquote")) -(defvar mal-quasiquoteexpand (make-mal-symbol "quasiquoteexpand")) (defvar mal-unquote (make-mal-symbol "unquote")) (defvar mal-splice-unquote (make-mal-symbol "splice-unquote")) (defvar mal-vec (make-mal-symbol "vec")) (defvar mal-cons (make-mal-symbol "cons")) (defvar mal-concat (make-mal-symbol "concat")) (defvar mal-defmacro! (make-mal-symbol "defmacro!")) -(defvar mal-macroexpand (make-mal-symbol "macroexpand")) (defvar mal-try* (make-mal-symbol "try*")) (defvar mal-catch* (make-mal-symbol "catch*")) (defvar mal-throw (make-mal-symbol "throw")) @@ -68,14 +66,6 @@ hash-map-value) (make-mal-hash-map new-hash-table))) -(defun eval-ast (ast env) - (switch-mal-type ast - (types:symbol (env:get-env env ast)) - (types:list (eval-sequence ast env)) - (types:vector (make-mal-vector (apply 'vector (eval-sequence ast env)))) - (types:hash-map (eval-hash-map ast env)) - (types:any ast))) - (defun qq-reducer (elt acc) (make-mal-list (if (and (mal-list-p elt) @@ -94,48 +84,36 @@ (types:symbol (make-mal-list (list mal-quote ast))) (types:any ast))) -(defun is-macro-call (ast env) - (when (mal-list-p ast) - (let* ((func-symbol (first (mal-data-value ast))) - (func (when (mal-symbol-p func-symbol) - (env:find-env env func-symbol)))) - (and func - (mal-fn-p func) - (cdr (assoc :is-macro (mal-data-attrs func))))))) - -(defun mal-macroexpand (ast env) - (loop - while (is-macro-call ast env) - do (let* ((forms (mal-data-value ast)) - (func (env:get-env env (first forms)))) - (setf ast (apply (mal-data-value func) - (cdr forms))))) - ast) - (defun mal-read (string) (reader:read-str string)) (defun mal-eval (ast env) (loop - do (setf ast (mal-macroexpand ast env)) - do (cond - ((null ast) (return mal-nil)) - ((not (mal-list-p ast)) (return (eval-ast ast env))) - ((zerop (length (mal-data-value ast))) (return ast)) - (t (let ((forms (mal-data-value ast))) + ;; do (write-line (format nil "EVAL: ~a" (pr-str ast))) + ;; do (force-output *standard-output*) + do (switch-mal-type ast + + (types:symbol + (return (env:get-env env ast))) + + (types:vector + (return (make-mal-vector (apply 'vector (eval-sequence ast env))))) + + (types-hash-map + (return (eval-hash-map ast env))) + + (types-mal-list + (let ((forms (mal-data-value ast))) (cond + ((zerop (length forms)) + (return ast)) + ((mal-data-value= mal-quote (first forms)) (return (second forms))) - ((mal-data-value= mal-quasiquoteexpand (first forms)) - (return (quasiquote (second forms)))) - ((mal-data-value= mal-quasiquote (first forms)) (setf ast (quasiquote (second forms)))) - ((mal-data-value= mal-macroexpand (first forms)) - (return (mal-macroexpand (second forms) env))) - ((mal-data-value= mal-def! (first forms)) (return (env:set-env env (second forms) (mal-eval (third forms) env)))) @@ -207,24 +185,28 @@ :exprs (list (if (typep condition 'mal-user-exception) (mal-exception-data condition) (make-mal-string (format nil "~a" condition))))))))))))) - - (t (let* ((evaluated-list (eval-ast ast env)) - (function (car evaluated-list))) + (t (let ((function (EVAL (car ast) env)) + (args (cdr ast))) ;; If first element is a mal function unwrap it (cond ((mal-fn-p function) (let* ((attrs (mal-data-attrs function))) + (if (cdr (assoc :is-macro attrs)) + (setf ast (apply (mal-data-value function) args)) (setf ast (cdr (assoc :ast attrs)) env (env:create-mal-env :parent (cdr (assoc :env attrs)) :binds (map 'list #'identity (mal-data-value (cdr (assoc :params attrs)))) - :exprs (cdr evaluated-list))))) + :exprs (eval-sequence args)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) - (cdr evaluated-list)))) + (eval-sequence args)))) (t (error 'invalid-function :form function - :context "apply"))))))))))) + :context "apply")))))))) + + (types:any + (return ast))))) (defun mal-print (expression) (printer:pr-str expression)) diff --git a/impls/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp index 34c940ba81..2de9c53a69 100644 --- a/impls/cpp/stepA_mal.cpp +++ b/impls/cpp/stepA_mal.cpp @@ -15,7 +15,6 @@ static void installFunctions(malEnvPtr env); static void makeArgv(malEnvPtr env, int argc, char* argv[]); static String safeRep(const String& input, malEnvPtr env); static malValuePtr quasiquote(malValuePtr obj); -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env); static ReadLine s_readLine("~/.mal-history"); @@ -83,13 +82,9 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) env = replEnv; } while (1) { - const malList* list = DYNAMIC_CAST(malList, ast); - if (!list || (list->count() == 0)) { - return ast->eval(env); - } + // std::cout << "EVAL: " << PRINT(ast) << "\n"; - ast = macroExpand(ast, env); - list = DYNAMIC_CAST(malList, ast); + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } @@ -167,16 +162,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "macroexpand") { - checkArgsIs("macroexpand", 1, argCount); - return macroExpand(list->item(1), env); - } - - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); @@ -236,15 +221,20 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) } // Now we're left with the case of a regular list to be evaluated. - std::unique_ptr items(list->evalItems(env)); - malValuePtr op = items->at(0); + malValuePtr op = EVAL(list->item(0), env); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { + if (lambda->isMacro()) { + ast = lambda->apply(list->begin()+1, list->end()); + continue; // TCO + } + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); ast = lambda->getBody(); - env = lambda->makeEnv(items->begin()+1, items->end()); + env = lambda->makeEnv(items->begin(), items->end()); continue; // TCO } else { - return APPLY(op, items->begin()+1, items->end()); + malValueVec* items = STATIC_CAST(malList, list->rest())->evalItems(env); + return APPLY(op, items->begin(), items->end()); } } } @@ -306,31 +296,6 @@ static malValuePtr quasiquote(malValuePtr obj) return res; } -static const malLambda* isMacroApplication(malValuePtr obj, malEnvPtr env) -{ - const malList* seq = DYNAMIC_CAST(malList, obj); - if (seq && !seq->isEmpty()) { - if (malSymbol* sym = DYNAMIC_CAST(malSymbol, seq->item(0))) { - if (malEnvPtr symEnv = env->find(sym->value())) { - malValuePtr value = sym->eval(symEnv); - if (malLambda* lambda = DYNAMIC_CAST(malLambda, value)) { - return lambda->isMacro() ? lambda : NULL; - } - } - } - } - return NULL; -} - -static malValuePtr macroExpand(malValuePtr obj, malEnvPtr env) -{ - while (const malLambda* macro = isMacroApplication(obj, env)) { - const malSequence* seq = STATIC_CAST(malSequence, obj); - obj = macro->apply(seq->begin() + 1, seq->end()); - } - return obj; -} - static const char* malFunctionTable[] = { "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", "(def! not (fn* (cond) (if cond false true)))", diff --git a/impls/cs/stepA_mal.cs b/impls/cs/stepA_mal.cs index cdc1490187..13d63fd069 100644 --- a/impls/cs/stepA_mal.cs +++ b/impls/cs/stepA_mal.cs @@ -59,70 +59,34 @@ public static MalVal quasiquote(MalVal ast) { } } - public static bool is_macro_call(MalVal ast, Env env) { - if (ast is MalList) { - MalVal a0 = ((MalList)ast)[0]; - if (a0 is MalSymbol && - env.find((MalSymbol)a0) != null) { - MalVal mac = env.get((MalSymbol)a0); - if (mac is MalFunc && - ((MalFunc)mac).isMacro()) { - return true; - } - } - } - return false; - } + static MalVal EVAL(MalVal orig_ast, Env env) { + MalVal a0, a1, a2, res; - public static MalVal macroexpand(MalVal ast, Env env) { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast)[0]; - MalFunc mac = (MalFunc) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } + while (true) { - static MalVal eval_ast(MalVal ast, Env env) { - if (ast is MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast is MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); + //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); + + if (orig_ast is MalSymbol) { + return env.get((MalSymbol)orig_ast); + } else if (orig_ast is MalVector) { + MalVector old_lst = (MalVector)orig_ast; + MalVector new_lst = new MalVector(); foreach (MalVal mv in old_lst.getValue()) { new_lst.conj_BANG(EVAL(mv, env)); } return new_lst; - } else if (ast is MalHashMap) { + } else if (orig_ast is MalHashMap) { var new_dict = new Dictionary(); - foreach (var entry in ((MalHashMap)ast).getValue()) { + foreach (var entry in ((MalHashMap)orig_ast).getValue()) { new_dict.Add(entry.Key, EVAL((MalVal)entry.Value, env)); } return new MalHashMap(new_dict); - } else { - return ast; - } - } - - - static MalVal EVAL(MalVal orig_ast, Env env) { - MalVal a0, a1, a2, res; - MalList el; - - while (true) { - - //Console.WriteLine("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + } else if (!(orig_ast is MalList)) { + return orig_ast; } // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList) orig_ast; if (ast.size() == 0) { return ast; } a0 = ast[0]; @@ -153,8 +117,6 @@ static MalVal EVAL(MalVal orig_ast, Env env) { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -166,9 +128,6 @@ static MalVal EVAL(MalVal orig_ast, Env env) { ((MalFunc)res).setMacro(); env.set(((MalSymbol)a1), res); return res; - case "macroexpand": - a1 = ast[1]; - return macroexpand(a1, env); case "try*": try { return EVAL(ast[1], env); @@ -191,7 +150,9 @@ static MalVal EVAL(MalVal orig_ast, Env env) { throw e; } case "do": - eval_ast(ast.slice(1, ast.size()-1), env); + foreach (MalVal mv in ast.slice(1, ast.size()-1).getValue()) { + EVAL(mv, env); + } orig_ast = ast[ast.size()-1]; break; case "if": @@ -216,14 +177,21 @@ static MalVal EVAL(MalVal orig_ast, Env env) { return new MalFunc(a2f, env, a1f, args => EVAL(a2f, new Env(cur_env, a1f, args)) ); default: - el = (MalList)eval_ast(ast, env); - var f = (MalFunc)el[0]; + MalFunc f = (MalFunc)EVAL(ast[0], env); + if (f.isMacro()) { + orig_ast = f.apply(ast.rest()); + break; + } + MalList arguments = new MalList(); + foreach (MalVal mv in ast.rest().getValue()) { + arguments.conj_BANG(EVAL(mv, env)); + } MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.rest()); + env = f.genEnv(arguments); } else { - return f.apply(el.rest()); + return f.apply(arguments); } break; } diff --git a/impls/d/stepA_mal.d b/impls/d/stepA_mal.d index 1b6e490853..6929395d84 100644 --- a/impls/d/stepA_mal.d +++ b/impls/d/stepA_mal.d @@ -46,50 +46,22 @@ MalType quasiquote(MalType ast) return res; } -bool is_macro_call(MalType ast, Env env) -{ - auto lst = cast(MalList) ast; - if (lst is null) return false; - if (lst.elements.length == 0) return false; - auto sym0 = cast(MalSymbol) lst.elements[0]; - if (sym0 is null) return false; - if (env.find(sym0) is null) return false; - auto val = env.get(sym0); - auto val_func = cast(MalFunc) val; - if (val_func is null) return false; - return val_func.is_macro; -} - -MalType macroexpand(MalType ast, Env env) -{ - while (is_macro_call(ast, env)) - { - auto ast_list = verify_cast!MalList(ast); - auto sym0 = verify_cast!MalSymbol(ast_list.elements[0]); - auto macrofunc = verify_cast!MalFunc(env.get(sym0)); - auto rest = ast_list.elements[1..$]; - auto callenv = new Env(macrofunc.def_env, macrofunc.arg_names, rest); - ast = EVAL(macrofunc.func_body, callenv); - } - return ast; -} - MalType READ(string str) { return read_str(str); } -MalType eval_ast(MalType ast, Env env) +MalType EVAL(MalType ast, Env env) { + for (;;) + { + + // writeln("EVAL: ", pr_str(ast)); + if (auto sym = cast(MalSymbol)ast) { return env.get(sym); } - else if (auto lst = cast(MalList)ast) - { - auto el = array(lst.elements.map!(e => EVAL(e, env))); - return new MalList(el); - } else if (auto lst = cast(MalVector)ast) { auto el = array(lst.elements.map!(e => EVAL(e, env))); @@ -104,29 +76,8 @@ MalType eval_ast(MalType ast, Env env) } return new MalHashmap(new_data); } - else - { - return ast; - } -} - -MalType EVAL(MalType ast, Env env) -{ - for (;;) + else if (auto ast_list = cast(MalList)ast) { - MalList ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - - ast = macroexpand(ast, env); - ast_list = cast(MalList) ast; - if (ast_list is null) - { - return eval_ast(ast, env); - } - auto aste = ast_list.elements; if (aste.length == 0) { @@ -156,9 +107,6 @@ MalType EVAL(MalType ast, Env env) case "quote": return aste[1]; - case "quasiquoteexpand": - return quasiquote(aste[1]); - case "quasiquote": ast = quasiquote(aste[1]); continue; // TCO @@ -170,9 +118,6 @@ MalType EVAL(MalType ast, Env env) mac.is_macro = true; return env.set(a1, mac); - case "macroexpand": - return macroexpand(aste[1], env); - case "try*": if (aste.length < 2) return mal_nil; if (aste.length < 3) @@ -203,8 +148,9 @@ MalType EVAL(MalType ast, Env env) continue; // TCO case "do": - auto all_but_last = new MalList(aste[1..$-1]); - eval_ast(all_but_last, env); + foreach (elt; aste[1..$-1]) { + EVAL(elt, env); + } ast = aste[$-1]; continue; // TCO @@ -231,15 +177,16 @@ MalType EVAL(MalType ast, Env env) return new MalFunc(args_list.elements, aste[2], env); default: - auto el = verify_cast!MalList(eval_ast(ast, env)); - if (el.elements.length == 0) - { - throw new Exception("Expected a non-empty list"); - } - auto first = el.elements[0]; - auto rest = el.elements[1..$]; + auto first = EVAL(aste[0], env); + auto rest = aste[1..$]; if (auto funcobj = cast(MalFunc)first) { + if (funcobj.is_macro) { + auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); + ast = EVAL(funcobj.func_body, callenv); + continue; // TCO + } + rest = array(rest.map!(e => EVAL(e, env))); auto callenv = new Env(funcobj.def_env, funcobj.arg_names, rest); ast = funcobj.func_body; env = callenv; @@ -247,6 +194,7 @@ MalType EVAL(MalType ast, Env env) } else if (auto builtinfuncobj = cast(MalBuiltinFunc)first) { + rest = array(rest.map!(e => EVAL(e, env))); return builtinfuncobj.fn(rest); } else @@ -255,6 +203,11 @@ MalType EVAL(MalType ast, Env env) } } } + else + { + return ast; + } + } } string PRINT(MalType ast) diff --git a/impls/dart/stepA_mal.dart b/impls/dart/stepA_mal.dart index 72bc20159c..1a07a4bddf 100644 --- a/impls/dart/stepA_mal.dart +++ b/impls/dart/stepA_mal.dart @@ -31,35 +31,6 @@ void setupEnv(List argv) { " (cons 'cond (rest (rest xs)))))))"); } -/// Returns `true` if [ast] is a macro call. -/// -/// This checks that [ast] is a list whose first element is a symbol that refers -/// to a function in the current [env] that is a macro. -bool isMacroCall(MalType ast, Env env) { - if (ast is MalList) { - if (ast.isNotEmpty && ast.first is MalSymbol) { - try { - var value = env.get(ast.first); - if (value is MalCallable) { - return value.isMacro; - } - } on NotFoundException { - return false; - } - } - } - return false; -} - -MalType macroexpand(MalType ast, Env env) { - while (isMacroCall(ast, env)) { - var macroSymbol = (ast as MalList).first; - var macro = env.get(macroSymbol) as MalCallable; - ast = macro((ast as MalList).sublist(1)); - } - return ast; -} - bool starts_with(MalType ast, String sym) { return ast is MalList && ast.length == 2 && ast.first == new MalSymbol(sym); } @@ -92,11 +63,12 @@ MalType quasiquote(MalType ast) { MalType READ(String x) => reader.read_str(x); -MalType eval_ast(MalType ast, Env env) { +MalType EVAL(MalType ast, Env env) { + while (true) { + // stdout.writeln("EVAL: ${printer.pr_str(ast)}"); + if (ast is MalSymbol) { return env.get(ast); - } else if (ast is MalList) { - return new MalList(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalVector) { return new MalVector(ast.elements.map((x) => EVAL(x, env)).toList()); } else if (ast is MalHashMap) { @@ -105,28 +77,15 @@ MalType eval_ast(MalType ast, Env env) { newMap[key] = EVAL(newMap[key], env); } return new MalHashMap(newMap); - } else { + } else if (ast is! MalList) { return ast; - } -} - -MalType EVAL(MalType ast, Env env) { - while (true) { - if (ast is! MalList) { - return eval_ast(ast, env); - } else { - if ((ast as MalList).elements.isEmpty) { - return ast; - } else { - ast = macroexpand(ast, env); - if (ast is! MalList) return eval_ast(ast, env); - if ((ast as MalList).isEmpty) return ast; - + } else { var list = ast as MalList; + if (list.isEmpty) return ast; + var args = list.elements.sublist(1); if (list.elements.first is MalSymbol) { var symbol = list.elements.first as MalSymbol; - var args = list.elements.sublist(1); if (symbol.value == "def!") { MalSymbol key = args.first; MalType value = EVAL(args[1], env); @@ -157,7 +116,9 @@ MalType EVAL(MalType ast, Env env) { env = newEnv; continue; } else if (symbol.value == "do") { - eval_ast(new MalList(args.sublist(0, args.length - 1)), env); + for (var elt in args.sublist(0, args.length - 1)) { + EVAL(elt, env); + } ast = args.last; continue; } else if (symbol.value == "if") { @@ -188,13 +149,9 @@ MalType EVAL(MalType ast, Env env) { EVAL(args[1], new Env(env, params, funcArgs))); } else if (symbol.value == "quote") { return args.single; - } else if (symbol.value == "quasiquoteexpand") { - return quasiquote(args.first); } else if (symbol.value == "quasiquote") { ast = quasiquote(args.first); continue; - } else if (symbol.value == 'macroexpand') { - return macroexpand(args.first, env); } else if (symbol.value == 'try*') { var body = args.first; if (args.length < 2) { @@ -222,9 +179,12 @@ MalType EVAL(MalType ast, Env env) { continue; } } - var newAst = eval_ast(ast, env) as MalList; - var f = newAst.elements.first; - var args = newAst.elements.sublist(1); + var f = EVAL(list.elements.first, env); + if (f is MalCallable && f.isMacro) { + ast = f.call(args); + continue; + } + args = args.map((x) => EVAL(x, env)).toList(); if (f is MalBuiltin) { return f.call(args); } else if (f is MalClosure) { @@ -234,9 +194,8 @@ MalType EVAL(MalType ast, Env env) { } else { throw 'bad!'; } - } - } } + } } String PRINT(MalType x) => printer.pr_str(x); diff --git a/impls/elisp/step2_eval.el b/impls/elisp/step2_eval.el index a27cbd6c4d..6b76b75d7b 100644 --- a/impls/elisp/step2_eval.el +++ b/impls/elisp/step2_eval.el @@ -12,32 +12,30 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + ;; (println "EVAL: %s\n" (PRINT ast)) + (cl-case (mal-type ast) + (list + (let ((a (mal-value ast))) + (if a + (let* ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (apply fn args)) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + ast))) (symbol - (let ((definition (gethash value env))) + (let ((definition (gethash (mal-value ast) env))) (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step3_env.el b/impls/elisp/step3_env.el index f05c178b21..6d854f68ea 100644 --- a/impls/elisp/step3_env.el +++ b/impls/elisp/step3_env.el @@ -13,20 +13,24 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) - (a1* (mal-value a1)) (a2 (nth 2 a))) + (if a (cl-case (mal-value (car a)) (def! - (let ((identifier a1*) + (let ((identifier (mal-value a1)) (value (EVAL a2 env))) (mal-env-set env identifier value))) (let* - (let ((env* (mal-env env)) - (bindings (if (vectorp a1*) (append a1* nil) a1*)) - (form a2)) + (let* ((env* (mal-env env)) + (a1* (mal-value a1)) + (bindings (if (vectorp a1*) (append a1* nil) a1*)) + (form a2)) (while bindings (let ((key (mal-value (pop bindings))) (value (EVAL (pop bindings) env*))) @@ -34,31 +38,25 @@ (EVAL form env*))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) - (apply fn args))))) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn args)))) + ast))) (symbol - (let ((definition (mal-env-get env value))) + (let ((definition (mal-env-get env (mal-value ast)))) (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step4_if_fn_do.el b/impls/elisp/step4_if_fn_do.el index f4f2142e3f..f5f4c5745f 100644 --- a/impls/elisp/step4_if_fn_do.el +++ b/impls/elisp/step4_if_fn_do.el @@ -17,11 +17,15 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (if a (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -37,7 +41,11 @@ (mal-env-set env* key value))) (EVAL form env*))) (do - (car (last (mal-value (eval-ast (mal-list (cdr a)) env))))) + (let* ((a0... (cdr a)) + (butlast (butlast a0...)) + (last (car (last a0...)))) + (mapcar (lambda (item) (EVAL item env)) butlast) + (EVAL last env))) (if (let* ((condition (EVAL a1 env)) (condition-type (mal-type condition)) @@ -58,31 +66,25 @@ (EVAL body env*)))))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn* (mal-value (car ast*))) - (args (cdr ast*))) - (apply fn* args))))) - (eval-ast ast env))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (let ((fn* (mal-value (EVAL (car a) env))) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) + (apply fn* args)))) + ast))) (symbol - (let ((definition (mal-env-get env value))) + (let ((definition (mal-env-get env (mal-value ast)))) (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) (mal-map map))) (t ;; return as is - ast)))) + ast))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step5_tco.el b/impls/elisp/step5_tco.el index 315cfa4605..656082d468 100644 --- a/impls/elisp/step5_tco.el +++ b/impls/elisp/step5_tco.el @@ -21,11 +21,17 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -45,8 +51,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -69,38 +74,33 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (if (mal-func-p fn) (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) args))) (setq env env* ast (mal-func-ast fn))) ; TCO + ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (defun PRINT (input) (pr-str input t)) diff --git a/impls/elisp/step6_file.el b/impls/elisp/step6_file.el index 88d09d0e12..2004c39eaf 100644 --- a/impls/elisp/step6_file.el +++ b/impls/elisp/step6_file.el @@ -20,11 +20,17 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -44,8 +50,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -68,9 +73,8 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (if (mal-func-p fn) (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) @@ -79,28 +83,23 @@ ast (mal-func-ast fn))) ; TCO ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elisp/step7_quote.el b/impls/elisp/step7_quote.el index 726fbee90f..0db4a9c508 100644 --- a/impls/elisp/step7_quote.el +++ b/impls/elisp/step7_quote.el @@ -46,11 +46,17 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -68,16 +74,13 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -100,9 +103,8 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (mapcar (lambda (x) (EVAL x env)) (cdr a)))) (if (mal-func-p fn) (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) @@ -111,28 +113,23 @@ ast (mal-func-ast fn))) ; TCO ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args)))))))) - (throw 'return (eval-ast ast env)))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* args))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elisp/step8_macros.el b/impls/elisp/step8_macros.el index 5462d87ca1..a5f347cf00 100644 --- a/impls/elisp/step8_macros.el +++ b/impls/elisp/step8_macros.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,23 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - ast) - (defun READ (input) (read-str input)) (defun EVAL (ast env) (catch 'return (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,22 +74,17 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (do (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -122,38 +107,36 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + ast (mal-func-ast fn)))) ; TCO ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elisp/step9_try.el b/impls/elisp/step9_try.el index 84fbc6038d..9cb121dd69 100644 --- a/impls/elisp/step9_try.el +++ b/impls/elisp/step9_try.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,23 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - ast) - (defun READ (input) (read-str input)) (defun EVAL (ast env) (catch 'return (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,16 +74,12 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (try* (condition-case err (throw 'return (EVAL a1 env)) @@ -114,8 +100,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -138,38 +123,36 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + ast (mal-func-ast fn)))) ; TCO ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elisp/stepA_mal.el b/impls/elisp/stepA_mal.el index 34c53c683d..eb0ff8a6cd 100644 --- a/impls/elisp/stepA_mal.el +++ b/impls/elisp/stepA_mal.el @@ -16,9 +16,11 @@ (mal-env-set repl-env symbol fn))) (defun starts-with-p (ast sym) - (let ((s (car (mal-value ast)))) - (and (mal-symbol-p s) - (eq (mal-value s) sym)))) + (let ((l (mal-value ast))) + (and l + (let ((s (car l))) + (and (mal-symbol-p s) + (eq (mal-value s) sym)))))) (defun qq-reducer (elt acc) (mal-list (if (and (mal-list-p elt) @@ -38,35 +40,23 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (t ast))) -(defun MACROEXPAND (ast env) - (let (a a0 macro) - (while (and (mal-list-p ast) - (setq a (mal-value ast)) - (setq a0 (car a)) - (mal-symbol-p a0) - (setq macro (mal-env-find env (mal-value a0))) - (mal-func-p macro) - (mal-func-macro-p macro)) - (setq ast (apply (mal-value (mal-func-fn macro)) (cdr a))))) - ast) - (defun READ (input) (read-str input)) (defun EVAL (ast env) (catch 'return (while t - (when (not (mal-list-p ast)) - (throw 'return (eval-ast ast env))) - (setq ast (MACROEXPAND ast env)) - (when (or (not (mal-list-p ast)) (not (mal-value ast))) - (throw 'return (eval-ast ast env))) + ;; (println "EVAL: %s\n" (PRINT ast)) + + (cl-case (mal-type ast) + (list (let* ((a (mal-value ast)) (a1 (cadr a)) (a2 (nth 2 a)) (a3 (nth 3 a))) + (unless a (throw 'return ast)) (cl-case (mal-value (car a)) (def! (let ((identifier (mal-value a1)) @@ -84,16 +74,12 @@ ast form))) ; TCO (quote (throw 'return a1)) - (quasiquoteexpand - (throw 'return (quasiquote a1))) (quasiquote (setq ast (quasiquote a1))) ; TCO (defmacro! (let ((identifier (mal-value a1)) (value (mal-macro (EVAL a2 env)))) (throw 'return (mal-env-set env identifier value)))) - (macroexpand - (throw 'return (MACROEXPAND a1 env))) (try* (condition-case err (throw 'return (EVAL a1 env)) @@ -114,8 +100,7 @@ (let* ((a0... (cdr a)) (butlast (butlast a0...)) (last (car (last a0...)))) - (when butlast - (eval-ast (mal-list butlast) env)) + (mapcar (lambda (item) (EVAL item env)) butlast) (setq ast last))) ; TCO (if (let* ((condition (EVAL a1 env)) @@ -138,38 +123,36 @@ (throw 'return (mal-func body binds env fn)))) (t ;; not a special form - (let* ((ast* (mal-value (eval-ast ast env))) - (fn (car ast*)) - (args (cdr ast*))) + (let ((fn (EVAL (car a) env)) + (args (cdr a))) (if (mal-func-p fn) + (if (mal-func-macro-p fn) + (setq ast (apply (mal-value (mal-func-fn fn)) args)) ; TCO (let ((env* (mal-env (mal-func-env fn) (mal-func-params fn) - args))) + (mapcar (lambda (x) (EVAL x env)) args)))) (setq env env* - ast (mal-func-ast fn))) ; TCO + ast (mal-func-ast fn)))) ; TCO ;; built-in function (let ((fn* (mal-value fn))) - (throw 'return (apply fn* args))))))))))) - -(defun eval-ast (ast env) - (let ((value (mal-value ast))) - (cl-case (mal-type ast) + (throw 'return (apply fn* (mapcar (lambda (x) (EVAL x env)) + args)))))))))) (symbol - (let ((definition (mal-env-get env value))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (throw 'return (or (mal-env-get env (mal-value ast)) + (error "Definition not found")))) (vector - (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value)))) + (throw 'return + (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) + (mal-value ast)))))) (map - (let ((map (copy-hash-table value))) + (let ((map (copy-hash-table (mal-value ast)))) (maphash (lambda (key val) (puthash key (EVAL val env) map)) map) - (mal-map map))) + (throw 'return (mal-map map)))) (t ;; return as is - ast)))) + (throw 'return ast)))))) (mal-env-set repl-env 'eval (mal-fn (let ((env repl-env)) (lambda (form) (EVAL form env))))) (mal-env-set repl-env '*ARGV* (mal-list (mapcar 'mal-string (cdr argv)))) diff --git a/impls/elixir/lib/mix/tasks/stepA_mal.ex b/impls/elixir/lib/mix/tasks/stepA_mal.ex index 3df0e41899..d2474e845d 100644 --- a/impls/elixir/lib/mix/tasks/stepA_mal.ex +++ b/impls/elixir/lib/mix/tasks/stepA_mal.ex @@ -75,7 +75,7 @@ defmodule Mix.Tasks.StepAMal do end defp eval_ast({:list, ast, meta}, env) when is_list(ast) do - {:list, Enum.map(ast, fn elem -> eval(elem, env) end), meta} + eval_list(ast, env, meta) end defp eval_ast({:map, ast, meta}, env) do @@ -126,39 +126,11 @@ defmodule Mix.Tasks.StepAMal do defp qq_loop({:list, [{:symbol, "splice-unquote"}| _], _}, _), do: throw({:error, "splice-unquote: arg count"}) defp qq_loop(elt, acc), do: list([{:symbol, "cons"}, quasiquote(elt), acc]) - defp macro_call?({:list, [{:symbol, key} | _tail], _}, env) do - case Mal.Env.get(env, key) do - {:ok, %Function{macro: true}} -> true - _ -> false - end - end - defp macro_call?(_ast, _env), do: false - - defp do_macro_call({:list, [{:symbol, key} | tail], _}, env) do - {:ok, %Function{value: macro, macro: true}} = Mal.Env.get(env, key) - macro.(tail) - |> macroexpand(env) - end - - defp macroexpand(ast, env) do - if macro_call?(ast, env) do - do_macro_call(ast, env) - else - ast - end + defp eval(ast, env) do + # IO.puts("EVAL: #{Mal.Printer.print_str(ast)}") + eval_ast(ast, env) end - defp eval({:list, [], _} = empty_ast, _env), do: empty_ast - defp eval({:list, _list, _meta} = ast, env) do - case macroexpand(ast, env) do - {:list, list, meta} -> eval_list(list, env, meta) - result -> eval_ast(result, env) - end - end - defp eval(ast, env), do: eval_ast(ast, env) - - defp eval_list([{:symbol, "macroexpand"}, ast], env, _), do: macroexpand(ast, env) - defp eval_list([{:symbol, "if"}, condition, if_true | if_false], env, _) do result = eval(condition, env) if result == nil or result == false do @@ -174,8 +146,7 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "do"} | ast], env, _) do ast |> List.delete_at(-1) - |> list - |> eval_ast(env) + |> Enum.map(fn elem -> eval(elem, env) end) eval(List.last(ast), env) end @@ -212,10 +183,6 @@ defmodule Mix.Tasks.StepAMal do defp eval_list([{:symbol, "quote"}, arg], _env, _), do: arg - defp eval_list([{:symbol, "quasiquoteexpand"}, ast], _, _) do - quasiquote(ast) - end - defp eval_list([{:symbol, "quasiquote"}, ast], env, _) do ast |> quasiquote |> eval(env) @@ -232,11 +199,16 @@ defmodule Mix.Tasks.StepAMal do throw({:error, "try* requires a list as the second parameter"}) end - defp eval_list(ast, env, meta) do - {:list, [func | args], _} = eval_ast({:list, ast, meta}, env) - func.value.(args) + defp eval_list([a0 | args], env, _meta) do + func = eval(a0, env) + case func do + %Function{macro: true} -> func.value.(args) |> eval(env) + _ -> func.value.(Enum.map(args, fn elem -> eval(elem, env) end)) + end end + defp eval_list([], _env, meta), do: {:list, [], meta} + defp eval_try(try_form, [{:symbol, "catch*"}, {:symbol, exception}, catch_form], env) do try do diff --git a/impls/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl index 4a32120ccb..494d166cdb 100644 --- a/impls/erlang/src/stepA_mal.erl +++ b/impls/erlang/src/stepA_mal.erl @@ -49,14 +49,8 @@ read(Input) -> end. eval(Value, Env) -> - case Value of - {list, _L1, _M1} -> - case macroexpand(Value, Env) of - {list, _L2, _M2} = List -> eval_list(List, Env); - AST -> eval_ast(AST, Env) - end; - _ -> eval_ast(Value, Env) - end. + %%% io.format("EVAL: %s~n", printer:pr_str(Value, true)), + eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; @@ -79,7 +73,7 @@ eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of @@ -109,10 +103,6 @@ eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); -eval_list({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval_list({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> @@ -130,10 +120,6 @@ eval_list({list, [{symbol, "defmacro!"}, _A1, _A2], _Meta}, _Env) -> error("defmacro! called with non-symbol"); eval_list({list, [{symbol, "defmacro!"}|_], _Meta}, _Env) -> error("defmacro! requires exactly two arguments"); -eval_list({list, [{symbol, "macroexpand"}, Macro], _Meta}, Env) -> - macroexpand(Macro, Env); -eval_list({list, [{symbol, "macroexpand"}], _Meta}, _Env) -> - error("macroexpand requires 1 argument"); eval_list({list, [{symbol, "try*"}, A, {list, [{symbol, "catch*"}, B, C], _M1}], _M2}, Env) -> try eval(A, Env) of Result -> Result @@ -151,23 +137,32 @@ eval_list({list, [{symbol, "try*"}, AST], _Meta}, Env) -> eval(AST, Env); eval_list({list, [{symbol, "try*"}|_], _Meta}, _Env) -> error("try*/catch* must be of the form (try* A (catch* B C))"); -eval_list({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M2} -> +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {closure, _Eval, Binds, Body, CE, _MC} -> % The args may be a single element or a list, so always make it % a list and then flatten it so it becomes a list. + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), NewEnv = env:new(CE), env:bind(NewEnv, Binds, lists:flatten([A])), eval(Body, NewEnv); - {list, [{function, F, _MF}|A], _M3} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M4} -> {error, Reason}; - _ -> error("expected a list") + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {macro, Binds, Body, ME} -> + NewEnv = env:new(ME), + env:bind(NewEnv, Binds, lists:flatten([Args])), + NewAst = eval(Body, NewEnv), + eval(NewAst, Env); + {error, Reason} -> {error, Reason} end. eval_ast({symbol, _Sym}=Value, Env) -> env:get(Env, Value); -eval_ast({Type, Seq, _Meta}, Env) when Type == list orelse Type == vector -> - {Type, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; +eval_ast({list, Seq, Meta}, Env) -> + eval_list({list, Seq, Meta}, Env); +eval_ast({vector, Seq, _Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, Seq), nil}; eval_ast({map, M, _Meta}, Env) -> {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), nil}; eval_ast(Value, _Env) -> @@ -226,27 +221,3 @@ quasiquote({map, _Map, _Meta} = Arg) -> {list, [{symbol, "quote"}, Arg], nil}; quasiquote(Arg) -> Arg. - -is_macro_call({list, [{symbol, Name}|_], _Meta}, Env) -> - case env:find(Env, {symbol, Name}) of - nil -> false; - Env2 -> - case env:get(Env2, {symbol, Name}) of - {macro, _Binds, _Body, _ME} -> true; - _ -> false - end - end; -is_macro_call(_AST, _Env) -> - false. - -macroexpand(AST, Env) -> - case is_macro_call(AST, Env) of - true -> - {list, [Name|A], _Meta} = AST, - {macro, Binds, Body, ME} = env:get(Env, Name), - NewEnv = env:new(ME), - env:bind(NewEnv, Binds, lists:flatten([A])), - NewAST = eval(Body, NewEnv), - macroexpand(NewAST, Env); - false -> AST - end. diff --git a/impls/es6/stepA_mal.mjs b/impls/es6/stepA_mal.mjs index 80261fbdc5..af1386d9fa 100644 --- a/impls/es6/stepA_mal.mjs +++ b/impls/es6/stepA_mal.mjs @@ -34,37 +34,22 @@ const quasiquote = ast => { } } -function macroexpand(ast, env) { - while (_list_Q(ast) && typeof ast[0] === 'symbol' && ast[0] in env) { - let f = env_get(env, ast[0]) - if (!f.ismacro) { break } - ast = f(...ast.slice(1)) - } - return ast -} - +const EVAL = (ast, env) => { + while (true) { + //console.log('EVAL:', pr_str(ast, true)) -const eval_ast = (ast, env) => { if (typeof ast === 'symbol') { return env_get(env, ast) - } else if (ast instanceof Array) { + } else if (ast instanceof Vector) { return ast.map(x => EVAL(x, env)) } else if (ast instanceof Map) { let new_hm = new Map() ast.forEach((v, k) => new_hm.set(k, EVAL(v, env))) return new_hm - } else { + } else if (!_list_Q(ast)) { return ast } -} -const EVAL = (ast, env) => { - while (true) { - //console.log('EVAL:', pr_str(ast, true)) - if (!_list_Q(ast)) { return eval_ast(ast, env) } - - ast = macroexpand(ast, env) - if (!_list_Q(ast)) { return eval_ast(ast, env) } if (ast.length === 0) { return ast } const [a0, a1, a2, a3] = ast @@ -81,8 +66,6 @@ const EVAL = (ast, env) => { break // continue TCO loop case 'quote': return a1 - case 'quasiquoteexpand': - return quasiquote(a1) case 'quasiquote': ast = quasiquote(a1) break // continue TCO loop @@ -90,8 +73,6 @@ const EVAL = (ast, env) => { let func = _clone(EVAL(a2, env)) func.ismacro = true return env_set(env, a1, func) - case 'macroexpand': - return macroexpand(a1, env) case 'try*': try { return EVAL(a1, env) @@ -104,7 +85,7 @@ const EVAL = (ast, env) => { } } case 'do': - eval_ast(ast.slice(1,-1), env) + ast.slice(1, -1).map(x => EVAL(x, env)) ast = ast[ast.length-1] break // continue TCO loop case 'if': @@ -119,7 +100,12 @@ const EVAL = (ast, env) => { return _malfunc((...args) => EVAL(a2, new_env(env, a1, args)), a2, env, a1) default: - let [f, ...args] = eval_ast(ast, env) + let f = EVAL(a0, env) + if (f.ismacro) { + ast = f(...ast.slice(1)) + break // continue TCO loop + } + let args = ast.slice(1).map(x => EVAL(x, env)) if (_malfunc_Q(f)) { env = new_env(f.env, f.params, args) ast = f.ast diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor index 0a2bb84694..fc09308106 100755 --- a/impls/factor/stepA_mal/stepA_mal.factor +++ b/impls/factor/stepA_mal/stepA_mal.factor @@ -11,12 +11,6 @@ SYMBOL: repl-env DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast env-get ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - :: eval-def! ( key value env -- maltype ) value env EVAL [ key env env-set ] keep ; @@ -32,7 +26,7 @@ M: object eval-ast drop ; exprs [ { } f ] [ - unclip-last [ env eval-ast drop ] dip env + unclip-last [ '[ env EVAL drop ] each ] dip env ] if-empty ; :: eval-if ( params env -- maltype env/f ) @@ -100,23 +94,14 @@ M: array quasiquote [ second ] [ qq_foldr ] if ; M: vector quasiquote qq_foldr "vec" swap 2array ; M: malsymbol quasiquote "quote" swap 2array ; -M: assoc quasiquote "quote" swap 2array ; +M: hashtable quasiquote "quote" swap 2array ; M: object quasiquote ; -:: macro-expand ( maltype env -- maltype ) - maltype dup array? [ - dup first { [ malsymbol? ] [ env env-find drop ] } 1&& [ - dup { [ malfn? ] [ macro?>> ] } 1&& [ - [ rest ] dip apply [ EVAL ] keep macro-expand - ] [ drop ] if - ] when* - ] when ; - : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ - [ macro-expand ] keep over array? [ +GENERIC# EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + over empty? [ drop ] [ over first dup malsymbol? [ name>> ] when { { "def!" [ [ rest first2 ] dip eval-def! f ] } { "defmacro!" [ [ rest first2 ] dip eval-defmacro! f ] } @@ -125,18 +110,29 @@ M: object quasiquote ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } { "quote" [ drop second f ] } - { "quasiquoteexpand" [ drop second quasiquote f ] } { "quasiquote" [ [ second quasiquote ] dip ] } - { "macroexpand" [ [ second ] dip macro-expand f ] } { "try*" [ [ rest ] dip eval-try* f ] } - [ drop '[ _ EVAL ] map unclip apply ] + [ drop swap ! env ast + unclip ! env rest first + pick EVAL ! env rest fn + dup { [ malfn? ] [ macro?>> ] } 1&& [ + apply ! env maltype newenv + EVAL swap + ] [ + [ swap '[ _ EVAL ] map ] dip ! args fn + apply + ] if + ] } case [ EVAL ] when* - ] [ - eval-ast - ] if - ] [ - eval-ast ] if ; +M: malsymbol EVAL-switch env-get ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + +: EVAL ( maltype env -- maltype ) + ! "EVAL: " pick PRINT concat print flush + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/fennel/stepA_mal.fnl b/impls/fennel/stepA_mal.fnl index 9623fa38bf..e0ccc328ed 100644 --- a/impls/fennel/stepA_mal.fnl +++ b/impls/fennel/stepA_mal.fnl @@ -17,52 +17,6 @@ [code-str] (reader.read_str code-str)) -(fn is_macro_call - [ast env] - (when (and (t.list?* ast) - (not (t.empty?* ast))) - (let [head-ast (. (t.get-value ast) 1)] - (when (and (t.symbol?* head-ast) - (e.env-find env head-ast)) - (let [target-ast (e.env-get env head-ast)] - (t.macro?* target-ast)))))) - -(fn macroexpand - [ast env] - (var ast-var ast) - (while (is_macro_call ast-var env) - (let [inner-asts (t.get-value ast-var) - head-ast (. inner-asts 1) - macro-fn (t.get-value (e.env-get env head-ast)) - args (u.slice inner-asts 2 -1)] - (set ast-var (macro-fn args)))) - ast-var) - -;; forward declaration -(var EVAL 1) - -(fn eval_ast - [ast env] - (if (t.symbol?* ast) - (e.env-get env ast) - ;; - (t.list?* ast) - (t.make-list (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value ast))) - ;; - (t.vector?* ast) - (t.make-vector (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value ast))) - ;; - (t.hash-map?* ast) - (t.make-hash-map (u.map (fn [elt-ast] - (EVAL elt-ast env)) - (t.get-value ast))) - ;; - ast)) - (fn starts-with [ast name] (when (and (t.list?* ast) @@ -105,20 +59,27 @@ ;; ast))) -(set EVAL - (fn [ast-param env-param] +(fn EVAL + [ast-param env-param] (var ast ast-param) (var env env-param) (var result nil) (while (not result) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (do - (set ast (macroexpand ast env)) - (if (not (t.list?* ast)) - (set result (eval_ast ast env)) - (if (t.empty?* ast) + ;; (print (.. "EVAL: " (PRINT ast))) + (if (t.symbol?* ast) + (set result (e.env-get env ast)) + ;; + (t.vector?* ast) + (set result (t.make-vector (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (t.hash-map?* ast) + (set result (t.make-hash-map (u.map (fn [x] (EVAL x env)) + (t.get-value ast)))) + ;; + (or (not (t.list?* ast)) (t.empty?* ast)) (set result ast) + ;; (let [ast-elts (t.get-value ast) head-name (t.get-value (. ast-elts 1))] ;; XXX: want to check for symbol, but... @@ -137,9 +98,6 @@ def-name macro-ast) (set result macro-ast)) ;; - (= "macroexpand" head-name) - (set result (macroexpand (. ast-elts 2) env)) - ;; (= "let*" head-name) (let [new-env (e.make-env env) bindings (t.get-value (. ast-elts 2)) @@ -159,10 +117,6 @@ ;; tco (set result (. ast-elts 2)) ;; - (= "quasiquoteexpand" head-name) - ;; tco - (set result (quasiquote* (. ast-elts 2))) - ;; (= "quasiquote" head-name) ;; tco (set ast (quasiquote* (. ast-elts 2))) @@ -203,8 +157,7 @@ (= "do" head-name) (let [most-forms (u.slice ast-elts 2 -2) ;; XXX last-body-form (u.last ast-elts) - res-ast (eval_ast - (t.make-list most-forms) env)] + res-ast (u.map (fn [x] (EVAL x env)) most-forms)] ;; tco (set ast last-body-form)) ;; @@ -231,10 +184,12 @@ (e.make-env env params args))) body params env false nil))) ;; - (let [eval-list (t.get-value (eval_ast ast env)) - f (. eval-list 1) - args (u.slice eval-list 2 -1)] - (let [body (t.get-ast f)] ;; tco + (let [f (EVAL (. ast-elts 1) env) + ast-rest (u.slice ast-elts 2 -1)] + (if (t.macro?* f) + (set ast ((t.get-value f) ast-rest)) + (let [args (u.map (fn [x] (EVAL x env)) ast-rest) + body (t.get-ast f)] ;; tco (if body (do (set ast body) @@ -243,8 +198,8 @@ (t.get-params f) args))) (set result - ((t.get-value f) args)))))))))))) - result)) + ((t.get-value f) args)))))))))) + result) (fn PRINT [ast] diff --git a/impls/fsharp/stepA_mal.fs b/impls/fsharp/stepA_mal.fs index 6417191ba5..13cae60a1f 100644 --- a/impls/fsharp/stepA_mal.fs +++ b/impls/fsharp/stepA_mal.fs @@ -31,19 +31,7 @@ module REPL | [node] -> node | _ -> raise <| Error.wrongArity () - let rec macroExpand env = function - | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> - f rest |> macroExpand env - | node -> node - - let rec eval_ast env = function - | Symbol(sym) -> Env.get env sym - | List(_, lst) -> lst |> List.map (eval env) |> makeList - | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray - | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap - | node -> node - - and defBangForm env = function + let rec defBangForm env = function | [sym; form] -> match sym with | Symbol(sym) -> @@ -67,10 +55,6 @@ module REPL | _ -> raise <| Error.errExpectedX "symbol" | _ -> raise <| Error.wrongArity () - and macroExpandForm env = function - | [form] -> macroExpand env form - | _ -> raise <| Error.wrongArity () - and setBinding env first second = let s = match first with | Symbol(s) -> s @@ -138,13 +122,14 @@ module REPL | Error.MalError(node) -> catchForm env node catchClause | _ -> raise <| Error.wrongArity () - and eval env = function - | List(_, _) as node -> - match macroExpand env node with - | List(_, []) as emptyList -> emptyList + and eval env ast = + // printfn "EVAL: %s" (Printer.pr_str [ast]) + match ast with + | Symbol(sym) -> Env.get env sym + | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray + | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | List(_, Symbol("def!")::rest) -> defBangForm env rest | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest - | List(_, Symbol("macroexpand")::rest) -> macroExpandForm env rest | List(_, Symbol("let*")::rest) -> let inner, form = letStarForm env rest form |> eval inner @@ -152,21 +137,18 @@ module REPL | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | List(_, Symbol("quote")::rest) -> quoteForm rest - | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote form - | List(_, Symbol("quasiquoteexpand")::_) -> raise <| Error.wrongArity () | List(_, [Symbol("quasiquote");form]) -> eval env <| quasiquote form | List(_, Symbol("quasiquote")::_) -> raise <| Error.wrongArity () | List(_, Symbol("try*")::rest) -> tryForm env rest - | List(_, _) as node -> - let resolved = node |> eval_ast env - match resolved with - | List(_, BuiltInFunc(_, _, f)::rest) -> f rest - | List(_, Func(_, _, _, body, binds, outer)::rest) -> - let inner = Env.makeNew outer binds rest + | List(_, (a0 :: args)) -> + match eval env a0 with + | BuiltInFunc(_, _, f) -> List.map (eval env) args |> f + | Func(_, _, _, body, binds, outer) -> + let inner = List.map (eval env) args |> Env.makeNew outer binds body |> eval inner + | Macro(_, _, f, _, _, _) -> f args |> eval env | _ -> raise <| Error.errExpectedX "func" - | node -> node |> eval_ast env - | node -> node |> eval_ast env + | node -> node let READ input = Reader.read_str input diff --git a/impls/gnu-smalltalk/stepA_mal.st b/impls/gnu-smalltalk/stepA_mal.st index c67c89bf3a..57e4841859 100644 --- a/impls/gnu-smalltalk/stepA_mal.st +++ b/impls/gnu-smalltalk/stepA_mal.st @@ -21,24 +21,6 @@ Object subclass: MAL [ ^Reader readStr: input ] - MAL class >> evalAst: sexp env: env [ - sexp type = #symbol ifTrue: [ - ^env get: sexp value - ]. - - sexp type = #list ifTrue: [ - ^self evalList: sexp env: env class: MALList - ]. - sexp type = #vector ifTrue: [ - ^self evalList: sexp env: env class: MALVector - ]. - sexp type = #map ifTrue: [ - ^self evalList: sexp env: env class: MALMap - ]. - - ^sexp - ] - MAL class >> evalList: sexp env: env class: aClass [ | items | items := sexp value collect: @@ -86,39 +68,6 @@ Object subclass: MAL [ ^acc ] - MAL class >> isMacroCall: ast env: env [ - | a0 a0_ f | - ast type = #list ifTrue: [ - a0 := ast value first. - a0_ := a0 value. - a0 type = #symbol ifTrue: [ - f := env find: a0_. - (f notNil and: [ f type = #func ]) ifTrue: [ - ^f isMacro - ] - ] - ]. - ^false - ] - - MAL class >> macroexpand: aSexp env: env [ - | sexp | - - "NOTE: redefinition of method arguments is not allowed" - sexp := aSexp. - - [ self isMacroCall: sexp env: env ] whileTrue: [ - | ast a0_ macro rest | - ast := sexp value. - a0_ := ast first value. - macro := env find: a0_. - rest := ast allButFirst. - sexp := macro fn value: rest. - ]. - - ^sexp - ] - MAL class >> EVAL: aSexp env: anEnv [ | sexp env ast a0 a0_ a1 a1_ a2 a2_ a3 forms function args | @@ -128,16 +77,20 @@ Object subclass: MAL [ [ [ :continue | - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + + " ('EVAL: ' , (Printer prStr: sexp printReadably: true)) displayNl. " + + sexp type = #symbol ifTrue: [ + ^env get: sexp value ]. - sexp value isEmpty ifTrue: [ - ^sexp + sexp type = #vector ifTrue: [ + ^self evalList: sexp env: env class: MALVector ]. - - sexp := self macroexpand: sexp env: env. - sexp type ~= #list ifTrue: [ - ^self evalAst: sexp env: env + sexp type = #map ifTrue: [ + ^self evalList: sexp env: env class: MALMap + ]. + (sexp type ~= #list or: [ sexp value isEmpty ]) ifTrue: [ + ^sexp ]. ast := sexp value. @@ -163,11 +116,6 @@ Object subclass: MAL [ ^result ]. - a0_ = #'macroexpand' ifTrue: [ - a1 := ast second. - ^self macroexpand: a1 env: env - ]. - a0_ = #'let*' ifTrue: [ | env_ | env_ := Env new: env. @@ -218,11 +166,6 @@ Object subclass: MAL [ ^a1 ]. - a0_ = #quasiquoteexpand ifTrue: [ - a1 := ast second. - ^self quasiquote: a1. - ]. - a0_ = #quasiquote ifTrue: [ | result | a1 := ast second. @@ -262,10 +205,13 @@ Object subclass: MAL [ ^Func new: a2 params: binds env: env fn: fn ]. - forms := (self evalAst: sexp env: env) value. - function := forms first. - args := forms allButFirst asArray. - + function := self EVAL: a0 env: env. + forms := ast allButFirst asArray. + (function type = #func and: [ function isMacro ]) ifTrue: [ + sexp := function fn value: forms. + continue value TCO + ]. + args := forms collect: [ :item | self EVAL: item env: env ]. function type = #fn ifTrue: [ ^function fn value: args ]. function type = #func ifTrue: [ | env_ | diff --git a/impls/go/src/stepA_mal/stepA_mal.go b/impls/go/src/stepA_mal/stepA_mal.go index dae2e4bb34..880bd36709 100644 --- a/impls/go/src/stepA_mal/stepA_mal.go +++ b/impls/go/src/stepA_mal/stepA_mal.go @@ -67,67 +67,28 @@ func quasiquote(ast MalType) MalType { } } -func is_macro_call(ast MalType, env EnvType) bool { - if List_Q(ast) { - slc, _ := GetSlice(ast) - if len(slc) == 0 { - return false - } - a0 := slc[0] - if Symbol_Q(a0) && env.Find(a0.(Symbol)) != nil { - mac, e := env.Get(a0.(Symbol)) - if e != nil { - return false - } - if MalFunc_Q(mac) { - return mac.(MalFunc).GetMacro() - } - } - } - return false -} - -func macroexpand(ast MalType, env EnvType) (MalType, error) { - var mac MalType - var e error - for is_macro_call(ast, env) { - slc, _ := GetSlice(ast) - a0 := slc[0] - mac, e = env.Get(a0.(Symbol)) - if e != nil { - return nil, e - } - fn := mac.(MalFunc) - ast, e = Apply(fn, slc[1:]) +func map_eval(xs []MalType, env EnvType) ([]MalType, error) { + lst := []MalType{} + for _, a := range xs { + exp, e := EVAL(a, env) if e != nil { return nil, e } + lst = append(lst, exp) } - return ast, nil + return lst, nil } -func eval_ast(ast MalType, env EnvType) (MalType, error) { - //fmt.Printf("eval_ast: %#v\n", ast) +func EVAL(ast MalType, env EnvType) (MalType, error) { + for { + //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) + if Symbol_Q(ast) { return env.Get(ast.(Symbol)) - } else if List_Q(ast) { - lst := []MalType{} - for _, a := range ast.(List).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) - } - return List{lst, nil}, nil } else if Vector_Q(ast) { - lst := []MalType{} - for _, a := range ast.(Vector).Val { - exp, e := EVAL(a, env) - if e != nil { - return nil, e - } - lst = append(lst, exp) + lst, e := map_eval(ast.(Vector).Val, env) + if e != nil { + return nil, e } return Vector{lst, nil}, nil } else if HashMap_Q(ast) { @@ -141,30 +102,10 @@ func eval_ast(ast MalType, env EnvType) (MalType, error) { new_hm.Val[k] = kv } return new_hm, nil - } else { + } else if !List_Q(ast) { return ast, nil - } -} - -func EVAL(ast MalType, env EnvType) (MalType, error) { - var e error - for { - - //fmt.Printf("EVAL: %v\n", printer.Pr_str(ast, true)) - switch ast.(type) { - case List: // continue - default: - return eval_ast(ast, env) - } - + } else { // apply list - ast, e = macroexpand(ast, env) - if e != nil { - return nil, e - } - if !List_Q(ast) { - return eval_ast(ast, env) - } if len(ast.(List).Val) == 0 { return ast, nil } @@ -217,8 +158,6 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { env = let_env case "quote": return a1, nil - case "quasiquoteexpand": - return quasiquote(a1), nil case "quasiquote": ast = quasiquote(a1) case "defmacro!": @@ -228,8 +167,6 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { return nil, e } return env.Set(a1.(Symbol), fn), nil - case "macroexpand": - return macroexpand(a1, env) case "try*": var exc MalType exp, e := EVAL(a1, env) @@ -260,10 +197,11 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { } case "do": lst := ast.(List).Val - _, e := eval_ast(List{lst[1 : len(lst)-1], nil}, env) + _, e := map_eval(lst[1 : len(lst)-1], env) if e != nil { return nil, e } + if len(lst) == 1 { return nil, nil } @@ -286,27 +224,44 @@ func EVAL(ast MalType, env EnvType) (MalType, error) { fn := MalFunc{EVAL, a2, env, a1, false, NewEnv, nil} return fn, nil default: - el, e := eval_ast(ast, env) + f, e := EVAL(a0, env) if e != nil { return nil, e } - f := el.(List).Val[0] + args := ast.(List).Val[1:] if MalFunc_Q(f) { + + if f.(MalFunc).GetMacro() { + new_ast, e := Apply(f.(MalFunc), args) + if e != nil { + return nil, e + } + ast = new_ast + continue + } + args, e = map_eval(args, env) + if e != nil { + return nil, e + } fn := f.(MalFunc) ast = fn.Exp - env, e = NewEnv(fn.Env, fn.Params, List{el.(List).Val[1:], nil}) + env, e = NewEnv(fn.Env, fn.Params, List{args, nil}) if e != nil { return nil, e } } else { + args, e = map_eval(args, env) + if e != nil { + return nil, e + } fn, ok := f.(Func) if !ok { return nil, errors.New("attempt to call non-function") } - return fn.Fn(el.(List).Val[1:]) + return fn.Fn(args) } } - + } } // TCO loop } diff --git a/impls/groovy/stepA_mal.groovy b/impls/groovy/stepA_mal.groovy index 44aeb28f50..b3b4a3948b 100644 --- a/impls/groovy/stepA_mal.groovy +++ b/impls/groovy/stepA_mal.groovy @@ -13,26 +13,6 @@ READ = { str -> } // EVAL -macro_Q = { ast, env -> - if (types.list_Q(ast) && - ast.size() > 0 && - ast[0].class == MalSymbol && - env.find(ast[0])) { - def obj = env.get(ast[0]) - if (obj instanceof MalFunc && obj.ismacro) { - return true - } - } - return false -} -macroexpand = { ast, env -> - while (macro_Q(ast, env)) { - def mac = env.get(ast[0]) - ast = mac(ast.drop(1)) - } - return ast -} - starts_with = { lst, sym -> lst.size() == 2 && lst[0].class == MalSymbol && lst[0].value == sym } @@ -66,12 +46,17 @@ quasiquote = { ast -> } } -eval_ast = { ast, env -> +EVAL = { ast, env -> + while (true) { + //println("EVAL: ${printer.pr_str(ast,true)}") + switch (ast) { case MalSymbol: return env.get(ast); - case List: return types.vector_Q(ast) ? - types.vector(ast.collect { EVAL(it,env) }) : - ast.collect { EVAL(it,env) } + case List: if (types.vector_Q(ast)) { + return types.vector(ast.collect { EVAL(it,env) }) + } else { + break + } case Map: def new_hm = [:] ast.each { k,v -> new_hm[k] = EVAL(v, env) @@ -79,15 +64,7 @@ eval_ast = { ast, env -> return new_hm default: return ast } -} -EVAL = { ast, env -> - while (true) { - //println("EVAL: ${printer.pr_str(ast,true)}") - if (! types.list_Q(ast)) return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if (! types.list_Q(ast)) return eval_ast(ast, env) if (ast.size() == 0) return ast switch (ast[0]) { @@ -103,8 +80,6 @@ EVAL = { ast, env -> break // TCO case { it instanceof MalSymbol && it.value == "quote" }: return ast[1] - case { it instanceof MalSymbol && it.value == "quasiquoteexpand" }: - return quasiquote(ast[1]) case { it instanceof MalSymbol && it.value == "quasiquote" }: ast = quasiquote(ast[1]) break // TCO @@ -113,8 +88,6 @@ EVAL = { ast, env -> f = f.clone() f.ismacro = true return env.set(ast[1], f) - case { it instanceof MalSymbol && it.value == "macroexpand" }: - return macroexpand(ast[1], env) case { it instanceof MalSymbol && it.value == "try*" }: try { return EVAL(ast[1], env) @@ -134,7 +107,7 @@ EVAL = { ast, env -> } } case { it instanceof MalSymbol && it.value == "do" }: - ast.size() > 2 ? eval_ast(ast[1..-2], env) : null + ast.size() > 2 ? ast[1..-2].collect { EVAL(it,env) } : null ast = ast[-1] break // TCO case { it instanceof MalSymbol && it.value == "if" }: @@ -153,13 +126,19 @@ EVAL = { ast, env -> case { it instanceof MalSymbol && it.value == "fn*" }: return new MalFunc(EVAL, ast[2], env, ast[1]) default: - def el = eval_ast(ast, env) - def (f, args) = [el[0], el.drop(1)] + def f = EVAL(ast[0], env) + def args = ast.drop(1) if (f instanceof MalFunc) { + if (f.ismacro) { + ast = f(args) + break // TCO + } + args = args.collect { EVAL(it, env) } env = new Env(f.env, f.params, args) ast = f.ast break // TCO } else { + args = args.collect { EVAL(it, env) } return f(args) } } diff --git a/impls/guile/stepA_mal.scm b/impls/guile/stepA_mal.scm index a010273e1b..bfd1089315 100644 --- a/impls/guile/stepA_mal.scm +++ b/impls/guile/stepA_mal.scm @@ -32,20 +32,6 @@ (define (READ str) (read_str str)) -(define (eval_ast ast env) - (define (_eval x) (EVAL x env)) - (match ast - ((? _nil? obj) obj) - ((? symbol? sym) (env-has sym env)) - ((? list? lst) (map _eval lst)) - ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) - ((? hash-table? ht) - (define new-ht (make-hash-table)) - (hash-for-each (lambda (k v) (hash-set! new-ht k (_eval v))) ht) - new-ht) - (else ast))) - - (define (eval_seq ast env) (cond ((null? ast) nil) @@ -67,20 +53,6 @@ ((? symbol?) (list 'quote ast)) (else ast))) -(define (is_macro_call ast env) - (and (list? ast) - (> (length ast) 0) - (and=> (env-check (car ast) env) is-macro))) - -(define (_macroexpand ast env) - (cond - ((is_macro_call ast env) - => (lambda (c) - ;; NOTE: Macros are normal-order, so we shouldn't eval args here. - ;; Or it's applicable-order. - (_macroexpand (callable-apply c (cdr ast)) env))) - (else ast))) - (define (EVAL ast env) (define (%unzip2 kvs) (let lp((next kvs) (k '()) (v '())) @@ -91,16 +63,20 @@ (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) (let tco-loop((ast ast) (env env)) ; expand as possible - (let ((ast (_macroexpand ast env))) + ;; (format #t "EVAL: ~a~%" (pr_str exp #t)) (match ast - ((? non-list?) (eval_ast ast env)) + ((? symbol? sym) (env-has sym env)) + ((? vector? vec) (vector-map (lambda (i x) (EVAL x env)) vec)) + ((? hash-table? ht) + (define new-ht (make-hash-table)) + (hash-for-each (lambda (k v) (hash-set! new-ht k (EVAL v env))) ht) + new-ht) + ((? non-list?) ast) (() ast) (('defmacro! k v) (let ((c (EVAL v env))) ((env 'set) k (callable-as-macro c)))) - (('macroexpand obj) (_macroexpand obj env)) (('quote obj) obj) - (('quasiquoteexpand obj) (_quasiquote obj)) (('quasiquote obj) (EVAL (_quasiquote obj) env)) (('def! k v) ((env 'set) k (EVAL v env))) (('let* kvs body) @@ -150,8 +126,11 @@ (let ((nenv (make-Env #:outer env #:binds (list B) #:exprs (cdr e)))) (EVAL C nenv))))) (else - (let ((el (map (lambda (x) (EVAL x env)) ast))) - (callable-apply (car el) (cdr el)))))))) + (let ((f (EVAL (car ast) env)) + (args (cdr ast))) + (if (is-macro f) + (EVAL (callable-apply f args) env) + (callable-apply f (map (lambda (x) (EVAL x env)) args)))))))) (define (EVAL-string str) (EVAL (read_str str) *toplevel*)) diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs index 26a4130a1a..7782efcc69 100644 --- a/impls/haskell/step7_quote.hs +++ b/impls/haskell/step7_quote.hs @@ -65,9 +65,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs index d49acf1b27..1bd65e1de1 100644 --- a/impls/haskell/step8_macros.hs +++ b/impls/haskell/step8_macros.hs @@ -41,14 +41,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +65,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +78,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "do") args env = foldlM (const $ eval env) Nil args apply_ast (MalSymbol "if") [a1, a2, a3] env = do diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs index d2c26837a1..ef39f6b0ec 100644 --- a/impls/haskell/step9_try.hs +++ b/impls/haskell/step9_try.hs @@ -41,14 +41,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +65,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +78,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do res <- liftIO $ runExceptT $ eval env a1 diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs index 3e3517282d..91c1da83db 100644 --- a/impls/haskell/stepA_mal.hs +++ b/impls/haskell/stepA_mal.hs @@ -41,14 +41,6 @@ quasiquote ast@(MalHashMap _ _) = return $ toList [MalSymbol "quote", ast] quasiquote ast@(MalSymbol _) = return $ toList [MalSymbol "quote", ast] quasiquote ast = return ast -macroexpand :: Env -> MalVal -> IOThrows MalVal -macroexpand env ast@(MalSeq _ (Vect False) (MalSymbol a0 : args)) = do - maybeMacro <- liftIO $ env_get env a0 - case maybeMacro of - Just (MalMacro f) -> macroexpand env =<< f args - _ -> return ast -macroexpand _ ast = return ast - let_bind :: Env -> [MalVal] -> IOThrows () let_bind _ [] = return () let_bind env (MalSymbol b : e : xs) = do @@ -73,9 +65,6 @@ apply_ast (MalSymbol "let*") _ _ = throwStr "invalid let*" apply_ast (MalSymbol "quote") [a1] _ = return a1 apply_ast (MalSymbol "quote") _ _ = throwStr "invalid quote" -apply_ast (MalSymbol "quasiquoteexpand") [a1] _ = quasiquote a1 -apply_ast (MalSymbol "quasiquoteexpand") _ _ = throwStr "invalid quasiquote" - apply_ast (MalSymbol "quasiquote") [a1] env = eval env =<< quasiquote a1 apply_ast (MalSymbol "quasiquote") _ _ = throwStr "invalid quasiquote" @@ -89,9 +78,6 @@ apply_ast (MalSymbol "defmacro!") [MalSymbol a1, a2] env = do _ -> throwStr "defmacro! on non-function" apply_ast (MalSymbol "defmacro!") _ _ = throwStr "invalid defmacro!" -apply_ast (MalSymbol "macroexpand") [a1] env = macroexpand env a1 -apply_ast (MalSymbol "macroexpand") _ _ = throwStr "invalid macroexpand" - apply_ast (MalSymbol "try*") [a1] env = eval env a1 apply_ast (MalSymbol "try*") [a1, MalSeq _ (Vect False) [MalSymbol "catch*", a21, a22]] env = do res <- liftIO $ runExceptT $ eval env a1 diff --git a/impls/haxe/StepA_mal.hx b/impls/haxe/StepA_mal.hx index 7a89cda115..1ef08a49e2 100644 --- a/impls/haxe/StepA_mal.hx +++ b/impls/haxe/StepA_mal.hx @@ -40,56 +40,30 @@ class StepA_mal { } } - static function is_macro(ast:MalType, env:Env) { - return switch(ast) { - case MalList([]): false; - case MalList(a): - var a0 = a[0]; - return symbol_Q(a0) && - env.find(a0) != null && - _macro_Q(env.get(a0)); - case _: false; - } - } + static function EVAL(ast:MalType, env:Env):MalType { + while (true) { - static function macroexpand(ast:MalType, env:Env) { - while (is_macro(ast, env)) { - var mac = env.get(first(ast)); - switch (mac) { - case MalFunc(f,_,_,_,_,_): - ast = f(_list(ast).slice(1)); - case _: break; - } - } - return ast; - } + // Compat.println("EVAL: " + PRINT(ast)); - static function eval_ast(ast:MalType, env:Env) { - return switch (ast) { - case MalSymbol(s): env.get(ast); + var alst; + + switch (ast) { + case MalSymbol(s): return env.get(ast); case MalList(l): - MalList(l.map(function(x) { return EVAL(x, env); })); + alst = l; case MalVector(l): - MalVector(l.map(function(x) { return EVAL(x, env); })); + return MalVector(l.map(function(x) { return EVAL(x, env); })); case MalHashMap(m): var new_map = new Map(); for (k in m.keys()) { new_map[k] = EVAL(m[k], env); } - MalHashMap(new_map); - case _: ast; + return MalHashMap(new_map); + case _: return ast; } - } - - static function EVAL(ast:MalType, env:Env):MalType { - while (true) { - if (!list_Q(ast)) { return eval_ast(ast, env); } // apply - ast = macroexpand(ast, env); - if (!list_Q(ast)) { return eval_ast(ast, env); } - var alst = _list(ast); if (alst.length == 0) { return ast; } switch (alst[0]) { case MalSymbol("def!"): @@ -109,8 +83,6 @@ class StepA_mal { continue; // TCO case MalSymbol("quote"): return alst[1]; - case MalSymbol("quasiquoteexpand"): - return quasiquote(alst[1]); case MalSymbol("quasiquote"): ast = quasiquote(alst[1]); continue; // TCO @@ -122,8 +94,6 @@ class StepA_mal { case _: throw "Invalid defmacro! call"; } - case MalSymbol("macroexpand"): - return macroexpand(alst[1], env); case MalSymbol("try*"): try { return EVAL(alst[1], env); @@ -146,7 +116,8 @@ class StepA_mal { } } case MalSymbol("do"): - var el = eval_ast(MalList(alst.slice(1, alst.length-1)), env); + for (i in 1...alst.length-1) + EVAL(alst[i], env); ast = last(ast); continue; // TCO case MalSymbol("if"): @@ -164,11 +135,15 @@ class StepA_mal { return EVAL(alst[2], new Env(env, _list(alst[1]), args)); },alst[2],env,alst[1],false,nil); case _: - var el = eval_ast(ast, env); - var lst = _list(el); - switch (first(el)) { - case MalFunc(f,a,e,params,_,_): - var args = _list(el).slice(1); + var fn = EVAL(alst[0], env); + var args = alst.slice(1); + switch (fn) { + case MalFunc(f,a,e,params,ismacro,_): + if (ismacro) { + ast = f(args); + continue; // TCO + } + args = args.map(function(x) { return EVAL(x, env); }); if (a != null) { ast = a; env = new Env(e, _list(params), args); diff --git a/impls/java/src/main/java/mal/stepA_mal.java b/impls/java/src/main/java/mal/stepA_mal.java index 4c8af749d2..294b37930e 100644 --- a/impls/java/src/main/java/mal/stepA_mal.java +++ b/impls/java/src/main/java/mal/stepA_mal.java @@ -4,10 +4,9 @@ import java.io.StringWriter; import java.io.PrintWriter; +import java.util.ArrayList; import java.util.List; import java.util.Map; -import java.util.HashMap; -import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; @@ -54,54 +53,12 @@ public static MalVal quasiquote(MalVal ast) { return res; } - public static Boolean is_macro_call(MalVal ast, Env env) - throws MalThrowable { - if (ast instanceof MalList) { - MalVal a0 = ((MalList)ast).nth(0); - if (a0 instanceof MalSymbol && - env.find(((MalSymbol)a0)) != null) { - MalVal mac = env.get(((MalSymbol)a0)); - if (mac instanceof MalFunction && - ((MalFunction)mac).isMacro()) { - return true; - } - } - } - return false; - } - - public static MalVal macroexpand(MalVal ast, Env env) - throws MalThrowable { - while (is_macro_call(ast, env)) { - MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); - MalFunction mac = (MalFunction) env.get(a0); - ast = mac.apply(((MalList)ast).rest()); - } - return ast; - } - - public static MalVal eval_ast(MalVal ast, Env env) throws MalThrowable { - if (ast instanceof MalSymbol) { - return env.get((MalSymbol)ast); - } else if (ast instanceof MalList) { - MalList old_lst = (MalList)ast; - MalList new_lst = ast.list_Q() ? new MalList() - : (MalList)new MalVector(); - for (MalVal mv : (List)old_lst.value) { - new_lst.conj_BANG(EVAL(mv, env)); - } - return new_lst; - } else if (ast instanceof MalHashMap) { - MalHashMap new_hm = new MalHashMap(); - Iterator it = ((MalHashMap)ast).value.entrySet().iterator(); - while (it.hasNext()) { - Map.Entry entry = (Map.Entry)it.next(); - new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); - } - return new_hm; - } else { - return ast; - } + public static List eval_ast(MalList old_lst, Env env) throws MalThrowable { + List new_lst = new ArrayList(); + for (MalVal mv : (List)old_lst.value) { + new_lst.add(EVAL(mv, env)); + } + return new_lst; } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { @@ -111,17 +68,23 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { while (true) { //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); - if (!orig_ast.list_Q()) { - return eval_ast(orig_ast, env); + + if (orig_ast instanceof MalSymbol) { + return env.get((MalSymbol)orig_ast); + } else if (orig_ast instanceof MalVector) { + return new MalVector(eval_ast((MalList)orig_ast, env)); + } else if (orig_ast instanceof MalHashMap) { + MalHashMap new_hm = new MalHashMap(); + for (Map.Entry entry : ((Map)((MalHashMap)orig_ast).value).entrySet()) { + new_hm.value.put(entry.getKey(), EVAL((MalVal)entry.getValue(), env)); + } + return new_hm; + } else if (! orig_ast.list_Q()) { + return orig_ast; } - if (((MalList)orig_ast).size() == 0) { return orig_ast; } // apply list - MalVal expanded = macroexpand(orig_ast, env); - if (!expanded.list_Q()) { - return eval_ast(expanded, env); - } - MalList ast = (MalList) expanded; + MalList ast = (MalList)orig_ast; if (ast.size() == 0) { return ast; } a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() @@ -149,8 +112,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { break; case "quote": return ast.nth(1); - case "quasiquoteexpand": - return quasiquote(ast.nth(1)); case "quasiquote": orig_ast = quasiquote(ast.nth(1)); break; @@ -162,9 +123,6 @@ public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { ((MalFunction)res).setMacro(); env.set((MalSymbol)a1, res); return res; - case "macroexpand": - a1 = ast.nth(1); - return macroexpand(a1, env); case "try*": try { return EVAL(ast.nth(1), env); @@ -218,14 +176,19 @@ public MalVal apply(MalList args) throws MalThrowable { } }; default: - el = (MalList)eval_ast(ast, env); - MalFunction f = (MalFunction)el.nth(0); + MalFunction f = (MalFunction)EVAL(a0, env); + el = ast.rest(); + if (f.isMacro()) { + orig_ast = f.apply(el); + continue; + } + el = new MalList(eval_ast(el, env)); MalVal fnast = f.getAst(); if (fnast != null) { orig_ast = fnast; - env = f.genEnv(el.slice(1)); + env = f.genEnv(el); } else { - return f.apply(el.rest()); + return f.apply(el); } } diff --git a/impls/js/stepA_mal.js b/impls/js/stepA_mal.js index 7d1cadb808..919e0199bb 100644 --- a/impls/js/stepA_mal.js +++ b/impls/js/stepA_mal.js @@ -36,26 +36,13 @@ function quasiquote(ast) { } } -function is_macro_call(ast, env) { - return types._list_Q(ast) && - types._symbol_Q(ast[0]) && - env.find(ast[0]) && - env.get(ast[0])._ismacro_; -} +function _EVAL(ast, env) { + while (true) { -function macroexpand(ast, env) { - while (is_macro_call(ast, env)) { - var mac = env.get(ast[0]); - ast = mac.apply(mac, ast.slice(1)); - } - return ast; -} + //printer.println("EVAL:", printer._pr_str(ast, true)); -function eval_ast(ast, env) { if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types._list_Q(ast)) { - return ast.map(function(a) { return EVAL(a, env); }); } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; @@ -66,24 +53,10 @@ function eval_ast(ast, env) { new_hm[k] = EVAL(ast[k], env); } return new_hm; - } else { + } else if (!types._list_Q(ast)) { return ast; } -} - -function _EVAL(ast, env) { - while (true) { - - //printer.println("EVAL:", printer._pr_str(ast, true)); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } - // apply list - ast = macroexpand(ast, env); - if (!types._list_Q(ast)) { - return eval_ast(ast, env); - } if (ast.length === 0) { return ast; } @@ -103,8 +76,6 @@ function _EVAL(ast, env) { break; case "quote": return a1; - case "quasiquoteexpand": - return quasiquote(a1); case "quasiquote": ast = quasiquote(a1); break; @@ -112,8 +83,6 @@ function _EVAL(ast, env) { var func = types._clone(EVAL(a2, env)); func._ismacro_ = true; return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); case "try*": try { return EVAL(a1, env); @@ -126,7 +95,9 @@ function _EVAL(ast, env) { } } case "do": - eval_ast(ast.slice(1, -1), env); + for (var i=1; i < ast.length - 1; i++) { + EVAL(ast[i], env); + } ast = ast[ast.length-1]; break; case "if": @@ -140,12 +111,18 @@ function _EVAL(ast, env) { case "fn*": return types._function(EVAL, Env, a2, env, a1); default: - var el = eval_ast(ast, env), f = el[0]; + var f = EVAL(a0, env); + var args = ast.slice(1) + if (f._ismacro_) { + ast = f.apply(f, args); + break; + } + args = args.map(function(a) { return EVAL(a, env); }); if (f.__ast__) { ast = f.__ast__; - env = f.__gen_env__(el.slice(1)); + env = f.__gen_env__(args); } else { - return f.apply(f, el.slice(1)); + return f.apply(f, args); } } diff --git a/impls/julia/stepA_mal.jl b/impls/julia/stepA_mal.jl index 77bdaa9f00..5fba0190ba 100755 --- a/impls/julia/stepA_mal.jl +++ b/impls/julia/stepA_mal.jl @@ -43,43 +43,18 @@ function quasiquote(ast) end end -function ismacroCall(ast, env) - return isa(ast, Array) && - !isempty(ast) && - isa(ast[1], Symbol) && - env_find(env, ast[1]) != nothing && - isa(env_get(env, ast[1]), MalFunc) && - env_get(env, ast[1]).ismacro -end - -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) - end - ast -end - -function eval_ast(ast, env) - if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) - elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast - end -end - function EVAL(ast, env) while true #println("EVAL: $(printer.pr_str(ast,true))") - if !isa(ast, Array) return eval_ast(ast, env) end - - # apply - ast = macroexpand(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end + if typeof(ast) == Symbol + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) + elseif isa(ast, Dict) + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast + end if isempty(ast) return ast end if :def! == ast[1] @@ -94,8 +69,6 @@ function EVAL(ast, env) # TCO loop elseif :quote == ast[1] return ast[2] - elseif :quasiquoteexpand == ast[1] - return quasiquote(ast[2]) elseif :quasiquote == ast[1] ast = quasiquote(ast[2]) # TCO loop @@ -103,8 +76,6 @@ function EVAL(ast, env) func = EVAL(ast[3], env) func.ismacro = true return env_set(env, ast[2], func) - elseif :macroexpand == ast[1] - return macroexpand(ast[2], env) elseif symbol("try*") == ast[1] try return EVAL(ast[2], env) @@ -124,7 +95,9 @@ function EVAL(ast, env) end end elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + for i = 2:1:length(ast)-1 + EVAL(ast[i], env) + end ast = ast[end] # TCO loop elseif :if == ast[1] @@ -145,13 +118,19 @@ function EVAL(ast, env) (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])), ast[3], env, ast[2]) else - el = eval_ast(ast, env) - f, args = el[1], el[2:end] + f, args = ast[1], ast[2:end] if isa(f, MalFunc) + if f.ismacro + ast = f.fn(args) + # TCO loop + else + args = collect(map((x) -> EVAL(x,env), args)) ast = f.ast env = Env(f.env, f.params, args) # TCO loop + end else + args = collect(map((x) -> EVAL(x,env), args)) return f(args...) end end diff --git a/impls/kotlin/src/mal/stepA_mal.kt b/impls/kotlin/src/mal/stepA_mal.kt index b72bfd3627..1873348578 100644 --- a/impls/kotlin/src/mal/stepA_mal.kt +++ b/impls/kotlin/src/mal/stepA_mal.kt @@ -9,11 +9,11 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - if (ast is MalList) { - if (ast.count() == 0) return ast - when ((ast.first() as? MalSymbol)?.value) { + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { "def!" -> return env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) "let*" -> { val childEnv = Env(env) @@ -44,37 +44,39 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } "quote" -> return ast.nth(1) - "quasiquoteexpand" -> return quasiquote(ast.nth(1)) "quasiquote" -> ast = quasiquote(ast.nth(1)) "defmacro!" -> return defmacro(ast, env) - "macroexpand" -> return macroexpand(ast.nth(1), env) "try*" -> return try_catch(ast, env) else -> { - val evaluated = eval_ast(ast, env) as ISeq - val firstEval = evaluated.first() + val firstEval = eval(ast.first(), env) + val unevaluatedArgs = ast.rest() + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(unevaluatedArgs) + continue + } + val args = eval_ast(unevaluatedArgs, env) when (firstEval) { is MalFnFunction -> { ast = firstEval.ast - env = Env(firstEval.env, firstEval.params, evaluated.rest().seq()) + env = Env(firstEval.env, firstEval.params, args.seq()) } - is MalFunction -> return firstEval.apply(evaluated.rest()) + is MalFunction -> return firstEval.apply(args) else -> throw MalException("cannot execute non-function") } } + } } - } else return eval_ast(ast, env) - } -} - -fun eval_ast(ast: MalType, env: Env): MalType = - when (ast) { is MalSymbol -> env.get(ast) - is MalList -> ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalVector -> ast.elements.fold(MalVector(), { a, b -> a.conj_BANG(eval(b, env)); a }) is MalHashMap -> ast.elements.entries.fold(MalHashMap(), { a, b -> a.assoc_BANG(b.key, eval(b.value, env)); a }) else -> ast } + } +} + +fun eval_ast(ast: MalList, env: Env): MalList = + ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) private fun fn_STAR(ast: MalList, env: Env): MalType { val binds = ast.nth(1) as? ISeq ?: throw MalException("fn* requires a binding list as first parameter") @@ -122,25 +124,6 @@ private fun quasiquote_loop(elt: MalType, acc: MalList): MalList { return result } -private fun is_macro_call(ast: MalType, env: Env): Boolean { - val ast_list = ast as? MalList ?: return false - if (ast_list.count() == 0) return false - val symbol = ast_list.first() as? MalSymbol ?: return false - val function = env.find(symbol) as? MalFunction ?: return false - - return function.is_macro -} - -private fun macroexpand(_ast: MalType, env: Env): MalType { - var ast = _ast - while (is_macro_call(ast, env)) { - val symbol = (ast as MalList).first() as MalSymbol - val function = env.find(symbol) as MalFunction - ast = function.apply(ast.rest()) - } - return ast -} - private fun defmacro(ast: MalList, env: Env): MalType { val macro = eval(ast.nth(2), env) as MalFunction macro.is_macro = true diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg index c3d1340444..09a5305e9e 100644 --- a/impls/logo/stepA_mal.lg +++ b/impls/logo/stepA_mal.lg @@ -32,47 +32,18 @@ if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] output :result end -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] - ] -] -output "false -end - -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env -end - -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] -] -end - to _eval :a_ast :a_env localmake "ast :a_ast localmake "env :a_env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] + ; (print "EVAL: pr_str :ast "true) + case (obj_type :ast) [ + [[symbol] output env_get :env :ast] + [[vector] output obj_new "vector map [_eval ? :env] obj_val :ast] + [[hashmap] output obj_new "hashmap map [_eval ? :env] obj_val :ast] + [[list]] + [else output :ast] + ] if emptyp obj_val :ast [output :ast] localmake "a0 nth :ast 0 case list obj_type :a0 obj_val :a0 [ @@ -98,9 +69,6 @@ forever [ [[[symbol quasiquote]] make "ast quasiquote nth :ast 1 ] ; TCO - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] - [[[symbol defmacro!]] localmake "a1 nth :ast 1 localmake "a2 nth :ast 2 @@ -108,9 +76,6 @@ forever [ fn_set_macro :macro_fn output env_set :env :a1 :macro_fn ] - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] - [[[symbol try*]] localmake "a1 nth :ast 1 if (_count :ast) < 3 [ @@ -154,14 +119,18 @@ forever [ output fn_new nth :ast 1 :env nth :ast 2 ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env + localmake "args rest :ast case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output apply obj_val :f map [_eval ? :env] obj_val :args ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el - make "ast fn_body :f ] ; TCO + ifelse (fn_is_macro :f) [ + make "ast invoke_fn :f :args + ] [ + make "env env_new fn_env :f fn_args :f obj_new "list map [_eval ? :env] obj_val :args + make "ast fn_body :f ] ; TCO + ] [else (throw "error [Wrong type for apply])] ] ] diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index fb5c4648b6..9f2462a34f 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -36,18 +36,6 @@ QUASIQUOTE = $(strip \ $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ $1)))) -define IS_MACRO_CALL -$(if $(call _list?,$(1)),$(if $(call ENV_FIND,$(2),$($(call _nth,$(1),0)_value)),$(_macro_$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value))),),) -endef - -define MACROEXPAND -$(strip $(if $(__ERROR),,\ - $(if $(call IS_MACRO_CALL,$(1),$(2)),\ - $(foreach mac,$(call ENV_GET,$(2),$($(call _nth,$(1),0)_value)),\ - $(call MACROEXPAND,$(call apply,$(mac),$(call srest,$(1))),$(2))),\ - $(1)))) -endef - define LET $(strip \ $(word 1,$(2) \ @@ -60,25 +48,6 @@ $(strip \ $(call LET,$(left),$(2)))))))) endef -define EVAL_AST -$(strip \ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(call ENV_GET,$(2),$(key))),\ - $(if $(call _list?,$(1)),\ - $(call _smap,EVAL,$(1),$(2)),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(1)))))) -endef - define EVAL_INVOKE $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) @@ -95,8 +64,6 @@ $(if $(__ERROR),,\ $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ $(if $(call _EQ,quote,$($(a0)_value)),\ $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquoteexpand,$($(a0)_value)),\ - $(call QUASIQUOTE,$(call _nth,$(1),1)),\ $(if $(call _EQ,quasiquote,$($(a0)_value)),\ $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ $(if $(call _EQ,defmacro!,$($(a0)_value)),\ @@ -105,8 +72,6 @@ $(if $(__ERROR),,\ $(foreach res,$(call EVAL,$(a2),$(2)),\ $(eval _macro_$(res) = true)\ $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,macroexpand,$($(a0)_value)),\ - $(call MACROEXPAND,$(call _nth,$(1),1),$(2)),\ $(if $(call _EQ,make*,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ @@ -127,7 +92,7 @@ $(if $(__ERROR),,\ $(res)))),\ $(res)))),\ $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call EVAL_AST,$(call srest,$(1)),$(2))),\ + $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ $(if $(call _EQ,if,$($(a0)_value)),\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ @@ -139,24 +104,32 @@ $(if $(__ERROR),,\ $(foreach a1,$(call _nth,$(1),1),\ $(foreach a2,$(call _nth,$(1),2),\ $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call EVAL_AST,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args))))))))))))))))))) + $(foreach f,$(call EVAL,$(a0),$(2)),\ + $(foreach args,$(call srest,$(1)),\ + $(if $(_macro_$(f)),\ + $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ + $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) endef define EVAL $(strip $(if $(__ERROR),,\ $(and $(EVAL_DEBUG),$(info EVAL: $(call _pr_str,$(1))))\ + $(if $(call _symbol?,$(1)),\ + $(foreach key,$($(1)_value),\ + $(call ENV_GET,$(2),$(key))),\ + $(if $(call _vector?,$(1)),\ + $(call _smap_vec,EVAL,$(1),$(2)),\ + $(if $(call _hash_map?,$(1)),\ + $(foreach new_hmap,$(call __new_obj,hmap),\ + $(foreach v,$(call __get_obj_values,$(1)),\ + $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ + $(eval $(new_hmap)_size := $($(1)_size))\ + $(new_hmap)),\ $(if $(call _list?,$(1)),\ - $(foreach ast,$(call MACROEXPAND,$(1),$(2)), - $(if $(call _list?,$(ast)),\ - $(if $(call _EQ,0,$(call _count,$(ast))),\ - $(ast),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(ast),$(2)) $(__nil)))),\ - $(call EVAL_AST,$(ast),$(2)))),\ - $(call EVAL_AST,$(1),$(2))))) + $(if $(call _EQ,0,$(call _count,$(1))),\ + $(1),\ + $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ + $(1))))))) endef diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal index a42c47482f..a579cb1e73 100644 --- a/impls/mal/step2_eval.mal +++ b/impls/mal/step2_eval.mal @@ -7,35 +7,29 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys env)) ) - (cond - (symbol? ast) (let* [res (get env (str ast))] - (if res res (throw (str ast " not found")))) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - - (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast) ) (try* - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (let* [res (get env (str ast))] + (if res res (throw (str ast " not found")))) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) - ;; apply list + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) (if (empty? ast) ast - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))) + (apply (EVAL (first ast) env) + (map (fn* [exp] (EVAL exp env)) (rest ast)))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal index ef813b833b..01925d658b 100644 --- a/impls/mal/step3_env.mal +++ b/impls/mal/step3_env.mal @@ -9,22 +9,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -35,10 +19,18 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) - ;; apply list + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) (let* [a0 (first ast)] (cond (empty? ast) @@ -51,8 +43,10 @@ (LET (new-env env) (nth ast 1) (nth ast 2)) "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (apply (EVAL a0 env) (map (fn* [exp] (EVAL exp env)) (rest ast))))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal index cd6b05ffa4..830359656e 100644 --- a/impls/mal/step4_if_fn_do.mal +++ b/impls/mal/step4_if_fn_do.mal @@ -10,22 +10,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -36,10 +20,18 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) - ;; apply list + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) (let* [a0 (first ast)] (cond (empty? ast) @@ -52,7 +44,7 @@ (LET (new-env env) (nth ast 1) (nth ast 2)) (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) (= 'if a0) (if (EVAL (nth ast 1) env) @@ -64,8 +56,10 @@ (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (apply (EVAL a0 env) (map (fn* [exp] (EVAL exp env)) (rest ast))))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal index 3d7ee78607..d1f35f43b3 100644 --- a/impls/mal/step6_file.mal +++ b/impls/mal/step6_file.mal @@ -10,22 +10,6 @@ ;; eval -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -36,10 +20,18 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) - ;; apply list + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) (let* [a0 (first ast)] (cond (empty? ast) @@ -52,7 +44,7 @@ (LET (new-env env) (nth ast 1) (nth ast 2)) (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) (= 'if a0) (if (EVAL (nth ast 1) env) @@ -64,8 +56,10 @@ (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (apply (EVAL a0 env) (map (fn* [exp] (EVAL exp env)) (rest ast))))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal index 9e85f55d75..9c0acc7bce 100644 --- a/impls/mal/step7_quote.mal +++ b/impls/mal/step7_quote.mal @@ -28,22 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -54,10 +38,18 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) - ;; apply list + (list? ast) (let* [a0 (first ast)] (cond (empty? ast) @@ -72,14 +64,11 @@ (= 'quote a0) (nth ast 1) - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - (= 'quasiquote a0) (EVAL (QUASIQUOTE (nth ast 1)) env) (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) (= 'if a0) (if (EVAL (nth ast 1) env) @@ -91,8 +80,10 @@ (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (apply (EVAL a0 env) (map (fn* [exp] (EVAL exp env)) (rest ast))))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal index cbbc6d4cb6..b602815ab0 100644 --- a/impls/mal/step8_macros.mal +++ b/impls/mal/step8_macros.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -62,53 +38,60 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + (list? ast) + (let* [a0 (first ast)] + (cond + (empty? ast) + ast - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) + (= 'def! a0) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - (= 'quote a0) - (nth ast 1) + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) + (= 'quote a0) + (nth ast 1) - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + "else" + ast) (catch* exc (do diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal index 1d7bbe44d6..1e0ec3ff8c 100644 --- a/impls/mal/step9_try.mal +++ b/impls/mal/step9_try.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -62,64 +38,71 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) - - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - - (= 'try* a0) - (if (< (count ast) 3) - (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (do - (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (let* [a0 (first ast)] + (cond + (empty? ast) + ast + + (= 'def! a0) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) + + (= 'try* a0) + (if (< (count ast) 3) + (EVAL (nth ast 1) env) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (let* [a2 (nth ast 2)] + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index 432dd31935..85524a53e9 100644 --- a/impls/mal/stepA_mal.mal +++ b/impls/mal/stepA_mal.mal @@ -28,30 +28,6 @@ (= (first ast) 'unquote) (nth ast 1) "else" (qq-foldr ast)))) -(def! MACROEXPAND (fn* [ast env] - (let* [a0 (if (list? ast) (first ast)) - e (if (symbol? a0) (env-find env a0)) - m (if e (env-get e a0))] - (if (_macro? m) - (MACROEXPAND (apply (get m :__MAL_MACRO__) (rest ast)) env) - ast)))) - -(def! eval-ast (fn* [ast env] - ;; (do (prn "eval-ast" ast "/" (keys @env)) ) - (cond - (symbol? ast) (env-get env ast) - - (list? ast) (map (fn* [exp] (EVAL exp env)) ast) - - (vector? ast) (vec (map (fn* [exp] (EVAL exp env)) ast)) - - (map? ast) (apply hash-map - (apply concat - (map (fn* [k] [k (EVAL (get ast k) env)]) - (keys ast)))) - - "else" ast))) - (def! LET (fn* [env binds form] (if (empty? binds) (EVAL form env) @@ -62,64 +38,71 @@ (def! EVAL (fn* [ast env] ;; (do (prn "EVAL" ast "/" (keys @env)) ) (try* - (let* [ast (MACROEXPAND ast env)] - (if (not (list? ast)) - (eval-ast ast env) - - ;; apply list - (let* [a0 (first ast)] - (cond - (empty? ast) - ast - - (= 'def! a0) - (env-set env (nth ast 1) (EVAL (nth ast 2) env)) - - (= 'let* a0) - (LET (new-env env) (nth ast 1) (nth ast 2)) - - (= 'quote a0) - (nth ast 1) - - (= 'quasiquoteexpand a0) - (QUASIQUOTE (nth ast 1)) - - (= 'quasiquote a0) - (EVAL (QUASIQUOTE (nth ast 1)) env) - - (= 'defmacro! a0) - (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ - (EVAL (nth ast 2) env))) - - (= 'macroexpand a0) - (MACROEXPAND (nth ast 1) env) - - (= 'try* a0) - (if (< (count ast) 3) - (EVAL (nth ast 1) env) - (try* - (EVAL (nth ast 1) env) - (catch* exc - (do - (reset! trace "") - (let* [a2 (nth ast 2)] - (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) - - (= 'do a0) - (nth (eval-ast (rest ast) env) (- (count ast) 2)) - - (= 'if a0) - (if (EVAL (nth ast 1) env) - (EVAL (nth ast 2) env) - (if (> (count ast) 3) - (EVAL (nth ast 3) env))) - - (= 'fn* a0) - (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el))))))) + (cond + (symbol? ast) + (env-get env ast) + + (vector? ast) + (vec (map (fn* [exp] (EVAL exp env)) ast)) + + (map? ast) + (apply hash-map + (apply concat (map (fn* [k] [k (EVAL (get ast k) env)]) (keys ast)))) + + (list? ast) + (let* [a0 (first ast)] + (cond + (empty? ast) + ast + + (= 'def! a0) + (env-set env (nth ast 1) (EVAL (nth ast 2) env)) + + (= 'let* a0) + (LET (new-env env) (nth ast 1) (nth ast 2)) + + (= 'quote a0) + (nth ast 1) + + (= 'quasiquote a0) + (EVAL (QUASIQUOTE (nth ast 1)) env) + + (= 'defmacro! a0) + (env-set env (nth ast 1) (hash-map :__MAL_MACRO__ + (EVAL (nth ast 2) env))) + + (= 'try* a0) + (if (< (count ast) 3) + (EVAL (nth ast 1) env) + (try* + (EVAL (nth ast 1) env) + (catch* exc + (do + (reset! trace "") + (let* [a2 (nth ast 2)] + (EVAL (nth a2 2) (new-env env [(nth a2 1)] [exc]))))))) + + (= 'do a0) + (nth (map (fn* [exp] (EVAL exp env)) (rest ast)) (- (count ast) 2)) + + (= 'if a0) + (if (EVAL (nth ast 1) env) + (EVAL (nth ast 2) env) + (if (> (count ast) 3) + (EVAL (nth ast 3) env))) + + (= 'fn* a0) + (fn* [& args] (EVAL (nth ast 2) (new-env env (nth ast 1) args))) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (if (_macro? f) + (EVAL (apply (get f :__MAL_MACRO__) args) env) + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do diff --git a/impls/miniMAL/stepA_mal.json b/impls/miniMAL/stepA_mal.json index e5b64ed92f..de73286968 100644 --- a/impls/miniMAL/stepA_mal.json +++ b/impls/miniMAL/stepA_mal.json @@ -36,25 +36,16 @@ ["list", ["symbol", ["`", "quote"]], "ast"], "ast"]]]]], -["def", "macro?", ["fn", ["ast", "env"], - ["and", ["list?", "ast"], - ["symbol?", ["first", "ast"]], - ["not", ["=", null, ["env-find", "env", ["first", "ast"]]]], - ["let", ["fn", ["env-get", "env", ["first", "ast"]]], - ["and", ["malfunc?", "fn"], - ["get", "fn", ["`", "macro?"]]]]]]], - -["def", "macroexpand", ["fn", ["ast", "env"], - ["if", ["macro?", "ast", "env"], - ["let", ["mac", ["get", ["env-get", "env", ["first", "ast"]], ["`", "fn"]]], - ["macroexpand", ["apply", "mac", ["rest", "ast"]], "env"]], - "ast"]]], - -["def", "eval-ast", ["fn", ["ast", "env"], +["def", "LET", ["fn", ["env", "args"], + ["if", [">", ["count", "args"], 0], + ["do", + ["env-set", "env", ["nth", "args", 0], + ["EVAL", ["nth", "args", 1], "env"]], + ["LET", "env", ["rest", ["rest", "args"]]]]]]], + +["def", "EVAL", ["fn", ["ast", "env"], ["if", ["symbol?", "ast"], ["env-get", "env", "ast"], - ["if", ["list?", "ast"], - ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"], ["if", ["vector?", "ast"], ["vectorl", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "ast"]], ["if", ["map?", "ast"], @@ -65,21 +56,8 @@ ["EVAL", ["get", "ast", "k"], "env"]]], ["keys", "ast"]], "new-hm"]], - "ast"]]]]]], - -["def", "LET", ["fn", ["env", "args"], - ["if", [">", ["count", "args"], 0], - ["do", - ["env-set", "env", ["nth", "args", 0], - ["EVAL", ["nth", "args", 1], "env"]], - ["LET", "env", ["rest", ["rest", "args"]]]]]]], - -["def", "EVAL", ["fn", ["ast", "env"], ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], - ["let", ["ast", ["macroexpand", "ast", "env"]], - ["if", ["not", ["list?", "ast"]], - ["eval-ast", "ast", "env"], + "ast", ["if", ["empty?", "ast"], "ast", ["let", ["a0", ["get", ["first", "ast"], ["`", "val"]]], @@ -93,8 +71,6 @@ ["EVAL", ["nth", "ast", 2], "let-env"]]], ["if", ["=", ["`", "quote"], "a0"], ["nth", "ast", 1], - ["if", ["=", ["`", "quasiquoteexpand"], "a0"], - ["quasiquote", ["nth", "ast", 1]], ["if", ["=", ["`", "quasiquote"], "a0"], ["EVAL", ["quasiquote", ["nth", "ast", 1]], "env"], ["if", ["=", ["`", "defmacro!"], "a0"], @@ -102,8 +78,6 @@ ["do", ["set", "func", ["`", "macro?"], true], ["env-set", "env", ["nth", "ast", 1], "func"]]], - ["if", ["=", ["`", "macroexpand"], "a0"], - ["macroexpand", ["nth", "ast", 1], "env"], ["if", ["=", ["`", "try*"], "a0"], ["if", ["and", [">", ["count", "ast"], 2], ["=", ["`", "catch*"], @@ -119,7 +93,7 @@ ["EVAL", ["nth", "ast", 1], "env"]], ["if", ["=", ["`", "do"], "a0"], ["do", - ["eval-ast", ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], ["slice", "ast", 1, ["-", ["count", "ast"], 1]], "env"], ["EVAL", ["nth", "ast", ["-", ["count", "ast"], 1]], "env"]], ["if", ["=", ["`", "if"], "a0"], ["let", ["cond", ["EVAL", ["nth", "ast", 1], "env"]], @@ -134,15 +108,16 @@ ["let", ["e", ["env-new", "env", ["nth", "ast", 1], "args"]], ["EVAL", ["nth", "ast", 2], "e"]]], ["nth", "ast", 2], "env", ["nth", "ast", 1]], - ["let", ["el", ["eval-ast", "ast", "env"], - "f", ["first", "el"], - "args", ["rest", "el"]], + ["let", ["f", ["EVAL", ["first", "ast"], "env"], + "args", ["rest", "ast"]], ["if", ["malfunc?", "f"], - ["EVAL", ["get", "f", ["`", "ast"]], + ["if", ["get", "f", ["`", "macro?"]], + ["EVAL", ["apply", ["get", "f", ["`", "fn"]], "args"], "env"], + ["EVAL", ["get", "f", ["`", "ast"]], ["env-new", ["get", "f", ["`", "env"]], ["get", "f", ["`", "params"]], - "args"]], - ["apply", "f", "args"]]]]]]]]]]]]]]]]]]]]], + ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]], + ["apply", "f", ["map", ["fn", ["x"], ["EVAL", "x", "env"]], "args"]]]]]]]]]]]]]]]]]]]]], ["def", "PRINT", ["fn", ["exp"], ["pr-str", "exp", true]]], diff --git a/impls/nasm/stepA_mal.asm b/impls/nasm/stepA_mal.asm index 571f14cda4..97b4dae7e4 100644 --- a/impls/nasm/stepA_mal.asm +++ b/impls/nasm/stepA_mal.asm @@ -27,6 +27,9 @@ section .data static prompt_string, db 10,"user> " ; The string to print at the prompt + static eval_debug_string, db "EVAL: " + static eval_debug_cr, db 10 + static error_string, db 27,'[31m',"Error",27,'[0m',": " static not_found_string, db " not found" @@ -62,7 +65,6 @@ section .data static_symbol if_symbol, 'if' static_symbol fn_symbol, 'fn*' static_symbol defmacro_symbol, 'defmacro!' - static_symbol macroexpand_symbol, 'macroexpand' static_symbol try_symbol, 'try*' static_symbol catch_symbol, 'catch*' @@ -70,7 +72,6 @@ section .data static_symbol quote_symbol, 'quote' static_symbol quasiquote_symbol, 'quasiquote' - static_symbol quasiquoteexpand_symbol, 'quasiquoteexpand' static_symbol unquote_symbol, 'unquote' static_symbol splice_unquote_symbol, 'splice-unquote' static_symbol concat_symbol, 'concat' @@ -121,9 +122,32 @@ car_and_incref: ;; ;; Inputs: RSI Form to evaluate ;; RDI Environment +;; Returns: Result in RAX +;; Note: Both the form and environment will have their reference count +;; reduced by one (released). This is for tail call optimisation (Env), +;; quasiquote and macroexpand (AST) ;; -eval_ast: +eval: +;; ---------------------------------------------------------------------- +;; Uncomment these instructions to see most EVAL cycles +;; (values are not displayed, but quasiquote and macroexpand are :-) +;; ---------------------------------------------------------------------- + ;; push rdi + ;; mov r15, rsi + ;; print_str_mac eval_debug_string ; -> rsi, rdx -> + ;; mov rdi, 1 + ;; mov rsi, r15 + ;; call pr_str ; rdi, rsi -> rcx, r8, r12, r13, r14 -> rax + ;; mov rsi, rax + ;; call print_string ; rsi -> -> + ;; call release_array ; rsi -> [rsi], rax, rbx -> + ;; print_str_mac eval_debug_cr ; -> rsi, rdx -> + ;; mov rsi, r15 + ;; pop rdi + mov r15, rdi ; Save Env in r15 + + push rsi ; AST pushed, must be popped before return ; Check the type mov al, BYTE [rsi] @@ -148,7 +172,7 @@ eval_ast: call incref_object ; Increment reference count mov rax, rsi - ret + jmp .return .symbol: ; Check if first character of symbol is ':' @@ -205,16 +229,104 @@ eval_ast: ; Just return keywords unaltered call incref_object mov rax, rsi - ret + jmp .return ; ------------------------------ -.list: - ; Evaluate each element of the list - ; - xor r8, r8 ; The list to return - ; r9 contains head of list +.list_map_eval: + + ;; Some code is duplicated for the first element because + ;; the iteration must stop if its evaluation products a macro, + ;; else a new list must be constructed. + + ; Evaluate first element of the list + + mov al, BYTE [rsi] ; Check type + mov ah, al + and ah, content_mask + cmp ah, content_pointer + je .list_pointer_first + + ; A value in RSI, so copy + + call alloc_cons + mov bl, BYTE [rsi] + and bl, content_mask + add bl, (block_cons + container_list) + mov [rax], BYTE bl ; set type + mov rbx, [rsi + Cons.car] + mov [rax + Cons.car], rbx ; copy value + + ; Result in RAX + jmp .list_append_first +.list_pointer_first: + ; List element is a pointer to something + push rsi + push r15 ; Env + mov rdi, [rsi + Cons.car] ; Get the address + mov rsi, r15 + + call incref_object ; Environment increment refs + xchg rsi, rdi ; Env in RDI, AST in RSI + + call incref_object ; AST increment refs + + call eval ; Evaluate it, result in rax + pop r15 + pop rsi + + ; Check the type it's evaluated to + mov bl, BYTE [rax] + ;; If the evaluated first element is a macro, exit the loop. + cmp bl, maltype_macro + je macroexpand + mov bh, bl + and bh, (block_mask + container_mask) + cmp bh, (block_cons + container_value) + je .list_eval_value_first + + ; Not a value, so need a pointer to it + push rax + call alloc_cons + mov [rax], BYTE (block_cons + container_list + content_pointer) + pop rbx ; Address to point to + mov [rax + Cons.car], rbx + jmp .list_append_first + +.list_eval_value_first: + ; Got value in RAX, so copy + push rax + call alloc_cons ; Copy in RAX + pop rbx ; Value to copy in RBX + mov cl, BYTE [rbx] + and cl, content_mask + or cl, (block_cons + container_list) + mov [rax], BYTE cl ; set type + mov rcx, [rbx + Cons.car] + mov [rax + Cons.car], rcx ; copy value + ; Release the value in RBX + push rsi + push rax + mov rsi, rbx + call release_cons + pop rax + pop rsi + ; Fall through to .list_append_first +.list_append_first: + ; In RAX + ; r8 contains the head of the constructed list + ; append to r9 + mov r8, rax + mov r9, rax .list_loop: + ; Evaluate each element of the remaining list + + ; Check if there's another + mov al, BYTE [rsi + Cons.typecdr] + cmp al, content_pointer + jne .list_done ; finished list + mov rsi, [rsi + Cons.cdr] ; next in list + mov al, BYTE [rsi] ; Check type mov ah, al and ah, content_mask @@ -292,32 +404,15 @@ eval_ast: ; Fall through to .list_append .list_append: ; In RAX - - cmp r8, 0 ; Check if this is the first - je .list_first - ; append to r9 mov [r9 + Cons.cdr], rax mov [r9 + Cons.typecdr], BYTE content_pointer mov r9, rax - jmp .list_next - -.list_first: - mov r8, rax - mov r9, rax - ; fall through to .list_next - -.list_next: - ; Check if there's another - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .list_done ; finished list - mov rsi, [rsi + Cons.cdr] ; next in list jmp .list_loop .list_done: mov rax, r8 ; Return the list - ret + jmp eval.return_from_list_map_eval ; --------------------- .map: @@ -330,7 +425,7 @@ eval_ast: ; map empty. Just return it call incref_object mov rax, rsi - ret + jmp .return .map_not_empty: @@ -456,11 +551,11 @@ eval_ast: .map_done: mov rax, r12 - ret + jmp .return .map_error_missing_value: mov rax, r12 - ret + jmp .return ; ------------------------------ .vector: @@ -571,11 +666,11 @@ eval_ast: .vector_done: mov rax, r8 ; Return the vector - ret + jmp .return ; --------------------- .done: - ret + jmp .return ; Releases Env @@ -594,65 +689,15 @@ eval_ast: test rax, rax ; ZF set if rax = 0 (equal) %endmacro -;; ---------------------------------------------------- -;; Evaluates a form -;; -;; Input: RSI AST to evaluate [ Released ] -;; RDI Environment [ Released ] -;; -;; Returns: Result in RAX -;; -;; Note: Both the form and environment will have their reference count -;; reduced by one (released). This is for tail call optimisation (Env), -;; quasiquote and macroexpand (AST) -;; -eval: - mov r15, rdi ; Env - - push rsi ; AST pushed, must be popped before return - - ; Check type - mov al, BYTE [rsi] - cmp al, maltype_empty_list - je .empty_list ; empty list, return unchanged - - and al, container_mask - cmp al, container_list - je .list - - ; Not a list. Evaluate and return - call eval_ast - jmp .return ; Releases Env - ; -------------------- .list: ; A list - ; Macro expand - pop rax ; Old AST, discard from stack - call macroexpand ; Replaces RSI - push rsi ; New AST - - ; Check if RSI is a list, and if + ; Check if ; the first element is a symbol - mov al, BYTE [rsi] - - ; Check type - mov al, BYTE [rsi] cmp al, maltype_empty_list je .empty_list ; empty list, return unchanged - mov ah, al - and ah, container_mask - cmp ah, container_list - je .list_still_list - - ; Not a list, so call eval_ast on it - mov rdi, r15 ; Environment - call eval_ast - jmp .return - -.list_still_list: and al, content_mask cmp al, content_pointer jne .list_eval @@ -684,18 +729,12 @@ eval: eval_cmp_symbol quote_symbol ; quote je .quote_symbol - eval_cmp_symbol quasiquoteexpand_symbol - je .quasiquoteexpand_symbol - eval_cmp_symbol quasiquote_symbol ; quasiquote je .quasiquote_symbol eval_cmp_symbol defmacro_symbol ; defmacro! je .defmacro_symbol - eval_cmp_symbol macroexpand_symbol ; macroexpand - je .macroexpand_symbol - eval_cmp_symbol try_symbol ; try* je .try_symbol @@ -1468,20 +1507,6 @@ eval: ; ----------------------------- -;;; Like quasiquote, but do not evaluate the result. -.quasiquoteexpand_symbol: - ;; Return nil if no cdr - mov cl, BYTE [rsi + Cons.typecdr] - cmp cl, content_pointer - jne .return_nil - - mov rsi, [rsi + Cons.cdr] - call car_and_incref - call quasiquote - jmp .return - - ; ----------------------------- - .quasiquote_symbol: ; call quasiquote function with first argument @@ -1523,37 +1548,6 @@ eval: jmp eval ; Tail call - ; ----------------------------- -.macroexpand_symbol: - ; Check if we have a second list element - - mov al, BYTE [rsi + Cons.typecdr] - cmp al, content_pointer - jne .return_nil ; No argument - - mov rsi, [rsi + Cons.cdr] - - ; Check if this is a value or pointer - mov al, BYTE [rsi + Cons.typecar] - and al, content_mask - cmp al, content_pointer - je .macroexpand_pointer - - ; RSI contains a value. Remove the list container - mov [rsi + Cons.typecar], BYTE al - call incref_object - mov rax, rsi - jmp .return - -.macroexpand_pointer: - mov rsi, [rsi + Cons.car] - call incref_object ; Since RSI will be released - - call macroexpand ; May release and replace RSI - - mov rax, rsi - jmp .return ; Releases original AST - ; ----------------------------- .try_symbol: @@ -1773,7 +1767,8 @@ eval: push rsi mov rdi, r15 ; Environment push r15 - call eval_ast ; List of evaluated forms in RAX + jmp .list_map_eval ; List of evaluated forms in RAX +.return_from_list_map_eval pop r15 pop rsi @@ -2198,83 +2193,13 @@ qq_loop: ret - -;; Tests if an AST in RSI is a list containing -;; a macro defined in the ENV in R15 -;; -;; Inputs: AST in RSI (not modified) -;; ENV in R15 (not modified) -;; -;; Returns: Sets ZF if macro call. If set (true), -;; then the macro object is in RAX -;; -;; Modifies: -;; RAX -;; RBX -;; RCX -;; RDX -;; R8 -;; R9 -is_macro_call: - ; Test if RSI is a list which contains a pointer - mov al, BYTE [rsi] - cmp al, (block_cons + container_list + content_pointer) - jne .false - - ; Test if this is a symbol - mov rbx, [rsi + Cons.car] - mov al, BYTE [rbx] - cmp al, maltype_symbol - jne .false - - ; Look up symbol in Env - push rsi - push r15 - mov rdi, rbx ; symbol in RDI - mov rsi, r15 ; Environment in RSI - call env_get - pop r15 - pop rsi - jne .false ; Not in environment - - ; Object in RAX - ; If this is not a macro then needs to be released - mov dl, BYTE [rax] - - cmp dl, maltype_macro - je .true - - ; Not a macro, so release - mov r8, rsi - mov rsi, rax - call release_object - mov rsi, r8 - -.false: - lahf ; flags in AH - and ah, 255-64 ; clear zero flag - sahf - ret -.true: - mov rbx, rax ; Returning Macro object - lahf ; flags in AH - or ah, 64 ; set zero flag - sahf - mov rax, rbx - ret - ;; Expands macro calls ;; -;; Input: AST in RSI (released and replaced) -;; Env in R15 (not modified) -;; -;; Result: New AST in RSI +;; A part of eval, written here for historical reasons. +;; RSI: AST, a non-empty list (released and replaced) +;; RAX: evaluated first element of AST, a macro +;; R15: env macroexpand: - push r15 - - call is_macro_call - jne .done - mov r13, rsi mov rdi, rax ; Macro in RDI @@ -2312,13 +2237,11 @@ macroexpand: call apply_fn - mov rsi, rax ; Result in RSI - - pop r15 - jmp macroexpand -.done: - pop r15 - ret + mov rsi, rax ; Result in RSI + pop rdi ; env pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as r15 by .list_eval + pop rax ; (ignored) ast pushed as rsi by eval + jmp eval ;; Read and eval read_eval: diff --git a/impls/nim/stepA_mal.nim b/impls/nim/stepA_mal.nim index 76a648e3eb..4c24ec6480 100644 --- a/impls/nim/stepA_mal.nim +++ b/impls/nim/stepA_mal.nim @@ -29,57 +29,33 @@ proc quasiquote(ast: MalType): MalType = else: result = ast -proc is_macro_call(ast: MalType, env: Env): bool = - ast.kind == List and ast.list.len > 0 and ast.list[0].kind == Symbol and - env.find(ast.list[0].str) != nil and env.get(ast.list[0].str).fun_is_macro - -proc macroexpand(ast: MalType, env: Env): MalType = - result = ast - while result.is_macro_call(env): - let mac = env.get(result.list[0].str) - result = mac.malfun.fn(result.list[1 .. ^1]).macroexpand(env) - -proc eval(ast: MalType, env: Env): MalType - -proc eval_ast(ast: MalType, env: var Env): MalType = - case ast.kind - of Symbol: - result = env.get(ast.str) - of List: - result = list ast.list.mapIt(it.eval(env)) - of Vector: - result = vector ast.list.mapIt(it.eval(env)) - of HashMap: - result = hash_map() - for k, v in ast.hash_map.pairs: - result.hash_map[k] = v.eval(env) - else: - result = ast - proc eval(ast: MalType, env: Env): MalType = var ast = ast var env = env - template defaultApply = - let el = ast.eval_ast(env) - let f = el.list[0] - case f.kind - of MalFun: - ast = f.malfun.ast - env = initEnv(f.malfun.env, f.malfun.params, list(el.list[1 .. ^1])) - else: - return f.fun(el.list[1 .. ^1]) - while true: - if ast.kind != List: return ast.eval_ast(env) - ast = ast.macroexpand(env) - if ast.kind != List: return ast.eval_ast(env) + # echo "EVAL: " & ast.pr_str + + case ast.kind + of Symbol: + return env.get(ast.str) + of List: + discard(nil) # Proceed after the case statement + of Vector: + return vector ast.list.mapIt(it.eval(env)) + of HashMap: + result = hash_map() + for k, v in ast.hash_map.pairs: + result.hash_map[k] = v.eval(env) + return result + else: + return ast + if ast.list.len == 0: return ast let a0 = ast.list[0] - case a0.kind - of Symbol: + if a0.kind == Symbol: case a0.str of "def!": let @@ -100,50 +76,44 @@ proc eval(ast: MalType, env: Env): MalType = else: raise newException(ValueError, "Illegal kind in let*") ast = a2 env = let_env - # Continue loop (TCO) + continue # TCO of "quote": return ast.list[1] - of "quasiquoteexpand": - return ast.list[1].quasiquote - of "quasiquote": ast = ast.list[1].quasiquote - # Continue loop (TCO) + continue # TCO of "defmacro!": var fun = ast.list[2].eval(env) fun = malfun(fun.malfun.fn, fun.malfun.ast, fun.malfun.params, fun.malfun.env, true) return env.set(ast.list[1].str, fun) - of "macroexpand": - return ast.list[1].macroexpand(env) - of "try*": let a1 = ast.list[1] if ast.list.len <= 2: - return a1.eval(env) + ast = a1 + continue # TCO let a2 = ast.list[2] - if a2.list[0].str == "catch*": - try: - return a1.eval(env) - except MalError: - let exc = (ref MalError) getCurrentException() - var catchEnv = initEnv(env, list a2.list[1], exc.t) - return a2.list[2].eval(catchEnv) - except: - let exc = getCurrentExceptionMsg() - var catchEnv = initEnv(env, list a2.list[1], list str(exc)) - return a2.list[2].eval(catchEnv) - else: + try: return a1.eval(env) + except MalError: + let exc = (ref MalError) getCurrentException() + env = initEnv(env, list a2.list[1], exc.t) + ast = a2.list[2] + continue # TCO + except: + let exc = getCurrentExceptionMsg() + env = initEnv(env, list a2.list[1], list str (exc)) + ast = a2.list[2] + continue # TCO of "do": let last = ast.list.high - discard (list ast.list[1 ..< last]).eval_ast(env) + discard (ast.list[1 ..< last].mapIt(it.eval(env))) ast = ast.list[last] - # Continue loop (TCO) + continue # TCO of "if": let @@ -152,9 +122,14 @@ proc eval(ast: MalType, env: Env): MalType = cond = a1.eval(env) if cond.kind in {Nil, False}: - if ast.list.len > 3: ast = ast.list[3] - else: ast = nilObj - else: ast = a2 + if ast.list.len > 3: + ast = ast.list[3] + continue # TCO + else: + return nilObj + else: + ast = a2 + continue # TCO of "fn*": let @@ -166,9 +141,17 @@ proc eval(ast: MalType, env: Env): MalType = a2.eval(newEnv) return malfun(fn, a2, a1, env) - else: defaultApply() + let f = eval(a0, env) + if f.fun_is_macro: + ast = f.malfun.fn(ast.list[1 .. ^1]) + continue # TCO + let args = ast.list[1 .. ^1].mapIt(it.eval(env)) + if f.kind == MalFun: + ast = f.malfun.ast + env = initEnv(f.malfun.env, f.malfun.params, list(args)) + continue # TCO - else: defaultApply() + return f.fun(args) proc print(exp: MalType): string = exp.pr_str diff --git a/impls/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas index 51174c9934..8c3aebfc37 100644 --- a/impls/objpascal/stepA_mal.pas +++ b/impls/objpascal/stepA_mal.pas @@ -71,91 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); end; -function is_macro_call(Ast: TMal; Env: TEnv): Boolean; -var - A0 : TMal; - Mac : TMal; -begin - is_macro_call := false; - if (Ast.ClassType = TMalList) and - (Length((Ast as TMalList).Val) > 0) then - begin - A0 := (Ast as TMalList).Val[0]; - if (A0 is TMalSymbol) and - (Env.Find(A0 as TMalSymbol) <> nil) then - begin - Mac := Env.Get((A0 as TMalSymbol)); - if Mac is TMalFunc then - is_macro_call := (Mac as TMalFunc).isMacro; - end; - end; - -end; - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function macroexpand(Ast: TMal; Env: TEnv): TMal; -var - A0 : TMal; - Arr : TMalArray; - Args : TMalArray; - Mac : TMalFunc; -begin - while is_macro_call(Ast, Env) do - begin - Arr := (Ast as TMalList).Val; - A0 := Arr[0]; - Mac := Env.Get((A0 as TMalSymbol)) as TMalFunc; - Args := (Ast as TMalList).Rest.Val; - if Mac.Ast = nil then - Ast := Mac.Val(Args) - else - Ast := EVAL(Mac.Ast, - TEnv.Create(Mac.Env, Mac.Params, Args)); - end; - macroexpand := Ast; -end; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; -var - OldArr, NewArr : TMalArray; - OldDict, NewDict : TMalDict; - I : longint; -begin - if Ast is TMalSymbol then - begin - eval_ast := Env.Get((Ast as TMalSymbol)); - end - else if Ast is TMalList then - begin - OldArr := (Ast as TMalList).Val; - SetLength(NewArr, Length(OldArr)); - for I := 0 to Length(OldArr)-1 do - begin - NewArr[I] := EVAL(OldArr[I], Env); - end; - if Ast is TMalVector then - eval_ast := TMalVector.Create(NewArr) - else - eval_ast := TMalList.Create(NewArr); - end - else if Ast is TMalHashMap then - begin - OldDict := (Ast as TMalHashMap).Val; - NewDict := TMalDict.Create; - I := 0; - while I < OldDict.Count do - begin - NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env); - I := I + 1; - end; - eval_ast := TMalHashMap.Create(NewDict); - end - else - eval_ast := Ast; -end; - function EVAL(Ast: TMal; Env: TEnv) : TMal; var Lst : TMalList; @@ -168,15 +83,33 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn : TMalFunc; Args : TMalArray; Err : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); - Ast := macroexpand(Ast, Env); - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + // WriteLn('EVAL: ' + PRINT(Ast)); + + if Ast is TMalSymbol then + Exit(Env.Get((Ast as TMalSymbol))) + else if Ast is TMalVector then + begin + Arr := (Ast as TMalVector).Val; + SetLength(Arr1, Length(Arr)); + for I := 0 to Length(Arr)-1 do + Arr1[I]:= EVAL(Arr[I], Env); + Exit(TMalVector.Create(Arr1)); + end + else if Ast is TMalHashMap then + begin + OldDict := (Ast as TMalHashMap).Val; + NewDict := TMalDict.Create; + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); + end + else if not (Ast is TMalList) then + Exit(Ast); // Apply list Lst := (Ast as TMalList); @@ -206,8 +139,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -217,8 +148,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; Fn.isMacro := true; Exit(Env.Add((Arr[1] as TMalSymbol), Fn)); end; - 'macroexpand': - Exit(macroexpand(Arr[1], Env)); 'try*': begin try @@ -242,7 +171,8 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - eval_ast(TMalList.Create(copy(Arr,1, Length(Arr)-2)), Env); + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); Ast := Arr[Length(Arr)-1]; // TCO end; 'if': @@ -262,14 +192,21 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; else begin - Arr := (eval_ast(Ast, Env) as TMalList).Val; - if Arr[0] is TMalFunc then + Cond := EVAL(Arr[0], Env); + Args := copy(Arr, 1, Length(Arr) - 1); + if Cond is TMalFunc then begin - Fn := Arr[0] as TMalFunc; - if Length(Arr) < 2 then - SetLength(Args, 0) - else - Args := copy(Arr, 1, Length(Arr)-1); + Fn := Cond as TMalFunc; + if Fn.isMacro then + begin + if Fn.Ast =nil then + Ast := Fn.Val(Args) + else + Ast := EVAL(Fn.Ast, Tenv.Create(Fn.Env, Fn.Params, Args)); + continue; // TCO + end; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then Exit(Fn.Val(Args)) else diff --git a/impls/ocaml/step2_eval.ml b/impls/ocaml/step2_eval.ml index ce4b5dcff2..82e8d38ef0 100644 --- a/impls/ocaml/step2_eval.ml +++ b/impls/ocaml/step2_eval.ml @@ -20,14 +20,13 @@ let repl_env = ref (List.fold_left (fun a b -> b a) Env.empty Env.add "*" (num_fun ( * )); Env.add "/" (num_fun ( / )) ]) -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol { T.value = s } -> (try Env.find s !env with Not_found -> raise (Invalid_argument ("Symbol '" ^ s ^ "' not found"))) - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -38,12 +37,11 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) + | _ -> raise (Invalid_argument "Cannot invoke non-function")) | _ -> ast -and eval ast env = - let result = eval_ast ast env in - match result with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> (f args) - | _ -> result let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step3_env.ml b/impls/ocaml/step3_env.ml index dde04dc133..a883ca92cb 100644 --- a/impls/ocaml/step3_env.ml +++ b/impls/ocaml/step3_env.ml @@ -14,12 +14,11 @@ let init_repl env = begin Env.set env (Types.symbol "/") (num_fun ( / )); end -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -30,10 +29,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -48,11 +43,11 @@ and eval ast env = | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step4_if_fn_do.ml b/impls/ocaml/step4_if_fn_do.ml index a425ffc8cb..9b836562cf 100644 --- a/impls/ocaml/step4_if_fn_do.ml +++ b/impls/ocaml/step4_if_fn_do.ml @@ -2,12 +2,11 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,10 +17,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -57,11 +52,15 @@ and eval ast env = | _ -> raise (Invalid_argument "Bad param count in fn call")) in bind_args arg_names args; eval expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step6_file.ml b/impls/ocaml/step6_file.ml index 0df1c3010f..a36a5e7a91 100644 --- a/impls/ocaml/step6_file.ml +++ b/impls/ocaml/step6_file.ml @@ -2,12 +2,11 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,10 +17,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -57,11 +52,15 @@ and eval ast env = | _ -> raise (Invalid_argument "Bad param count in fn call")) in bind_args arg_names args; eval expr sub_env) - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step7_quote.ml b/impls/ocaml/step7_quote.ml index dcad28fe54..f3216d101b 100644 --- a/impls/ocaml/step7_quote.ml +++ b/impls/ocaml/step7_quote.ml @@ -16,12 +16,11 @@ and qq_folder elt acc = | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -32,10 +31,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match ast with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -72,15 +67,17 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env - | T.List _ -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | _ -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step8_macros.ml b/impls/ocaml/step8_macros.ml index b9f35df5ed..ee6b1a0310 100644 --- a/impls/ocaml/step8_macros.ml +++ b/impls/ocaml/step8_macros.ml @@ -16,31 +16,11 @@ and qq_folder elt acc = | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,10 +31,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -97,17 +73,17 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/step9_try.ml b/impls/ocaml/step9_try.ml index ba68aab346..d430104a09 100644 --- a/impls/ocaml/step9_try.ml +++ b/impls/ocaml/step9_try.ml @@ -16,31 +16,11 @@ and qq_folder elt acc = | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,10 +31,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -97,12 +73,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env | T.List { T.value = [T.Symbol { T.value = "try*" }; scary]} -> (eval scary env) | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; @@ -117,11 +89,15 @@ and eval ast env = let sub_env = Env.make (Some env) in Env.set sub_env local value; eval handler sub_env) - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml index d9f56be6f4..14c68e20ee 100644 --- a/impls/ocaml/stepA_mal.ml +++ b/impls/ocaml/stepA_mal.ml @@ -16,31 +16,11 @@ and qq_folder elt acc = | T.List {T.value = [T.Symbol {T.value = "splice-unquote"}; x]} -> Types.list [Types.symbol "concat"; x; acc] | _ -> Types.list [Types.symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = - match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.meta = T.Map { T.value = meta } } - -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) - | _ -> false) - | _ -> false - -let rec macroexpand ast env = - if is_macro_call ast env - then match ast with - | T.List { T.value = s :: args } -> - (match (try Env.get env s with _ -> T.Nil) with - | T.Fn { T.value = f } -> macroexpand (f args) env - | _ -> ast) - | _ -> ast - else ast - -let rec eval_ast ast env = +let rec eval ast env = + (* output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); *) + (* flush stderr; *) match ast with | T.Symbol s -> Env.get env ast - | T.List { T.value = xs; T.meta = meta } - -> T.List { T.value = (List.map (fun x -> eval x env) xs); - T.meta = meta } | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,10 +31,6 @@ let rec eval_ast ast env = -> Types.MalMap.add k (eval v env) m) xs Types.MalMap.empty)} - | _ -> ast -and eval ast env = - match macroexpand ast env with - | T.List { T.value = [] } -> ast | T.List { T.value = [(T.Symbol { T.value = "def!" }); key; expr] } -> let value = (eval expr env) in Env.set env key value; value @@ -97,12 +73,8 @@ and eval ast env = in bind_args arg_names args; eval expr sub_env) | T.List { T.value = [T.Symbol { T.value = "quote" }; ast] } -> ast - | T.List { T.value = [T.Symbol { T.value = "quasiquoteexpand" }; ast] } -> - quasiquote ast | T.List { T.value = [T.Symbol { T.value = "quasiquote" }; ast] } -> eval (quasiquote ast) env - | T.List { T.value = [T.Symbol { T.value = "macroexpand" }; ast] } -> - macroexpand ast env | T.List { T.value = [T.Symbol { T.value = "try*" }; scary]} -> (eval scary env) | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; @@ -117,11 +89,15 @@ and eval ast env = let sub_env = Env.make (Some env) in Env.set sub_env local value; eval handler sub_env) - | T.List _ as ast -> - (match eval_ast ast env with - | T.List { T.value = ((T.Fn { T.value = f }) :: args) } -> f args + | T.List { T.value = (a0 :: args) } -> + (match eval a0 env with + | T.Fn { T.value = f; T.meta = T.Map { T.value = meta } } -> + if Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta) + then eval (f args) env + else f (List.map (fun x -> eval x env) args) + | T.Fn { T.value = f } -> f (List.map (fun x -> eval x env) args) | _ -> raise (Invalid_argument "Cannot invoke non-function")) - | ast -> eval_ast ast env + | _ -> ast let read str = Reader.read_str str let print exp = Printer.pr_str exp true diff --git a/impls/perl/step2_eval.pl b/impls/perl/step2_eval.pl index 8fe002e97a..3ef9ce44c8 100644 --- a/impls/perl/step2_eval.pl +++ b/impls/perl/step2_eval.pl @@ -19,31 +19,27 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->{$$ast} // die "'$$ast' not found\n"; - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my ($a0) = @$ast; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } # print diff --git a/impls/perl/step3_env.pl b/impls/perl/step3_env.pl index 478c1e9ad2..a44cd5a270 100644 --- a/impls/perl/step3_env.pl +++ b/impls/perl/step3_env.pl @@ -22,29 +22,25 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } - given (${$ast->[0]}) { + my ($a0) = @$ast; + given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; return $env->set($sym, EVAL($val, $env)); @@ -59,9 +55,9 @@ sub EVAL { return EVAL($body, $let_env); } default { - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } } } diff --git a/impls/perl/step4_if_fn_do.pl b/impls/perl/step4_if_fn_do.pl index be0611bd5e..1220901b3f 100644 --- a/impls/perl/step4_if_fn_do.pl +++ b/impls/perl/step4_if_fn_do.pl @@ -23,27 +23,22 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - return eval_ast($ast, $env); - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { @@ -62,8 +57,9 @@ sub EVAL { } when ('do') { my (undef, @todo) = @$ast; - my $el = eval_ast(Mal::List->new(\@todo), $env); - return pop @$el; + my $last = pop @todo; + map { EVAL($_, $env) } @todo; + return EVAL($last, $env); } when ('if') { my (undef, $if, $then, $else) = @$ast; @@ -82,9 +78,9 @@ sub EVAL { }); } default { - my @el = @{eval_ast($ast, $env)}; - my $f = shift @el; - return &$f(@el); + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + return &$f(map { EVAL($_, $env) } @args); } } } diff --git a/impls/perl/step5_tco.pl b/impls/perl/step5_tco.pl index 2c726ecaa3..8c9ac5ab64 100644 --- a/impls/perl/step5_tco.pl +++ b/impls/perl/step5_tco.pl @@ -23,28 +23,22 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { @@ -65,7 +59,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -88,8 +82,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl/step6_file.pl b/impls/perl/step6_file.pl index 631d4c59ae..e59d03e060 100644 --- a/impls/perl/step6_file.pl +++ b/impls/perl/step6_file.pl @@ -23,28 +23,22 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { @@ -65,7 +59,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -88,8 +82,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl/step7_quote.pl b/impls/perl/step7_quote.pl index af87a29391..b12d120d71 100644 --- a/impls/perl/step7_quote.pl +++ b/impls/perl/step7_quote.pl @@ -54,28 +54,22 @@ sub quasiquote { } } -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } # apply list + unless (@$ast) { return $ast; } my ($a0) = @$ast; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { @@ -96,9 +90,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -106,7 +97,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -129,8 +120,9 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl/step8_macros.pl b/impls/perl/step8_macros.pl index 727d2eec7f..65dee4e113 100644 --- a/impls/perl/step8_macros.pl +++ b/impls/perl/step8_macros.pl @@ -54,56 +54,21 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa("Mal::Symbol") && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); - } - return $ast; -} - - -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; @@ -125,9 +90,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -136,14 +98,10 @@ sub EVAL { my (undef, $sym, $val) = @$ast; return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; - } when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -166,8 +124,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl/step9_try.pl b/impls/perl/step9_try.pl index dd1ca1430c..34098898e3 100644 --- a/impls/perl/step9_try.pl +++ b/impls/perl/step9_try.pl @@ -15,7 +15,6 @@ use printer; use env; use core; -use interop qw(pl_to_mal); # read sub READ { @@ -55,56 +54,21 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa('Mal::Symbol') && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); - } - return $ast; -} - - -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; @@ -126,9 +90,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -137,10 +98,6 @@ sub EVAL { my (undef, $sym, $val) = @$ast; return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; - } when ('try*') { my (undef, $try, $catch) = @$ast; local $@; @@ -165,7 +122,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -188,8 +145,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl index f62aa5a7d8..b0d63f2500 100644 --- a/impls/perl/stepA_mal.pl +++ b/impls/perl/stepA_mal.pl @@ -54,56 +54,21 @@ sub quasiquote { } } -sub is_macro_call { - my ($ast, $env) = @_; - if ($ast->isa('Mal::List') && - $ast->[0]->isa('Mal::Symbol') && - $env->find($ast->[0])) { - my ($f) = $env->get($ast->[0]); - return $f->isa('Mal::Macro'); - } - return 0; -} - -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); - } - return $ast; -} - - -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + #print "EVAL: " . printer::_pr_str($ast) . "\n"; + if ($ast->isa('Mal::Symbol')) { return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + } elsif ($ast->isa('Mal::Vector')) { return ref($ast)->new([ map { EVAL($_, $env) } @$ast ]); } elsif ($ast->isa('Mal::HashMap')) { return Mal::HashMap->new({ pairmap { $a => EVAL($b, $env) } %$ast }); - } else { + } elsif (! $ast->isa('Mal::List')) { return $ast; } -} - -sub EVAL { - my($ast, $env) = @_; - - #print "EVAL: " . printer::_pr_str($ast) . "\n"; - if (! $ast->isa('Mal::List')) { - goto &eval_ast; - } - @$ast or return $ast; # apply list - $ast = macroexpand($ast, $env); - if (! $ast->isa('Mal::List')) { - @_ = ($ast, $env); - goto &eval_ast; - } unless (@$ast) { return $ast; } my ($a0) = @$ast; @@ -125,9 +90,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -136,10 +98,6 @@ sub EVAL { my (undef, $sym, $val) = @$ast; return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; - } when ('try*') { my (undef, $try, $catch) = @$ast; local $@; @@ -164,7 +122,7 @@ sub EVAL { when ('do') { my (undef, @todo) = @$ast; my $last = pop @todo; - eval_ast(Mal::List->new(\@todo), $env); + map { EVAL($_, $env) } @todo; @_ = ($last, $env); goto &EVAL; } @@ -187,8 +145,13 @@ sub EVAL { }); } default { - @_ = @{eval_ast($ast, $env)}; - my $f = shift; + my $f = EVAL($a0, $env); + my (undef, @args) = @$ast; + if ($f->isa('Mal::Macro')) { + @_ = (&$f(@args), $env); + goto &EVAL; + } + @_ = map { EVAL($_, $env) } @args; goto &$f; } } diff --git a/impls/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl index e7beec30d9..5b3bf4b6e9 100644 --- a/impls/perl6/stepA_mal.pl +++ b/impls/perl6/stepA_mal.pl @@ -10,16 +10,6 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { - given $ast { - when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } - when MalList { MalList([$ast.map({ eval($_, $env) })]) } - when MalVector { MalVector([$ast.map({ eval($_, $env) })]) } - when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } - default { $ast // $NIL } - } -} - sub qqLoop ($ast) { my $acc = MalList([]); for |$ast.val.reverse -> $elt { @@ -50,24 +40,19 @@ ($ast) } } -sub is_macro_call ($ast, $env) { - return so $ast ~~ MalList && $ast[0] ~~ MalSymbol - && $env.find($ast[0].val).?get($ast[0].val).?is_macro; -} - -sub macroexpand ($ast is copy, $env is copy) { - while is_macro_call($ast, $env) { - my $func = $env.get($ast[0].val); - $ast = $func.apply($ast[1..*]); - } - return $ast; -} - sub eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; - $ast = macroexpand($ast, $env); - return eval_ast($ast, $env) if $ast !~~ MalList; + + # say "EVAL" ~ print($line); + + given $ast { + when MalSymbol { return $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) } + when MalList { } + when MalVector { return MalVector([$ast.map({ eval($_, $env) })]) } + when MalHashMap { return MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) } + default { return $ast // $NIL } + } + return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -84,7 +69,7 @@ ($ast is copy, $env is copy) $ast = $a2; } when 'do' { - eval_ast(MalList([$ast[1..*-2]]), $env); + $ast[1..*-2].map({ eval($_, $env) }); $ast = $ast[*-1]; } when 'if' { @@ -104,7 +89,6 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } when 'quote' { return $a1 } - when 'quasiquoteexpand' { return quasiquote($a1) } when 'quasiquote' { $ast = quasiquote($a1) } when 'defmacro!' { my $func = eval($a2, $env); @@ -112,7 +96,6 @@ ($ast is copy, $env is copy) $func.is_macro = True; return $env.set($a1.val, $func); } - when 'macroexpand' { return macroexpand($a1, $env) } when 'try*' { return eval($a1, $env); CATCH { @@ -124,7 +107,13 @@ ($ast is copy, $env is copy) } } default { - my ($func, @args) = eval_ast($ast, $env).val; + my $func = eval($a0, $env); + my @args = $ast[1..*]; + if $func.?is_macro { + $ast = $func.apply(@args); + next; + } + @args = @args.map({ eval($_, $env) }); return $func.apply(|@args) if $func !~~ MalFunction; $ast = $func.ast; $env = MalEnv.new($func.env, $func.params, @args); diff --git a/impls/php/stepA_mal.php b/impls/php/stepA_mal.php index 6e57ab6445..2b84acaeda 100644 --- a/impls/php/stepA_mal.php +++ b/impls/php/stepA_mal.php @@ -47,32 +47,15 @@ function quasiquote($ast) { } } -function is_macro_call($ast, $env) { - return _list_Q($ast) && - count($ast) >0 && - _symbol_Q($ast[0]) && - $env->find($ast[0]) && - $env->get($ast[0])->ismacro; -} +function MAL_EVAL($ast, $env) { + while (true) { -function macroexpand($ast, $env) { - while (is_macro_call($ast, $env)) { - $mac = $env->get($ast[0]); - $args = array_slice($ast->getArrayCopy(),1); - $ast = $mac->apply($args); - } - return $ast; -} + #echo "EVAL: " . _pr_str($ast) . "\n"; -function eval_ast($ast, $env) { if (_symbol_Q($ast)) { return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { - $el = _vector(); - } + } elseif (_vector_Q($ast)) { + $el = _vector(); foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -81,24 +64,10 @@ function eval_ast($ast, $env) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } return $new_hm; - } else { + } elseif (!_list_Q($ast)) { return $ast; } -} - -function MAL_EVAL($ast, $env) { - while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } - - // apply list - $ast = macroexpand($ast, $env); - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -120,8 +89,6 @@ function MAL_EVAL($ast, $env) { break; // Continue loop (TCO) case "quote": return $ast[1]; - case "quasiquoteexpand": - return quasiquote($ast[1]); case "quasiquote": $ast = quasiquote($ast[1]); break; // Continue loop (TCO) @@ -130,8 +97,6 @@ function MAL_EVAL($ast, $env) { $func = _function('MAL_EVAL', 'native', $func->ast, $func->env, $func->params); $func->ismacro = true; return $env->set($ast[1], $func); - case "macroexpand": - return macroexpand($ast[1], $env); case "php*": $res = eval($ast[1]); return _to_mal($res); @@ -154,7 +119,7 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($a1, $env); } case "do": - eval_ast($ast->slice(1, -1), $env); + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } $ast = $ast[count($ast)-1]; break; // Continue loop (TCO) case "if": @@ -172,9 +137,14 @@ function MAL_EVAL($ast, $env) { case "to-native": return _to_native($ast[1]->value, $env); default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $f = MAL_EVAL($a0, $env); + $unevaluated_args = array_slice($ast->getArrayCopy(), 1); + if ($f->ismacro) { + $ast = $f->apply($unevaluated_args); + continue; // TCO + } + $args = []; + foreach ($unevaluated_args as $a) { $args[] = MAL_EVAL($a, $env); } if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); diff --git a/impls/picolisp/stepA_mal.l b/impls/picolisp/stepA_mal.l index 6e587d58ff..4712472668 100644 --- a/impls/picolisp/stepA_mal.l +++ b/impls/picolisp/stepA_mal.l @@ -41,29 +41,14 @@ ((map symbol) (MAL-list (list (MAL-symbol 'quote) Ast))) (T Ast))) -(de is-macro-call (Ast Env) - (when (= (MAL-type Ast) 'list) - (let A0 (car (MAL-value Ast)) - (when (= (MAL-type A0) 'symbol) - (let Value (find> Env (MAL-value A0)) - (and (isa '+Func Value) (get Value 'is-macro) T) ) ) ) ) ) - -(de macroexpand (Ast Env) - (while (is-macro-call Ast Env) - (let (Ast* (MAL-value Ast) - Macro (get (find> Env (MAL-value (car Ast*))) 'fn) - Args (cdr Ast*) ) - (setq Ast (apply (MAL-value Macro) Args)) ) ) - Ast ) - (de EVAL (Ast Env) (catch 'done (while t - (when (not (= (MAL-type Ast) 'list)) - (throw 'done (eval-ast Ast Env)) ) - (setq Ast (macroexpand Ast Env)) - (when (or (not (= (MAL-type Ast) 'list)) (not (MAL-value Ast))) - (throw 'done (eval-ast Ast Env)) ) + # (prinl "EVAL: " (pr-str Ast)) + (case (MAL-type Ast) + (list + + (if (MAL-value Ast) (let (Ast* (MAL-value Ast) A0* (MAL-value (car Ast*)) A1 (cadr Ast*) @@ -75,14 +60,10 @@ (throw 'done (set> Env A1* (EVAL A2 Env))) ) ((= A0* 'quote) (throw 'done A1) ) - ((= A0* 'quasiquoteexpand) - (throw 'done (quasiquote A1))) ((= A0* 'quasiquote) (setq Ast (quasiquote A1)) ) # TCO ((= A0* 'defmacro!) (throw 'done (set> Env A1* (MAL-macro (EVAL A2 Env))))) - ((= A0* 'macroexpand) - (throw 'done (macroexpand A1 Env)) ) ((= A0* 'try*) (let Result (catch 'err (throw 'done (EVAL A1 Env))) (if (isa '+MALError Result) @@ -121,22 +102,21 @@ (EVAL Body Env*) ) ) ) ) (throw 'done (MAL-func Env Body Binds Fn)) ) ) (T - (let (Ast* (MAL-value (eval-ast Ast Env)) - Fn (car Ast*) + (let (Fn (EVAL (car Ast*) Env) Args (cdr Ast*) ) + (if (get Fn 'is-macro) + (setq Ast (apply (MAL-value (get Fn 'fn)) Args)) # TCO + (let Args (mapcar '((Form) (EVAL Form Env)) Args) (if (isa '+MALFn Fn) (throw 'done (apply (MAL-value Fn) Args)) (let Env* (MAL-env (get Fn 'env) (get Fn 'params) Args) - (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) ) - -(de eval-ast (Ast Env) - (let Value (MAL-value Ast) - (case (MAL-type Ast) - (symbol (get> Env Value)) - (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value))) - (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value))) - (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value))) - (T Ast) ) ) ) + (setq Ast (get Fn 'ast) Env Env*) ) ) ) ) ) ) ) ) + (throw 'done Ast))) ; () + + (symbol (throw 'done (get> Env (MAL-value Ast)))) + (vector (throw 'done (MAL-vector (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (map (throw 'done (MAL-map (mapcar '((Form) (EVAL Form Env)) (MAL-value Ast))))) + (T (throw 'done Ast)) ) ) ) ) (set> *ReplEnv 'eval (MAL-fn (curry (*ReplEnv) (Form) (EVAL Form *ReplEnv)))) (set> *ReplEnv '*ARGV* (MAL-list (mapcar MAL-string (cdr (argv))))) diff --git a/impls/pike/stepA_mal.pike b/impls/pike/stepA_mal.pike index f2a9c64a63..035293983e 100644 --- a/impls/pike/stepA_mal.pike +++ b/impls/pike/stepA_mal.pike @@ -50,37 +50,18 @@ Val quasiquote(Val ast) } } -bool is_macro_call(Val ast, Env env) -{ - if(ast.mal_type == MALTYPE_LIST && - !ast.emptyp() && - ast.data[0].mal_type == MALTYPE_SYMBOL && - env.find(ast.data[0])) - { - Val v = env.get(ast.data[0]); - if(objectp(v) && v.macro) return true; - } - return false; -} - -Val macroexpand(Val ast, Env env) +Val EVAL(Val ast, Env env) { - while(is_macro_call(ast, env)) + while(true) { - Val macro = env.get(ast.data[0]); - ast = macro(@ast.data[1..]); - } - return ast; -} + // write(({ "EVAL: ", PRINT(ast), "\n" })); -Val eval_ast(Val ast, Env env) -{ switch(ast.mal_type) { case MALTYPE_SYMBOL: return env.get(ast); case MALTYPE_LIST: - return List(map(ast.data, lambda(Val e) { return EVAL(e, env); })); + break; case MALTYPE_VECTOR: return Vector(map(ast.data, lambda(Val e) { return EVAL(e, env); })); case MALTYPE_MAP: @@ -92,16 +73,8 @@ Val eval_ast(Val ast, Env env) return Map(elements); default: return ast; - } -} + } -Val EVAL(Val ast, Env env) -{ - while(true) - { - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); - ast = macroexpand(ast, env); - if(ast.mal_type != MALTYPE_LIST) return eval_ast(ast, env); if(ast.emptyp()) return ast; if(ast.data[0].mal_type == MALTYPE_SYMBOL) { switch(ast.data[0].value) @@ -120,16 +93,12 @@ Val EVAL(Val ast, Env env) continue; // TCO case "quote": return ast.data[1]; - case "quasiquoteexpand": - return quasiquote(ast.data[1]); case "quasiquote": ast = quasiquote(ast.data[1]); continue; // TCO case "defmacro!": Val macro = EVAL(ast.data[2], env).clone_as_macro(); return env.set(ast.data[1], macro); - case "macroexpand": - return macroexpand(ast.data[1], env); case "try*": if(ast.count() < 3) return EVAL(ast.data[1], env); if(mixed err = catch { return EVAL(ast.data[1], env); } ) @@ -168,15 +137,20 @@ Val EVAL(Val ast, Env env) lambda(Val ... a) { return EVAL(ast.data[2], Env(env, ast.data[1], List(a))); }); } } - Val evaled_ast = eval_ast(ast, env); - Val f = evaled_ast.data[0]; + Val f = EVAL(ast.data[0], env); + array(Val) args = ast.data[1..]; switch(f.mal_type) { case MALTYPE_BUILTINFN: - return f(@evaled_ast.data[1..]); + return f(@map(args, lambda(Val e) { return EVAL(e, env);})); case MALTYPE_FN: + if(f.macro) + { + ast = f(@args); + continue; // TCO + } ast = f.ast; - env = Env(f.env, f.params, List(evaled_ast.data[1..])); + env = Env(f.env, f.params, List(map(args, lambda(Val e) { return EVAL(e, env);}))); continue; // TCO default: throw("Unknown function type"); diff --git a/impls/prolog/step7_quote.pl b/impls/prolog/step7_quote.pl index 2a0d61fcb6..2cf470dd66 100644 --- a/impls/prolog/step7_quote.pl +++ b/impls/prolog/step7_quote.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), diff --git a/impls/prolog/step8_macros.pl b/impls/prolog/step8_macros.pl index ffb5de38e9..07054f3103 100644 --- a/impls/prolog/step8_macros.pl +++ b/impls/prolog/step8_macros.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -113,19 +109,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -163,8 +146,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/prolog/step9_try.pl b/impls/prolog/step9_try.pl index 3c396be101..0098bcef12 100644 --- a/impls/prolog/step9_try.pl +++ b/impls/prolog/step9_try.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -126,19 +122,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -176,8 +159,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/prolog/stepA_mal.pl b/impls/prolog/stepA_mal.pl index 0f713d70f6..0b22579770 100644 --- a/impls/prolog/stepA_mal.pl +++ b/impls/prolog/stepA_mal.pl @@ -68,10 +68,6 @@ eval_list(_, quote, Args, Res) :- !, check(Args = [Res], "quote: expects 1 argument, got ~L", [Args]). -eval_list(_, quasiquoteexpand, Args, Res) :- !, - check(Args = [X], "quasiquoteexpand: expects 1 argument, got: ~L", [Args]), - quasiquote(X, Res). - eval_list(Env, quasiquote, Args, Res) :- !, check(Args = [X], "quasiquote: expects 1 argument, got: ~L", [Args]), quasiquote(X, Y), @@ -126,19 +122,6 @@ mal_macro(Fn, Res), env_set(Env, Key, Res). -eval_list(Env, macroexpand, Args, Res) :- !, - check(Args = [X], "macroexpand: expects 1 argument, got: ~L", [Args]), - macroexpand(Env, X, Res). - -macroexpand(Env, Ast, Res) :- - list([Key | Args], Ast), - env_get(Env, Key, Macro), - mal_macro(Fn, Macro), !, - mal_fn(Goal, Fn), - call(Goal, Args, New_Ast), - macroexpand(Env, New_Ast, Res). -macroexpand(_, Ast, Ast). - % apply phase eval_list(Env, First, Rest, Res) :- @@ -176,8 +159,7 @@ maplist(eval(Env), Xs, Ys), vector(Ys, Res). -eval(Env, Map, Res) :- - map_map(eval(Env), Map, Res). +eval(Env, Map, Res) :- map_map(eval(Env), Map, Res). eval(_, Anything_Else, Anything_Else). diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps index 53c087478f1e52fda4924d54c1cfbaa8af787e6e..fb718eea88f77912d166afa662dcbc762f29587e 100644 GIT binary patch delta 600 zcmbu6O-lk%6o#3|(lIFlu@6U2fzcO?wP?{s?1P|$phW}`!%eRmjgH!bV~YJSx+MEayo=z9vOSThlt3+zG&2%ngT*QoXqjKd z_fSw_lq;lX={&^1v`G4N6$s0jASSS^gqn^pQQv_gt!Z3KSG!9IZEnMJbGJG?H~x!v z{PfgM9`Htq<4b=qdDsb42>vq=Hw-ue%}KZCJA^~-<^ZoFGVX?b_@u1;f1~}OgeAO< Q4B}QefNIodFGO1dU-v}1od5s; delta 1110 zcmZuwJ#W)c6jh*3z!4~F^U*Y_a$876r&L4;2$ZM-rb4R@bV9OTljrbM$4+b~Y89f6 zEJz4lc4h=aQ3n12D+3D>e}RQx0QWwpsawbpKb?Dg?z!haA3yrCd0aIXRbX{Q)Ay{V zaGVAVp$0A03}H{Um5aN^D!!k|;UHCh8XR`^JWZ)68^ju@03ytU*iX6xF4DuYmD>Wh z?>OK}Qa*i+l*`%N)flxcL;P8&V`e6G>r{YHsA_u+;B)BrCCHvu>Ii>dwm<}+3AmHb z8n$o(iJ$Vt$!RH<+te70K-rRt+UjTs=TJ#TN6?bCX-56zL01s=Zya00>9isUc}&XT zY=lz+r^0fY1!OgZHL%?91>u|z4=oCFKseVdU(!GGZO0QWc)YvuM0>)eV!@CHDm3w1 zF;^Rb<9S`sZRkBSZe9+AW3ku}Zk}7@LgmIuwGOM$^_3g-U0=tq#>4A@?DeG^DiQ6N z)1o~)io`r02C^A?KF%gP_qA8X`MOwqux#J!Si<+kAyBwhL_UK~^2fKy`2tk_Fa9C< zI$we5nm9h5j~=*FD&ew`OVsd=v6ujSX57O!#_hWkPGqA2uE&$}MdOpu?x*Wu-@GrK z0&b;Nj;aiu!1@|Z_RcqfrK6?k8PAH-3f#8z&$o#9(9%B_TKA@K=t}wD5Dx~n+5!6X2+gcN~B{x@sD{8pPObz&lM|-N9pg0Oxy=_ zz3#YoW!s#sO6nhvLg4QUb7exK3&;ms`NXJ@ThZLFGaWMvdHhjW$L{ MalExpression: return reader.read(x) -def eval_ast(ast: MalExpression, env: Env) -> MalExpression: - if isinstance(ast, MalSymbol): - return env.get(ast) - if isinstance(ast, MalList): - return MalList([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalVector): - return MalVector([EVAL(x, env) for x in ast.native()]) - if isinstance(ast, MalHash_map): - new_dict = {} # type: Dict[str, MalExpression] - for key in ast.native(): - new_dict[key] = EVAL(ast.native()[key], env) - return MalHash_map(new_dict) - return ast - - def qq_loop(acc: MalList, elt: MalExpression) -> MalList: if isinstance(elt, MalList): lst = elt.native() @@ -73,17 +58,23 @@ def quasiquote(ast: MalExpression) -> MalExpression: def EVAL(ast: MalExpression, env: Env) -> MalExpression: while True: # print("EVAL: " + str(ast)) - ast = macroexpand(ast, env) ast_native = ast.native() + if isinstance(ast, MalSymbol): + return env.get(ast) + if isinstance(ast, MalVector): + return MalVector([EVAL(x, env) for x in ast_native]) + if isinstance(ast, MalHash_map): + new_dict = {} # type: Dict[str, MalExpression] + for key in ast_native: + new_dict[key] = EVAL(ast_native[key], env) + return MalHash_map(new_dict) if not isinstance(ast, MalList): - return eval_ast(ast, env) + return ast elif len(ast_native) == 0: return ast first_str = str(ast_native[0]) - if first_str == "macroexpand": - return macroexpand(ast.native()[1], env) - elif first_str == "def!": + if first_str == "def!": name: str = str(ast_native[1]) value: MalExpression = EVAL(ast_native[2], env) return env.set(name, value) @@ -169,16 +160,18 @@ def fn(args: List[MalExpression]) -> MalExpression: ast = catch_block.native()[2] continue else: - evaled_ast = eval_ast(ast, env) - f = evaled_ast.native()[0] - args = evaled_ast.native()[1:] + f = EVAL(ast_native[0], env) + if isinstance(f, (MalFunctionCompiled, MalFunctionRaw)) and f.is_macro(): + ast = f.call(ast_native[1:]) + continue + args = [EVAL(x, env) for x in ast_native[1:]] if isinstance(f, MalFunctionRaw): ast = f.ast() env = Env( outer=f.env(), binds=f.params().native(), - exprs=evaled_ast.native()[1:], + exprs=args, ) continue elif isinstance(f, MalFunctionCompiled): @@ -224,39 +217,6 @@ def eval_func(args: List[MalExpression], env: Env) -> MalExpression: return env -def is_macro_call(ast: MalExpression, env: Env) -> bool: - try: - x = env.get(ast.native()[0].native()) - try: - assert isinstance(x, MalFunctionRaw) or isinstance(x, MalFunctionCompiled) - except AssertionError: - return False - return x.is_macro() # type: ignore - except TypeError: - return False - except MalUnknownSymbolException: - return False - except AttributeError: - return False - except IndexError: - return False - except KeyError: - return False - - -def macroexpand(ast: MalExpression, env: Env) -> MalExpression: - while True: - if not is_macro_call(ast, env): - return ast - assert isinstance(ast, MalList) - macro_func = env.get(ast.native()[0].native()) - assert isinstance(macro_func, MalFunctionRaw) or isinstance( - macro_func, MalFunctionCompiled - ) - ast = macro_func.call(ast.native()[1:]) - continue - - def rep_handling_exceptions(line: str, repl_env: Env) -> str: try: return rep(line, repl_env) diff --git a/impls/python/step2_eval.py b/impls/python/step2_eval.py index b2f17f1822..19309c806f 100644 --- a/impls/python/step2_eval.py +++ b/impls/python/step2_eval.py @@ -8,38 +8,34 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): try: return env[ast] except: raise Exception("'" + ast + "' not found") - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + f = EVAL(ast[0], env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): return printer._pr_str(exp) # repl -repl_env = {} +repl_env = {} def REP(str): return PRINT(EVAL(READ(str), repl_env)) diff --git a/impls/python/step3_env.py b/impls/python/step3_env.py index 1496305795..75ec834eeb 100644 --- a/impls/python/step3_env.py +++ b/impls/python/step3_env.py @@ -9,22 +9,18 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast @@ -41,9 +37,9 @@ def EVAL(ast, env): let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + f = EVAL(a0, env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step4_if_fn_do.py b/impls/python/step4_if_fn_do.py index 3567a14cc9..554e3a8746 100644 --- a/impls/python/step4_if_fn_do.py +++ b/impls/python/step4_if_fn_do.py @@ -10,22 +10,18 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast @@ -42,8 +38,9 @@ def EVAL(ast, env): let_env.set(a1[i], EVAL(a1[i+1], let_env)) return EVAL(a2, let_env) elif "do" == a0: - el = eval_ast(ast[1:], env) - return el[-1] + for i in range(1, len(ast)-1): + EVAL(ast[i], env) + return EVAL(ast[-1], env) elif "if" == a0: a1, a2 = ast[1], ast[2] cond = EVAL(a1, env) @@ -56,9 +53,9 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + f = EVAL(a0, env) + args = ast[1:] + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step5_tco.py b/impls/python/step5_tco.py index 5d783d3d08..333f2785b9 100644 --- a/impls/python/step5_tco.py +++ b/impls/python/step5_tco.py @@ -10,23 +10,19 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast @@ -45,7 +41,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -61,13 +58,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step6_file.py b/impls/python/step6_file.py index 2fd02eb0ea..6c7306749e 100644 --- a/impls/python/step6_file.py +++ b/impls/python/step6_file.py @@ -10,23 +10,19 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast @@ -45,7 +41,8 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -61,13 +58,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step7_quote.py b/impls/python/step7_quote.py index 7bdb312efd..56834e5ead 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -33,23 +33,19 @@ def quasiquote(ast): else: return ast -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) + if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list if len(ast) == 0: return ast @@ -69,13 +65,12 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -91,13 +86,13 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step8_macros.py b/impls/python/step8_macros.py index 4d67304e5c..d0465ecef2 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -33,40 +33,21 @@ def quasiquote(ast): else: return ast -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) -def eval_ast(ast, env): if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): - return eval_ast(ast, env) if len(ast) == 0: return ast a0 = ast[0] @@ -84,8 +65,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,10 +72,9 @@ def EVAL(ast, env): func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -112,13 +90,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/step9_try.py b/impls/python/step9_try.py index 8162ab3cdc..ee31004aac 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -33,40 +33,21 @@ def quasiquote(ast): else: return ast -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) -def eval_ast(ast, env): if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): - return eval_ast(ast, env) if len(ast) == 0: return ast a0 = ast[0] @@ -84,8 +65,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,13 +72,8 @@ def EVAL(ast, env): func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) elif "py!*" == a0: - if sys.version_info[0] >= 3: - exec(compile(ast[1], '', 'single'), globals()) - else: - exec(compile(ast[1], '', 'single') in globals()) + exec(compile(ast[1], '', 'single'), globals()) return None elif "try*" == a0: if len(ast) < 3: @@ -118,7 +92,8 @@ def EVAL(ast, env): else: return EVAL(a1, env); elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -134,13 +109,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/python/stepA_mal.py b/impls/python/stepA_mal.py index 2ac1d679c3..290f6262b0 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -33,40 +33,21 @@ def quasiquote(ast): else: return ast -def is_macro_call(ast, env): - return (types._list_Q(ast) and - types._symbol_Q(ast[0]) and - env.find(ast[0]) and - hasattr(env.get(ast[0]), '_ismacro_')) - -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) -def eval_ast(ast, env): if types._symbol_Q(ast): return env.get(ast) - elif types._list_Q(ast): - return types._list(*map(lambda a: EVAL(a, env), ast)) elif types._vector_Q(ast): return types._vector(*map(lambda a: EVAL(a, env), ast)) elif types._hash_map_Q(ast): return types.Hash_Map((k, EVAL(v, env)) for k, v in ast.items()) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) + else: # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): - return eval_ast(ast, env) if len(ast) == 0: return ast a0 = ast[0] @@ -84,8 +65,6 @@ def EVAL(ast, env): # Continue loop (TCO) elif "quote" == a0: return ast[1] - elif "quasiquoteexpand" == a0: - return quasiquote(ast[1]); elif "quasiquote" == a0: ast = quasiquote(ast[1]); # Continue loop (TCO) @@ -93,15 +72,13 @@ def EVAL(ast, env): func = types._clone(EVAL(ast[2], env)) func._ismacro_ = True return env.set(ast[1], func) - elif 'macroexpand' == a0: - return macroexpand(ast[1], env) elif "py!*" == a0: exec(compile(ast[1], '', 'single'), globals()) return None elif "py*" == a0: return types.py_to_mal(eval(ast[1])) elif "." == a0: - el = eval_ast(ast[2:], env) + el = (EVAL(ast[i], env) for i in range(2, len(ast))) f = eval(ast[1]) return f(*el) elif "try*" == a0: @@ -121,7 +98,8 @@ def EVAL(ast, env): else: return EVAL(a1, env); elif "do" == a0: - eval_ast(ast[1:-1], env) + for i in range(1, len(ast)-1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif "if" == a0: @@ -137,13 +115,16 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return types._function(EVAL, Env, a2, env, a1) else: - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast[1:] + if hasattr(f, '_ismacro_'): + ast = f(*args) + continue # TCO if hasattr(f, '__ast__'): ast = f.__ast__ - env = f.__gen_env__(el[1:]) + env = f.__gen_env__(types.List(EVAL(a, env) for a in args)) else: - return f(*el[1:]) + return f(*(EVAL(a, env) for a in args)) # print def PRINT(exp): diff --git a/impls/r/stepA_mal.r b/impls/r/stepA_mal.r index ca77531c2d..daef29e092 100644 --- a/impls/r/stepA_mal.r +++ b/impls/r/stepA_mal.r @@ -46,54 +46,29 @@ quasiquote <- function(ast) { } } -is_macro_call <- function(ast, env) { - if(.list_q(ast) && - .symbol_q(ast[[1]]) && - (!.nil_q(Env.find(env, ast[[1]])))) { - exp <- Env.get(env, ast[[1]]) - return(.malfunc_q(exp) && exp$ismacro) - } - FALSE -} +EVAL <- function(ast, env) { + repeat { -macroexpand <- function(ast, env) { - while(is_macro_call(ast, env)) { - mac <- Env.get(env, ast[[1]]) - ast <- fapply(mac, slice(ast, 2)) - } - ast -} + #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") -eval_ast <- function(ast, env) { if (.symbol_q(ast)) { - Env.get(env, ast) - } else if (.list_q(ast)) { - new.listl(lapply(ast, function(a) EVAL(a, env))) + return(Env.get(env, ast)) } else if (.vector_q(ast)) { - new.vectorl(lapply(ast, function(a) EVAL(a, env))) + return(new.vectorl(lapply(ast, function(a) EVAL(a, env)))) } else if (.hash_map_q(ast)) { lst <- list() for(k in ls(ast)) { lst[[length(lst)+1]] = k lst[[length(lst)+1]] = EVAL(ast[[k]], env) } - new.hash_mapl(lst) - } else { - ast + return(new.hash_mapl(lst)) + } else if (!.list_q(ast)) { + return(ast) } -} - -EVAL <- function(ast, env) { - repeat { - #cat("EVAL: ", .pr_str(ast,TRUE), "\n", sep="") - if (!.list_q(ast)) { return(eval_ast(ast, env)) } if (length(ast) == 0) { return(ast) } # apply list - ast <- macroexpand(ast, env) - if (!.list_q(ast)) return(eval_ast(ast, env)) - switch(paste("l",length(ast),sep=""), l0={ return(ast) }, l1={ a0 <- ast[[1]]; a1 <- NULL; a2 <- NULL }, @@ -113,16 +88,12 @@ EVAL <- function(ast, env) { env <- let_env } else if (a0sym == "quote") { return(a1) - } else if (a0sym == "quasiquoteexpand") { - return(quasiquote(a1)) } else if (a0sym == "quasiquote") { ast <- quasiquote(a1) } else if (a0sym == "defmacro!") { func <- EVAL(a2, env) func$ismacro = TRUE return(Env.set(env, a1, func)) - } else if (a0sym == "macroexpand") { - return(macroexpand(a1, env)) } else if (a0sym == "try*") { edata <- new.env() tryCatch({ @@ -138,7 +109,7 @@ EVAL <- function(ast, env) { throw(edata$exc) } } else if (a0sym == "do") { - eval_ast(slice(ast,2,length(ast)-1), env) + lapply(slice(ast, 2, length(ast)-1), function(a) EVAL(a, env)) ast <- ast[[length(ast)]] } else if (a0sym == "if") { cond <- EVAL(a1, env) @@ -151,13 +122,18 @@ EVAL <- function(ast, env) { } else if (a0sym == "fn*") { return(malfunc(EVAL, a2, env, a1)) } else { - el <- eval_ast(ast, env) - f <- el[[1]] + f <- EVAL(a0, env) + args <- slice(ast, 2) + if (.macro_q(f)) { + ast <- fapply(f, args) + next + } + args <- new.listl(lapply(args, function(a) EVAL(a, env))) if (class(f) == "MalFunc") { ast <- f$ast - env <- f$gen_env(slice(el,2)) + env <- f$gen_env(args) } else { - return(do.call(f,slice(el,2))) + return(do.call(f, args)) } } diff --git a/impls/racket/stepA_mal.rkt b/impls/racket/stepA_mal.rkt index 9b68e7097d..5a7f487bc8 100755 --- a/impls/racket/stepA_mal.rkt +++ b/impls/racket/stepA_mal.rkt @@ -32,36 +32,17 @@ [else (foldr qq-loop null ast)])) -(define (macro? ast env) - (and (list? ast) - (not (empty? ast)) - (symbol? (first ast)) - (not (equal? null (send env find (first ast)))) - (let ([fn (send env get (first ast))]) - (and (malfunc? fn) (malfunc-macro? fn))))) - -(define (macroexpand ast env) - (if (macro? ast env) - (let ([mac (malfunc-fn (send env get (first ast)))]) - (macroexpand (apply mac (rest ast)) env)) - ast)) - -(define (eval-ast ast env) +(define (EVAL ast env) + ;(printf "EVAL: ~a~n" (pr_str ast true)) + (cond [(symbol? ast) (send env get ast)] - [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] + [(vector? ast) (_map (lambda (x) (EVAL x env)) ast)] [(hash? ast) (make-hash (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] - [else ast])) - -(define (EVAL ast env) - ;(printf "~a~n" (pr_str ast true)) - (if (not (list? ast)) - (eval-ast ast env) - - (let ([ast (macroexpand ast env)]) + [else (if (or (not (list? ast)) (empty? ast)) - (eval-ast ast env) + ast (let ([a0 (_nth ast 0)]) (cond [(eq? 'def! a0) @@ -75,16 +56,12 @@ (EVAL (_nth ast 2) let-env))] [(eq? 'quote a0) (_nth ast 1)] - [(eq? 'quasiquoteexpand a0) - (quasiquote (cadr ast))] [(eq? 'quasiquote a0) (EVAL (quasiquote (_nth ast 1)) env)] [(eq? 'defmacro! a0) (let* ([func (EVAL (_nth ast 2) env)] [mac (struct-copy malfunc func [macro? #t])]) (send env set (_nth ast 1) mac))] - [(eq? 'macroexpand a0) - (macroexpand (_nth ast 1) env)] [(eq? 'try* a0) (if (or (< (length ast) 3) (not (eq? 'catch* (_nth (_nth ast 2) 0)))) @@ -101,7 +78,7 @@ [exn:fail? (lambda (exc) (efn (format "~a" exc)))]) (EVAL (_nth ast 1) env))))] [(eq? 'do a0) - (eval-ast (drop (drop-right ast 1) 1) env) + (_map (lambda (x) (EVAL x env)) (drop (drop-right ast 1) 1)) (EVAL (last ast) env)] [(eq? 'if a0) (let ([cnd (EVAL (_nth ast 1) env)]) @@ -117,16 +94,17 @@ [binds (_nth ast 1)] [exprs args]))) (_nth ast 2) env (_nth ast 1) #f nil)] - [else (let* ([el (eval-ast ast env)] - [f (first el)] - [args (rest el)]) + [else (let* ([f (EVAL a0 env)] + [args (rest ast)]) (if (malfunc? f) - (EVAL (malfunc-ast f) + (if (malfunc-macro? f) + (EVAL (apply f args) env) + (EVAL (malfunc-ast f) (new Env% [outer (malfunc-env f)] [binds (malfunc-params f)] - [exprs args])) - (apply f args)))])))))) + [exprs (_map (lambda (x) (EVAL x env)) args)]))) + (apply f (_map (lambda (x) (EVAL x env)) args))))])))])) ;; print (define (PRINT exp) diff --git a/impls/rpython/stepA_mal.py b/impls/rpython/stepA_mal.py index 79f266211c..9592851066 100644 --- a/impls/rpython/stepA_mal.py +++ b/impls/rpython/stepA_mal.py @@ -49,30 +49,12 @@ def quasiquote(ast): else: return ast -def is_macro_call(ast, env): - if types._list_Q(ast): - a0 = ast[0] - if isinstance(a0, MalSym): - if not env.find(a0) is None: - return env.get(a0).ismacro - return False - -def macroexpand(ast, env): - while is_macro_call(ast, env): - assert isinstance(ast[0], MalSym) - mac = env.get(ast[0]) - ast = macroexpand(mac.apply(ast.rest()), env) - return ast - -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + #print("EVAL %s" % printer._pr_str(ast)) if types._symbol_Q(ast): assert isinstance(ast, MalSym) return env.get(ast) - elif types._list_Q(ast): - res = [] - for a in ast.values: - res.append(EVAL(a, env)) - return MalList(res) elif types._vector_Q(ast): res = [] for a in ast.values: @@ -83,20 +65,10 @@ def eval_ast(ast, env): for k in ast.dct.keys(): new_dct[k] = EVAL(ast.dct[k], env) return MalHashMap(new_dct) - else: + elif not types._list_Q(ast): return ast # primitive value, return unchanged - -def EVAL(ast, env): - while True: - #print("EVAL %s" % printer._pr_str(ast)) - if not types._list_Q(ast): - return eval_ast(ast, env) - if len(ast) == 0: return ast - + else: # apply list - ast = macroexpand(ast, env) - if not types._list_Q(ast): - return eval_ast(ast, env) if len(ast) == 0: return ast a0 = ast[0] if isinstance(a0, MalSym): @@ -117,16 +89,12 @@ def EVAL(ast, env): env = let_env # Continue loop (TCO) elif u"quote" == a0sym: return ast[1] - elif u"quasiquoteexpand" == a0sym: - return quasiquote(ast[1]) elif u"quasiquote" == a0sym: ast = quasiquote(ast[1]) # Continue loop (TCO) elif u"defmacro!" == a0sym: func = EVAL(ast[2], env) func.ismacro = True return env.set(ast[1], func) - elif u"macroexpand" == a0sym: - return macroexpand(ast[1], env) elif u"try*" == a0sym: if len(ast) < 3: return EVAL(ast[1], env); @@ -148,8 +116,8 @@ def EVAL(ast, env): elif u"do" == a0sym: if len(ast) == 0: return nil - elif len(ast) > 1: - eval_ast(ast.slice2(1, len(ast)-1), env) + for i in range(1, len(ast) - 1): + EVAL(ast[i], env) ast = ast[-1] # Continue loop (TCO) elif u"if" == a0sym: a1, a2 = ast[1], ast[2] @@ -163,14 +131,21 @@ def EVAL(ast, env): a1, a2 = ast[1], ast[2] return MalFunc(None, a2, env, a1, EVAL) else: - el = eval_ast(ast, env) - f = el.values[0] + f = EVAL(a0, env) + args = ast.rest() + if f.ismacro: + ast = f.apply(ast.rest()) # Continue loop (TCO) + else: + res = [] + for a in args.values: + res.append(EVAL(a, env)) + el = MalList(res) if isinstance(f, MalFunc): if f.ast: ast = f.ast - env = f.gen_env(el.rest()) # Continue loop (TCO) + env = f.gen_env(el) # Continue loop (TCO) else: - return f.apply(el.rest()) + return f.apply(el) else: raise Exception("%s is not callable" % f) diff --git a/impls/ruby/step2_eval.rb b/impls/ruby/step2_eval.rb index 23e47b3ff0..66376f2ce5 100644 --- a/impls/ruby/step2_eval.rb +++ b/impls/ruby/step2_eval.rb @@ -9,38 +9,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol raise "'" + ast.to_s + "' not found" if not env.key? ast - env[ast] + return env[ast] when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(ast[0], env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end # print diff --git a/impls/ruby/step3_env.rb b/impls/ruby/step3_env.rb index ece32bd57f..a4a2ceb806 100644 --- a/impls/ruby/step3_env.rb +++ b/impls/ruby/step3_env.rb @@ -10,34 +10,28 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -49,9 +43,9 @@ def EVAL(ast, env) end return EVAL(a2, let_env) else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step4_if_fn_do.rb b/impls/ruby/step4_if_fn_do.rb index 204dde6f5d..8284f65920 100644 --- a/impls/ruby/step4_if_fn_do.rb +++ b/impls/ruby/step4_if_fn_do.rb @@ -11,34 +11,28 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -50,8 +44,8 @@ def EVAL(ast, env) end return EVAL(a2, let_env) when :do - el = eval_ast(ast.drop(1), env) - return el.last + ast[1..-2].map{|a| EVAL(a, env)} + return EVAL(ast[-1], env) when :if cond = EVAL(a1, env) if not cond @@ -65,9 +59,9 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] - return f[*el.drop(1)] + f = EVAL(a0, env) + args = ast.drop(1) + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step5_tco.rb b/impls/ruby/step5_tco.rb index 06e5767012..dffe3ae02b 100644 --- a/impls/ruby/step5_tco.rb +++ b/impls/ruby/step5_tco.rb @@ -11,36 +11,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -53,7 +47,7 @@ def EVAL(ast, env) env = let_env ast = a2 # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -68,13 +62,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step6_file.rb b/impls/ruby/step6_file.rb index 0a1b060cd4..85ad237483 100644 --- a/impls/ruby/step6_file.rb +++ b/impls/ruby/step6_file.rb @@ -11,36 +11,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -53,7 +47,7 @@ def EVAL(ast, env) env = let_env ast = a2 # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -68,13 +62,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step7_quote.rb b/impls/ruby/step7_quote.rb index de33426a85..d4290850b4 100644 --- a/impls/ruby/step7_quote.rb +++ b/impls/ruby/step7_quote.rb @@ -42,36 +42,30 @@ def quasiquote(ast) end end -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + #puts "EVAL: #{_pr_str(ast, true)}" + + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast + return ast end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - if not ast.is_a? List - return eval_ast(ast, env) - end + # apply list if ast.empty? return ast end - # apply list a0,a1,a2,a3 = ast case a0 when :def! @@ -85,12 +79,10 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -105,13 +97,14 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step8_macros.rb b/impls/ruby/step8_macros.rb index 04ebaa0be7..b04634726b 100644 --- a/impls/ruby/step8_macros.rb +++ b/impls/ruby/step8_macros.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,26 @@ def quasiquote(ast) end end -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end +def EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end + #puts "EVAL: #{_pr_str(ast, true)}" -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) + return ast end # apply list - ast = macroexpand(ast, env) - if not ast.is_a? List - return eval_ast(ast, env) - end if ast.empty? return ast end @@ -110,18 +79,14 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -136,13 +101,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/step9_try.rb b/impls/ruby/step9_try.rb index d4b2bde72d..7365af589d 100644 --- a/impls/ruby/step9_try.rb +++ b/impls/ruby/step9_try.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,26 @@ def quasiquote(ast) end end -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end +def EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end + #puts "EVAL: #{_pr_str(ast, true)}" -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) + return ast end # apply list - ast = macroexpand(ast, env) - if not ast.is_a? List - return eval_ast(ast, env) - end if ast.empty? return ast end @@ -110,16 +79,12 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :"try*" begin return EVAL(a1, env) @@ -136,7 +101,7 @@ def EVAL(ast, env) end end when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -151,13 +116,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/ruby/stepA_mal.rb b/impls/ruby/stepA_mal.rb index 4f1b0d4453..708ed48930 100644 --- a/impls/ruby/stepA_mal.rb +++ b/impls/ruby/stepA_mal.rb @@ -11,14 +11,10 @@ def READ(str) end # eval -def starts_with(ast, sym) - return ast.is_a?(List) && ast.size == 2 && ast[0] == sym -end - def qq_loop(ast) acc = List.new [] ast.reverse_each do |elt| - if starts_with(elt, :"splice-unquote") + if elt.is_a?(List) && elt.size == 2 && elt[0] == :"splice-unquote" acc = List.new [:concat, elt[1], acc] else acc = List.new [:cons, quasiquote(elt), acc] @@ -30,7 +26,7 @@ def qq_loop(ast) def quasiquote(ast) return case ast when List - if starts_with(ast, :unquote) + if ast.size == 2 && ast[0] == :unquote ast[1] else qq_loop(ast) @@ -46,53 +42,26 @@ def quasiquote(ast) end end -def macro_call?(ast, env) - return (ast.is_a?(List) && - ast[0].is_a?(Symbol) && - env.find(ast[0]) && - env.get(ast[0]).is_a?(Function) && - env.get(ast[0]).is_macro) -end +def EVAL(ast, env) + while true -def macroexpand(ast, env) - while macro_call?(ast, env) - mac = env.get(ast[0]) - ast = mac[*ast.drop(1)] - end - return ast -end + #puts "EVAL: #{_pr_str(ast, true)}" -def eval_ast(ast, env) - return case ast + case ast when Symbol - env.get(ast) + return env.get(ast) when List - List.new ast.map{|a| EVAL(a, env)} when Vector - Vector.new ast.map{|a| EVAL(a, env)} + return Vector.new ast.map{|a| EVAL(a, env)} when Hash new_hm = {} ast.each{|k,v| new_hm[k] = EVAL(v, env)} - new_hm + return new_hm else - ast - end -end - -def EVAL(ast, env) - while true - - #puts "EVAL: #{_pr_str(ast, true)}" - - if not ast.is_a? List - return eval_ast(ast, env) + return ast end # apply list - ast = macroexpand(ast, env) - if not ast.is_a? List - return eval_ast(ast, env) - end if ast.empty? return ast end @@ -110,16 +79,12 @@ def EVAL(ast, env) ast = a2 # Continue loop (TCO) when :quote return a1 - when :quasiquoteexpand - return quasiquote(a1); when :quasiquote ast = quasiquote(a1); # Continue loop (TCO) when :defmacro! func = EVAL(a2, env).clone func.is_macro = true return env.set(a1, func) - when :macroexpand - return macroexpand(a1, env) when :"rb*" res = eval(a1) return case res @@ -142,7 +107,7 @@ def EVAL(ast, env) end end when :do - eval_ast(ast[1..-2], env) + ast[1..-2].map{|a| EVAL(a, env)} ast = ast.last # Continue loop (TCO) when :if cond = EVAL(a1, env) @@ -157,13 +122,18 @@ def EVAL(ast, env) EVAL(a2, Env.new(env, a1, List.new(args))) } else - el = eval_ast(ast, env) - f = el[0] + f = EVAL(a0, env) + args = ast.drop(1) if f.class == Function + if f.is_macro + ast = f[*args] + next # Continue loop (TCO) + end ast = f.ast - env = f.gen_env(el.drop(1)) # Continue loop (TCO) + env = f.gen_env(List.new args.map{|a| EVAL(a, env)}) + # Continue loop (TCO) else - return f[*el.drop(1)] + return f[*args.map{|a| EVAL(a, env)}] end end diff --git a/impls/rust/stepA_mal.rs b/impls/rust/stepA_mal.rs index 6b86d6b5b2..4f6e57b4f4 100644 --- a/impls/rust/stepA_mal.rs +++ b/impls/rust/stepA_mal.rs @@ -23,7 +23,7 @@ use crate::types::{error, format_error, MalArgs, MalErr, MalRet, MalVal}; mod env; mod printer; mod reader; -use crate::env::{env_bind, env_find, env_get, env_new, env_set, env_sets, Env}; +use crate::env::{env_bind, env_get, env_new, env_set, env_sets, Env}; #[macro_use] mod core; @@ -70,52 +70,27 @@ fn quasiquote(ast: &MalVal) -> MalVal { } } -fn is_macro_call(ast: &MalVal, env: &Env) -> Option<(MalVal, MalArgs)> { - match ast { - List(v, _) => match v[0] { - Sym(ref s) => match env_find(env, s) { - Some(e) => match env_get(&e, &v[0]) { - Ok(f @ MalFunc { is_macro: true, .. }) => Some((f, v[1..].to_vec())), - _ => None, - }, - _ => None, - }, - _ => None, - }, - _ => None, - } +fn eval_ast(v: &MalArgs, env: &Env) -> Result { + let mut lst: MalArgs = vec![]; + for a in v.iter() { + match eval(a.clone(), env.clone()) { + Ok(elt) => lst.push(elt), + Err(e) => return Err(e), + } + } + return Ok(lst); } -fn macroexpand(mut ast: MalVal, env: &Env) -> (bool, MalRet) { - let mut was_expanded = false; - while let Some((mf, args)) = is_macro_call(&ast, env) { - //println!("macroexpand 1: {:?}", ast); - ast = match mf.apply(args) { - Err(e) => return (false, Err(e)), - Ok(a) => a, - }; - //println!("macroexpand 2: {:?}", ast); - was_expanded = true; - } - ((was_expanded, Ok(ast))) -} +fn eval(mut ast: MalVal, mut env: Env) -> MalRet { + let ret: MalRet; -fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { - match ast { + 'tco: loop { + // println(print(ast)); + ret = match ast { Sym(_) => Ok(env_get(&env, &ast)?), - List(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(list!(lst)) - } - Vector(v, _) => { - let mut lst: MalArgs = vec![]; - for a in v.iter() { - lst.push(eval(a.clone(), env.clone())?) - } - Ok(vector!(lst)) + Vector(ref v, _) => match eval_ast(&v, &env) { + Ok(lst) => Ok(vector!(lst)), + Err(e) => Err(e), } Hash(hm, _) => { let mut new_hm: FnvHashMap = FnvHashMap::default(); @@ -124,28 +99,7 @@ fn eval_ast(ast: &MalVal, env: &Env) -> MalRet { } Ok(Hash(Rc::new(new_hm), Rc::new(Nil))) } - _ => Ok(ast.clone()), - } -} - -fn eval(mut ast: MalVal, mut env: Env) -> MalRet { - let ret: MalRet; - - 'tco: loop { - ret = match ast.clone() { - List(l, _) => { - if l.len() == 0 { - return Ok(ast); - } - match macroexpand(ast.clone(), &env) { - (true, Ok(new_ast)) => { - ast = new_ast; - continue 'tco; - } - (_, Err(e)) => return Err(e), - _ => (), - } - + List(ref l, _) => { if l.len() == 0 { return Ok(ast); } @@ -182,7 +136,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { continue 'tco; } Sym(ref a0sym) if a0sym == "quote" => Ok(l[1].clone()), - Sym(ref a0sym) if a0sym == "quasiquoteexpand" => Ok(quasiquote(&l[1])), Sym(ref a0sym) if a0sym == "quasiquote" => { ast = quasiquote(&l[1]); continue 'tco; @@ -212,12 +165,6 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { _ => error("set_macro on non-function"), } } - Sym(ref a0sym) if a0sym == "macroexpand" => { - match macroexpand(l[1].clone(), &env) { - (_, Ok(new_ast)) => Ok(new_ast), - (_, e) => return e, - } - } Sym(ref a0sym) if a0sym == "try*" => match eval(l[1].clone(), env.clone()) { Err(ref e) if l.len() >= 3 => { let exc = match e { @@ -239,12 +186,12 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { res => res, }, Sym(ref a0sym) if a0sym == "do" => { - match eval_ast(&list!(l[1..l.len() - 1].to_vec()), &env)? { - List(_, _) => { + match eval_ast(&l[1..l.len() - 1].to_vec(), &env) { + Ok(_) => { ast = l.last().unwrap_or(&Nil).clone(); continue 'tco; } - _ => error("invalid do form"), + Err(e) => return Err(e), } } Sym(ref a0sym) if a0sym == "if" => { @@ -280,32 +227,39 @@ fn eval(mut ast: MalVal, mut env: Env) -> MalRet { } continue 'tco; } - _ => match eval_ast(&ast, &env)? { - List(ref el, _) => { - let ref f = el[0].clone(); - let args = el[1..].to_vec(); - match f { - Func(_, _) => f.apply(args), - MalFunc { - ast: mast, - env: menv, - params, + _ => match eval(a0.clone(), env.clone()) { + Ok(f @ MalFunc { is_macro: true, .. }) => match f.apply(l[1..].to_vec()) { + Ok(new_ast) => { + ast = new_ast; + continue 'tco; + } + Err(e) => return Err(e), + } + Ok(f @ Func(_, _)) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => f.apply(args), + Err(e) => return Err(e), + } + Ok(MalFunc { + ast: ref mast, + env: ref menv, + params : ref mparams, .. - } => { + }) => match eval_ast(&l[1..].to_vec(), &env) { + Ok(args) => { let a = &**mast; - let p = &**params; - env = env_bind(Some(menv.clone()), p.clone(), args)?; + let p = &**mparams; + env = env_bind(Some(menv.clone()), p.clone(), args.to_vec())?; ast = a.clone(); continue 'tco; + } + Err(e) => return Err(e), } - _ => error("attempt to call non-function"), - } - } - _ => error("expected a list"), + Ok(_) => error("attempt to call non-function"), + Err(e) => return Err(e), }, } - } - _ => eval_ast(&ast, &env), + } + _ => Ok(ast.clone()), }; break; diff --git a/impls/scheme/stepA_mal.scm b/impls/scheme/stepA_mal.scm index f054354bf2..0d6ce1ff8b 100644 --- a/impls/scheme/stepA_mal.scm +++ b/impls/scheme/stepA_mal.scm @@ -12,16 +12,6 @@ (define (READ input) (read-str input)) -(define (eval-ast ast env) - (let ((type (and (mal-object? ast) (mal-type ast))) - (value (and (mal-object? ast) (mal-value ast)))) - (case type - ((symbol) (env-get env value)) - ((list) (mal-list (map (lambda (item) (EVAL item env)) value))) - ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value))) - ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value))) - (else ast)))) - (define (starts-with? ast sym) (let ((items (mal-value ast))) (and (not (null? items)) @@ -47,44 +37,21 @@ ((map symbol) (mal-list (list (mal-symbol 'quote) ast))) (else ast))) -(define (is-macro-call? ast env) - (if (mal-instance-of? ast 'list) - (let ((op (car-safe (mal-value ast)))) - (if (mal-instance-of? op 'symbol) - (let ((x (env-find env (mal-value op)))) - (if x - (if (and (func? x) (func-macro? x)) - #t - #f) - #f)) - #f)) - #f)) - -(define (macroexpand ast env) - (let loop ((ast ast)) - (if (is-macro-call? ast env) - (let* ((items (mal-value ast)) - (op (car items)) - (ops (cdr items)) - (fn (func-fn (env-get env (mal-value op))))) - (loop (apply fn ops))) - ast))) - (define (EVAL ast env) (define (handle-catch value handler) (let* ((symbol (mal-value (cadr handler))) (form (list-ref handler 2)) (env* (make-env env (list symbol) (list value)))) (EVAL form env*))) - (let ((type (and (mal-object? ast) (mal-type ast)))) - (if (not (eq? type 'list)) - (eval-ast ast env) - (if (null? (mal-value ast)) - ast - (let* ((ast (macroexpand ast env)) - (items (mal-value ast))) - (if (not (mal-instance-of? ast 'list)) - (eval-ast ast env) + (let ((type (and (mal-object? ast) (mal-type ast))) + (items (and (mal-object? ast) (mal-value ast)))) + (case type + ((symbol) (env-get env items)) + ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) items))) + ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) items))) + ((list) + (if (null? items) + ast (let ((a0 (car items))) (case (and (mal-object? a0) (mal-value a0)) ((def!) @@ -99,8 +66,6 @@ (func-macro?-set! value #t)) (env-set env symbol value) value)) - ((macroexpand) - (macroexpand (cadr items) env)) ((try*) (if (< (length items) 3) (EVAL (cadr items) env) @@ -151,8 +116,6 @@ (EVAL (list-ref items 2) env)))) ; TCO ((quote) (cadr items)) - ((quasiquoteexpand) - (QUASIQUOTE (cadr items))) ((quasiquote) (EVAL (QUASIQUOTE (cadr items)) env)) ; TCO ((fn*) @@ -164,15 +127,17 @@ (EVAL body env*))))) (make-func body binds env fn))) (else - (let* ((items (mal-value (eval-ast ast env))) - (op (car items)) - (ops (cdr items))) + (let ((op (EVAL (car items) env))) + (if (and (func? op) (func-macro? op)) + (EVAL (apply (func-fn op) (cdr items)) env) ; TCO + (let* ((ops (map (lambda (item) (EVAL item env)) (cdr items)))) (if (func? op) (let* ((outer (func-env op)) (binds (func-params op)) (env* (make-env outer binds ops))) (EVAL (func-ast op) env*)) ; TCO - (apply op ops)))))))))))) + (apply op ops)))))))))) + (else ast)))) (define (PRINT ast) (pr-str ast #t)) diff --git a/impls/skew/stepA_mal.sk b/impls/skew/stepA_mal.sk index 622936426f..29125f907b 100644 --- a/impls/skew/stepA_mal.sk +++ b/impls/skew/stepA_mal.sk @@ -33,33 +33,15 @@ def quasiquote(ast MalVal) MalVal { } } -def isMacro(ast MalVal, env Env) bool { - if !(ast is MalList) { return false } - const astList = ast as MalList - if astList.isEmpty { return false } - const a0 = astList[0] - if !(a0 is MalSymbol) { return false } - const a0Sym = a0 as MalSymbol - if env.find(a0Sym) == null { return false } - const f = env.get(a0Sym) - if !(f is MalFunc) { return false } - return (f as MalFunc).isMacro -} +def EVAL(ast MalVal, env Env) MalVal { + while true { -def macroexpand(ast MalVal, env Env) MalVal { - while isMacro(ast, env) { - const astList = ast as MalList - const mac = env.get(astList[0] as MalSymbol) as MalFunc - ast = mac.call((astList.rest as MalSequential).val) - } - return ast -} + # printLn("EVAL: " + PRINT(ast)) -def eval_ast(ast MalVal, env Env) MalVal { if ast is MalSymbol { return env.get(ast as MalSymbol) } else if ast is MalList { - return MalList.new((ast as MalList).val.map(e => EVAL(e, env))) + # proceed further after this conditional } else if ast is MalVector { return MalVector.new((ast as MalVector).val.map(e => EVAL(e, env))) } else if ast is MalHashMap { @@ -72,13 +54,7 @@ def eval_ast(ast MalVal, env Env) MalVal { } else { return ast } -} -def EVAL(ast MalVal, env Env) MalVal { - while true { - if !(ast is MalList) { return eval_ast(ast, env) } - ast = macroexpand(ast, env) - if !(ast is MalList) { return eval_ast(ast, env) } const astList = ast as MalList if astList.isEmpty { return ast } const a0sym = astList[0] as MalSymbol @@ -95,8 +71,6 @@ def EVAL(ast MalVal, env Env) MalVal { continue # TCO } else if a0sym.val == "quote" { return astList[1] - } else if a0sym.val == "quasiquoteexpand" { - return quasiquote(astList[1]) } else if a0sym.val == "quasiquote" { ast = quasiquote(astList[1]) continue # TCO @@ -105,8 +79,6 @@ def EVAL(ast MalVal, env Env) MalVal { var macro = MalFunc.new(fn.ast, fn.params, fn.env, fn.func) macro.setAsMacro return env.set(astList[1] as MalSymbol, macro) - } else if a0sym.val == "macroexpand" { - return macroexpand(astList[1], env) } else if a0sym.val == "try*" { if astList.count < 3 { return EVAL(astList[1], env) @@ -122,9 +94,10 @@ def EVAL(ast MalVal, env Env) MalVal { var catchEnv = Env.new(env, [catchClause[1] as MalSymbol], [exc]) return EVAL(catchClause[2], catchEnv) } else if a0sym.val == "do" { - const parts = astList.val.slice(1) - eval_ast(MalList.new(parts.slice(0, parts.count - 1)), env) - ast = parts[parts.count - 1] + for i = 1; i < astList.count - 1; i += 1 { + EVAL(astList[i], env) + } + ast = astList[astList.count - 1] continue # TCO } else if a0sym.val == "if" { const condRes = EVAL(astList[1], env) @@ -138,9 +111,13 @@ def EVAL(ast MalVal, env Env) MalVal { const argsNames = astList[1] as MalSequential return MalFunc.new(astList[2], argsNames, env, (args List) => EVAL(astList[2], Env.new(env, argsNames.val, args))) } else { - const evaledList = eval_ast(ast, env) as MalList - const fn = evaledList[0] - const callArgs = evaledList.val.slice(1) + const fn = EVAL(astList[0], env) + const args = astList.val.slice(1) + if fn is MalFunc && (fn as MalFunc).isMacro { + ast = (fn as MalFunc).call(args) + continue # TCO + } + const callArgs = args.map(e => EVAL(e, env)) if fn is MalNativeFunc { return (fn as MalNativeFunc).call(callArgs) } else if fn is MalFunc { diff --git a/impls/sml/stepA_mal.sml b/impls/sml/stepA_mal.sml index e279debec9..18e0610aa7 100644 --- a/impls/sml/stepA_mal.sml +++ b/impls/sml/stepA_mal.sml @@ -1,13 +1,11 @@ fun read s = readStr s -fun eval e ast = eval' e (expandMacro e [ast]) - -and eval' e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) - | eval' e (SYMBOL s) = evalSymbol e s - | eval' e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) - | eval' e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) - | eval' e ast = ast +fun eval e (LIST (a::args, _)) = (case specialEval a of SOME special => special e args | _ => evalApply e (eval e a) args) + | eval e (SYMBOL s) = evalSymbol e s + | eval e (VECTOR (v,_)) = VECTOR (map (eval e) v, NO_META) + | eval e (MAP (m,_)) = MAP (List.map (fn (k, v) => (k, eval e v)) m, NO_META) + | eval e ast = ast and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "let*") = SOME evalLet @@ -16,9 +14,7 @@ and specialEval (SYMBOL "def!") = SOME evalDef | specialEval (SYMBOL "fn*") = SOME evalFn | specialEval (SYMBOL "quote") = SOME evalQuote | specialEval (SYMBOL "quasiquote") = SOME evalQuasiquote - | specialEval (SYMBOL "quasiquoteexpand") = SOME (fn _ => expandQuasiquote) | specialEval (SYMBOL "defmacro!") = SOME evalDefmacro - | specialEval (SYMBOL "macroexpand") = SOME expandMacro | specialEval (SYMBOL "try*") = SOME evalTry | specialEval _ = NONE @@ -61,10 +57,6 @@ and evalDefmacro e [SYMBOL s, ast] = defMacro e s (eval e ast) and defMacro e s (FN (f,_)) = let val m = MACRO f in (def s m e; m) end | defMacro _ _ _ = raise NotApplicable "defmacro! needs a name, and a fn*" -and expandMacro e [(ast as LIST (SYMBOL s::args, _))] = (case lookup e s of SOME (MACRO m) => m args | _ => ast) - | expandMacro _ [ast] = ast - | expandMacro _ _ = raise NotApplicable "macroexpand needs one argument" - and evalTry e [a, LIST ([SYMBOL "catch*", b, c],_)] = (eval e a handle ex => evalCatch (inside e) b ex c) | evalTry e [a] = eval e a | evalTry _ _ = raise NotApplicable "try* needs a form to evaluate" @@ -77,6 +69,7 @@ and exnVal (MalException x) = x | exnVal exn = STRING (exnMessage exn) and evalApply e (FN (f,_)) args = f (map (eval e) args) + | evalApply e (MACRO m) args = eval e (m args) | evalApply _ x args = raise NotApplicable (prStr x ^ " is not applicable on " ^ prStr (malList args)) and evalSymbol e s = valOrElse (lookup e s) diff --git a/impls/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl index 1857a9a5ef..718ce9af9c 100644 --- a/impls/tcl/stepA_mal.tcl +++ b/impls/tcl/stepA_mal.tcl @@ -55,51 +55,18 @@ proc quasiquote {ast} { } } -proc is_macro_call {ast env} { - if {![list_q $ast]} { - return 0 - } - set a0 [lindex [obj_val $ast] 0] - if {$a0 == "" || ![symbol_q $a0]} { - return 0 - } - set varname [obj_val $a0] - set foundenv [$env find $varname] - if {$foundenv == 0} { - return 0 - } - macro_q [$env get $varname] -} +proc EVAL {ast env} { + while {true} { -proc macroexpand {ast env} { - while {[is_macro_call $ast $env]} { - set a0 [mal_first [list $ast]] - set macro_name [obj_val $a0] - set macro_obj [$env get $macro_name] - set macro_args [obj_val [mal_rest [list $ast]]] + # set img [PRINT $ast] + # puts "EVAL: ${img}" - set funcdict [obj_val $macro_obj] - set body [dict get $funcdict body] - set env [dict get $funcdict env] - set binds [dict get $funcdict binds] - set funcenv [Env new $env $binds $macro_args] - set ast [EVAL $body $funcenv] - } - return $ast -} - -proc eval_ast {ast env} { switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] return [$env get $varname] } "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -116,18 +83,6 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} - -proc EVAL {ast env} { - while {true} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } - - set ast [macroexpand $ast $env] - if {![list_q $ast]} { - return [eval_ast $ast $env] } lassign [obj_val $ast] a0 a1 a2 a3 @@ -153,9 +108,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +116,6 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "tcl*" { return [string_new [eval [obj_val $a1]]] } @@ -189,8 +138,9 @@ proc EVAL {ast env} { } } "do" { - set el [list_new [lrange [obj_val $ast] 1 end-1]] - eval_ast $el $env + foreach element [lrange [obj_val $ast] 1 end-1] { + EVAL $element $env + } set ast [lindex [obj_val $ast] end] # TCO: Continue loop } @@ -214,10 +164,21 @@ proc EVAL {ast env} { return [function_new $a2 $env $binds] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] - set f [lindex $lst 0] - set call_args [lrange $lst 1 end] + set f [EVAL $a0 $env] + set unevaluated_args [lrange [obj_val $ast] 1 end] + if {[macro_q $f]} { + set fn [obj_val $f] + set f_ast [dict get $fn body] + set f_env [dict get $fn env] + set f_binds [dict get $fn binds] + set apply_env [Env new $f_env $f_binds $unevaluated_args] + set ast [EVAL $f_ast $apply_env] + continue + } + set call_args {} + foreach element $unevaluated_args { + lappend call_args [EVAL $element $env] + } switch [obj_type $f] { function { set fn [obj_val $f] diff --git a/impls/tests/step7_quote.mal b/impls/tests/step7_quote.mal index ef80c8259a..b30c7c7f9e 100644 --- a/impls/tests/step7_quote.mal +++ b/impls/tests/step7_quote.mal @@ -277,73 +277,3 @@ a ;=>[unquote 0] `[splice-unquote 0] ;=>[splice-unquote 0] - -;; Debugging quasiquote -(quasiquoteexpand nil) -;=>nil -(quasiquoteexpand 7) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand {"a" b}) -;=>(quote {"a" b}) -(quasiquoteexpand ()) -;=>() -(quasiquoteexpand (1 2 3)) -;=>(cons 1 (cons 2 (cons 3 ()))) -(quasiquoteexpand (a)) -;=>(cons (quote a) ()) -(quasiquoteexpand (1 2 (3 4))) -;=>(cons 1 (cons 2 (cons (cons 3 (cons 4 ())) ()))) -(quasiquoteexpand (nil)) -;=>(cons nil ()) -(quasiquoteexpand (1 ())) -;=>(cons 1 (cons () ())) -(quasiquoteexpand (() 1)) -;=>(cons () (cons 1 ())) -(quasiquoteexpand (1 () 2)) -;=>(cons 1 (cons () (cons 2 ()))) -(quasiquoteexpand (())) -;=>(cons () ()) -(quasiquoteexpand (f () g (h) i (j k) l)) -;=>(cons (quote f) (cons () (cons (quote g) (cons (cons (quote h) ()) (cons (quote i) (cons (cons (quote j) (cons (quote k) ())) (cons (quote l) ()))))))) -(quasiquoteexpand (unquote 7)) -;=>7 -(quasiquoteexpand a) -;=>(quote a) -(quasiquoteexpand (unquote a)) -;=>a -(quasiquoteexpand (1 a 3)) -;=>(cons 1 (cons (quote a) (cons 3 ()))) -(quasiquoteexpand (1 (unquote a) 3)) -;=>(cons 1 (cons a (cons 3 ()))) -(quasiquoteexpand (1 b 3)) -;=>(cons 1 (cons (quote b) (cons 3 ()))) -(quasiquoteexpand (1 (unquote b) 3)) -;=>(cons 1 (cons b (cons 3 ()))) -(quasiquoteexpand ((unquote 1) (unquote 2))) -;=>(cons 1 (cons 2 ())) -(quasiquoteexpand (a (splice-unquote (b c)) d)) -;=>(cons (quote a) (concat (b c) (cons (quote d) ()))) -(quasiquoteexpand (1 c 3)) -;=>(cons 1 (cons (quote c) (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c) 3)) -;=>(cons 1 (concat c (cons 3 ()))) -(quasiquoteexpand (1 (splice-unquote c))) -;=>(cons 1 (concat c ())) -(quasiquoteexpand ((splice-unquote c) 2)) -;=>(concat c (cons 2 ())) -(quasiquoteexpand ((splice-unquote c) (splice-unquote c))) -;=>(concat c (concat c ())) -(quasiquoteexpand []) -;=>(vec ()) -(quasiquoteexpand [[]]) -;=>(vec (cons (vec ()) ())) -(quasiquoteexpand [()]) -;=>(vec (cons () ())) -(quasiquoteexpand ([])) -;=>(cons (vec ()) ()) -(quasiquoteexpand [1 a 3]) -;=>(vec (cons 1 (cons (quote a) (cons 3 ())))) -(quasiquoteexpand [a [] b [c] d [e f] g]) -;=>(vec (cons (quote a) (cons (vec ()) (cons (quote b) (cons (vec (cons (quote c) ())) (cons (quote d) (cons (vec (cons (quote e) (cons (quote f) ()))) (cons (quote g) ())))))))) diff --git a/impls/tests/step8_macros.mal b/impls/tests/step8_macros.mal index 6fd1ef9d94..8b828b3937 100644 --- a/impls/tests/step8_macros.mal +++ b/impls/tests/step8_macros.mal @@ -18,20 +18,8 @@ (unless2 true 7 8) ;=>8 -;; Testing macroexpand -(macroexpand (one)) -;=>1 -(macroexpand (unless PRED A B)) -;=>(if PRED B A) -(macroexpand (unless2 PRED A B)) -;=>(if (not PRED) A B) -(macroexpand (unless2 2 3 4)) -;=>(if (not 2) 3 4) - ;; Testing evaluation of macro result (defmacro! identity (fn* (x) x)) -(let* (a 123) (macroexpand (identity a))) -;=>a (let* (a 123) (identity a)) ;=>123 @@ -84,18 +72,12 @@ x ;; Testing cond macro -(macroexpand (cond)) -;=>nil (cond) ;=>nil -(macroexpand (cond X Y)) -;=>(if X Y (cond)) (cond true 7) ;=>7 (cond false 7) ;=>nil -(macroexpand (cond X Y Z T)) -;=>(if X Y (cond Z T)) (cond true 7 true 8) ;=>7 (cond false 7 true 8) diff --git a/impls/ts/stepA_mal.ts b/impls/ts/stepA_mal.ts index e61f8ce30f..fafa672a67 100644 --- a/impls/ts/stepA_mal.ts +++ b/impls/ts/stepA_mal.ts @@ -57,47 +57,12 @@ function quasiquote(ast: MalType): MalType { } } -function isMacro(ast: MalType, env: Env): boolean { - if (!isSeq(ast)) { - return false; - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - return false; - } - const foundEnv = env.find(s); - if (!foundEnv) { - return false; - } - - const f = foundEnv.get(s); - if (f.type !== Node.Function) { - return false; - } - - return f.isMacro; -} - -function macroexpand(ast: MalType, env: Env): MalType { - while (isMacro(ast, env)) { - if (!isSeq(ast)) { - throw new Error(`unexpected token type: ${ast.type}, expected: list or vector`); - } - const s = ast.list[0]; - if (s.type !== Node.Symbol) { - throw new Error(`unexpected token type: ${s.type}, expected: symbol`); - } - const f = env.get(s); - if (f.type !== Node.Function) { - throw new Error(`unexpected token type: ${f.type}, expected: function`); - } - ast = f.func(...ast.list.slice(1)); - } +// EVAL +function evalMal(ast: MalType, env: Env): MalType { + loop: while (true) { - return ast; -} + // console.log("EVAL: ", prStr(ast)); -function evalAST(ast: MalType, env: Env): MalType { switch (ast.type) { case Node.Symbol: const f = env.get(ast); @@ -105,8 +70,6 @@ function evalAST(ast: MalType, env: Env): MalType { throw new Error(`unknown symbol: ${ast.v}`); } return f; - case Node.List: - return new MalList(ast.list.map(ast => evalMal(ast, env))); case Node.Vector: return new MalVector(ast.list.map(ast => evalMal(ast, env))); case Node.HashMap: @@ -116,29 +79,16 @@ function evalAST(ast: MalType, env: Env): MalType { list.push(evalMal(value, env)); } return new MalHashMap(list); + case Node.List: + break; default: return ast; } -} -// EVAL -function evalMal(ast: MalType, env: Env): MalType { - loop: while (true) { - if (ast.type !== Node.List) { - return evalAST(ast, env); - } if (ast.list.length === 0) { return ast; } - ast = macroexpand(ast, env); - if (!isSeq(ast)) { - return evalAST(ast, env); - } - - if (ast.list.length === 0) { - return ast; - } const first = ast.list[0]; switch (first.type) { case Node.Symbol: @@ -177,9 +127,6 @@ function evalMal(ast: MalType, env: Env): MalType { case "quote": { return ast.list[1]; } - case "quasiquoteexpand": { - return quasiquote(ast.list[1]); - } case "quasiquote": { ast = quasiquote(ast.list[1]); continue loop; @@ -198,9 +145,6 @@ function evalMal(ast: MalType, env: Env): MalType { } return env.set(key, f.toMacro()); } - case "macroexpand": { - return macroexpand(ast.list[1], env); - } case "try*": { try { return evalMal(ast.list[1], env); @@ -228,7 +172,7 @@ function evalMal(ast: MalType, env: Env): MalType { } case "do": { const list = ast.list.slice(1, -1); - evalAST(new MalList(list), env); + list.map(x => evalMal(x, env)); ast = ast.list[ast.list.length - 1]; continue loop; } @@ -265,14 +209,15 @@ function evalMal(ast: MalType, env: Env): MalType { } } } - const result = evalAST(ast, env); - if (!isSeq(result)) { - throw new Error(`unexpected return type: ${result.type}, expected: list or vector`); - } - const [f, ...args] = result.list; + const f = evalMal(first, env); if (f.type !== Node.Function) { throw new Error(`unexpected token: ${f.type}, expected: function`); } + if (f.isMacro) { + ast = f.func(...ast.list.slice(1)); + continue loop; + } + const args = ast.list.slice(1).map(x => evalMal(x, env)); if (f.ast) { ast = f.ast; env = f.newEnv(args); diff --git a/impls/vb/stepA_mal.vb b/impls/vb/stepA_mal.vb index ba289f5c3c..5e40929897 100644 --- a/impls/vb/stepA_mal.vb +++ b/impls/vb/stepA_mal.vb @@ -61,37 +61,9 @@ Namespace Mal return result End Function - Shared Function is_macro_call(ast As MalVal, env As MalEnv) As Boolean - If TypeOf ast Is MalList Then - Dim a0 As MalVal = DirectCast(ast,MalList)(0) - If TypeOf a0 Is MalSymbol AndAlso _ - env.find(DirectCast(a0,MalSymbol)) IsNot Nothing Then - Dim mac As MalVal = env.do_get(DirectCast(a0,MalSymbol)) - If TypeOf mac Is MalFunc AndAlso _ - DirectCast(mac,MalFunc).isMacro() Then - return True - End If - End If - End If - return False - End Function - - Shared Function macroexpand(ast As MalVal, env As MalEnv) As MalVal - While is_macro_call(ast, env) - Dim a0 As MalSymbol = DirectCast(DirectCast(ast,MalList)(0),MalSymbol) - Dim mac As MalFunc = DirectCast(env.do_get(a0),MalFunc) - ast = mac.apply(DirectCast(ast,MalList).rest()) - End While - return ast - End Function - - Shared Function eval_ast(ast As MalVal, env As MalEnv) As MalVal - If TypeOf ast Is MalSymbol Then - return env.do_get(DirectCast(ast, MalSymbol)) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) + Shared Function eval_ast(old_lst As MalList, env As MalEnv) As MalList Dim new_lst As MalList - If ast.list_Q() Then + If old_lst.list_Q() Then new_lst = New MalList Else new_lst = DirectCast(New MalVector, MalList) @@ -101,17 +73,6 @@ Namespace Mal new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then - Dim new_dict As New Dictionary(Of String, MalVal) - Dim entry As KeyValuePair(Of String, MalVal) - For Each entry in DirectCast(ast,MalHashMap).getValue() - new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) - Next - return New MalHashMap(new_dict) - Else - return ast - End If - return ast End Function ' TODO: move to types.vb when it is ported @@ -128,16 +89,24 @@ Namespace Mal Do 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then + + If TypeOf orig_ast Is MalSymbol Then + return env.do_get(DirectCast(orig_ast, MalSymbol)) + Else If TypeOf orig_ast Is MalVector Then return eval_ast(orig_ast, env) + Else If TypeOf orig_ast Is MalHashMap Then + Dim new_dict As New Dictionary(Of String, MalVal) + Dim entry As KeyValuePair(Of String, MalVal) + For Each entry in DirectCast(orig_ast,MalHashMap).getValue() + new_dict.Add(entry.Key, EVAL(DirectCast(entry.Value,MalVal), env)) + Next + return New MalHashMap(new_dict) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list - Dim expanded As MalVal = macroexpand(orig_ast, env) - if not expanded.list_Q() Then - return eval_ast(expanded, env) - End If - Dim ast As MalList = DirectCast(expanded, MalList) + Dim ast As MalList = DirectCast(orig_ast, MalList) If ast.size() = 0 Then return ast @@ -172,8 +141,6 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "defmacro!" @@ -183,9 +150,6 @@ Namespace Mal DirectCast(res,MalFunc).setMacro() env.do_set(DirectCast(a1,MalSymbol), res) return res - Case "macroexpand" - Dim a1 As MalVal = ast(1) - return macroexpand(a1, env) Case "try*" Try return EVAL(ast(1), env) @@ -237,14 +201,18 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) - Dim f As MalFunc = DirectCast(el(0), MalFunc) + Dim f As MalFunc = DirectCast(EVAL(ast(0), env), MalFunc) + if f.isMacro() Then + ast = f.apply(ast.rest()) + Continue Do + End If + Dim args As MalList = eval_ast(ast.rest(), env) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing orig_ast = fnast - env = f.genEnv(el.rest()) + env = f.genEnv(args) Else - Return f.apply(el.rest()) + Return f.apply(args) End If End Select diff --git a/impls/vhdl/stepA_mal.vhdl b/impls/vhdl/stepA_mal.vhdl index bcbaadcd29..a8fcd4833c 100644 --- a/impls/vhdl/stepA_mal.vhdl +++ b/impls/vhdl/stepA_mal.vhdl @@ -97,40 +97,6 @@ architecture test of stepA_mal is procedure apply_func(fn: inout mal_val_ptr; args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr); - procedure is_macro_call(ast: inout mal_val_ptr; env: inout env_ptr; is_macro: out boolean) is - variable f, env_err: mal_val_ptr; - begin - is_macro := false; - if ast.val_type = mal_list and - ast.seq_val'length > 0 and - ast.seq_val(0).val_type = mal_symbol then - env_get(env, ast.seq_val(0), f, env_err); - if env_err = null and f /= null and - f.val_type = mal_fn and f.func_val.f_is_macro then - is_macro := true; - end if; - end if; - end procedure is_macro_call; - - procedure macroexpand(in_ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable ast, macro_fn, call_args, macro_err: mal_val_ptr; - variable is_macro: boolean; - begin - ast := in_ast; - is_macro_call(ast, env, is_macro); - while is_macro loop - env_get(env, ast.seq_val(0), macro_fn, macro_err); - seq_drop_prefix(ast, 1, call_args); - apply_func(macro_fn, call_args, ast, macro_err); - if macro_err /= null then - err := macro_err; - return; - end if; - is_macro_call(ast, env, is_macro); - end loop; - result := ast; - end procedure macroexpand; - procedure fn_eval(args: inout mal_val_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is begin EVAL(args.seq_val(0), repl_env, result, err); @@ -221,12 +187,16 @@ architecture test of stepA_mal is end case; end procedure apply_func; - procedure eval_ast_seq(ast_seq: inout mal_seq_ptr; env: inout env_ptr; result: inout mal_seq_ptr; err: out mal_val_ptr) is + procedure eval_ast_seq(ast_seq : inout mal_seq_ptr; + skip : in natural; + env : inout env_ptr; + result : inout mal_seq_ptr; + err : out mal_val_ptr) is variable eval_err: mal_val_ptr; begin - result := new mal_seq(0 to ast_seq'length - 1); + result := new mal_seq(0 to ast_seq'length - 1 - skip); for i in result'range loop - EVAL(ast_seq(i), env, result(i), eval_err); + EVAL(ast_seq(skip + i), env, result(i), eval_err); if eval_err /= null then err := eval_err; return; @@ -234,12 +204,28 @@ architecture test of stepA_mal is end loop; end procedure eval_ast_seq; - procedure eval_ast(ast: inout mal_val_ptr; env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is + procedure EVAL(in_ast : inout mal_val_ptr; + in_env : inout env_ptr; + result : out mal_val_ptr; + err : out mal_val_ptr) is variable key, val, eval_err, env_err: mal_val_ptr; - variable new_seq: mal_seq_ptr; + variable new_seq, evaled_ast: mal_seq_ptr; variable i: integer; + variable ast, a0, call_args, vars, sub_err, fn: mal_val_ptr; + variable env, let_env, catch_env, fn_env: env_ptr; + variable s: line; begin - case ast.val_type is + ast := in_ast; + env := in_env; + loop + + -- mal_printstr("EVAL: "); + -- PRINT (ast, s); + -- mal_printline(s.all); + -- deallocate(s); + -- mal_printline(""); + + case ast.val_type is when mal_symbol => env_get(env, ast, val, env_err); if env_err /= null then @@ -248,8 +234,10 @@ architecture test of stepA_mal is end if; result := val; return; - when mal_list | mal_vector | mal_hashmap => - eval_ast_seq(ast.seq_val, env, new_seq, eval_err); + when mal_list => + null; + when mal_vector | mal_hashmap => + eval_ast_seq(ast.seq_val, 0, env, new_seq, eval_err); if eval_err /= null then err := eval_err; return; @@ -259,31 +247,8 @@ architecture test of stepA_mal is when others => result := ast; return; - end case; - end procedure eval_ast; - - procedure EVAL(in_ast: inout mal_val_ptr; in_env: inout env_ptr; result: out mal_val_ptr; err: out mal_val_ptr) is - variable i: integer; - variable ast, evaled_ast, a0, call_args, val, vars, sub_err, fn: mal_val_ptr; - variable env, let_env, catch_env, fn_env: env_ptr; - begin - ast := in_ast; - env := in_env; - loop - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; + end case; - macroexpand(ast, env, ast, sub_err); - if sub_err /= null then - err := sub_err; - return; - end if; - if ast.val_type /= mal_list then - eval_ast(ast, env, result, err); - return; - end if; if ast.seq_val'length = 0 then result := ast; return; @@ -322,10 +287,6 @@ architecture test of stepA_mal is result := ast.seq_val(1); return; - elsif a0.string_val.all = "quasiquoteexpand" then - quasiquote(ast.seq_val(1), result); - return; - elsif a0.string_val.all = "quasiquote" then quasiquote(ast.seq_val(1), ast); next; -- TCO @@ -342,10 +303,6 @@ architecture test of stepA_mal is result := val; return; - elsif a0.string_val.all = "macroexpand" then - macroexpand(ast.seq_val(1), env, result, err); - return; - elsif a0.string_val.all = "try*" then EVAL(ast.seq_val(1), env, result, sub_err); if sub_err /= null then @@ -400,18 +357,43 @@ architecture test of stepA_mal is end if; end if; - eval_ast(ast, env, evaled_ast, sub_err); + EVAL (ast.seq_val(0), env, fn, sub_err); if sub_err /= null then err := sub_err; return; end if; - seq_drop_prefix(evaled_ast, 1, call_args); - fn := evaled_ast.seq_val(0); case fn.val_type is when mal_nativefn => + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, evaled_ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, evaled_ast, call_args); + -- Apply core function apply_native_func(fn, call_args, result, err); return; when mal_fn => + if fn.func_val.f_is_macro then + -- Apply macro + seq_drop_prefix(ast, 1, call_args); + new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); + apply_func(fn, call_args, ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + next; -- TCO + end if; + -- Evaluate arguments + eval_ast_seq(ast.seq_val, 1, env, evaled_ast, sub_err); + if sub_err /= null then + err := sub_err; + return; + end if; + new_seq_obj(mal_list, evaled_ast, call_args); + -- Apply fn* function new_env(fn_env, fn.func_val.f_env, fn.func_val.f_args, call_args); env := fn_env; ast := fn.func_val.f_body; diff --git a/impls/vimscript/stepA_mal.vim b/impls/vimscript/stepA_mal.vim index 2ca2a7ca22..1b32c6e664 100644 --- a/impls/vimscript/stepA_mal.vim +++ b/impls/vimscript/stepA_mal.vim @@ -46,51 +46,6 @@ function Quasiquote(ast) endif endfunction -function IsMacroCall(ast, env) - if !ListQ(a:ast) - return 0 - endif - let a0 = ListFirst(a:ast) - if !SymbolQ(a0) - return 0 - endif - let macroname = a0.val - if empty(a:env.find(macroname)) - return 0 - endif - return MacroQ(a:env.get(macroname)) -endfunction - -function MacroExpand(ast, env) - let ast = a:ast - while IsMacroCall(ast, a:env) - let macroobj = a:env.get(ListFirst(ast).val) - let macroargs = ListRest(ast) - let ast = FuncInvoke(macroobj, macroargs) - endwhile - return ast -endfunction - -function EvalAst(ast, env) - if SymbolQ(a:ast) - let varname = a:ast.val - return a:env.get(varname) - elseif ListQ(a:ast) - return ListNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - elseif VectorQ(a:ast) - return VectorNew(map(copy(a:ast.val), {_, e -> EVAL(e, a:env)})) - elseif HashQ(a:ast) - let ret = {} - for [k,v] in items(a:ast.val) - let newval = EVAL(v, a:env) - let ret[k] = newval - endfor - return HashNew(ret) - else - return a:ast - end -endfunction - function GetCatchClause(ast) if ListCount(a:ast) < 3 return "" @@ -108,13 +63,24 @@ function EVAL(ast, env) let env = a:env while 1 - if !ListQ(ast) - return EvalAst(ast, env) - end - let ast = MacroExpand(ast, env) + " call PrintLn("EVAL: " . PRINT(ast)) + + if SymbolQ(ast) + let varname = ast.val + return env.get(varname) + elseif VectorQ(ast) + return VectorNew(map(copy(ast.val), {_, e -> EVAL(e, env)})) + elseif HashQ(ast) + let ret = {} + for [k,v] in items(ast.val) + let newval = EVAL(v, env) + let ret[k] = newval + endfor + return HashNew(ret) + endif if !ListQ(ast) - return EvalAst(ast, env) + return ast end if EmptyQ(ast) return ast @@ -140,8 +106,6 @@ function EVAL(ast, env) " TCO elseif first_symbol == "quote" return ListNth(ast, 1) - elseif first_symbol == "quasiquoteexpand" - return Quasiquote(ListNth(ast, 1)) elseif first_symbol == "quasiquote" let ast = Quasiquote(ListNth(ast, 1)) " TCO @@ -150,8 +114,6 @@ function EVAL(ast, env) let a2 = ListNth(ast, 2) let macro = MarkAsMacro(EVAL(a2, env)) return env.set(a1.val, macro) - elseif first_symbol == "macroexpand" - return MacroExpand(ListNth(ast, 1), env) elseif first_symbol == "if" let condvalue = EVAL(ast.val[1], env) if FalseQ(condvalue) || NilQ(condvalue) @@ -184,7 +146,9 @@ function EVAL(ast, env) endtry elseif first_symbol == "do" let astlist = ast.val - call EvalAst(ListNew(astlist[1:-2]), env) + for elt in astlist[1:-2] + let ignored = EVAL(elt, env) + endfor let ast = astlist[-1] " TCO elseif first_symbol == "fn*" @@ -196,9 +160,14 @@ function EVAL(ast, env) " TCO else " apply list - let el = EvalAst(ast, env) - let funcobj = ListFirst(el) - let args = ListRest(el) + let funcobj = EVAL(first, env) + let args = ListRest(ast) + if MacroQ(funcobj) + let ast = FuncInvoke(funcobj, args) + continue + " TCO + endif + let args = ListNew(map(copy(args.val), {_, e -> EVAL(e, env)})) if NativeFunctionQ(funcobj) return NativeFuncInvoke(funcobj, args) elseif FunctionQ(funcobj) diff --git a/impls/wren/stepA_mal.wren b/impls/wren/stepA_mal.wren index aa2f130543..c29372c551 100644 --- a/impls/wren/stepA_mal.wren +++ b/impls/wren/stepA_mal.wren @@ -45,28 +45,12 @@ class Mal { } } - static isMacro(ast, env) { - return (ast is MalList && - !ast.isEmpty && - ast[0] is MalSymbol && - env.find(ast[0].value) && - env.get(ast[0].value) is MalFn && - env.get(ast[0].value).isMacro) - } - - static macroexpand(ast, env) { - while (isMacro(ast, env)) { - var macro = env.get(ast[0].value) - ast = macro.call(ast.elements[1..-1]) - } - return ast - } - - static eval_ast(ast, env) { + static eval(ast, env) { + while (true) { + // System.print("EVAL: %(print(ast))") + var tco = false if (ast is MalSymbol) { return env.get(ast.value) - } else if (ast is MalList) { - return MalList.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { @@ -75,17 +59,9 @@ class Mal { m[e.key] = eval(e.value, env) } return MalMap.new(m) - } else { + } else if (!(ast is MalList)) { return ast - } - } - - static eval(ast, env) { - while (true) { - var tco = false - if (!(ast is MalList)) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (!(ast is MalList)) return eval_ast(ast, env) + } else { if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -102,15 +78,11 @@ class Mal { tco = true } else if (ast[0].value == "quote") { return ast[1] - } else if (ast[0].value == "quasiquoteexpand") { - return quasiquote(ast[1]) } else if (ast[0].value == "quasiquote") { ast = quasiquote(ast[1]) tco = true } else if (ast[0].value == "defmacro!") { return env.set(ast[1].value, eval(ast[2], env).makeMacro()) - } else if (ast[0].value == "macroexpand") { - return macroexpand(ast[1], env) } else if (ast[0].value == "try*") { if (ast.count > 2 && ast[2][0] is MalSymbol && ast[2][0].value == "catch*") { var fiber = Fiber.new { eval(ast[1], env) } @@ -146,19 +118,25 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) - var f = evaled_ast[0] + var f = eval(ast[0], env) + var args = ast[1..-1] if (f is MalNativeFn) { - return f.call(evaled_ast[1..-1]) + return f.call(args.map { |e| eval(e, env) }) } else if (f is MalFn) { + if (f.isMacro) { + ast = f.call(args) + tco = true + } else { ast = f.ast - env = Env.new(f.env, f.params, evaled_ast[1..-1]) + env = Env.new(f.env, f.params, args.map { |e| eval(e, env) }) tco = true + } } else { Fiber.abort("unknown function type") } } } + } } static print(ast) { diff --git a/impls/yorick/stepA_mal.i b/impls/yorick/stepA_mal.i index fe90a24892..c3f7c83169 100644 --- a/impls/yorick/stepA_mal.i +++ b/impls/yorick/stepA_mal.i @@ -47,46 +47,13 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) -{ - if (structof(ast) != MalList) return 0 - if (count(ast) == 0) return 0 - a1 = *((*ast.val)(1)) - if (structof(a1) != MalSymbol) return 0 - var_name = a1.val - found_env = env_find(env, var_name) - if (is_void(found_env)) return 0 - obj = env_get(env, var_name) - return is_macro(obj) -} - -func macroexpand(ast, env) -{ - while (is_macro_call(ast, env)) { - macro_name = (*ast.val)(1)->val - macro_obj = env_get(env, macro_name) - macro_args = *rest(ast).val - fn_env = env_new(macro_obj.env, binds=*macro_obj.binds, exprs=macro_args) - ast = EVAL(*macro_obj.ast, fn_env) - } - return ast -} - -func eval_ast(ast, env) +func EVAL(ast, env) { + while (1) { + // write, format="EVAL: %s\n", pr_str(ast, 1) type = structof(ast) if (type == MalSymbol) { return env_get(env, ast.val) - } else if (type == MalList) { - seq = *(ast.val) - if (numberof(seq) == 0) return ast - res = array(pointer, numberof(seq)) - for (i = 1; i <= numberof(seq); ++i) { - e = EVAL(*seq(i), env) - if (structof(e) == MalError) return e - res(i) = &e - } - return MalList(val=&res) } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -107,16 +74,9 @@ func eval_ast(ast, env) hash_set, res, (*h.keys)(i), new_val } return MalHashmap(val=&res) - } else return ast -} - -func EVAL(ast, env) -{ - while (1) { - if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) - ast = macroexpand(ast, env) - if (structof(ast) != MalList) return eval_ast(ast, env) + } else if (type != MalList) { // including MalError + return ast + } else { lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +98,6 @@ func EVAL(ast, env) // TCO } else if (a1 == "quote") { return *lst(2) - } else if (a1 == "quasiquoteexpand") { - return quasiquote(*lst(2)) } else if (a1 == "quasiquote") { ast = quasiquote(*lst(2)) // TCO } else if (a1 == "defmacro!") { @@ -147,8 +105,6 @@ func EVAL(ast, env) if (structof(new_value) == MalError) return new_value new_value.macro = 1 return env_set(env, lst(2)->val, new_value) - } else if (a1 == "macroexpand") { - return macroexpand(*lst(2), env) } else if (a1 == "try*") { ret = EVAL(*lst(2), env) if (structof(ret) == MalError && numberof(lst) > 2) { @@ -186,16 +142,27 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3), macro=0) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val - if (structof(*seq(1)) == MalNativeFunction) { - args = (numberof(seq) > 1) ? seq(2:) : [] - return call_core_fn(seq(1)->val, args) - } else if (structof(*seq(1)) == MalFunction) { - fn = *seq(1) - exprs = numberof(seq) > 1 ? seq(2:) : [] - fn_env = env_new(fn.env, binds=*fn.binds, exprs=exprs) + fn = EVAL(*lst(1), env) + if (structof(fn) == MalError) return fn + if (is_macro(fn)) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=*lst(2:)) + ast = EVAL(*fn.ast, fn_env) + continue // TCO + } + if (numberof(lst) == 1) { + args = [] + } else { + args = array(pointer, numberof(lst) - 1) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + args(i) = e + } + } + if (structof(fn) == MalNativeFunction) { + return call_core_fn(fn->val, args) + } else if (structof(fn) == MalFunction) { + fn_env = env_new(fn.env, binds=*fn.binds, exprs=args) ast = *fn.ast env = fn_env // TCO @@ -204,6 +171,7 @@ func EVAL(ast, env) } } } + } } func PRINT(exp) diff --git a/process/guide.md b/process/guide.md index ec3deaaaeb..359eea21b1 100644 --- a/process/guide.md +++ b/process/guide.md @@ -541,24 +541,16 @@ repl_env = {'+': lambda a,b: a+b, * Modify the `rep` function to pass the REPL environment as the second parameter for the `EVAL` call. -* Create a new function `eval_ast` which takes `ast` (mal data type) - and an associative structure (the environment from above). - `eval_ast` switches on the type of `ast` as follows: +* In `EVAL`, switch on the type of the first parameter `ast` as follows: * symbol: lookup the symbol in the environment structure and return the value or raise an error if no value is found - * list: return a new list that is the result of calling `EVAL` on - each of the members of the list + * `ast` is a non-empty list: + call `EVAL` on each of the members of the list. + Take the first evaluated item and call it as function using + the rest of the evaluated items as its arguments. * otherwise just return the original `ast` value -* Modify `EVAL` to check if the first parameter `ast` is a list. - * `ast` is not a list: then return the result of calling `eval_ast` - on it. - * `ast` is a empty list: return ast unchanged. - * `ast` is a list: call `eval_ast` to get a new evaluated list. Take - the first item of the evaluated list and call it as function using - the rest of the evaluated list as its arguments. - If your target language does not have full variable length argument support (e.g. variadic, vararg, splats, apply) then you will need to pass the full list of arguments as a single parameter and split apart @@ -585,8 +577,17 @@ You now have a simple prefix notation calculator! #### Deferrable: -* `eval_ast` should evaluate elements of vectors and hash-maps. Add the - following cases in `eval_ast`: +* It is recommended to add a print statement at the top of the main + `eval` function. This statement should be disabled in normal + circumstances (commented out, enabled by an environment variable…). + + This information may be quite useful when debugging an issue, or + simply figuring how evaluation works. For consistence with existing + implementations, it should print "EVAL: " followed by the current + value of `ast`, formatted with `pr_str`. + +* `EVAL` should evaluate elements of vectors and hash-maps. Add the + following cases in `EVAL`: * If `ast` is a vector: return a new vector that is the result of calling `EVAL` on each of the members of the vector. * If `ast` is a hash-map: return a new hash-map which consists of key-value @@ -646,7 +647,7 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt repl_env (with a `nil` outer value) and use the `set` method to add the numeric functions. -* Modify `eval_ast` to call the `get` method on the `env` parameter. +* Modify `EVAL` to call the `get` method on the `env` parameter. * Modify the apply section of `EVAL` to switch on the first element of the list: @@ -667,8 +668,7 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt original `let*` form is evaluated using the new "let\*" environment and the result is returned as the result of the `let*` (the new let environment is discarded upon completion). - * otherwise: call `eval_ast` on the list and apply the first element - to the rest as before. + * otherwise: proceed as before. `def!` and `let*` are Lisp "specials" (or "special atoms") which means that they are language level features and more specifically that the @@ -757,7 +757,7 @@ diff -urp ../process/step3_env.txt ../process/step4_if_fn_do.txt * Add the following special forms to `EVAL`: - * `do`: Evaluate all the elements of the list using `eval_ast` + * `do`: Evaluate all the elements of the list and return the final evaluated element. * `if`: Evaluate the first parameter (second element). If the result (condition) is anything other than `nil` or `false`, then evaluate @@ -905,7 +905,7 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt `ast` (i.e. the local variable passed in as first parameter of `EVAL`) to be the second `ast` argument. Continue at the beginning of the loop (no return). - * `do`: change the `eval_ast` call to evaluate all the parameters + * `do`: change the implementation to evaluate all the parameters except for the last (2nd list element up to but not including last). Set `ast` to the last element of `ast`. Continue at the beginning of the loop (`env` stays unchanged). @@ -930,7 +930,7 @@ diff -urp ../process/step4_if_fn_do.txt ../process/step5_tco.txt * The default "apply"/invoke case of `EVAL` must now be changed to account for the new object/structure returned by the `fn*` form. - Continue to call `eval_ast` on `ast`. The first element of the + Once each element of `ast` is evaluated, the first element of the result of `eval_ast` is `f` and the remaining elements are in `args`. Switch on the type of `f`: * regular function (not one defined by `fn*`): apply/invoke it as @@ -1216,15 +1216,11 @@ Mal borrows most of its syntax and feature-set). Such forms are not affected by evaluation, so you may quote them as in the previous case if implementation is easyer. -* Optionally, add a the `quasiquoteexpand` special form. - This form calls the `quasiquote` function using the first `ast` - argument (second list element) and returns the result. - It has no other practical purpose than testing your implementation - of the `quasiquote` internal function. - * Add the `quasiquote` special form. - This form does the same than `quasiquoteexpand`, - but evaluates the result in the current environment before returning it, + + This form calls the `quasiquote` function using the first `ast` + argument (second list element), + then evaluates the result in the current environment, either by recursively calling `EVAL` with the result and `env`, or by assigning `ast` with the result and continuing execution at the top of the loop (TCO). @@ -1234,6 +1230,11 @@ Now go to the top level, run the step 7 tests: make "test^quux^step7" ``` +If some tests do not pass, it may be convenient to enable the debug +print statement at the top of your main `eval` function (inside the +TCO loop). The quasiquoted but yet unevaluated AST will often reveal +the source of the issue. + Quoting is one of the more mundane functions available in mal, but do not let that discourage you. Your mal implementation is almost complete, and quoting sets the stage for the next very exciting step: @@ -1313,35 +1314,28 @@ simple. `def!` form, but before the evaluated value (mal function) is set in the environment, the `is_macro` attribute should be set to true. -* Add a `is_macro_call` function: This function takes arguments `ast` - and `env`. It returns true if `ast` is a list that contains a symbol - as the first element and that symbol refers to a function in the - `env` environment and that function has the `is_macro` attribute set - to true. Otherwise, it returns false. - -* Add a `macroexpand` function: This function takes arguments `ast` - and `env`. It calls `is_macro_call` with `ast` and `env` and loops - while that condition is true. Inside the loop, the first element of - the `ast` list (a symbol), is looked up in the environment to get - the macro function. This macro function is then called/applied with - the rest of the `ast` elements (2nd through the last) as arguments. - The return value of the macro call becomes the new value of `ast`. - When the loop completes because `ast` no longer represents a macro - call, the current value of `ast` is returned. - -* In the evaluator (`EVAL`) before the special forms switch (apply - section), perform macro expansion by calling the `macroexpand` - function with the current value of `ast` and `env`. Set `ast` to the - result of that call. If the new value of `ast` is no longer a list - after macro expansion, then return the result of calling `eval_ast` - on it, otherwise continue with the rest of the apply section - (special forms switch). - -* Add a new special form condition for `macroexpand`. Call the - `macroexpand` function using the first `ast` argument (second list - element) and `env`. Return the result. This special form allows - a mal program to do explicit macro expansion without applying the - result (which can be useful for debugging macro expansion). +* In `EVAL`, + when `ast` is a non-empty list without leading special form, + the normal apply phase evaluates all elements of `ast`. + + Start by evaluating the first element separately. + The result must be a function. + If this function does have the `is_macro` attribute set, + + * apply the function to the (unevaluated) remaining elements of + `ast`, producing a new form. + + * evaluate the new form in the `env` environment. + Of course, instead of recursively calling `EVAL`, replace `ast` + with the new form and restart the TCO loop. + + For functions without the attribute, proceed as before: evaluate the + remaining elements of `ast`, then apply the function to them. + + +If you check existing implementations, be warned that former versions +of this guide were describing a slightly different macro expansion +mechanism. Now go to the top level, run the step 8 tests: ``` @@ -1352,14 +1346,14 @@ There is a reasonably good chance that the macro tests will not pass the first time. Although the implementation of macros is fairly simple, debugging runtime bugs with macros can be fairly tricky. If you do run into subtle problems that are difficult to solve, let me -recommend a couple of approaches: - -* Use the macroexpand special form to eliminate one of the layers of - indirection (to expand but skip evaluate). This will often reveal - the source of the issue. -* Add a debug print statement to the top of your main `eval` function - (inside the TCO loop) to print the current value of `ast` (hint use - `pr_str` to get easier to debug output). Pull up the step8 +recommend an approach: + +* Enable the debug print statement at the top of your main `eval` + function (inside the TCO loop). + The expanded but yet unevaluated AST will often reveal the source of + the issue. + +* Pull up the step8 implementation from another language and uncomment its `eval` function (yes, I give you permission to violate the rule this once). Run the two side-by-side. The first difference is likely to point to diff --git a/process/step2_eval.txt b/process/step2_eval.txt index 9cd2e08c32..5fed5d74ef 100644 --- a/process/step2_eval.txt +++ b/process/step2_eval.txt @@ -3,18 +3,15 @@ import types, reader, printer READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return lookup(env, ast) OR raise "'" + ast + "' not found" - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + ;; prn("EVAL: " ast) + match ast: + 'key: return lookup(env, key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + (callable arg1 ..): f = EVAL(callable, env) + return apply(f, [EVAL(arg1, env) ..]) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step3_env.txt b/process/step3_env.txt index 0210efccf8..2b9ceb6cb2 100644 --- a/process/step3_env.txt +++ b/process/step3_env.txt @@ -3,21 +3,21 @@ import types, reader, printer, env READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: let_env = ...; return EVAL(ast[2], let_env) - _default_: f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + return EVAL(form, env) + ('let* [k1 v1 ..] form): // idem + (callable arg1 ..): f = EVAL(callable, env) + return apply(f, [EVAL(arg1, env) ..]) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step4_if_fn_do.txt b/process/step4_if_fn_do.txt index f1a32d0f82..86a51fcb63 100644 --- a/process/step4_if_fn_do.txt +++ b/process/step4_if_fn_do.txt @@ -3,24 +3,29 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: let_env = ...; return EVAL(ast[2], let_env) - 'do: return eval_ast(rest(ast), env)[-1] - 'if: return EVAL(EVAL(ast[1], env) ? ast[2] : ast[3], env) - 'fn*: return (...a) -> EVAL(ast[2], new Env(env, ast[1], a)) - _default_: f, args = eval_ast(ast, env) - return apply(f, args) +EVAL(ast, env): + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + return EVAL(form, env) + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + return EVAL(last, env) + ('if cond yes no): if EVAL(cond, env) then: return EVAL(yes, env) else: return EVAL(no, env) + ('if cond yes): if EVAL(cond, env) then: return EVAL(yes, env) else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: return EVAL(f.impl, new Env(f.env, f.params, [EVAL(arg1, env) ..])) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step5_tco.txt b/process/step5_tco.txt index 0c81b5e2be..4e752cf3bc 100644 --- a/process/step5_tco.txt +++ b/process/step5_tco.txt @@ -3,26 +3,31 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step6_file.txt b/process/step6_file.txt index 43712c1bcb..3003b674ad 100644 --- a/process/step6_file.txt +++ b/process/step6_file.txt @@ -3,26 +3,31 @@ import types, reader, printer, env, core READ(str): return reader.read_str(str) -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step7_quote.txt b/process/step7_quote.txt index 6ccfb94dc1..774722920d 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -5,28 +5,33 @@ READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + (callable arg1 ..): f = EVAL(callable, env) + if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step8_macros.txt b/process/step8_macros.txt index 42a5dc560b..885202a885 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -5,37 +5,35 @@ READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f): ast = apply(f, [arg1 ..]) + else if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step9_try.txt b/process/step9_try.txt index a5988c43e7..c0c39ac6e6 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -5,38 +5,39 @@ READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + ('try* f ('catch* 'k h)): try returning EVAL(f, env) + if native or malval exception: env = new Env(env, [k], [exception]) + ast = h + ('try* f): ast = f + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f): ast = apply(f, [arg1 ..]) + else if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 1f3ac41203..9528005288 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -5,38 +5,39 @@ READ(str): return reader.read_str(str) quasiquote(ast): return ... // quasiquote -macro?(ast, env): return ... // true if macro call -macroexpand(ast, env): return ... // recursive macro expansion - -eval_ast(ast,env): - switch type(ast): - symbol: return env.get(ast) - list,vector: return ast.map((x) -> EVAL(x,env)) - hash: return ast.map((k,v) -> list(k, EVAL(v,env))) - _default_: return ast - -EVAL(ast,env): - while true: - if not list?(ast): return eval_ast(ast, env) - - ast = macroexpand(ast, env) - if not list?(ast): return eval_ast(ast, env) - if empty?(ast): return ast - - switch ast[0]: - 'def!: return env.set(ast[1], EVAL(ast[2], env)) - 'let*: env = ...; ast = ast[2] // TCO - 'quote: return ast[1] - 'quasiquote: ast = quasiquote(ast[1]) // TCO - 'defmacro!: return ... // like def!, but set macro property - 'macroexpand: return macroexpand(ast[1], env) - 'try*: return ... // try/catch native and malval exceptions - 'do: ast = eval_ast(ast[1..-1], env)[-1] // TCO - 'if: EVAL(ast[1], env) ? ast = ast[2] : ast = ast[3] // TCO - 'fn*: return new MalFunc(...) - _default_: f, args = eval_ast(ast, env) - if malfunc?(f): ast = f.fn; env = ... // TCO - else: return apply(f, args) +EVAL(ast, env): + loop: + ;; prn("EVAL: " ast) + match ast: + 'key: return env.get(key) + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + ('def! 'key value): return env.set(key, EVAL(value, env)) + ('let* (k1 v1 ..) form): env = new Env(env) + env.set(k1, EVAL(v1, env)) + .. + ast = form + ('let* [k1 v1 ..] form): // idem + ('do form1 .. last): EVAL(form1, env) + .. + ast = last + ('if cond yes no): if EVAL(cond, env) then: ast = yes else: ast = no + ('if cond yes): if EVAL(cond, env) then: ast = yes else: return nil + ('fn* ('key1 ..) impl): return new MalFunc(env, impl, params=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + ('defmacro! 'key value): return env.set(key, as_macro(EVAL(value, env))) + ('try* f ('catch* 'k h)): try returning EVAL(f, env) + if native or malval exception: env = new Env(env, [k], [exception]) + ast = h + ('try* f): ast = f + (callable arg1 ..): f = EVAL(callable, env) + if macro?(f): ast = apply(f, [arg1 ..]) + else if core?(f): return apply(f, [EVAL(arg1, env) ..]) + else: env = new Env(f.env, f.params, [EVAL(arg1, env) ..]) + ast = f.impl + otherwise: return ast PRINT(exp): return printer.pr_str(exp)