diff --git a/impls/ada.2/envs.adb b/impls/ada.2/envs.adb index 8638b92513..3383b9c0ab 100644 --- a/impls/ada.2/envs.adb +++ b/impls/ada.2/envs.adb @@ -53,6 +53,25 @@ package body Envs is return HM.Element (Position); end Get; + function Get_Or_Nil (Env : Instance; + Key : Types.String_Ptr) return Types.T is + Position : HM.Cursor := Env.Data.Find (Key); + Ref : Link; + begin + if not HM.Has_Element (Position) then + Ref := Env.Outer; + loop + if Ref = null then + return Types.Nil; + end if; + Position := Ref.all.Data.Find (Key); + exit when HM.Has_Element (Position); + Ref := Ref.all.Outer; + end loop; + end if; + return HM.Element (Position); + end Get_Or_Nil; + procedure Keep_References (Object : in out Instance) is begin for Position in Object.Data.Iterate loop diff --git a/impls/ada.2/envs.ads b/impls/ada.2/envs.ads index e6652dbcab..e9870e2eb0 100644 --- a/impls/ada.2/envs.ads +++ b/impls/ada.2/envs.ads @@ -27,6 +27,9 @@ package Envs is function Get (Env : in Instance; Key : in Types.String_Ptr) return Types.T; + function Get_Or_Nil (Env : Instance; + Key : Types.String_Ptr) return Types.T; + procedure Set (Env : in out Instance; Key : in Types.T; New_Item : in Types.T) with Inline; diff --git a/impls/ada.2/step2_eval.adb b/impls/ada.2/step2_eval.adb index 7eadeb6990..e5b69044d7 100644 --- a/impls/ada.2/step2_eval.adb +++ b/impls/ada.2/step2_eval.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Containers.Indefinite_Hashed_Maps; with Ada.Strings.Hash; with Ada.Text_IO.Unbounded_IO; @@ -14,7 +13,7 @@ with Types.Strings; procedure Step2_Eval is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Boolean := False; use type Types.T; use all type Types.Kind_Type; @@ -53,11 +52,9 @@ procedure Step2_Eval is First : Types.T; begin if Dbgeval then - Ada.Text_IO.New_Line; Ada.Text_IO.Put ("EVAL: "); Print (Ast); end if; - case Ast.Kind is when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key | Kind_Macro | Types.Kind_Function => diff --git a/impls/ada.2/step3_env.adb b/impls/ada.2/step3_env.adb index cee5987d7a..0346136dac 100644 --- a/impls/ada.2/step3_env.adb +++ b/impls/ada.2/step3_env.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Envs; @@ -13,7 +12,7 @@ with Types.Strings; procedure Step3_Env is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -45,8 +44,8 @@ procedure Step3_Env is is First : Types.T; begin - if Dbgeval then - Ada.Text_IO.New_Line; + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -209,6 +208,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step4_if_fn_do.adb b/impls/ada.2/step4_if_fn_do.adb index 687e1c2e27..fec8db9abb 100644 --- a/impls/ada.2/step4_if_fn_do.adb +++ b/impls/ada.2/step4_if_fn_do.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -15,7 +14,7 @@ with Types.Strings; procedure Step4_If_Fn_Do is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -47,8 +46,8 @@ procedure Step4_If_Fn_Do is is First : Types.T; begin - if Dbgeval then - Ada.Text_IO.New_Line; + <> + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -81,17 +80,13 @@ procedure Step4_If_Fn_Do is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - return Eval (Ast.Sequence.all.Data (3), Env); - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - return Eval (Ast.Sequence.all.Data (4), Env); - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + return Eval (Ast.Sequence.all.Data (3), Env); + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + return Eval (Ast.Sequence.all.Data (4), Env); + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -251,6 +246,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step5_tco.adb b/impls/ada.2/step5_tco.adb index b69dbe3853..18754079b8 100644 --- a/impls/ada.2/step5_tco.adb +++ b/impls/ada.2/step5_tco.adb @@ -1,4 +1,3 @@ -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -15,7 +14,7 @@ with Types.Strings; procedure Step5_Tco is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -56,8 +55,7 @@ procedure Step5_Tco is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -90,19 +88,15 @@ procedure Step5_Tco is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -284,6 +278,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step6_file.adb b/impls/ada.2/step6_file.adb index 18cc6a92e8..45cce5d679 100644 --- a/impls/ada.2/step6_file.adb +++ b/impls/ada.2/step6_file.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step6_File is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -60,8 +59,7 @@ procedure Step6_File is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -94,19 +92,15 @@ procedure Step6_File is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -310,6 +304,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step7_quote.adb b/impls/ada.2/step7_quote.adb index 94182fb1b7..dc134f13fc 100644 --- a/impls/ada.2/step7_quote.adb +++ b/impls/ada.2/step7_quote.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step7_Quote is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -62,8 +61,7 @@ procedure Step7_Quote is First : Types.T; begin <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -96,19 +94,15 @@ procedure Step7_Quote is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -167,9 +161,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)); @@ -379,6 +370,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step8_macros.adb b/impls/ada.2/step8_macros.adb index 1f7951b2d4..98c7e7022a 100644 --- a/impls/ada.2/step8_macros.adb +++ b/impls/ada.2/step8_macros.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step8_Macros is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -59,12 +58,10 @@ 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 <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -97,19 +94,15 @@ procedure Step8_Macros is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -183,14 +176,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 +202,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 +231,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; @@ -434,6 +401,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/step9_try.adb b/impls/ada.2/step9_try.adb index 333c7adf12..7ae8b4afcc 100644 --- a/impls/ada.2/step9_try.adb +++ b/impls/ada.2/step9_try.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -16,7 +15,7 @@ with Types.Strings; procedure Step9_Try is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -59,12 +58,10 @@ 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 <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -97,19 +94,15 @@ procedure Step9_Try is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -183,14 +176,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 +232,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 +261,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; @@ -464,6 +431,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/stepa_mal.adb b/impls/ada.2/stepa_mal.adb index 59a1ad7fd1..e790871c0f 100644 --- a/impls/ada.2/stepa_mal.adb +++ b/impls/ada.2/stepa_mal.adb @@ -1,5 +1,4 @@ with Ada.Command_Line; -with Ada.Environment_Variables; with Ada.Text_IO.Unbounded_IO; with Core; @@ -17,7 +16,7 @@ with Types.Strings; procedure StepA_Mal is - Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval"); + Dbgeval : constant Types.String_Ptr := Types.Strings.Alloc ("DEBUG-EVAL"); use type Types.T; use all type Types.Kind_Type; @@ -60,12 +59,10 @@ 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 <> - if Dbgeval then - Ada.Text_IO.New_Line; + if Types.To_Boolean (Env.all.Get_Or_Nil (Dbgeval)) then Ada.Text_IO.Put ("EVAL: "); Print (Ast); Envs.Dump_Stack (Env.all); @@ -98,19 +95,15 @@ procedure StepA_Mal is if First.Str.all = "if" then Err.Check (Ast.Sequence.all.Length in 3 .. 4, "expected 2 or 3 parameters"); - declare - Tst : constant Types.T := Eval (Ast.Sequence.all.Data (2), Env); - begin - if Tst /= Types.Nil and Tst /= (Kind_Boolean, False) then - Ast := Ast.Sequence.all.Data (3); - goto Restart; - elsif Ast.Sequence.all.Length = 3 then - return Types.Nil; - else - Ast := Ast.Sequence.all.Data (4); - goto Restart; - end if; - end; + if Types.To_Boolean (Eval (Ast.Sequence.all.Data (2), Env)) then + Ast := Ast.Sequence.all.Data (3); + goto Restart; + elsif Ast.Sequence.all.Length = 3 then + return Types.Nil; + else + Ast := Ast.Sequence.all.Data (4); + goto Restart; + end if; elsif First.Str.all = "let*" then Err.Check (Ast.Sequence.all.Length = 3 and then Ast.Sequence.all.Data (2).Kind in Types.Kind_Sequence, @@ -184,14 +177,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 +233,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 +267,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; @@ -472,6 +439,7 @@ begin -- Collect garbage. Err.Data := Types.Nil; Repl.all.Keep; + Dbgeval.Keep; Garbage_Collected.Clean; end loop; Ada.Text_IO.New_Line; diff --git a/impls/ada.2/types.adb b/impls/ada.2/types.adb index 6b0ebf0a53..1f6ddb9df9 100644 --- a/impls/ada.2/types.adb +++ b/impls/ada.2/types.adb @@ -55,4 +55,10 @@ package body Types is end case; end Keep; + function To_Boolean (Form : T) return Boolean is + (case Form.Kind is + when Kind_Nil => False, + when Kind_Boolean => Form.Ada_Boolean, + when others => True); + end Types; diff --git a/impls/ada.2/types.ads b/impls/ada.2/types.ads index 011288b6cd..4a26248d00 100644 --- a/impls/ada.2/types.ads +++ b/impls/ada.2/types.ads @@ -83,6 +83,8 @@ package Types is Nil : constant T := (Kind => Kind_Nil); + function To_Boolean (Form : T) return Boolean with Inline; + procedure Keep (Object : in T) with Inline; type T_Array is array (Positive range <>) of T; diff --git a/impls/ada/step2_eval.adb b/impls/ada/step2_eval.adb index 6f0e281d8a..d877a1afa3 100644 --- a/impls/ada/step2_eval.adb +++ b/impls/ada/step2_eval.adb @@ -82,6 +82,7 @@ procedure Step2_Eval is end if; end Get; + function Print (Param : Types.Mal_Handle) return String; Repl_Env : String_Mal_Hash.Map; @@ -99,9 +100,10 @@ procedure Step2_Eval is end Read; - function Eval_Ast - (Ast : Mal_Handle; Env : String_Mal_Hash.Map) - return Mal_Handle is + function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map) + return Mal_Handle is + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; function Call_Eval (A : Mal_Handle) return Mal_Handle is begin @@ -110,16 +112,20 @@ procedure Step2_Eval is begin - case Deref (Ast).Sym_Type is + if Debug then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + - when Sym => + case Deref (Param).Sym_Type is + when Sym => declare - Sym : Mal_String := Deref_Sym (Ast).Get_Sym; + 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 Ast; + return Param; else return Get (Env, Sym); end if; @@ -127,53 +133,42 @@ procedure Step2_Eval is when Not_Found => raise Not_Found with ("'" & Sym & "' not found"); end; + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => - when List => - - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); - - when others => return Ast; - - end case; - - end Eval_Ast; + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); + when List_List => - function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map) - return Mal_Handle is - First_Elem : Mal_Handle; - begin + Param_List := Deref_List (Param).all; - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; - declare - Evaled_H, First_Param : Mal_Handle; - Evaled_List : List_Mal_Type; - Param_List : List_Mal_Type; - begin - Param_List := Deref_List (Param).all; + -- The APPLY section. - -- Deal with empty list.. - if Param_List.Length = 0 then - return Param; - end if; + First_Param := Eval (First_Param, Env); + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); - Evaled_H := Eval_Ast (Param, Env); - Evaled_List := Deref_List (Evaled_H).all; - First_Param := Car (Evaled_List); - return Call_Func (Deref_Func (First_Param).all, Cdr (Evaled_List)); - end; + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + else + raise Mal_Exception; + 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/ada/step3_env.adb b/impls/ada/step3_env.adb index cca59b36f9..a7dd741f57 100644 --- a/impls/ada/step3_env.adb +++ b/impls/ada/step3_env.adb @@ -66,6 +66,7 @@ procedure Step3_Env is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -102,9 +103,31 @@ procedure Step3_Env is end Let_Processing; - function Eval_Ast - (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is + function Eval_As_Boolean (MH : Mal_Handle) return Boolean is + Res : Boolean; + begin + case Deref (MH).Sym_Type is + when Bool => + Res := Deref_Bool (MH).Get_Bool; + when Nil => + return False; +-- when List => +-- declare +-- L : List_Mal_Type; +-- begin +-- L := Deref_List (MH).all; +-- Res := not Is_Null (L); +-- end; + when others => -- Everything else + Res := True; + end case; + return Res; + end Eval_As_Boolean; + + + function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; function Call_Eval (A : Mal_Handle) return Mal_Handle is begin @@ -113,82 +136,81 @@ procedure Step3_Env is begin - case Deref (Ast).Sym_Type is + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; - when Sym => + case Deref (Param).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; + 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; - when List => + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => - return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all); + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); - when others => return Ast; + when List_List => - end case; + Param_List := Deref_List (Param).all; - end Eval_Ast; + -- Deal with empty list.. + if Param_List.Length = 0 then + return Param; + end if; + First_Param := Car (Param_List); + Rest_Params := Cdr (Param_List); + Rest_List := Deref_List (Rest_Params).all; - function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is - First_Elem : Mal_Handle; - begin + if Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "def!" then - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + return Def_Fn (Rest_List, Env); - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + elsif Deref (First_Param).Sym_Type = Sym and then + Deref_Sym (First_Param).Get_Sym = "let*" then - declare - Evaled_H, First_Param, Rest_List : Mal_Handle; - Param_List : List_Mal_Type; - begin - Param_List := Deref_List (Param).all; + return Let_Processing (Rest_List, Env); - -- Deal with empty list.. - if Param_List.Length = 0 then - return Param; - end if; + else - First_Param := Car (Param_List); - Rest_List := Cdr (Param_List); + -- The APPLY section. - if Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "def!" then - return Def_Fn (Deref_List (Rest_List).all, Env); - elsif Deref (First_Param).Sym_Type = Sym and then - Deref_Sym (First_Param).Get_Sym = "let*" then - return Let_Processing (Deref_List (Rest_List).all, Env); - else - -- The APPLY section. - Evaled_H := Eval_Ast (Param, Env); - Param_List := Deref_List (Evaled_H).all; - First_Param := Car (Param_List); - return Call_Func (Deref_Func (First_Param).all, Cdr (Param_List)); - end if; + First_Param := Eval (First_Param, Env); + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); - end; + if Deref (First_Param).Sym_Type = Func then + return Call_Func (Deref_Func (First_Param).all, Rest_Params); + else + raise Mal_Exception; + end if; - else -- Not a List_List + end if; - return Eval_Ast (Param, Env); + end case; + when others => -- not a list, map, symbol or vector - end if; + return Param; + + end case; end Eval; diff --git a/impls/ada/step4_if_fn_do.adb b/impls/ada/step4_if_fn_do.adb index d41e9bc084..9a929ba11b 100644 --- a/impls/ada/step4_if_fn_do.adb +++ b/impls/ada/step4_if_fn_do.adb @@ -17,6 +17,7 @@ procedure Step4_If_Fn_Do is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -92,9 +93,9 @@ procedure Step4_If_Fn_Do is end Eval_As_Boolean; - function Eval_Ast - (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is + function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is + First_Param, Rest_Params : Mal_Handle; + Rest_List, Param_List : List_Mal_Type; function Call_Eval (A : Mal_Handle) return Mal_Handle is begin @@ -103,46 +104,38 @@ procedure Step4_If_Fn_Do is 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; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + case Deref (Param).Sym_Type is + when Sym => + + 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; - function Eval (Param : Mal_Handle; Env : Envs.Env_Handle) return Mal_Handle is - First_Param, Rest_Params : Mal_Handle; - Rest_List, Param_List : List_Mal_Type; - begin + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List_List => Param_List := Deref_List (Param).all; @@ -211,34 +204,52 @@ procedure Step4_If_Fn_Do 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); + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); elsif Deref (First_Param).Sym_Type = Lambda then - return Apply (Deref_Lambda (First_Param).all, Rest_Params); - else + declare + + L : Lambda_Mal_Type; + E : Envs.Env_Handle; + Param_Names : List_Mal_Type; + Res : Mal_Handle; + + begin + + L := Deref_Lambda (First_Param).all; + + E := Envs.New_Env (L.Get_Env); + + Param_Names := Deref_List (L.Get_Params).all; + + if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then + + return Eval (L.Get_Expr, E); + + else + + raise Mal_Exception with "Bind failed in Apply"; + + end if; + + end; + + else -- neither a Lambda or a Func raise Mal_Exception; 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/ada/step5_tco.adb b/impls/ada/step5_tco.adb index 2234b21309..60394c2d25 100644 --- a/impls/ada/step5_tco.adb +++ b/impls/ada/step5_tco.adb @@ -17,6 +17,7 @@ procedure Step5_TCO is function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -61,52 +62,18 @@ procedure Step5_TCO 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 Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) return Mal_Handle is Param : Mal_Handle; 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; @@ -114,12 +81,38 @@ procedure Step5_TCO is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + + 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; @@ -227,16 +220,9 @@ procedure Step5_TCO 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); + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); @@ -251,6 +237,7 @@ procedure Step5_TCO is begin L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; @@ -274,15 +261,14 @@ procedure Step5_TCO is raise Mal_Exception; 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/ada/step6_file.adb b/impls/ada/step6_file.adb index a02969cc68..6ddba4f3a0 100644 --- a/impls/ada/step6_file.adb +++ b/impls/ada/step6_file.adb @@ -13,19 +13,18 @@ procedure Step6_File is use Types; - - function Read (Param : String) return Types.Mal_Handle is - begin - return Reader.Read_Str (Param); - end Read; - - -- Forward declaration of Eval. function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle) return Types.Mal_Handle; - Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). + + + function Read (Param : String) return Types.Mal_Handle is + begin + return Reader.Read_Str (Param); + end Read; function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle) @@ -64,9 +63,12 @@ procedure Step6_File is end Eval_As_Boolean; - function Eval_Ast - (Ast : Mal_Handle; Env : Envs.Env_Handle) - return Mal_Handle is + function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) + return Mal_Handle is + Param : Mal_Handle; + 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 @@ -75,54 +77,43 @@ procedure Step6_File is 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; + Param := AParam; + Env := AnEnv; - end Eval_Ast; + <> + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; - function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle) - return Mal_Handle is - Param : Mal_Handle; - Env : Envs.Env_Handle; - First_Param, Rest_Params : Mal_Handle; - Rest_List, Param_List : List_Mal_Type; - begin + case Deref (Param).Sym_Type is + when Sym => - Param := AParam; - Env := AnEnv; + 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; - <> + when List => + case Deref_List (Param).Get_List_Type is + when Hashed_List | Vector_List => - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all); - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List_List => Param_List := Deref_List (Param).all; @@ -230,16 +221,9 @@ procedure Step6_File 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); + Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List); if Deref (First_Param).Sym_Type = Func then return Call_Func (Deref_Func (First_Param).all, Rest_Params); @@ -254,6 +238,7 @@ procedure Step6_File is begin L := Deref_Lambda (First_Param).all; + E := Envs.New_Env (L.Get_Env); Param_Names := Deref_List (L.Get_Params).all; @@ -277,15 +262,14 @@ procedure Step6_File 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/ada/step7_quote.adb b/impls/ada/step7_quote.adb index 52babdae9f..c50adcc0b8 100644 --- a/impls/ada/step7_quote.adb +++ b/impls/ada/step7_quote.adb @@ -17,6 +17,7 @@ procedure Step7_Quote is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -61,45 +62,6 @@ procedure Step7_Quote 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 @@ -183,6 +145,12 @@ procedure Step7_Quote 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; @@ -190,12 +158,38 @@ procedure Step7_Quote is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; + + case Deref (Param).Sym_Type is + when Sym => + + 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; + + 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); - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List_List => Param_List := Deref_List (Param).all; @@ -305,11 +299,6 @@ procedure Step7_Quote 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 @@ -319,18 +308,11 @@ procedure Step7_Quote 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 @@ -343,6 +325,16 @@ procedure Step7_Quote 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; @@ -366,15 +358,14 @@ procedure Step7_Quote 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/ada/step8_macros.adb b/impls/ada/step8_macros.adb index 5c6a0a1199..972c92d2d2 100644 --- a/impls/ada/step8_macros.adb +++ b/impls/ada/step8_macros.adb @@ -17,6 +17,7 @@ procedure Step8_Macros is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -59,52 +60,6 @@ procedure Step8_Macros is 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 @@ -127,45 +82,6 @@ procedure Step8_Macros 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 @@ -249,6 +165,12 @@ procedure Step8_Macros 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; @@ -256,18 +178,38 @@ procedure Step8_Macros is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; - 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; @@ -286,9 +228,6 @@ procedure Step8_Macros 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 @@ -383,11 +322,6 @@ procedure Step8_Macros 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 @@ -397,18 +331,11 @@ procedure Step8_Macros 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 @@ -421,6 +348,16 @@ procedure Step8_Macros 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; @@ -444,15 +381,14 @@ procedure Step8_Macros 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/ada/step9_try.adb b/impls/ada/step9_try.adb index 2d52272ae5..de06d44e4e 100644 --- a/impls/ada/step9_try.adb +++ b/impls/ada/step9_try.adb @@ -17,6 +17,7 @@ procedure Step9_Try is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -59,52 +60,6 @@ procedure Step9_Try is 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 @@ -127,45 +82,6 @@ procedure Step9_Try 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 @@ -275,6 +191,12 @@ procedure Step9_Try 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; @@ -282,18 +204,38 @@ procedure Step9_Try is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; - 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; @@ -312,9 +254,6 @@ procedure Step9_Try 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 @@ -409,11 +348,6 @@ procedure Step9_Try 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 @@ -450,18 +384,11 @@ procedure Step9_Try 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 @@ -474,6 +401,16 @@ procedure Step9_Try 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; @@ -497,15 +434,14 @@ procedure Step9_Try 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/ada/stepa_mal.adb b/impls/ada/stepa_mal.adb index 1d0b71fd60..89bd1be916 100644 --- a/impls/ada/stepa_mal.adb +++ b/impls/ada/stepa_mal.adb @@ -17,6 +17,7 @@ procedure StepA_Mal is return Types.Mal_Handle; Debug : Boolean := False; + -- Debugging output (in addition to DEBUG-EVAL). function Read (Param : String) return Types.Mal_Handle is @@ -59,53 +60,6 @@ procedure StepA_Mal is 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 +82,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 +191,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; @@ -283,18 +204,38 @@ procedure StepA_Mal is <> - if Debug then - Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String); - end if; + begin + if Eval_As_Boolean (Envs.Get (Env, "DEBUG-EVAL")) then + Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String); + end if; + exception + when Envs.Not_Found => null; + end; - 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; + + 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); - if Deref (Param).Sym_Type = List and then - Deref_List (Param).Get_List_Type = List_List then + when List_List => Param_List := Deref_List (Param).all; @@ -313,9 +254,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 +348,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 +384,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 +401,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 +434,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/ada/types.adb b/impls/ada/types.adb index 29b8d2b181..0107a8dddb 100644 --- a/impls/ada/types.adb +++ b/impls/ada/types.adb @@ -141,40 +141,6 @@ package body Types is return To_Str (T, Print_Readably); end To_String; - function Is_Macro_Call (T : Mal_Type'Class; Env : Envs.Env_Handle) return Boolean is - L : List_Mal_Type; - First_Elem, Func : Mal_Handle; - begin - - if T.Sym_Type /= List then - return False; - end if; - - L := List_Mal_Type (T); - - if Is_Null (L) then - return False; - end if; - - First_Elem := Car (L); - - if Deref (First_Elem).Sym_Type /= Sym then - return False; - end if; - - Func := Envs.Get (Env, Deref_Sym (First_Elem).Get_Sym); - - if Deref (Func).Sym_Type /= Lambda then - return False; - end if; - - return Deref_Lambda (Func).Get_Is_Macro; - - exception - when Envs.Not_Found => return False; - end Is_Macro_Call; - - -- A helper function that just view converts the smart pointer. function Deref (S : Mal_Handle) return Mal_Ptr is begin @@ -1072,41 +1038,6 @@ package body Types is end Apply; - - function Get_Macro (T : Mal_Handle; Env : Envs.Env_Handle) return Lambda_Ptr is - L : List_Mal_Type; - First_Elem, Func : Mal_Handle; - begin - - if Deref (T).Sym_Type /= List then - return null; - end if; - - L := Deref_List (T).all; - - if Is_Null (L) then - return null; - end if; - - First_Elem := Car (L); - - if Deref (First_Elem).Sym_Type /= Sym then - return null; - end if; - - Func := Envs.Get (Env, Deref_Sym (First_Elem).Get_Sym); - - if Deref (Func).Sym_Type /= Lambda then - return null; - end if; - - return Deref_Lambda (Func); - - exception - when Envs.Not_Found => return null; - end Get_Macro; - - overriding function To_Str (T : Lambda_Mal_Type; Print_Readably : Boolean := True) return Mal_String is diff --git a/impls/ada/types.ads b/impls/ada/types.ads index 8329453bca..5084d28bcb 100644 --- a/impls/ada/types.ads +++ b/impls/ada/types.ads @@ -51,8 +51,6 @@ package Types is function To_String (T : Mal_Type'Class; Print_Readably : Boolean := True) return Mal_String; - function Is_Macro_Call (T : Mal_Type'Class; Env : Envs.Env_Handle) return Boolean; - type Mal_Ptr is access all Mal_Type'Class; -- A helper function that just view converts the smart pointer to @@ -297,8 +295,6 @@ package Types is type Lambda_Ptr is access all Lambda_Mal_Type; - function Get_Macro (T : Mal_Handle; Env : Envs.Env_Handle) return Lambda_Ptr; - function Deref_Lambda (SP : Mal_Handle) return Lambda_Ptr; generic diff --git a/impls/awk/step2_eval.awk b/impls/awk/step2_eval.awk index 145a7cf44c..8b56497d46 100644 --- a/impls/awk/step2_eval.awk +++ b/impls/awk/step2_eval.awk @@ -8,18 +8,20 @@ function READ(str) } 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 /^'/: - if (ast in env) { - return types_addref(env[ast]) - } - return "!\"'" substr(ast, 2) "' not found" - 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 @@ -30,7 +32,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]) { @@ -44,29 +49,48 @@ function eval_ast(ast, env, i, idx, len, new_idx, ret) } } return "{" new_idx - default: - return ast - } } function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { - if (ast !~ /^\(/) { + # print "EVAL: " printer_pr_str(ast, 1) + + switch (ast) { + case /^'/: # symbol + if (ast in env) { + ret = types_addref(env[ast]) + } else { + ret = "!\"'" substr(ast, 2) "' not found" + } + types_release(ast) + return ret + case /^\[/: # vector ret = eval_ast(ast, env) types_release(ast) return ret + case /^\{/: # map + ret = eval_map(ast, env) + types_release(ast) + return ret + case /^[^(]/: # not a list + types_release(ast) + return ast } idx = substr(ast, 2) if (types_heap[idx]["len"] == 0) { return ast } + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + return f + } new_ast = eval_ast(ast, env) types_release(ast) if (new_ast ~ /^!/) { return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] if (f ~ /^&/) { f_idx = substr(f, 2) ret = @f_idx(idx) diff --git a/impls/awk/step3_env.awk b/impls/awk/step3_env.awk index 203ef50a45..8c771e5513 100644 --- a/impls/awk/step3_env.awk +++ b/impls/awk/step3_env.awk @@ -9,19 +9,20 @@ function READ(str) } 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 @@ -32,7 +33,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]) { @@ -46,9 +50,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) @@ -125,11 +126,39 @@ function EVAL_let(ast, env, idx, params, params_idx, params_len, new_env, i, function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) - if (ast !~ /^\(/) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + 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) if (types_heap[idx]["len"] == 0) { @@ -142,6 +171,12 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) case "'let*": return EVAL_let(ast, env) default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) @@ -149,13 +184,13 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] - if (f ~ /^&/) { - f_idx = substr(f, 2) + f_idx = substr(f, 2) + switch (f) { + case /^&/: ret = @f_idx(idx) types_release(new_ast) return ret - } else { + default: types_release(new_ast) return "!\"First element of list must be function, supplied " types_typename(f) "." } diff --git a/impls/awk/step4_if_fn_do.awk b/impls/awk/step4_if_fn_do.awk index f05112a415..c7a7808546 100644 --- a/impls/awk/step4_if_fn_do.awk +++ b/impls/awk/step4_if_fn_do.awk @@ -10,19 +10,20 @@ function READ(str) } 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 @@ -33,7 +34,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]) { @@ -47,9 +51,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) @@ -225,11 +226,39 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx function EVAL(ast, env, new_ast, ret, idx, f, f_idx) { env_addref(env) - if (ast !~ /^\(/) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + 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) if (types_heap[idx]["len"] == 0) { @@ -248,6 +277,12 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) case "'fn*": return EVAL_fn(ast, env) default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) @@ -255,7 +290,6 @@ function EVAL(ast, env, new_ast, ret, idx, f, f_idx) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: diff --git a/impls/awk/step5_tco.awk b/impls/awk/step5_tco.awk index 43810458bc..482d593d29 100644 --- a/impls/awk/step5_tco.awk +++ b/impls/awk/step5_tco.awk @@ -10,19 +10,20 @@ function READ(str) } 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 @@ -33,7 +34,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]) { @@ -47,9 +51,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) @@ -214,15 +215,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + 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"] @@ -256,6 +285,12 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) case "'fn*": return EVAL_fn(ast, env) default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) @@ -263,7 +298,6 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -273,6 +307,7 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -281,7 +316,9 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) 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/awk/step6_file.awk b/impls/awk/step6_file.awk index 369bd0557b..e42483df4e 100644 --- a/impls/awk/step6_file.awk +++ b/impls/awk/step6_file.awk @@ -10,19 +10,20 @@ function READ(str) } 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 @@ -33,7 +34,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]) { @@ -47,9 +51,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) @@ -214,15 +215,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + 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"] @@ -256,6 +285,12 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) case "'fn*": return EVAL_fn(ast, env) default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) @@ -263,7 +298,6 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -273,6 +307,7 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -281,7 +316,9 @@ function EVAL(ast, env, new_ast, ret, idx, len, f, f_idx, ret_env) 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/awk/step7_quote.awk b/impls/awk/step7_quote.awk index c089c03fa1..e112e99889 100644 --- a/impls/awk/step7_quote.awk +++ b/impls/awk/step7_quote.awk @@ -89,19 +89,20 @@ function quasiquote(ast, new_idx, ret, ast_idx, elt_i, elt, previous) } 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 @@ -112,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]) { @@ -126,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) @@ -293,15 +294,43 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + switch (ast) { + case /^'/: # symbol + ret = env_get(env, ast) + if (ret !~ /^!/) { + types_addref(ret) + } + types_release(ast) + env_release(env) + return ret + 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"] @@ -329,15 +358,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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) @@ -368,6 +388,12 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) case "'fn*": return EVAL_fn(ast, env) default: + f = EVAL(types_addref(types_heap[idx][0]), env) + if (f ~ /^!/) { + types_release(ast) + env_release(env) + return f + } new_ast = eval_ast(ast, env) types_release(ast) env_release(env) @@ -375,7 +401,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) return new_ast } idx = substr(new_ast, 2) - f = types_heap[idx][0] f_idx = substr(f, 2) switch (f) { case /^\$/: @@ -385,6 +410,7 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) return env } types_addref(ast = types_heap[f_idx]["body"]) + types_release(f) types_release(new_ast) continue case /^&/: @@ -393,7 +419,9 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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/awk/step8_macros.awk b/impls/awk/step8_macros.awk index ca20cc123b..289cd68180 100644 --- a/impls/awk/step8_macros.awk +++ b/impls/awk/step8_macros.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) @@ -368,33 +337,50 @@ function EVAL_fn(ast, env, idx, params, params_idx, params_len, i, sym, f_idx return "$" f_idx } -function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) +function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_body, ret_env) { env_addref(env) for (;;) { - if (ast !~ /^\(/) { - ret = eval_ast(ast, env) + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + 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) @@ -415,15 +401,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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) @@ -440,17 +417,6 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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 "'do": ast = EVAL_do(ast, env) if (ast ~ /^!/) { @@ -467,32 +433,61 @@ function EVAL(ast, env, body, new_ast, ret, idx, len, f, f_idx, ret_env) 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 /^&/: + 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/awk/step9_try.awk b/impls/awk/step9_try.awk index d0c4a16d2b..336bbafb41 100644 --- a/impls/awk/step9_try.awk +++ b/impls/awk/step9_try.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,46 @@ 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) + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + 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 +455,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 +471,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,32 +495,61 @@ 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 /^&/: + 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/awk/stepA_mal.awk b/impls/awk/stepA_mal.awk index 045d483a98..40ee32b677 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,46 @@ 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) + + switch (env_get(env, "'DEBUG-EVAL")) { + case /^!/: + case "#nil": + case "#false": + break + default: + print "EVAL: " printer_pr_str(ast, 1) + } + + 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 +455,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 +471,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 +495,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/step2_eval.sh b/impls/bash/step2_eval.sh index 15083b937e..181dc1e9b3 100755 --- a/impls/bash/step2_eval.sh +++ b/impls/bash/step2_eval.sh @@ -10,7 +10,7 @@ READ () { } # eval -EVAL_AST () { +EVAL () { local ast="${1}" env="${2}" #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" _obj_type "${ast}"; local ot="${r}" @@ -18,11 +18,13 @@ EVAL_AST () { symbol) local val="${ANON["${ast}"]}" eval r="\${${env}["${val}"]}" - [ "${r}" ] || _error "'${val}' not found" ;; + [ "${r}" ] || _error "'${val}' not found" + 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}" @@ -32,32 +34,30 @@ 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}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return - EVAL_AST "${ast}" "${env}" + _nth "${ast}" 0; local a0="${r}" + EVAL "${a0}" "${env}" [[ "${__ERROR}" ]] && return 1 - local el="${r}" - _first "${el}"; local f="${r}" - _rest "${el}"; local args="${ANON["${r}"]}" - #echo "invoke: ${f} ${args}" + local f="${r}" + + _rest "${ast}" + # Should cause no error as ast is not empty. + local args="${r}" + + _map_with_type _list EVAL "${args}" "${env}" + [[ "${__ERROR}" ]] && r= && return 1 + args="${ANON["${r}"]}" + + # echo "invoke: ${f} ${args}" eval ${f} ${args} } diff --git a/impls/bash/step3_env.sh b/impls/bash/step3_env.sh index 2200c8362c..29d7bbcc6e 100755 --- a/impls/bash/step3_env.sh +++ b/impls/bash/step3_env.sh @@ -11,18 +11,28 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _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}" @@ -32,22 +42,12 @@ 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}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return @@ -71,11 +71,18 @@ EVAL () { done EVAL "${a2}" "${let_env}" 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}" + + _map_with_type _list EVAL "${args}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 - local el="${r}" - _first "${el}"; local f="${r}" - _rest "${el}"; local args="${ANON["${r}"]}" + args="${ANON["${r}"]}" + #echo "invoke: ${f} ${args}" eval ${f} ${args} return ;; diff --git a/impls/bash/step4_if_fn_do.sh b/impls/bash/step4_if_fn_do.sh index e701e9fb25..999269fa60 100755 --- a/impls/bash/step4_if_fn_do.sh +++ b/impls/bash/step4_if_fn_do.sh @@ -12,18 +12,28 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _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}" @@ -33,22 +43,12 @@ 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}" - r= - [[ "${__ERROR}" ]] && return 1 - #_pr_str "${ast}"; echo "EVAL '${r} / ${env}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return @@ -73,7 +73,7 @@ EVAL () { EVAL "${a2}" "${let_env}" return ;; do) _rest "${ast}" - EVAL_AST "${r}" "${env}" + _map_with_type _list EVAL "${r}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 _last "${r}" return ;; @@ -95,11 +95,20 @@ EVAL () { fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ EVAL \"${a2}\" \"\${r}\"" 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}" + + 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}" eval ${f} ${args} return ;; diff --git a/impls/bash/step5_tco.sh b/impls/bash/step5_tco.sh index e7eda09a7b..e22b171484 100755 --- a/impls/bash/step5_tco.sh +++ b/impls/bash/step5_tco.sh @@ -12,18 +12,30 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _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}" @@ -33,23 +45,12 @@ 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}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return @@ -77,7 +78,7 @@ EVAL () { ;; 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}" @@ -104,11 +105,20 @@ 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}" + + 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/bash/step6_file.sh b/impls/bash/step6_file.sh index 4d430883e8..cbbfcfab74 100755 --- a/impls/bash/step6_file.sh +++ b/impls/bash/step6_file.sh @@ -12,18 +12,30 @@ READ () { } # eval -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _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}" @@ -33,23 +45,12 @@ 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}'" - _obj_type "${ast}"; local ot="${r}" - if [[ "${ot}" != "list" ]]; then - EVAL_AST "${ast}" "${env}" - return - fi # apply list _empty? "${ast}" && r="${ast}" && return @@ -77,7 +78,7 @@ EVAL () { ;; 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}" @@ -104,11 +105,20 @@ 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}" + + 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/bash/step7_quote.sh b/impls/bash/step7_quote.sh index f6076fc85a..782f3e3642 100755 --- a/impls/bash/step7_quote.sh +++ b/impls/bash/step7_quote.sh @@ -55,18 +55,30 @@ qqIter () { fi } -EVAL_AST () { +_symbol DEBUG-EVAL; debug_eval="$r" + +EVAL () { local ast="${1}" env="${2}" - #_pr_str "${ast}"; echo "EVAL_AST '${ast}:${r} / ${env}'" + while true; do + r= + + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi + _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}" @@ -76,22 +88,12 @@ 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 _empty? "${ast}" && r="${ast}" && return @@ -120,9 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -130,7 +129,7 @@ EVAL () { ;; 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}" @@ -157,11 +156,20 @@ 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}" + + 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/bash/step8_macros.sh b/impls/bash/step8_macros.sh index 2a632c89b7..64710610e2 100755 --- a/impls/bash/step8_macros.sh +++ b/impls/bash/step8_macros.sh @@ -55,45 +55,30 @@ 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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -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= + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi -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 +88,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 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,12 +136,9 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - 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}" @@ -202,11 +165,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/bash/step9_try.sh b/impls/bash/step9_try.sh index 7b824e847c..bc6336ac34 100755 --- a/impls/bash/step9_try.sh +++ b/impls/bash/step9_try.sh @@ -55,45 +55,30 @@ 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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -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= + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi -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 +88,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 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,9 +136,6 @@ EVAL () { ANON["${r}_ismacro_"]="yes" ENV_SET "${env}" "${a1}" "${r}" return ;; - macroexpand) - MACROEXPAND "${a1}" "${env}" - return ;; try__STAR__) EVAL "${a1}" "${env}" [[ -z "${__ERROR}" ]] && return _nth "${a2}" 0; local a20="${r}" @@ -188,7 +151,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}" @@ -215,11 +178,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/bash/stepA_mal.sh b/impls/bash/stepA_mal.sh index df1543cfa5..f65b4b1db2 100755 --- a/impls/bash/stepA_mal.sh +++ b/impls/bash/stepA_mal.sh @@ -55,45 +55,30 @@ 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 -} +_symbol DEBUG-EVAL; debug_eval="$r" -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= + ENV_GET "$env" "$debug_eval" + if [ -n "$__ERROR" ]; then + __ERROR= + elif [ "$r" != "$__false" -a "$r" != "$__nil" ]; then + _pr_str "$ast" yes; echo "EVAL: $r / $env" + fi -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 +88,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 +122,6 @@ EVAL () { quote) r="${a1}" return ;; - quasiquoteexpand) - QUASIQUOTE "${a1}" - return ;; quasiquote) QUASIQUOTE "${a1}" ast="${r}" @@ -170,9 +136,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 +161,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 +188,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/env.c b/impls/c.2/env.c index 458de15215..f681079408 100644 --- a/impls/c.2/env.c +++ b/impls/c.2/env.c @@ -15,7 +15,7 @@ Env* env_make(Env* outer, list symbol_list, list exprs_list, MalType* more_symbo while (symbol_list) { - env = env_set(env, symbol_list->data, exprs_list->data); + env_set(env, ((MalType*)symbol_list->data)->value.mal_symbol, exprs_list->data); symbol_list = symbol_list->next; exprs_list = exprs_list->next; @@ -23,45 +23,28 @@ Env* env_make(Env* outer, list symbol_list, list exprs_list, MalType* more_symbo /* set the 'more' symbol if there is one */ if (more_symbol) { - env = env_set(env, more_symbol, make_list(exprs_list)); + env_set(env, more_symbol->value.mal_symbol, make_list(exprs_list)); } return env; } -Env* env_set(Env* current, MalType* symbol, MalType* value) { +void env_set(Env* current, char* symbol, MalType* value) { + + current->data = hashmap_put(current->data, symbol, value); - current->data = hashmap_put(current->data, symbol->value.mal_symbol, value); - return current; } -Env* env_find(Env* current, MalType* symbol) { +MalType* env_get(Env* current, char* symbol) { - MalType* val = hashmap_get(current->data, symbol->value.mal_symbol); + MalType* val = hashmap_get(current->data, symbol); if (val) { - return current; + return val; } else if (current->outer) { - return env_find(current->outer, symbol); + return env_get(current->outer, symbol); } else { return NULL; /* not found */ } } - -MalType* env_get(Env* current, MalType* symbol) { - - Env* env = env_find(current, symbol); - - if (env) { - return hashmap_get(env->data, symbol->value.mal_symbol); - } - else { - return make_error_fmt("'%s' not found", symbol->value.mal_symbol); - } -} - -Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list)) { - - return env_set(current, make_symbol(symbol_name), make_function(fn)); -} diff --git a/impls/c.2/env.h b/impls/c.2/env.h index 825249dc94..3957c1f893 100644 --- a/impls/c.2/env.h +++ b/impls/c.2/env.h @@ -15,9 +15,7 @@ struct Env_s { }; Env* env_make(Env* outer, list binds, list exprs, MalType* variadic_symbol); -Env* env_set(Env* current, MalType* symbol, MalType* value); -Env* env_set_C_fn(Env* current, char* symbol_name, MalType*(*fn)(list)); -MalType* env_get(Env* current, MalType* symbol); -Env* env_find(Env* current, MalType* symbol); +void env_set(Env* current, char* symbol, MalType* value); +MalType* env_get(Env* current, char* symbol); #endif diff --git a/impls/c.2/step2_eval.c b/impls/c.2/step2_eval.c index 0b0d6424d9..0fdd2369f3 100644 --- a/impls/c.2/step2_eval.c +++ b/impls/c.2/step2_eval.c @@ -21,30 +21,60 @@ 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); + void PRINT(MalType* val); + + /* printf("EVAL: "); */ + /* PRINT(ast); */ + + 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("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + return make_vector(result); + } - /* NULL */ - if (!ast) { return make_nil(); } + if (is_hashmap(ast)) { + list result = evaluate_hashmap(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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 +142,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..0263cbc3f0 100644 --- a/impls/c.2/step3_env.c +++ b/impls/c.2/step3_env.c @@ -24,21 +24,53 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env* env); MalType* eval_letstar(MalType* ast, Env* env); - /* NULL */ - if (!ast) { return make_nil(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + printf("EVAL: "); + PRINT(ast); + } + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +84,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; - 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.", \ @@ -92,10 +126,10 @@ int main(int argc, char** argv) { puts("Press Ctrl+d to exit\n"); Env* repl_env = env_make(NULL, NULL, NULL, NULL); - repl_env = env_set_C_fn(repl_env, "+", mal_add); - repl_env = env_set_C_fn(repl_env, "-", mal_sub); - repl_env = env_set_C_fn(repl_env, "*", mal_mul); - repl_env = env_set_C_fn(repl_env, "/", mal_div); + env_set(repl_env, "+", make_function(mal_add)); + env_set(repl_env, "-", make_function(mal_sub)); + env_set(repl_env, "*", make_function(mal_mul)); + env_set(repl_env, "/", make_function(mal_div)); while (1) { @@ -122,58 +156,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; @@ -185,7 +167,7 @@ MalType* eval_defbang(MalType* ast, Env* env) { MalType* result = EVAL(defbang_value, env); if (!is_error(result)) { - env_set(env, defbang_symbol, result); + env_set(env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -206,7 +188,7 @@ MalType* eval_letstar(MalType* ast, Env* env) { MalType* symbol = letstar_bindings_list->data; MalType* value = letstar_bindings_list->next->data; - letstar_env = env_set(letstar_env, symbol, EVAL(value, letstar_env)); + env_set(letstar_env, symbol->value.mal_symbol, EVAL(value, letstar_env)); letstar_bindings_list = letstar_bindings_list->next->next; /* pop symbol and value*/ } diff --git a/impls/c.2/step4_if_fn_do.c b/impls/c.2/step4_if_fn_do.c index 93cdf63e25..7aab169abe 100644 --- a/impls/c.2/step4_if_fn_do.c +++ b/impls/c.2/step4_if_fn_do.c @@ -28,24 +28,56 @@ 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); + void PRINT(MalType* val); 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + printf("EVAL: "); + PRINT(ast); + } + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +100,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; - 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)) { @@ -85,7 +119,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 +129,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); } } @@ -129,9 +163,9 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; @@ -166,58 +200,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; @@ -236,7 +218,7 @@ MalType* eval_defbang(MalType* ast, Env* env) { MalType* result = EVAL(defbang_value, env); if (!is_error(result)){ - env = env_set(env, defbang_symbol, result); + env_set(env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -272,7 +254,7 @@ MalType* eval_letstar(MalType* ast, Env* env) { /* early return from error */ if (is_error(value)) { return value; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } return EVAL(forms, letstar_env); diff --git a/impls/c.2/step5_tco.c b/impls/c.2/step5_tco.c index 78fbf40535..b76d30e5c0 100644 --- a/impls/c.2/step5_tco.c +++ b/impls/c.2/step5_tco.c @@ -28,7 +28,10 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,17 +41,46 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + printf("EVAL: "); + PRINT(ast); + } + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +118,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 +137,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 +148,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; } @@ -149,9 +185,9 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; @@ -186,58 +222,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; @@ -256,7 +240,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -298,7 +282,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step6_file.c b/impls/c.2/step6_file.c index 4e73fb78b2..ef9331d4d4 100644 --- a/impls/c.2/step6_file.c +++ b/impls/c.2/step6_file.c @@ -28,7 +28,11 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -38,17 +42,46 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + printf("EVAL: "); + PRINT(ast); + } + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +119,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; - 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)) { @@ -103,7 +138,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 +149,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 +182,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); @@ -157,15 +193,15 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -177,7 +213,7 @@ int main(int argc, char** argv) { for (int i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -218,58 +254,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; @@ -288,7 +272,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -330,7 +314,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step7_quote.c b/impls/c.2/step7_quote.c index 27cbd53721..1174ee609e 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,11 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -41,22 +44,50 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + printf("EVAL: "); + PRINT(ast); + } + + if (is_symbol(ast)) { + MalType* symbol_value = env_get(env, ast->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +133,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 +154,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 +165,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 +198,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); @@ -181,15 +209,15 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -201,7 +229,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -242,58 +270,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; @@ -312,7 +288,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -354,7 +330,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } diff --git a/impls/c.2/step8_macros.c b/impls/c.2/step8_macros.c index 06c8097f91..5ee0e1e1fa 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,11 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -43,29 +45,51 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + 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->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +135,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; } - if (is_error(evaluated_list)) { return evaluated_list; } + lst = lst->next; + + 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 +164,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 +175,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 +208,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); @@ -196,15 +219,15 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -216,7 +239,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -257,58 +280,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; @@ -327,7 +298,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -369,7 +340,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -668,51 +639,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } 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 +797,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..faf60f7d65 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,11 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -45,30 +47,52 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + 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->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +138,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 +151,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 +175,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 +186,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; } @@ -207,15 +230,15 @@ int main(int argc, char** argv) { while (mappings) { char* symbol = mappings->data; - MalType*(*function)(list) = (MalType*(*)(list))mappings->next->data; + MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); + env_set(repl_env, "eval", make_function(mal_eval)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -227,7 +250,7 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); /* run in script mode if a filename is given */ if (argc > 1) { @@ -268,58 +291,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; @@ -338,7 +309,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -380,7 +351,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -679,51 +650,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } 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; @@ -773,11 +704,10 @@ void eval_try(MalType** ast, Env** env) { } /* bind the symbol to the exception */ - list symbol_list = list_make(catch_list->next->data); - list expr_list = list_make(try_result->value.mal_error); - - /* TODO: validate symbols and exprs match before calling env_make */ - Env* catch_env = env_make(*env, symbol_list, expr_list, NULL); + Env* catch_env = env_make(*env, NULL, NULL, NULL); + env_set(catch_env, + ((MalType*)catch_list->next->data)->value.mal_symbol, + try_result->value.mal_error); *ast = catch_list->next->next->data; *env = catch_env; @@ -937,32 +867,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..5da9ee9726 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,11 @@ 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); + void PRINT(MalType* val); MalType* eval_defbang(MalType* ast, Env** env); void eval_letstar(MalType** ast, Env** env); void eval_if(MalType** ast, Env** env); @@ -46,30 +48,52 @@ 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(); } + MalType* dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval)) { + 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->value.mal_symbol); + if (symbol_value) + return symbol_value; + else + return make_error_fmt("'%s' not found", ast->value.mal_symbol); + } + + if (is_vector(ast)) { + list result = evaluate_vector(ast->value.mal_list, env); + if (result && is_error(result->data)) + return result->data; + else + 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; + else + 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 +139,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 +152,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 +176,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 +187,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; } @@ -233,14 +256,14 @@ int main(int argc, char** argv) { char* symbol = mappings->data; MalType*(*function)(list) = mappings->next->data; - env_set_C_fn(repl_env, symbol, function); + env_set(repl_env, symbol, make_function(function)); /* pop symbol and function from hashmap/list */ mappings = mappings->next->next; } - env_set_C_fn(repl_env, "eval", mal_eval); - env_set_C_fn(repl_env, "readline", mal_readline); + env_set(repl_env, "eval", make_function(mal_eval)); + env_set(repl_env, "readline", make_function(mal_readline)); /* add functions written in mal - not using rep as it prints the result */ EVAL(READ("(def! not (fn* (a) (if a false true)))"), repl_env); @@ -252,8 +275,8 @@ int main(int argc, char** argv) { for (long i = 2; i < argc; i++) { lst = list_push(lst, make_string(argv[i])); } - env_set(repl_env, make_symbol("*ARGV*"), make_list(list_reverse(lst))); - env_set(repl_env, make_symbol("*host-language*"), make_string("c.2")); + env_set(repl_env, "*ARGV*", make_list(list_reverse(lst))); + env_set(repl_env, "*host-language*", make_string("c.2")); /* run in script mode if a filename is given */ if (argc > 1) { @@ -293,58 +316,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; @@ -363,7 +334,7 @@ MalType* eval_defbang(MalType* ast, Env** env) { MalType* result = EVAL(defbang_value, *env); if (!is_error(result)){ - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } return result; } @@ -405,7 +376,7 @@ void eval_letstar(MalType** ast, Env** env) { return; } - env_set(letstar_env, symbol, value); + env_set(letstar_env, symbol->value.mal_symbol, value); bindings_list = bindings_list->next->next; } @@ -704,51 +675,11 @@ MalType* eval_defmacrobang(MalType* ast, Env** env) { if (!is_error(result)) { result = copy_type(result); result->is_macro = 1; - *env = env_set(*env, defbang_symbol, result); + env_set(*env, defbang_symbol->value.mal_symbol, result); } 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; @@ -798,10 +729,10 @@ void eval_try(MalType** ast, Env** env) { } /* bind the symbol to the exception */ - list symbol_list = list_make(catch_list->next->data); - list expr_list = list_make(try_result->value.mal_error); - - Env* catch_env = env_make(*env, symbol_list, expr_list, NULL); + Env* catch_env = env_make(*env, NULL, NULL, NULL); + env_set(catch_env, + ((MalType*)catch_list->next->data)->value.mal_symbol, + try_result->value.mal_error); *ast = catch_list->next->next->data; *env = catch_env; @@ -961,32 +892,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/env.c b/impls/c/env.c index c3128f97af..b0204280aa 100644 --- a/impls/c/env.c +++ b/impls/c/env.c @@ -20,10 +20,11 @@ Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { if (i > exprs_len) { break; } if (_nth(binds, i)->val.string[0] == '&') { varargs = 1; - env_set(e, _nth(binds, i+1), _slice(exprs, i, _count(exprs))); + env_set(e, _nth(binds, i+1)->val.string, + _slice(exprs, i, _count(exprs))); break; } else { - env_set(e, _nth(binds, i), _nth(exprs, i)); + env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); } } assert(varargs || (binds_len == exprs_len), @@ -34,24 +35,17 @@ Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { return e; } -Env *env_find(Env *env, MalVal *key) { - void *val = g_hash_table_lookup(env->table, key->val.string); +MalVal *env_get(Env *env, const char *key) { + MalVal *val = g_hash_table_lookup(env->table, key); if (val) { - return env; + return val; } else if (env->outer) { - return env_find(env->outer, key); + return env_get(env->outer, key); } else { return NULL; } } -MalVal *env_get(Env *env, MalVal *key) { - Env *e = env_find(env, key); - assert(e, "'%s' not found", key->val.string); - return g_hash_table_lookup(e->table, key->val.string); -} - -Env *env_set(Env *env, MalVal *key, MalVal *val) { - g_hash_table_insert(env->table, key->val.string, val); - return env; +void env_set(Env *env, char *key, MalVal *val) { + g_hash_table_insert(env->table, key, val); } 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..30c63336fd 100644 --- a/impls/c/step3_env.c +++ b/impls/c/step3_env.c @@ -29,12 +29,22 @@ 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; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + 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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +69,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)); @@ -81,7 +82,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if (strcmp("let*", a0->val.string) == 0) { //g_print("eval apply let*\n"); @@ -97,12 +98,12 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_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)); @@ -142,10 +143,10 @@ WRAP_INTEGER_OP(divide,/) void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); - env_set(repl_env, malval_new_symbol("+"), (MalVal *)int_plus); - env_set(repl_env, malval_new_symbol("-"), (MalVal *)int_minus); - env_set(repl_env, malval_new_symbol("*"), (MalVal *)int_multiply); - env_set(repl_env, malval_new_symbol("/"), (MalVal *)int_divide); + env_set(repl_env, "+", (MalVal *)int_plus); + env_set(repl_env, "-", (MalVal *)int_minus); + env_set(repl_env, "*", (MalVal *)int_multiply); + env_set(repl_env, "/", (MalVal *)int_divide); } int main() diff --git a/impls/c/step4_if_fn_do.c b/impls/c/step4_if_fn_do.c index c6628c16c2..6413a4e43d 100644 --- a/impls/c/step4_if_fn_do.c +++ b/impls/c/step4_if_fn_do.c @@ -30,12 +30,22 @@ 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; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + 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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +70,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)); @@ -82,7 +83,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -99,13 +100,13 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } return EVAL(a2, let_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 +137,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); @@ -177,8 +178,7 @@ void init_repl_env() { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } diff --git a/impls/c/step5_tco.c b/impls/c/step5_tco.c index 917e3e3807..26e9beb592 100644 --- a/impls/c/step5_tco.c +++ b/impls/c/step5_tco.c @@ -30,12 +30,24 @@ 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; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + 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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +72,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)); @@ -84,7 +85,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -101,7 +102,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -109,7 +110,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 +142,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); @@ -190,8 +191,7 @@ void init_repl_env() { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } diff --git a/impls/c/step6_file.c b/impls/c/step6_file.c index e7388c878b..7126ce525b 100644 --- a/impls/c/step6_file.c +++ b/impls/c/step6_file.c @@ -30,12 +30,24 @@ 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; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + 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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +72,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)); @@ -84,7 +85,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -101,7 +102,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -109,7 +110,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 +142,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); @@ -192,12 +193,10 @@ void init_repl_env(int argc, char *argv[]) { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -205,7 +204,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step7_quote.c b/impls/c/step7_quote.c index a42f978041..71dfc608c1 100644 --- a/impls/c/step7_quote.c +++ b/impls/c/step7_quote.c @@ -68,12 +68,24 @@ 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; + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + 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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +110,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)); @@ -122,7 +123,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -139,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -148,9 +149,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 +158,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 +190,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); @@ -243,12 +241,10 @@ void init_repl_env(int argc, char *argv[]) { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -256,7 +252,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step8_macros.c b/impls/c/step8_macros.c index ac5a3b0f02..2311b63be0 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,24 @@ 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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - return ast; -} -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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +110,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; @@ -148,7 +123,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -165,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -174,9 +149,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"); @@ -188,20 +160,17 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + MalVal *old = EVAL(a2, env); if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; res->ismacro = TRUE; - env_set(env, a1, res); + env_set(env, a1->val.string, 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 +203,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) { @@ -285,12 +259,10 @@ void init_repl_env(int argc, char *argv[]) { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -298,7 +270,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/step9_try.c b/impls/c/step9_try.c index 61ac91f784..9bdf356330 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,24 @@ 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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - return ast; -} -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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +111,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; @@ -149,7 +124,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -166,7 +141,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -175,9 +150,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"); @@ -189,16 +161,13 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + MalVal *old = EVAL(a2, env); if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; res->ismacro = TRUE; - env_set(env, a1, res); + env_set(env, a1->val.string, 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 +195,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 +228,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) { @@ -310,12 +284,10 @@ void init_repl_env(int argc, char *argv[]) { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -323,7 +295,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/impls/c/stepA_mal.c b/impls/c/stepA_mal.c index 75051170f3..95862d2a5c 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,24 @@ 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)); + + MalVal *dbgeval = env_get(env, "DEBUG-EVAL"); + if (dbgeval && !(dbgeval->type & (MAL_FALSE|MAL_NIL))) { + g_print("EVAL: %s\n", _pr_str(ast,1)); } - return ast; -} -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)) { + MalVal *res = env_get(env, ast->val.string); + assert(res, "'%s' not found", ast->val.string); + return res; + } 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 +111,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; @@ -149,7 +124,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *a2 = _nth(ast, 2); MalVal *res = EVAL(a2, env); if (mal_error) return NULL; - env_set(env, a1, res); + env_set(env, a1->val.string, res); return res; } else if ((a0->type & MAL_SYMBOL) && strcmp("let*", a0->val.string) == 0) { @@ -166,7 +141,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { key = g_array_index(a1->val.array, MalVal*, i); val = g_array_index(a1->val.array, MalVal*, i+1); assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); - env_set(let_env, key, EVAL(val, let_env)); + env_set(let_env, key->val.string, EVAL(val, let_env)); } ast = a2; env = let_env; @@ -175,9 +150,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"); @@ -189,20 +161,18 @@ MalVal *EVAL(MalVal *ast, Env *env) { //g_print("eval apply defmacro!\n"); MalVal *a1 = _nth(ast, 1), *a2 = _nth(ast, 2); - MalVal *res = EVAL(a2, env); + MalVal *old = EVAL(a2, env); if (mal_error) return NULL; + MalVal *res = malval_new(MAL_FUNCTION_MAL, NULL); + res->val.func = old->val.func; res->ismacro = TRUE; - env_set(env, a1, res); + env_set(env, a1->val.string, 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 +201,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 +234,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) { @@ -315,12 +290,10 @@ void init_repl_env(int argc, char *argv[]) { // core.c: defined using C int i; for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { - env_set(repl_env, - malval_new_symbol(core_ns[i].name), + env_set(repl_env, core_ns[i].name, malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); } - env_set(repl_env, - malval_new_symbol("eval"), + env_set(repl_env, "eval", malval_new_function((void*(*)(void *))do_eval, 1)); MalVal *_argv = _listX(0); @@ -328,7 +301,7 @@ void init_repl_env(int argc, char *argv[]) { MalVal *arg = malval_new_string(argv[i]); g_array_append_val(_argv->val.array, arg); } - env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); + env_set(repl_env, "*ARGV*", _argv); // core.mal: defined using the language itself RE(repl_env, "", "(def! *host-language* \"c\")"); diff --git a/impls/c/types.h b/impls/c/types.h index 7f327b8e7c..d4674c9ef9 100644 --- a/impls/c/types.h +++ b/impls/c/types.h @@ -35,9 +35,9 @@ typedef struct Env { } Env; Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs); -Env *env_find(Env *env, struct MalVal *key); -struct MalVal *env_get(Env *env, struct MalVal *key); -Env *env_set(Env *env, struct MalVal *key, struct MalVal *val); +struct MalVal *env_get(Env *env, const char *key); +// Returns NULL if the key is missing. +void env_set(Env *env, char *key, struct MalVal *val); // Utility functiosn diff --git a/impls/clojure/src/mal/step2_eval.cljc b/impls/clojure/src/mal/step2_eval.cljc index 2727f0585c..0a0131d3c2 100644 --- a/impls/clojure/src/mal/step2_eval.cljc +++ b/impls/clojure/src/mal/step2_eval.cljc @@ -10,36 +10,31 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] +(defn EVAL [ast env] + + ;; (println "EVAL:" (printer/pr-str ast) (keys @env)) + ;; (flush) + (cond (symbol? ast) (or (get env ast) (throw (#?(:clj Error. :cljs js/Error.) (str ast " not found")))) - (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)))) + (vector? ast) (vec (map #(EVAL % env) ast)) - :else ast)) - -(defn EVAL [ast env] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (if (empty? ast) ast - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args))))) + (let [f (EVAL (first ast) env) + args (map #(EVAL % env) (rest ast))] + (apply f args))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step3_env.cljc b/impls/clojure/src/mal/step3_env.cljc index 6a2c8da5a3..fa032f071a 100644 --- a/impls/clojure/src/mal/step3_env.cljc +++ b/impls/clojure/src/mal/step3_env.cljc @@ -11,28 +11,26 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -48,10 +46,12 @@ (EVAL a2 let-env)) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))) + (let [f (EVAL a0 env) + args (map #(EVAL % env) (rest ast))] + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step4_if_fn_do.cljc b/impls/clojure/src/mal/step4_if_fn_do.cljc index fe3e4c9b02..bcc5e362f1 100644 --- a/impls/clojure/src/mal/step4_if_fn_do.cljc +++ b/impls/clojure/src/mal/step4_if_fn_do.cljc @@ -12,28 +12,26 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - ;; indented to match later steps - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -49,7 +47,7 @@ (EVAL a2 let-env)) 'do - (last (eval-ast (rest ast) env)) + (last (doall (map #(EVAL % env) (rest ast)))) 'if (let [cond (EVAL a1 env)] @@ -64,10 +62,12 @@ (EVAL a2 (env/env env a1 (or args '())))) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el)] - (apply f args)))))) + (let [f (EVAL a0 env) + args (map #(EVAL % env) (rest ast))] + (apply f args)))) + + :else ;; not a list, map, symbol or vector + ast)) ;; print (defn PRINT [exp] (printer/pr-str exp)) diff --git a/impls/clojure/src/mal/step5_tco.cljc b/impls/clojure/src/mal/step5_tco.cljc index dc1209e1e6..fc1b3df920 100644 --- a/impls/clojure/src/mal/step5_tco.cljc +++ b/impls/clojure/src/mal/step5_tco.cljc @@ -12,29 +12,28 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -50,7 +49,7 @@ (recur a2 let-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 @@ -70,13 +69,16 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (let [f (EVAL a0 env) + args (map #(EVAL % env) (rest ast)) {: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/clojure/src/mal/step6_file.cljc b/impls/clojure/src/mal/step6_file.cljc index d81a291a02..84a1cedaad 100644 --- a/impls/clojure/src/mal/step6_file.cljc +++ b/impls/clojure/src/mal/step6_file.cljc @@ -12,29 +12,28 @@ (reader/read-string strng)) ;; eval -(declare EVAL) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -50,7 +49,7 @@ (recur a2 let-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 @@ -70,13 +69,16 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (let [f (EVAL a0 env) + args (map #(EVAL % env) (rest ast)) {: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/clojure/src/mal/step7_quote.cljc b/impls/clojure/src/mal/step7_quote.cljc index 5b2284158f..c1fa0c5cb6 100644 --- a/impls/clojure/src/mal/step7_quote.cljc +++ b/impls/clojure/src/mal/step7_quote.cljc @@ -12,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -27,34 +25,34 @@ (list 'concat (second elt) acc) (list 'cons (quasiquote elt) acc))))) (defn quasiquote [ast] - (cond (starts_with ast 'unquote) (second ast) - (seq? ast) (qq-iter ast) - (vector? ast) (list 'vec (qq-iter ast)) + (cond (starts_with ast 'unquote) (second ast) + (seq? ast) (qq-iter ast) + (vector? ast) (list 'vec (qq-iter ast)) (or (symbol? ast) (map? ast)) (list 'quote ast) :else ast)) -(defn eval-ast [ast env] - (cond - (symbol? ast) (env/env-get env ast) - - (seq? ast) (doall (map #(EVAL % env) ast)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast))) + (seq? ast) ;; apply list - ;; indented to match later steps + (let [[a0 a1 a2 a3] ast] (condp = a0 nil @@ -72,14 +70,11 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote 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 @@ -99,13 +94,16 @@ :parameters a1}) ;; apply - (let [el (eval-ast ast env) - f (first el) - args (rest el) + (let [f (EVAL a0 env) + args (map #(EVAL % env) (rest ast)) {: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/clojure/src/mal/step8_macros.cljc b/impls/clojure/src/mal/step8_macros.cljc index fea4a39519..31cf1ec571 100644 --- a/impls/clojure/src/mal/step8_macros.cljc +++ b/impls/clojure/src/mal/step8_macros.cljc @@ -1,5 +1,4 @@ (ns mal.step8-macros - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,45 +31,27 @@ (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,11 +81,8 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand 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 @@ -133,13 +106,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/clojure/src/mal/step9_try.cljc b/impls/clojure/src/mal/step9_try.cljc index 47a430c818..97867b0da2 100644 --- a/impls/clojure/src/mal/step9_try.cljc +++ b/impls/clojure/src/mal/step9_try.cljc @@ -1,5 +1,4 @@ (ns mal.step9-try - (:refer-clojure :exclude [macroexpand]) (:require [mal.readline :as readline] #?(:clj [clojure.repl]) [mal.reader :as reader] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,45 +31,27 @@ (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +81,6 @@ :ismacro true})] (env/env-set env a1 mac)) - 'macroexpand - (macroexpand a1 env) - 'try* (if (= 'catch* (nth a2 0)) (try @@ -126,7 +99,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 @@ -150,13 +123,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/clojure/src/mal/stepA_mal.cljc b/impls/clojure/src/mal/stepA_mal.cljc index d6203ef4e8..8d54e26c41 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] @@ -13,8 +12,6 @@ (reader/read-string strng)) ;; eval -(declare EVAL) - (declare quasiquote) (defn starts_with [ast sym] (and (seq? ast) @@ -34,45 +31,27 @@ (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)) +(defn EVAL [ast env] + (loop [ast ast + env env] - (vector? ast) (vec (doall (map #(EVAL % env) ast))) + (let [e (env/env-find env 'DEBUG-EVAL)] + (when e + (let [v (env/env-get e 'DEBUG-EVAL)] + (when (and (not= v nil) + (not= v false)) + (println "EVAL:" (printer/pr-str ast) (keys @env)) + (flush))))) - (map? ast) (apply hash-map (doall (map #(EVAL % env) - (mapcat identity ast)))) + (cond + (symbol? ast) (env/env-get env ast) - :else ast)) + (vector? ast) (vec (map #(EVAL % env) ast)) -(defn EVAL [ast env] - (loop [ast ast - env env] - ;;(prn "EVAL" ast (keys @env)) (flush) - (if (not (seq? ast)) - (eval-ast ast env) + (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 +70,6 @@ 'quote a1 - 'quasiquoteexpand - (quasiquote a1) - 'quasiquote (recur (quasiquote a1) env) @@ -105,9 +81,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 +107,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 +131,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..e7032f2cd2 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 (mal-eval (car forms) env)) + (args (cdr forms))) ;; 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 env)))))) ((mal-builtin-fn-p function) (return (apply (mal-data-value function) - (cdr evaluated-list)))) + (eval-sequence args env)))) (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/step2_eval.cpp b/impls/cpp/step2_eval.cpp index dcd9461174..9b64f5ea5c 100644 --- a/impls/cpp/step2_eval.cpp +++ b/impls/cpp/step2_eval.cpp @@ -51,6 +51,8 @@ malValuePtr READ(const String& input) malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { + // std::cout << "EVAL: " << PRINT(ast) << "\n"; + return ast->eval(env); } diff --git a/impls/cpp/step3_env.cpp b/impls/cpp/step3_env.cpp index 26b2bc4b85..fe76214a71 100644 --- a/impls/cpp/step3_env.cpp +++ b/impls/cpp/step3_env.cpp @@ -50,6 +50,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) if (!env) { env = replEnv; } + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); diff --git a/impls/cpp/step4_if_fn_do.cpp b/impls/cpp/step4_if_fn_do.cpp index 2369cb3a40..cef3c4ed99 100644 --- a/impls/cpp/step4_if_fn_do.cpp +++ b/impls/cpp/step4_if_fn_do.cpp @@ -52,6 +52,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) if (!env) { env = replEnv; } + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); diff --git a/impls/cpp/step5_tco.cpp b/impls/cpp/step5_tco.cpp index 3aa9d4a866..0766d53f02 100644 --- a/impls/cpp/step5_tco.cpp +++ b/impls/cpp/step5_tco.cpp @@ -53,6 +53,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) env = replEnv; } while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); diff --git a/impls/cpp/step6_file.cpp b/impls/cpp/step6_file.cpp index ad16f6db9e..e0c15e6109 100644 --- a/impls/cpp/step6_file.cpp +++ b/impls/cpp/step6_file.cpp @@ -76,6 +76,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) env = replEnv; } while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); diff --git a/impls/cpp/step7_quote.cpp b/impls/cpp/step7_quote.cpp index 337353dd13..1ced69952a 100644 --- a/impls/cpp/step7_quote.cpp +++ b/impls/cpp/step7_quote.cpp @@ -77,6 +77,12 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) env = replEnv; } while (1) { + + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); @@ -146,11 +152,6 @@ malValuePtr EVAL(malValuePtr ast, malEnvPtr env) continue; // TCO } - if (special == "quasiquoteexpand") { - checkArgsIs("quasiquote", 1, argCount); - return quasiquote(list->item(1)); - } - if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); diff --git a/impls/cpp/step8_macros.cpp b/impls/cpp/step8_macros.cpp index a425fdd2a8..b8897adbd1 100644 --- a/impls/cpp/step8_macros.cpp +++ b/impls/cpp/step8_macros.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"); @@ -79,13 +78,13 @@ 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); - } - ast = macroExpand(ast, env); - list = DYNAMIC_CAST(malList, ast); + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } @@ -163,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)); @@ -186,15 +175,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()); } } } @@ -256,31 +250,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/cpp/step9_try.cpp b/impls/cpp/step9_try.cpp index 5b38a8469a..f107ee6910 100644 --- a/impls/cpp/step9_try.cpp +++ b/impls/cpp/step9_try.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"); @@ -82,13 +81,13 @@ 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); - } - ast = macroExpand(ast, env); - list = DYNAMIC_CAST(malList, ast); + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } @@ -166,16 +165,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)); @@ -235,15 +224,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()); } } } @@ -305,31 +299,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/cpp/stepA_mal.cpp b/impls/cpp/stepA_mal.cpp index 34c940ba81..143a9bec6c 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,13 @@ 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); - } - ast = macroExpand(ast, env); - list = DYNAMIC_CAST(malList, ast); + const malEnvPtr dbgenv = env->find("DEBUG-EVAL"); + if (dbgenv && dbgenv->get("DEBUG-EVAL")->isTrue()) { + std::cout << "EVAL: " << PRINT(ast) << "\n"; + } + + const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } @@ -167,16 +166,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 +225,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 +300,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 @@ class stepA_mal { } } - 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 @@ class stepA_mal { break; case "quote": return ast[1]; - case "quasiquoteexpand": - return quasiquote(ast[1]); case "quasiquote": orig_ast = quasiquote(ast[1]); break; @@ -166,9 +128,6 @@ class stepA_mal { ((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 @@ class stepA_mal { 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 @@ class stepA_mal { 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/mal/env.el b/impls/elisp/mal/env.el index f03902976c..94f6d3e717 100644 --- a/impls/elisp/mal/env.el +++ b/impls/elisp/mal/env.el @@ -16,19 +16,13 @@ (let ((data (aref (aref env 1) 0))) (puthash key value data))) -(defun mal-env-find (env key) +(defun mal-env-get (env key) (let* ((data (aref (aref env 1) 0)) (value (gethash key data))) - (if (not value) + (or value (let ((outer (aref (aref env 1) 1))) - (when outer - (mal-env-find outer key))) - value))) - -(defun mal-env-get (env key) - (let ((value (mal-env-find env key))) - (if (not value) - (error "'%s' not found" key) - value))) + (if outer + (mal-env-get outer key) + nil))))) (provide 'mal/env) 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..a003e55144 100644 --- a/impls/elisp/step3_env.el +++ b/impls/elisp/step3_env.el @@ -13,20 +13,27 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +41,26 @@ (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))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (or (mal-env-get env key) + (error "'%s' not found" key)))) (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..d0a9f96072 100644 --- a/impls/elisp/step4_if_fn_do.el +++ b/impls/elisp/step4_if_fn_do.el @@ -17,11 +17,18 @@ (read-str input)) (defun EVAL (ast env) - (if (and (mal-list-p ast) (mal-value ast)) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +44,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 +69,26 @@ (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))) - (or definition (error "Definition not found")))) - (list - (mal-list (mapcar (lambda (item) (EVAL item env)) value))) + (let ((key (mal-value ast))) + (or (mal-env-get env key) + (error "'%s' not found" key)))) (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..2acffcff0d 100644 --- a/impls/elisp/step5_tco.el +++ b/impls/elisp/step5_tco.el @@ -21,11 +21,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +54,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 +77,34 @@ (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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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..4c4ea269b8 100644 --- a/impls/elisp/step6_file.el +++ b/impls/elisp/step6_file.el @@ -20,11 +20,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +53,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 +76,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 +86,24 @@ 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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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..4ec792c137 100644 --- a/impls/elisp/step7_quote.el +++ b/impls/elisp/step7_quote.el @@ -46,11 +46,20 @@ (defun EVAL (ast env) (catch 'return (while t - (if (and (mal-list-p ast) (mal-value ast)) + + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +77,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 +106,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 +116,24 @@ 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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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..04c442dbcb 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,26 @@ ((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))) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +77,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 +110,37 @@ (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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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..b381dd4070 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,26 @@ ((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))) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +77,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 +103,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 +126,37 @@ (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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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..5ceb4d6dcd 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,26 @@ ((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))) + (let ((dbgeval (mal-env-get env 'DEBUG-EVAL))) + (if (and dbgeval + (not (member (mal-type dbgeval) '(false nil)))) + (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 +77,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 +103,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 +126,37 @@ (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))) + (let ((key (mal-value ast))) + (throw 'return (or (mal-env-get env key) + (error "'%s' not found" key))))) (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/step2_eval.erl b/impls/erlang/src/step2_eval.erl index 39dfd6942c..f51c925b2c 100644 --- a/impls/erlang/src/step2_eval.erl +++ b/impls/erlang/src/step2_eval.erl @@ -46,32 +46,22 @@ read(String) -> eval({list, [], _Meta}=AST, _Env) -> AST; -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [F|Args], _M} -> erlang:apply(F, [Args]); +eval({list, List, _Meta}, Env) -> + case lists:map(fun(Elem) -> eval(Elem, Env) end, List) of + [F|Args] -> erlang:apply(F, [Args]); _ -> {error, "expected a list"} end; -eval(Value, Env) -> - eval_ast(Value, Env). - -eval_ast(Value, Env) -> - EvalList = fun(Elem) -> - eval(Elem, Env) - end, - EvalMap = fun(_Key, Val) -> - eval(Val, Env) - end, - case Value of - {symbol, Sym} -> - case maps:is_key(Sym, Env) of - true -> maps:get(Sym, Env); - false -> error(io_lib:format("'~s' not found", [Sym])) - end; - {list, L, Meta} -> {list, lists:map(EvalList, L), Meta}; - {vector, V, Meta} -> {vector, lists:map(EvalList, V), Meta}; - {map, M, Meta} -> {map, maps:map(EvalMap, M), Meta}; - _ -> Value - end. +eval({symbol, Sym}, Env) -> + case maps:is_key(Sym, Env) of + true -> maps:get(Sym, Env); + false -> error(io_lib:format("'~s' not found", [Sym])) + end; +eval({vector, V, Meta}, Env) -> + {vector, lists:map(fun(Elem) -> eval(Elem, Env) end, V), Meta}; +eval({map, M, Meta}, Env) -> + {map, maps:map(fun(_Key, Val) -> eval(Val, Env) end, M), Meta}; +eval(Value, _Env) -> + Value. print(none) -> % if nothing meaningful was entered, print nothing at all diff --git a/impls/erlang/src/step3_env.erl b/impls/erlang/src/step3_env.erl index 2abfbea88a..1a01fa85ec 100644 --- a/impls/erlang/src/step3_env.erl +++ b/impls/erlang/src/step3_env.erl @@ -32,34 +32,47 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{function, F, _MF}|A], _M1} -> erlang:apply(F, [A]); - _ -> error("expected a list with a function") - end; -eval(Value, Env) -> - eval_ast(Value, Env). +eval_list({list, [A0 | Args], _Meta}, Env) -> + case eval(A0, Env) of + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {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) -> diff --git a/impls/erlang/src/step4_if_fn_do.erl b/impls/erlang/src/step4_if_fn_do.erl index df8e82d3b7..dc19319592 100644 --- a/impls/erlang/src/step4_if_fn_do.erl +++ b/impls/erlang/src/step4_if_fn_do.erl @@ -35,26 +35,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - {list, Results, _M2} = eval_ast({list, Args, nil}, Env), - lists:last(Results); -eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> +eval_list({list, [{symbol, "do"}|Args], _Meta}, 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 Cond when Cond == false orelse Cond == nil -> case Alternate of @@ -64,32 +75,35 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|A], _M3} -> +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], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {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) -> diff --git a/impls/erlang/src/step5_tco.erl b/impls/erlang/src/step5_tco.erl index 933d7450e6..462628880d 100644 --- a/impls/erlang/src/step5_tco.erl +++ b/impls/erlang/src/step5_tco.erl @@ -35,26 +35,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); -eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of @@ -64,32 +75,35 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M2}|A], _M3} -> +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], _M4} -> erlang:apply(F, [A]); - _ -> error("expected a list") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {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) -> diff --git a/impls/erlang/src/step6_file.erl b/impls/erlang/src/step6_file.erl index 0a37f26c69..94bc24c328 100644 --- a/impls/erlang/src/step6_file.erl +++ b/impls/erlang/src/step6_file.erl @@ -45,26 +45,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); -eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of @@ -74,39 +85,41 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, [{symbol, "eval"}, AST], _Meta}, Env) -> +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); -eval({list, [{symbol, "eval"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|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") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {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) -> diff --git a/impls/erlang/src/step7_quote.erl b/impls/erlang/src/step7_quote.erl index 8588afbd0d..82664c33b8 100644 --- a/impls/erlang/src/step7_quote.erl +++ b/impls/erlang/src/step7_quote.erl @@ -45,26 +45,37 @@ read(Input) -> {error, Reason} -> error(Reason) end. -eval({list, [], _Meta}=AST, _Env) -> +eval(Value, Env) -> + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). + +eval_list({list, [], _Meta}=AST, _Env) -> AST; -eval({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "def!"}, {symbol, A1}, A2], _Meta}, Env) -> Result = eval(A2, Env), env:set(Env, {symbol, A1}, Result), Result; -eval({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}, _A1, _A2], _Meta}, _Env) -> error("def! called with non-symbol"); -eval({list, [{symbol, "def!"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "def!"}|_], _Meta}, _Env) -> error("def! requires exactly two arguments"); -eval({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> +eval_list({list, [{symbol, "let*"}, A1, A2], _Meta}, Env) -> NewEnv = env:new(Env), let_star(NewEnv, A1), eval(A2, NewEnv); -eval({list, [{symbol, "let*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "let*"}|_], _Meta}, _Env) -> error("let* requires exactly two arguments"); -eval({list, [{symbol, "do"}|Args], _Meta}, Env) -> - eval_ast({list, lists:droplast(Args), nil}, Env), +eval_list({list, [{symbol, "do"}|Args], _Meta}, Env) -> + lists:map(fun(Elem) -> eval(Elem, Env) end, lists:droplast(Args)), eval(lists:last(Args), Env); -eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> +eval_list({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> case eval(Test, Env) of Cond when Cond == false orelse Cond == nil -> case Alternate of @@ -74,51 +85,49 @@ eval({list, [{symbol, "if"}, Test, Consequent|Alternate], _Meta}, Env) -> end; _ -> eval(Consequent, Env) end; -eval({list, [{symbol, "if"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "if"}|_], _Meta}, _Env) -> error("if requires test and consequent"); -eval({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> - {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> +eval_list({list, [{symbol, "fn*"}, {vector, Binds, _M1}, Body], _Meta}, Env) -> + {closure, fun eval/2, Binds, Body, Env, nil}; +eval_list({list, [{symbol, "fn*"}, {list, Binds, _M1}, Body], _Meta}, Env) -> {closure, fun eval/2, Binds, Body, Env, nil}; -eval({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "fn*"}|_], _Meta}, _Env) -> error("fn* requires 2 arguments"); -eval({list, [{symbol, "eval"}, AST], _Meta}, Env) -> +eval_list({list, [{symbol, "eval"}, AST], _Meta}, Env) -> % Must use the root environment so the variables set within the parsed % expression will be visible within the repl. eval(eval(AST, Env), env:root(Env)); -eval({list, [{symbol, "eval"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "eval"}|_], _Meta}, _Env) -> error("eval requires 1 argument"); -eval({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> +eval_list({list, [{symbol, "quote"}, AST], _Meta}, _Env) -> AST; -eval({list, [{symbol, "quote"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "quote"}|_], _Meta}, _Env) -> error("quote requires 1 argument"); -eval({list, [{symbol, "quasiquoteexpand"}, AST], _Meta}, Env) -> - quasiquote(AST); -eval({list, [{symbol, "quasiquoteexpand"}|_], _Meta}, _Env) -> - error("quasiquoteexpand requires 1 argument"); -eval({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> +eval_list({list, [{symbol, "quasiquote"}, AST], _Meta}, Env) -> eval(quasiquote(AST), Env); -eval({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> +eval_list({list, [{symbol, "quasiquote"}|_], _Meta}, _Env) -> error("quasiquote requires 1 argument"); -eval({list, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _M1}|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") - end; -eval(Value, Env) -> - eval_ast(Value, Env). + {function, F, _MF} -> + A = lists:map(fun(Elem) -> eval(Elem, Env) end, Args), + erlang:apply(F, [A]); + {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) -> diff --git a/impls/erlang/src/step8_macros.erl b/impls/erlang/src/step8_macros.erl index 1e024f73c3..e940442b9f 100644 --- a/impls/erlang/src/step8_macros.erl +++ b/impls/erlang/src/step8_macros.erl @@ -46,14 +46,15 @@ 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. + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; @@ -76,7 +77,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 @@ -106,10 +107,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) -> @@ -127,27 +124,32 @@ 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, List, Meta}, Env) -> - case eval_ast({list, List, Meta}, Env) of - {list, [{closure, _Eval, Binds, Body, CE, _MC}|A], _M1} -> +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], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {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) -> @@ -206,27 +208,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/erlang/src/step9_try.erl b/impls/erlang/src/step9_try.erl index 7bf67834f0..d053eccbf3 100644 --- a/impls/erlang/src/step9_try.erl +++ b/impls/erlang/src/step9_try.erl @@ -47,14 +47,15 @@ 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. + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; @@ -77,7 +78,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 @@ -107,10 +108,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) -> @@ -128,10 +125,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 @@ -149,23 +142,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], _M1} -> +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], _M2} -> erlang:apply(F, [A]); - {list, [{error, Reason}], _M3} -> {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) -> @@ -224,27 +226,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], _M2} = 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/erlang/src/stepA_mal.erl b/impls/erlang/src/stepA_mal.erl index 4a32120ccb..ffc39d3526 100644 --- a/impls/erlang/src/stepA_mal.erl +++ b/impls/erlang/src/stepA_mal.erl @@ -49,14 +49,15 @@ 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. + case env:find(Env, {symbol, "DEBUG-EVAL"}) of + nil -> none; + Env2 -> + case env:get(Env2, {symbol, "DEBUG-EVAL"}) of + Cond when Cond == false orelse Cond == nil -> none; + _ -> io:format("EVAL: ~s~n", [printer:pr_str(Value, true)]) + end + end, + eval_ast(Value, Env). eval_list({list, [], _Meta}=AST, _Env) -> AST; @@ -79,7 +80,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 +110,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 +127,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 +144,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 +228,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/step2_eval/step2_eval.factor b/impls/factor/step2_eval/step2_eval.factor index 8b73333126..d883752438 100755 --- a/impls/factor/step2_eval/step2_eval.factor +++ b/impls/factor/step2_eval/step2_eval.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit -continuations fry io kernel math lib.printer lib.reader lib.types -quotations readline sequences ; +continuations fry hashtables io kernel math lib.printer lib.reader lib.types +quotations readline sequences vectors ; IN: step2_eval CONSTANT: repl-env H{ @@ -14,21 +14,26 @@ CONSTANT: repl-env H{ DEFER: EVAL -GENERIC# eval-ast 1 ( ast env -- ast ) -M: malsymbol eval-ast - [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; -M: sequence eval-ast '[ _ EVAL ] map ; -M: assoc eval-ast '[ _ EVAL ] assoc-map ; -M: object eval-ast drop ; - : READ ( str -- maltype ) read-str ; +: apply ( maltype env -- maltype ) + dup quotation? [ drop "not a fn" throw ] unless + with-datastack + first ; + +GENERIC# EVAL-switch 1 ( maltype env -- maltype ) +M: array EVAL-switch + '[ _ EVAL ] map + dup empty? [ unclip apply ] unless ; +M: malsymbol EVAL-switch + [ name>> ] dip ?at [ "no variable " prepend throw ] unless ; +M: vector EVAL-switch '[ _ EVAL ] map ; +M: hashtable EVAL-switch '[ _ EVAL ] assoc-map ; +M: object EVAL-switch drop ; + : EVAL ( maltype env -- maltype ) - eval-ast dup { [ array? ] [ empty? not ] } 1&& [ - unclip - dup quotation? [ "not a fn" throw ] unless - with-datastack first - ] when ; + ! "EVAL: " pick pr-str append print flush + EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step3_env/step3_env.factor b/impls/factor/step3_env/step3_env.factor index 742c3f59f2..13f177319c 100755 --- a/impls/factor/step3_env/step3_env.factor +++ b/impls/factor/step3_env/step3_env.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2015 Jordan Lewis. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators combinators.short-circuit -continuations fry grouping hashtables io kernel locals lib.env lib.printer -lib.reader lib.types math namespaces quotations readline sequences ; +continuations fry grouping hashtables io kernel lists locals lib.env lib.printer +lib.reader lib.types math namespaces quotations readline sequences vectors ; IN: step3_env CONSTANT: repl-bindings H{ @@ -16,12 +16,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,22 +26,33 @@ M: object eval-ast drop ; : READ ( str -- maltype ) read-str ; -:: EVAL ( maltype env -- maltype ) - maltype dup { [ array? ] [ empty? not ] } 1&& [ - unclip dup dup malsymbol? [ name>> ] when { - { "def!" [ drop first2 env eval-def! ] } - { "let*" [ drop first2 env eval-let* ] } - [ - drop env eval-ast dup quotation? [ - [ env eval-ast ] dip with-datastack first - ] [ - drop "not a fn" throw - ] if - ] +: apply ( maltype env -- maltype ) + dup quotation? [ drop "not a fn" throw ] unless + with-datastack + first ; + +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! ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + [ drop '[ _ EVAL ] map unclip apply ] } case - ] [ - env 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor index 37076e98f2..2c4a444fbb 100755 --- a/impls/factor/step4_if_fn_do/step4_if_fn_do.factor +++ b/impls/factor/step4_if_fn_do/step4_if_fn_do.factor @@ -3,19 +3,13 @@ USING: accessors arrays assocs combinators combinators.short-circuit continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences -splitting ; +splitting vectors ; IN: step4_if_fn_do 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 ; @@ -52,19 +46,31 @@ M: callable apply call( x -- y ) ; : READ ( str -- maltype ) read-str ; -:: EVAL ( maltype env -- maltype ) - maltype dup { [ array? ] [ empty? not ] } 1&& [ - dup first dup malsymbol? [ name>> ] when { - { "def!" [ rest first2 env eval-def! ] } - { "let*" [ rest first2 env eval-let* ] } - { "do" [ rest env eval-ast last ] } - { "if" [ rest env eval-if ] } - { "fn*" [ rest env eval-fn* ] } - [ drop [ env EVAL ] map unclip apply ] +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! ] } + { "let*" [ [ rest first2 ] dip eval-let* ] } + { "do" [ [ rest ] dip '[ _ EVAL ] map last ] } + { "if" [ [ rest ] dip eval-if ] } + { "fn*" [ [ rest ] dip eval-fn* ] } + [ drop '[ _ EVAL ] map unclip apply ] } case - ] [ - env 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step5_tco/step5_tco.factor b/impls/factor/step5_tco/step5_tco.factor index aff1b9cf37..91598b667e 100755 --- a/impls/factor/step5_tco/step5_tco.factor +++ b/impls/factor/step5_tco/step5_tco.factor @@ -3,19 +3,13 @@ USING: accessors arrays assocs combinators combinators.short-circuit continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations readline sequences -splitting ; +splitting vectors ; IN: step5_tco 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 ; @@ -28,7 +22,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 ) @@ -59,8 +53,9 @@ M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ +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 ] } { "let*" [ [ rest first2 ] dip eval-let* ] } @@ -68,10 +63,21 @@ M: callable apply call( x -- y ) f ; { "if" [ [ rest ] dip eval-if ] } { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] - } case - ] [ - eval-ast f - ] if [ EVAL ] when* ; + } case [ EVAL ] when* + ] 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; : PRINT ( maltype -- str ) pr-str ; diff --git a/impls/factor/step6_file/step6_file.factor b/impls/factor/step6_file/step6_file.factor index 290ee83333..8bcb8af6d3 100755 --- a/impls/factor/step6_file/step6_file.factor +++ b/impls/factor/step6_file/step6_file.factor @@ -3,19 +3,13 @@ USING: accessors arrays assocs combinators combinators.short-circuit command-line continuations fry grouping hashtables io kernel lists locals lib.core lib.env lib.printer lib.reader lib.types math namespaces quotations -readline sequences splitting ; +readline sequences splitting vectors ; IN: step6_file 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 ; @@ -28,7 +22,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 ) @@ -59,8 +53,9 @@ M: callable apply call( x -- y ) f ; : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ +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 ] } { "let*" [ [ rest first2 ] dip eval-let* ] } @@ -69,9 +64,20 @@ M: callable apply call( x -- y ) f ; { "fn*" [ [ rest ] dip eval-fn* f ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* - ] [ - 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/factor/step7_quote/step7_quote.factor b/impls/factor/step7_quote/step7_quote.factor index eae1cc5de1..2f530255ff 100755 --- a/impls/factor/step7_quote/step7_quote.factor +++ b/impls/factor/step7_quote/step7_quote.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 ; @@ -29,7 +23,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 ) @@ -49,7 +43,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -86,13 +80,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 ; : READ ( str -- maltype ) read-str ; -: EVAL ( maltype env -- maltype ) - over { [ array? ] [ empty? not ] } 1&& [ +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 ] } { "let*" [ [ rest first2 ] dip eval-let* ] } @@ -100,13 +95,23 @@ 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 ] } [ drop '[ _ EVAL ] map unclip apply ] } case [ EVAL ] when* - ] [ - 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/factor/step8_macros/step8_macros.factor b/impls/factor/step8_macros/step8_macros.factor index f6c7db7cdd..ef5cd08220 100755 --- a/impls/factor/step8_macros/step8_macros.factor +++ b/impls/factor/step8_macros/step8_macros.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 ) @@ -52,7 +46,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -89,23 +83,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 ] } @@ -114,17 +99,33 @@ 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 ] } - [ 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/factor/step9_try/step9_try.factor b/impls/factor/step9_try/step9_try.factor index cf0119e813..db98a9d308 100755 --- a/impls/factor/step9_try/step9_try.factor +++ b/impls/factor/step9_try/step9_try.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 ) @@ -63,7 +57,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -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,34 @@ 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + EVAL-switch ; [ apply [ EVAL ] when* ] mal-apply set-global diff --git a/impls/factor/stepA_mal/stepA_mal.factor b/impls/factor/stepA_mal/stepA_mal.factor index 0a2bb84694..230407a841 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 ) @@ -63,7 +57,7 @@ M: object eval-ast drop ; swapd [ over length cut [ zip ] dip ] dip [ swap 2array suffix ] [ drop ] if* >hashtable ; -GENERIC# apply 0 ( args fn -- maltype newenv/f ) +GENERIC: apply ( args fn -- maltype newenv/f ) M: malfn apply [ exprs>> nip ] @@ -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,34 @@ 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 ) + "DEBUG-EVAL" over env-find [ + { f +nil+ } index not + [ + "EVAL: " pick pr-str append print flush + ] when + ] [ drop ] if + 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/step3_env.hs b/impls/haskell/step3_env.hs index 4edb7489d0..2043eaae30 100644 --- a/impls/haskell/step3_env.hs +++ b/impls/haskell/step3_env.hs @@ -7,12 +7,6 @@ import Reader (read_str) import Printer (_pr_list, _pr_str) import Env (Env, env_get, env_let, env_put, env_repl, env_set) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -49,15 +43,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step4_if_fn_do.hs b/impls/haskell/step4_if_fn_do.hs index bfc2e49aa0..acba2ce0a0 100644 --- a/impls/haskell/step4_if_fn_do.hs +++ b/impls/haskell/step4_if_fn_do.hs @@ -9,12 +9,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -78,15 +72,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step5_tco.hs b/impls/haskell/step5_tco.hs index bfc2e49aa0..acba2ce0a0 100644 --- a/impls/haskell/step5_tco.hs +++ b/impls/haskell/step5_tco.hs @@ -9,12 +9,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -78,15 +72,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step6_file.hs b/impls/haskell/step6_file.hs index 01f28a8e3f..56ff9539af 100644 --- a/impls/haskell/step6_file.hs +++ b/impls/haskell/step6_file.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -79,15 +73,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step7_quote.hs b/impls/haskell/step7_quote.hs index 26a4130a1a..25bd80402f 100644 --- a/impls/haskell/step7_quote.hs +++ b/impls/haskell/step7_quote.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -65,9 +59,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" @@ -106,15 +97,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step8_macros.hs b/impls/haskell/step8_macros.hs index d49acf1b27..9ceea18c2f 100644 --- a/impls/haskell/step8_macros.hs +++ b/impls/haskell/step8_macros.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,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 +59,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 +72,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 @@ -128,15 +108,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/step9_try.hs b/impls/haskell/step9_try.hs index d2c26837a1..483019d872 100644 --- a/impls/haskell/step9_try.hs +++ b/impls/haskell/step9_try.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,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 +59,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 +72,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 @@ -138,15 +118,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym diff --git a/impls/haskell/stepA_mal.hs b/impls/haskell/stepA_mal.hs index 3e3517282d..8661f0fe15 100644 --- a/impls/haskell/stepA_mal.hs +++ b/impls/haskell/stepA_mal.hs @@ -10,12 +10,6 @@ import Printer(_pr_list, _pr_str) import Env (Env, env_apply, env_get, env_let, env_put, env_repl, env_set) import Core (ns) --- --- Set this to True for a trace of each call to Eval. --- -traceEval :: Bool -traceEval = False - -- read mal_read :: String -> IOThrows MalVal @@ -41,14 +35,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 +59,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 +72,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 @@ -138,15 +118,18 @@ apply_ast first rest env = do eval :: Env -> MalVal -> IOThrows MalVal eval env ast = do + traceEval <- liftIO $ env_get env "DEBUG-EVAL" case traceEval of - True -> liftIO $ do + Nothing -> pure () + Just Nil -> pure () + Just (MalBoolean False) -> pure () + Just _ -> liftIO $ do putStr "EVAL: " putStr =<< _pr_str True ast putStr " " env_put env putStrLn "" hFlush stdout - False -> pure () case ast of MalSymbol sym -> do maybeVal <- liftIO $ env_get env sym 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/step2_eval.jl b/impls/julia/step2_eval.jl index f61697866e..b64ca9e17c 100755 --- a/impls/julia/step2_eval.jl +++ b/impls/julia/step2_eval.jl @@ -11,24 +11,23 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + # println("EVAL: $(printer.pr_str(ast,true))") + if typeof(ast) == Symbol - env[ast] - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env[ast] + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end diff --git a/impls/julia/step3_env.jl b/impls/julia/step3_env.jl index 1436bcb6ef..8bcb42f34b 100755 --- a/impls/julia/step3_env.jl +++ b/impls/julia/step3_env.jl @@ -12,20 +12,25 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply @@ -38,7 +43,7 @@ function EVAL(ast, env) end EVAL(ast[3], let_env) else - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end diff --git a/impls/julia/step4_if_fn_do.jl b/impls/julia/step4_if_fn_do.jl index 5891975874..8461c6208b 100755 --- a/impls/julia/step4_if_fn_do.jl +++ b/impls/julia/step4_if_fn_do.jl @@ -13,20 +13,25 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return ast end -end -function EVAL(ast, env) - if !isa(ast, Array) return eval_ast(ast, env) end if isempty(ast) return ast end # apply @@ -39,7 +44,7 @@ function EVAL(ast, env) end EVAL(ast[3], let_env) elseif :do == ast[1] - eval_ast(ast[2:end], env)[end] + map((x) -> EVAL(x,env), ast[2:end])[end] elseif :if == ast[1] cond = EVAL(ast[2], env) if cond === nothing || cond === false @@ -54,7 +59,7 @@ function EVAL(ast, env) elseif symbol("fn*") == ast[1] (args...) -> EVAL(ast[3], Env(env, ast[2], Any[args...])) else - el = eval_ast(ast, env) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] f(args...) end diff --git a/impls/julia/step5_tco.jl b/impls/julia/step5_tco.jl index 42b48febbe..e98c1cb6d4 100755 --- a/impls/julia/step5_tco.jl +++ b/impls/julia/step5_tco.jl @@ -14,22 +14,27 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + while true + + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 if isempty(ast) return ast end # apply @@ -44,7 +49,7 @@ function EVAL(ast, env) ast = ast[3] # TCO loop elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -65,7 +70,7 @@ 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) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast diff --git a/impls/julia/step6_file.jl b/impls/julia/step6_file.jl index 51190c8e8f..68522e8a94 100755 --- a/impls/julia/step6_file.jl +++ b/impls/julia/step6_file.jl @@ -14,22 +14,27 @@ function READ(str) end # EVAL -function eval_ast(ast, env) +function EVAL(ast, env) + while true + + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 if isempty(ast) return ast end # apply @@ -44,7 +49,7 @@ function EVAL(ast, env) ast = ast[3] # TCO loop elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -65,7 +70,7 @@ 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) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast diff --git a/impls/julia/step7_quote.jl b/impls/julia/step7_quote.jl index d21e423951..0a5fb69739 100755 --- a/impls/julia/step7_quote.jl +++ b/impls/julia/step7_quote.jl @@ -43,22 +43,27 @@ function quasiquote(ast) end end -function eval_ast(ast, env) +function EVAL(ast, env) + while true + + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + end + end + if typeof(ast) == Symbol - env_get(env,ast) - elseif isa(ast, Array) || isa(ast, Tuple) - map((x) -> EVAL(x,env), ast) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 if isempty(ast) return ast end # apply @@ -74,13 +79,11 @@ 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 elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -101,7 +104,7 @@ 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) + el = map((x) -> EVAL(x,env), ast) f, args = el[1], el[2:end] if isa(f, MalFunc) ast = f.ast diff --git a/impls/julia/step8_macros.jl b/impls/julia/step8_macros.jl index 49b7833869..c66fa50b51 100755 --- a/impls/julia/step8_macros.jl +++ b/impls/julia/step8_macros.jl @@ -43,43 +43,28 @@ 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 isempty(ast) return ast end if :def! == ast[1] @@ -94,8 +79,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,10 +86,8 @@ 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 :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -127,8 +108,13 @@ 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 = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) and f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) diff --git a/impls/julia/step9_try.jl b/impls/julia/step9_try.jl index a739930ec4..c20b11a408 100755 --- a/impls/julia/step9_try.jl +++ b/impls/julia/step9_try.jl @@ -43,43 +43,28 @@ 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 isempty(ast) return ast end if :def! == ast[1] @@ -94,8 +79,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 +86,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 +105,7 @@ function EVAL(ast, env) end end elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -145,8 +126,13 @@ 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 = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) and f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) diff --git a/impls/julia/stepA_mal.jl b/impls/julia/stepA_mal.jl index 77bdaa9f00..5a64e29389 100755 --- a/impls/julia/stepA_mal.jl +++ b/impls/julia/stepA_mal.jl @@ -43,43 +43,28 @@ 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 EVAL(ast, env) + while true -function macroexpand(ast, env) - while ismacroCall(ast, env) - mac = env_get(env, ast[1]) - ast = mac.fn(ast[2:end]...) + dbgenv = env_find(env, :DEBUG-EVAL) + if dbgenv + dbgeval = env_get(dbgenv, :DEBUG-EVAL) + if dbgeval !== nothing && dbgeval !== false + println("EVAL: $(printer.pr_str(ast,true))") + 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) + return env_get(env,ast) + elseif isa(ast, Tuple) + return map((x) -> EVAL(x,env), ast) elseif isa(ast, Dict) - [x[1] => EVAL(x[2], env) for x=ast] - else - ast + return [x[1] => EVAL(x[2], env) for x=ast] + elseif !isa(ast, Array) + return 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 isempty(ast) return ast end if :def! == ast[1] @@ -94,8 +79,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 +86,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 +105,7 @@ function EVAL(ast, env) end end elseif :do == ast[1] - eval_ast(ast[2:end-1], env) + map((x) -> EVAL(x,env), ast[2:end-1]) ast = ast[end] # TCO loop elseif :if == ast[1] @@ -145,8 +126,13 @@ 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 = EVAL(ast[1], env) + args = ast[2:end] + if isa(f, MalFunc) and f.ismacro + ast = f.fn(args...) + continue # TCO loop + end + args = map((x) -> EVAL(x,env), args) if isa(f, MalFunc) ast = f.ast env = Env(f.env, f.params, args) diff --git a/impls/kotlin/src/mal/env.kt b/impls/kotlin/src/mal/env.kt index fa7b599124..b95fba2a49 100644 --- a/impls/kotlin/src/mal/env.kt +++ b/impls/kotlin/src/mal/env.kt @@ -30,7 +30,5 @@ class Env(val outer: Env?, binds: Sequence?, exprs: Sequence return value } - fun find(key: MalSymbol): MalType? = data[key.value] ?: outer?.find(key) - - fun get(key: MalSymbol): MalType = find(key) ?: throw MalException("'${key.value}' not found") + fun get(key: String): MalType? = data[key] ?: outer?.get(key) } diff --git a/impls/kotlin/src/mal/step2_eval.kt b/impls/kotlin/src/mal/step2_eval.kt index 630745a1c0..340c58691d 100644 --- a/impls/kotlin/src/mal/step2_eval.kt +++ b/impls/kotlin/src/mal/step2_eval.kt @@ -3,16 +3,15 @@ package mal fun read(input: String?): MalType = read_str(input) fun eval(ast: MalType, env: Map): MalType = - if (ast is MalList && ast.count() > 0) { - val evaluated = eval_ast(ast, env) as ISeq + // println ("EVAL: ${print(ast)}") + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") (evaluated.first() as MalFunction).apply(evaluated.rest()) - } else eval_ast(ast, env) - -fun eval_ast(ast: MalType, env: Map): MalType = - when (ast) { + } is MalSymbol -> env[ast.value] ?: throw MalException("'${ast.value}' not found") - 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 diff --git a/impls/kotlin/src/mal/step3_env.kt b/impls/kotlin/src/mal/step3_env.kt index 021ac4875d..d8a9ddb091 100644 --- a/impls/kotlin/src/mal/step3_env.kt +++ b/impls/kotlin/src/mal/step3_env.kt @@ -3,11 +3,19 @@ package mal fun read(input: String?): MalType = read_str(input) fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { - val first = ast.first() - if (first is MalSymbol && first.value == "def!") { + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { + "def!" -> { env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) - } else if (first is MalSymbol && first.value == "let*") { + } + "let*" -> { val child = Env(env) val bindings = ast.nth(1) if (bindings !is ISeq) throw MalException("expected sequence as the first parameter to let*") @@ -19,17 +27,15 @@ fun eval(ast: MalType, env: Env): MalType = child.set(key as MalSymbol, value) } eval(ast.nth(2), child) - } else { - val evaluated = eval_ast(ast, env) as ISeq + } + else -> { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq if (evaluated.first() !is MalFunction) throw MalException("cannot execute non-function") (evaluated.first() as MalFunction).apply(evaluated.rest()) } - } else 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 diff --git a/impls/kotlin/src/mal/step4_if_fn_do.kt b/impls/kotlin/src/mal/step4_if_fn_do.kt index ff7ae5c58b..78caca3f77 100644 --- a/impls/kotlin/src/mal/step4_if_fn_do.kt +++ b/impls/kotlin/src/mal/step4_if_fn_do.kt @@ -2,11 +2,16 @@ package mal fun read(input: String?): MalType = read_str(input) -fun eval(ast: MalType, env: Env): MalType = - if (ast is MalList && ast.count() > 0) { - val first = ast.first() - if (first is MalSymbol) { - when (first.value) { +fun eval(ast: MalType, env: Env): MalType { + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + when (ast) { + is MalList -> { + if (ast.count() == 0) return ast + when ((ast.first() as? MalSymbol)?.value) { "def!" -> eval_def_BANG(ast, env) "let*" -> eval_let_STAR(ast, env) "fn*" -> eval_fn_STAR(ast, env) @@ -14,8 +19,13 @@ fun eval(ast: MalType, env: Env): MalType = "if" -> eval_if(ast, env) else -> eval_function_call(ast, env) } - } else eval_function_call(ast, env) - } else eval_ast(ast, env) + } + is MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") + 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 + } +} private fun eval_def_BANG(ast: ISeq, env: Env): MalType = env.set(ast.nth(1) as MalSymbol, eval(ast.nth(2), env)) @@ -46,8 +56,9 @@ private fun eval_fn_STAR(ast: ISeq, env: Env): MalType { }) } -private fun eval_do(ast: ISeq, env: Env): MalType = - (eval_ast(MalList(ast.rest()), env) as ISeq).seq().last() +private fun eval_do(ast: MalList, env: Env): MalType = + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) + eval(ast.seq().last(), env) private fun eval_if(ast: ISeq, env: Env): MalType { val check = eval(ast.nth(1), env) @@ -59,21 +70,12 @@ private fun eval_if(ast: ISeq, env: Env): MalType { } else NIL } -private fun eval_function_call(ast: ISeq, env: Env): MalType { - val evaluated = eval_ast(ast, env) as ISeq +private fun eval_function_call(ast: MalList, env: Env): MalType { + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) val first = evaluated.first() as? MalFunction ?: throw MalException("cannot execute non-function") return first.apply(evaluated.rest()) } -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 print(result: MalType) = pr_str(result, print_readably = true) fun rep(input: String, env: Env): String = diff --git a/impls/kotlin/src/mal/step5_tco.kt b/impls/kotlin/src/mal/step5_tco.kt index cfc750f387..869c99ded6 100644 --- a/impls/kotlin/src/mal/step5_tco.kt +++ b/impls/kotlin/src/mal/step5_tco.kt @@ -7,7 +7,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - if (ast is MalList) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -27,7 +34,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -40,7 +47,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq val firstEval = evaluated.first() when (firstEval) { @@ -52,19 +59,15 @@ fun eval(_ast: MalType, _env: Env): MalType { 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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") diff --git a/impls/kotlin/src/mal/step6_file.kt b/impls/kotlin/src/mal/step6_file.kt index 12baaaf33a..4137ef6540 100644 --- a/impls/kotlin/src/mal/step6_file.kt +++ b/impls/kotlin/src/mal/step6_file.kt @@ -9,7 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - if (ast is MalList) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -29,7 +36,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -42,7 +49,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } else return NIL } else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq val firstEval = evaluated.first() when (firstEval) { @@ -54,19 +61,15 @@ fun eval(_ast: MalType, _env: Env): MalType { 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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") diff --git a/impls/kotlin/src/mal/step7_quote.kt b/impls/kotlin/src/mal/step7_quote.kt index 9cb803fe98..3a8e7abab4 100644 --- a/impls/kotlin/src/mal/step7_quote.kt +++ b/impls/kotlin/src/mal/step7_quote.kt @@ -9,7 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - if (ast is MalList) { + + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -29,7 +36,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -42,10 +49,9 @@ 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)) else -> { - val evaluated = eval_ast(ast, env) as ISeq + val evaluated = ast.elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) as ISeq val firstEval = evaluated.first() when (firstEval) { @@ -57,19 +63,15 @@ fun eval(_ast: MalType, _env: Env): MalType { 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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") diff --git a/impls/kotlin/src/mal/step8_macros.kt b/impls/kotlin/src/mal/step8_macros.kt index d3c031fae7..d8492c8e93 100644 --- a/impls/kotlin/src/mal/step8_macros.kt +++ b/impls/kotlin/src/mal/step8_macros.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - if (ast is MalList) { + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -31,7 +36,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -44,36 +49,34 @@ 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) else -> { - val evaluated = eval_ast(ast, env) as ISeq - val firstEval = evaluated.first() + val firstEval = eval(ast.first(), env) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.rest().elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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") @@ -121,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/kotlin/src/mal/step9_try.kt b/impls/kotlin/src/mal/step9_try.kt index a65659f860..0956a45d6c 100644 --- a/impls/kotlin/src/mal/step9_try.kt +++ b/impls/kotlin/src/mal/step9_try.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - if (ast is MalList) { + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -31,7 +36,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -44,37 +49,35 @@ 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) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.rest().elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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 +125,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/kotlin/src/mal/stepA_mal.kt b/impls/kotlin/src/mal/stepA_mal.kt index b72bfd3627..ea1b5030d5 100644 --- a/impls/kotlin/src/mal/stepA_mal.kt +++ b/impls/kotlin/src/mal/stepA_mal.kt @@ -9,9 +9,14 @@ fun eval(_ast: MalType, _env: Env): MalType { var env = _env while (true) { - ast = macroexpand(ast, env) - if (ast is MalList) { + val dbgeval = env.get("DEBUG-EVAL") + if (dbgeval !== null && dbgeval !== NIL && dbgeval !== FALSE) { + println ("EVAL: ${print(ast)}") + } + + 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)) @@ -31,7 +36,7 @@ fun eval(_ast: MalType, _env: Env): MalType { } "fn*" -> return fn_STAR(ast, env) "do" -> { - eval_ast(ast.slice(1, ast.count() - 1), env) + for (i in 1..ast.count() - 1) eval(ast.nth(i), env) ast = ast.seq().last() } "if" -> { @@ -44,37 +49,35 @@ 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) + if (firstEval is MalFunction && firstEval.is_macro) { + ast = firstEval.apply(ast.rest()) + } else { + val args = ast.rest().elements.fold(MalList(), { a, b -> a.conj_BANG(eval(b, env)); a }) 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 MalSymbol -> env.get(ast.value) ?: throw MalException("'${ast.value}' not found") 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 } + } +} 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 +125,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/env.mal b/impls/mal/env.mal index b802ddad54..41b97e8a75 100644 --- a/impls/mal/env.mal +++ b/impls/mal/env.mal @@ -16,10 +16,16 @@ (atom {:outer (first args)}) (atom (apply bind-env {:outer (first args)} (rest args)))))) -(def! env-find (fn* [env k] - (env-find-str env (str k)))) +(def! env-as-map (fn* [env] + (dissoc @env :outer))) -;; Private helper for env-find and env-get. +(def! env-get-or-nil (fn* [env k] + (let* [ks (str k) + e (env-find-str env ks)] + (if e + (get @e ks))))) + +;; Private helper for env-get and env-get-or-nil. (def! env-find-str (fn* [env ks] (if env (let* [data @env] diff --git a/impls/mal/step2_eval.mal b/impls/mal/step2_eval.mal index a42c47482f..4aa16dd82f 100644 --- a/impls/mal/step2_eval.mal +++ b/impls/mal/step2_eval.mal @@ -7,35 +7,31 @@ ;; 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) ) + ;; (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))))) + () + (let* [a0 (first ast) + f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))) + + "else" + ast) (catch* exc (do diff --git a/impls/mal/step3_env.mal b/impls/mal/step3_env.mal index ef813b833b..1658160279 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) @@ -33,31 +17,44 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (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)) - - "else" - (let* [el (eval-ast ast env)] - (apply (first el) (rest el)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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)) + + "else" + (let* [f (EVAL a0 env) + args (rest ast)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step4_if_fn_do.mal b/impls/mal/step4_if_fn_do.mal index cd6b05ffa4..c98b470e06 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) @@ -34,43 +18,56 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (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)) - - (= '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)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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)) + + (= '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)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step6_file.mal b/impls/mal/step6_file.mal index 3d7ee78607..e1ebec480e 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) @@ -34,43 +18,56 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (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)) - - (= '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)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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)) + + (= '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)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step7_quote.mal b/impls/mal/step7_quote.mal index 9e85f55d75..54b9cfd26c 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) @@ -52,52 +36,62 @@ (LET env (rest (rest binds)) form))))) (def! EVAL (fn* [ast env] - ;; (do (prn "EVAL" ast "/" (keys @env)) ) - (try* - (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) - - (= '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)))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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) + + (= '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)] + (apply f (map (fn* [exp] (EVAL exp env)) args)))))) + + "else" + ast) (catch* exc (do (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step8_macros.mal b/impls/mal/step8_macros.mal index cbbc6d4cb6..929cec6d33 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) @@ -60,60 +36,68 @@ (LET env (rest (rest binds)) form))))) (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) - - (= '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))))))) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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))) + + (= '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 (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/step9_try.mal b/impls/mal/step9_try.mal index 1d7bbe44d6..194e7f35ad 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) @@ -60,71 +36,79 @@ (LET env (rest (rest binds)) form))))) (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) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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]))))))) + (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)) - (= '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 (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) diff --git a/impls/mal/stepA_mal.mal b/impls/mal/stepA_mal.mal index 432dd31935..79b1b225f7 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) @@ -60,71 +36,79 @@ (LET env (rest (rest binds)) form))))) (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) + (do + (if (env-get-or-nil env 'DEBUG-EVAL) + (prn 'EVAL: ast (env-as-map env))) + (try* + (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) + (if (empty? ast) + () + (let* [a0 (first ast)] + (cond + (= '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]))))))) + (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)) - (= '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 (swap! trace str "\n in mal EVAL: " ast) - (throw exc)))))) + (throw exc))))))) ;; print (def! PRINT pr-str) 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..3d7c5524db 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" @@ -56,13 +59,13 @@ section .data ;; Symbols used for comparison + static_symbol debug_eval, 'DEBUG-EVAL' static_symbol def_symbol, 'def!' static_symbol let_symbol, 'let*' static_symbol do_symbol, 'do' 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 +73,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 +123,48 @@ 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: + push rdi ; save environment + mov r15, rsi ; save form + + mov rsi, rdi ; look for DEBUG-EVAL in environment + mov rdi, debug_eval + call env_get + jne .debug_eval_finished + mov bl, BYTE [rax] ; Get type of result + mov cl, bl + and cl, content_mask + cmp cl, content_pointer + je .debug_eval_release_pointer + cmp bl, maltype_nil + je .debug_eval_finished + cmp bl, maltype_false + je .debug_eval_finished + + print_str_mac eval_debug_string ; -> rsi, rdx -> + mov rdi, 1 + mov rsi, r15 ; ast + 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 -> + jmp .debug_eval_finished +.debug_eval_release_pointer: + mov rsi, rax + call release_object +.debug_eval_finished: + mov rsi, r15 ; restore form + pop rdi ; restore environment + 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 +189,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 +246,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 +421,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 +442,7 @@ eval_ast: ; map empty. Just return it call incref_object mov rax, rsi - ret + jmp .return .map_not_empty: @@ -456,11 +568,11 @@ eval_ast: .map_done: mov rax, r12 - ret + jmp .return .map_error_missing_value: mov rax, r12 - ret + jmp .return ; ------------------------------ .vector: @@ -571,11 +683,11 @@ eval_ast: .vector_done: mov rax, r8 ; Return the vector - ret + jmp .return ; --------------------- .done: - ret + jmp .return ; Releases Env @@ -594,65 +706,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 +746,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 +1524,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 +1565,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 +1784,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 +2210,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 +2254,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/mal_env.pas b/impls/objpascal/mal_env.pas index 9bbe2ebd61..1fc2ea580d 100644 --- a/impls/objpascal/mal_env.pas +++ b/impls/objpascal/mal_env.pas @@ -20,8 +20,7 @@ type TEnv = class(TObject) Exprs : TMalArray); function Add(Key : TMalSymbol; Val : TMal) : TMal; - function Find(Key : TMalSymbol) : TEnv; - function Get(Key : TMalSymbol) : TMal; + function Get(Key : String) : TMal; end; //////////////////////////////////////////////////////////// @@ -72,30 +71,14 @@ function TEnv.Add(Key : TMalSymbol; Val : TMal) : TMal; Add := Val; end; -function TEnv.Find(Key : TMalSymbol) : TEnv; -var - Sym : string; +function TEnv.Get(Key : String) : TMal; begin - Sym := (Key as TMalSymbol).Val; - if Data.IndexOf(Sym) >= 0 then - Find := Self + if Data.IndexOf(Key) >= 0 then + Get := Data[Key] else if Outer <> nil then - Find := Outer.Find(Key) - else - Find := nil; -end; - -function TEnv.Get(Key : TMalSymbol) : TMal; -var - Sym : string; - Env : TEnv; -begin - Sym := (Key as TMalSymbol).Val; - Env := Self.Find(Key); - if Env <> nil then - Get := Env.Data[Sym] + Get := Outer.Get(Key) else - raise Exception.Create('''' + Sym + ''' not found'); + Get := nil; end; end. diff --git a/impls/objpascal/step2_eval.pas b/impls/objpascal/step2_eval.pas index 9da3bcbad6..d73846c2fa 100644 --- a/impls/objpascal/step2_eval.pas +++ b/impls/objpascal/step2_eval.pas @@ -25,69 +25,58 @@ function READ(const Str: string) : TMal; end; // eval -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; +function EVAL(Ast: TMal; Env: TEnv) : TMal; var + Arr : TMalArray; + Arr1 : TMalArray; Sym : string; - OldArr, NewArr : TMalArray; + Cond : TMal; + Fn : TMalFunc; + Args : TMalArray; OldDict, NewDict : TMalDict; I : longint; begin + // WriteLn('EVAL: ' + pr_str(Ast, True)); + if Ast is TMalSymbol then begin Sym := (Ast as TMalSymbol).Val; if Env.IndexOf(Sym) < 0 then raise Exception.Create('''' + Sym + ''' not found') else - eval_ast := Env[Sym]; + Exit(Env[Sym]); end - else if Ast is TMalList then + else if Ast is TMalVector 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); + 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; - 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); + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); end - else - eval_ast := Ast; -end; - -function EVAL(Ast: TMal; Env: TEnv) : TMal; -var - Arr : TMalArray; - Fn : TMalCallable; -begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + else if not (Ast is TMalList) then + Exit(Ast); // Apply list - Arr := (eval_ast(Ast, Env) as TMalList).Val; + Arr := (Ast as TMalList).Val; if Length(Arr) = 0 then Exit(Ast); - 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).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); + Fn := (Cond as TMalFunc); + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + EVAL := Fn.Val(Args) end else raise Exception.Create('invalid apply'); diff --git a/impls/objpascal/step3_env.pas b/impls/objpascal/step3_env.pas index f51e318beb..d6940a90dc 100644 --- a/impls/objpascal/step3_env.pas +++ b/impls/objpascal/step3_env.pas @@ -23,59 +23,48 @@ function READ(const Str: string) : TMal; end; // eval -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -function eval_ast(Ast: TMal; Env: TEnv) : TMal; +function EVAL(Ast: TMal; Env: TEnv) : TMal; var - OldArr, NewArr : TMalArray; + Arr : TMalArray; + Arr1 : TMalArray; + A0Sym : string; + LetEnv : TEnv; + Cond : TMal; + Fn : TMalCallable; + Args : TMalArray; OldDict, NewDict : TMalDict; I : longint; begin + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + if Ast is TMalSymbol then begin - eval_ast := Env.Get((Ast as TMalSymbol)); + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); end - else if Ast is TMalList then + else if Ast is TMalVector 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); + 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; - 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); + for I := 0 to OldDict.Count-1 do + NewDict[OldDict.Keys[I]]:= EVAL(OldDict[OldDict.Keys[I]], Env); + Exit(TMalHashMap.Create(NewDict)); end - else - eval_ast := Ast; -end; - -function EVAL(Ast: TMal; Env: TEnv) : TMal; -var - Arr : TMalArray; - Arr1 : TMalArray; - A0Sym : string; - LetEnv : TEnv; - I : longint; - Fn : TMalCallable; -begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + else if not (Ast is TMalList) then + Exit(Ast); // Apply list Arr := (Ast as TMalList).Val; @@ -103,11 +92,14 @@ 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).Val; - EVAL := Fn(copy(Arr, 1, Length(Arr)-1)); + Fn := (Cond as TMalFunc).Val; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); + EVAL := Fn(Args) end else raise Exception.Create('invalid apply'); diff --git a/impls/objpascal/step4_if_fn_do.pas b/impls/objpascal/step4_if_fn_do.pas index f1204b7160..77cb53bf42 100644 --- a/impls/objpascal/step4_if_fn_do.pas +++ b/impls/objpascal/step4_if_fn_do.pas @@ -26,48 +26,6 @@ function READ(const Str: string) : TMal; end; // eval -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -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; @@ -80,9 +38,38 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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); @@ -111,8 +98,9 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'do': begin - Arr := (eval_ast(Lst.Rest, Env) as TMalList).Val; - EVAL := Arr[Length(Arr)-1]; + for I := 1 to Length(Arr) - 2 do + Cond := EVAL(Arr[I], Env); + EVAL := EVAL(Arr[Length(Arr)-1], Env); end; 'if': begin @@ -131,14 +119,13 @@ 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; + for I := 0 to Length(Args) - 1 do + Args[I]:= EVAL(Args[I], Env); if Fn.Ast = nil then EVAL := Fn.Val(Args) else diff --git a/impls/objpascal/step5_tco.pas b/impls/objpascal/step5_tco.pas index 6771931079..776026c594 100644 --- a/impls/objpascal/step5_tco.pas +++ b/impls/objpascal/step5_tco.pas @@ -26,48 +26,6 @@ function READ(const Str: string) : TMal; end; // eval -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -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; @@ -79,11 +37,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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); @@ -113,7 +101,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': @@ -133,14 +122,13 @@ 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; + 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/objpascal/step6_file.pas b/impls/objpascal/step6_file.pas index dfc53f16cd..dca8a85366 100644 --- a/impls/objpascal/step6_file.pas +++ b/impls/objpascal/step6_file.pas @@ -28,48 +28,6 @@ function READ(const Str: string) : TMal; end; // eval -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -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; @@ -81,11 +39,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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); @@ -115,7 +103,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': @@ -135,14 +124,13 @@ 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; + 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/objpascal/step7_quote.pas b/impls/objpascal/step7_quote.pas index c960b1e5db..15c640fd86 100644 --- a/impls/objpascal/step7_quote.pas +++ b/impls/objpascal/step7_quote.pas @@ -71,50 +71,6 @@ function quasiquote(Ast: TMal) : TMal; Exit(Res); end; - - -// Forward declation since eval_ast call it -function EVAL(Ast: TMal; Env: TEnv) : TMal; forward; - -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; @@ -126,11 +82,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : TMalArray; + OldDict, NewDict : TMalDict; begin while true do begin - if Ast.ClassType <> TMalList then - Exit(eval_ast(Ast, Env)); + + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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); @@ -160,13 +146,12 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); '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': @@ -186,14 +171,13 @@ 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; + 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/objpascal/step8_macros.pas b/impls/objpascal/step8_macros.pas index 1efe3ff2e5..18ccfbbc68 100644 --- a/impls/objpascal/step8_macros.pas +++ b/impls/objpascal/step8_macros.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; @@ -167,15 +82,41 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; I : longint; Fn : TMalFunc; Args : 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)); + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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); @@ -205,8 +146,6 @@ function EVAL(Ast: TMal; Env: TEnv) : TMal; end; 'quote': Exit(Arr[1]); - 'quasiquoteexpand': - Exit(quasiquote(Arr[1])); 'quasiquote': Ast := quasiquote(Arr[1]); 'defmacro!': @@ -216,11 +155,10 @@ 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)); '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': @@ -240,14 +178,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/objpascal/step9_try.pas b/impls/objpascal/step9_try.pas index 3ce8c89159..4c510eac63 100644 --- a/impls/objpascal/step9_try.pas +++ b/impls/objpascal/step9_try.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,41 @@ 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)); + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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 +147,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 +156,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 +179,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 +200,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/objpascal/stepA_mal.pas b/impls/objpascal/stepA_mal.pas index 51174c9934..be05145d4b 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,41 @@ 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)); + Cond := Env.Get('DEBUG-EVAL'); + if (Cond <> nil) and not (Cond is TMalNil) and not (Cond is TMalFalse) then + WriteLn('EVAL: ' + pr_str(Ast, True)); + + if Ast is TMalSymbol then + begin + A0Sym := (Ast as TMalSymbol).Val; + Cond := Env.Get(A0Sym); + if Cond = nil then + raise Exception.Create('''' + A0Sym+ ''' not found'); + Exit(Cond); + end + 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 +147,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 +156,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 +179,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 +200,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/core.ml b/impls/ocaml/core.ml index da2041e94b..fc665f9a6a 100644 --- a/impls/ocaml/core.ml +++ b/impls/ocaml/core.ml @@ -57,69 +57,69 @@ let rec conj = function | _ -> T.Nil let init env = begin - Env.set env (Types.symbol "throw") + Env.set env "throw" (Types.fn (function [ast] -> raise (Types.MalExn ast) | _ -> T.Nil)); - Env.set env (Types.symbol "+") (num_fun mk_int ( + )); - Env.set env (Types.symbol "-") (num_fun mk_int ( - )); - Env.set env (Types.symbol "*") (num_fun mk_int ( * )); - Env.set env (Types.symbol "/") (num_fun mk_int ( / )); - Env.set env (Types.symbol "<") (num_fun mk_bool ( < )); - Env.set env (Types.symbol "<=") (num_fun mk_bool ( <= )); - Env.set env (Types.symbol ">") (num_fun mk_bool ( > )); - Env.set env (Types.symbol ">=") (num_fun mk_bool ( >= )); - - Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs)); - Env.set env (Types.symbol "list?") + Env.set env "+" (num_fun mk_int ( + )); + Env.set env "-" (num_fun mk_int ( - )); + Env.set env "*" (num_fun mk_int ( * )); + Env.set env "/" (num_fun mk_int ( / )); + Env.set env "<" (num_fun mk_bool ( < )); + Env.set env "<=" (num_fun mk_bool ( <= )); + Env.set env ">" (num_fun mk_bool ( > )); + Env.set env ">=" (num_fun mk_bool ( >= )); + + Env.set env "list" (Types.fn (function xs -> Types.list xs)); + Env.set env "list?" (Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs)); - Env.set env (Types.symbol "vector?") + Env.set env "vector" (Types.fn (function xs -> Types.vector xs)); + Env.set env "vector?" (Types.fn (function [T.Vector _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "empty?") + Env.set env "empty?" (Types.fn (function | [T.List {T.value = []}] -> T.Bool true | [T.Vector {T.value = []}] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "count") + Env.set env "count" (Types.fn (function | [T.List {T.value = xs}] | [T.Vector {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); - Env.set env (Types.symbol "=") + Env.set env "=" (Types.fn (function | [a; b] -> T.Bool (Types.mal_equal a b) | _ -> T.Bool false)); - Env.set env (Types.symbol "pr-str") + Env.set env "pr-str" (Types.fn (function xs -> T.String (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)))); - Env.set env (Types.symbol "str") + Env.set env "str" (Types.fn (function xs -> T.String (String.concat "" (List.map (fun s -> Printer.pr_str s false) xs)))); - Env.set env (Types.symbol "prn") + Env.set env "prn" (Types.fn (function xs -> print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)); T.Nil)); - Env.set env (Types.symbol "println") + Env.set env "println" (Types.fn (function xs -> print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s false) xs)); T.Nil)); - Env.set env (Types.symbol "compare") + Env.set env "compare" (Types.fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); - Env.set env (Types.symbol "with-meta") + Env.set env "with-meta" (Types.fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); - Env.set env (Types.symbol "meta") + Env.set env "meta" (Types.fn (function [x] -> Printer.meta x | _ -> T.Nil)); - Env.set env (Types.symbol "read-string") + Env.set env "read-string" (Types.fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); - Env.set env (Types.symbol "slurp") + Env.set env "slurp" (Types.fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); - Env.set env (Types.symbol "cons") + Env.set env "cons" (Types.fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); - Env.set env (Types.symbol "concat") + Env.set env "concat" (Types.fn (let rec concat = function | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) @@ -127,59 +127,59 @@ let init env = begin | [x] -> Types.list (seq x) | [] -> Types.list [] in concat)); - Env.set env (Types.symbol "vec") (Types.fn (function + Env.set env "vec" (Types.fn (function | [T.List {T.value = xs}] -> Types.vector xs | [T.Vector {T.value = xs}] -> Types.vector xs | [_] -> raise (Invalid_argument "vec: expects a sequence") | _ -> raise (Invalid_argument "vec: arg count"))); - Env.set env (Types.symbol "nth") + Env.set env "nth" (Types.fn (function [xs; T.Int i] -> (try List.nth (seq xs) i with _ -> raise (Invalid_argument "nth: index out of range")) | _ -> T.Nil)); - Env.set env (Types.symbol "first") + Env.set env "first" (Types.fn (function | [xs] -> (match seq xs with x :: _ -> x | _ -> T.Nil) | _ -> T.Nil)); - Env.set env (Types.symbol "rest") + Env.set env "rest" (Types.fn (function | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) | _ -> T.Nil)); - Env.set env (Types.symbol "string?") + Env.set env "string?" (Types.fn (function [T.String _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "symbol") - (Types.fn (function [T.String x] -> Types.symbol x | _ -> T.Nil)); - Env.set env (Types.symbol "symbol?") + Env.set env "symbol" + (Types.fn (function [T.String x] -> T.Symbol x | _ -> T.Nil)); + Env.set env "symbol?" (Types.fn (function [T.Symbol _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "keyword") + Env.set env "keyword" (Types.fn (function | [T.String x] -> T.Keyword x | [T.Keyword x] -> T.Keyword x | _ -> T.Nil)); - Env.set env (Types.symbol "keyword?") + Env.set env "keyword?" (Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "number?") + Env.set env "number?" (Types.fn (function [T.Int _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "fn?") + Env.set env "fn?" (Types.fn (function | [T.Fn { T.meta = T.Map { T.value = meta } }] -> mk_bool (not (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta))) | [T.Fn _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "macro?") + Env.set env "macro?" (Types.fn (function | [T.Fn { T.meta = T.Map { T.value = meta } }] -> mk_bool (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)) | _ -> T.Bool false)); - Env.set env (Types.symbol "nil?") + Env.set env "nil?" (Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "true?") + Env.set env "true?" (Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "false?") + Env.set env "false?" (Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "sequential?") + Env.set env "sequential?" (Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "apply") + Env.set env "apply" (Types.fn (function | (T.Fn { T.value = f } :: apply_args) -> (match List.rev apply_args with @@ -187,56 +187,56 @@ let init env = begin f ((List.rev rev_args) @ (seq last_arg)) | [] -> f []) | _ -> raise (Invalid_argument "First arg to apply must be a fn"))); - Env.set env (Types.symbol "map") + Env.set env "map" (Types.fn (function | [T.Fn { T.value = f }; xs] -> Types.list (List.map (fun x -> f [x]) (seq xs)) | _ -> T.Nil)); - Env.set env (Types.symbol "readline") + Env.set env "readline" (Types.fn (function | [T.String x] -> print_string x; T.String (read_line ()) | _ -> T.String (read_line ()))); - Env.set env (Types.symbol "map?") + Env.set env "map?" (Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "hash-map") + Env.set env "hash-map" (Types.fn (function xs -> Types.list_into_map Types.MalMap.empty xs)); - Env.set env (Types.symbol "assoc") (Types.fn assoc); - Env.set env (Types.symbol "dissoc") (Types.fn dissoc); - Env.set env (Types.symbol "get") + Env.set env "assoc" (Types.fn assoc); + Env.set env "dissoc" (Types.fn dissoc); + Env.set env "get" (Types.fn (function | [T.Map { T.value = m }; k] -> (try Types.MalMap.find k m with _ -> T.Nil) | _ -> T.Nil)); - Env.set env (Types.symbol "keys") + Env.set env "keys" (Types.fn (function | [T.Map { T.value = m }] -> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m []) | _ -> T.Nil)); - Env.set env (Types.symbol "vals") + Env.set env "vals" (Types.fn (function | [T.Map { T.value = m }] -> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m []) | _ -> T.Nil)); - Env.set env (Types.symbol "contains?") + Env.set env "contains?" (Types.fn (function | [T.Map { T.value = m }; k] -> T.Bool (Types.MalMap.mem k m) | _ -> T.Bool false)); - Env.set env (Types.symbol "conj") (Types.fn conj); - Env.set env (Types.symbol "seq") (Types.fn mal_seq); + Env.set env "conj" (Types.fn conj); + Env.set env "seq" (Types.fn mal_seq); - Env.set env (Types.symbol "atom?") + Env.set env "atom?" (Types.fn (function [T.Atom _] -> T.Bool true | _ -> T.Bool false)); - Env.set env (Types.symbol "atom") + Env.set env "atom" (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil)); - Env.set env (Types.symbol "deref") + Env.set env "deref" (Types.fn (function [T.Atom x] -> !x | _ -> T.Nil)); - Env.set env (Types.symbol "reset!") + Env.set env "reset!" (Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil)); - Env.set env (Types.symbol "swap!") + Env.set env "swap!" (Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args -> let v = f (!x :: args) in x := v; v | _ -> T.Nil)); - Env.set env (Types.symbol "time-ms") + Env.set env "time-ms" (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))); end diff --git a/impls/ocaml/env.ml b/impls/ocaml/env.ml index cb32360eb0..769281cf06 100644 --- a/impls/ocaml/env.ml +++ b/impls/ocaml/env.ml @@ -8,26 +8,12 @@ type env = { let make outer = { outer = outer; data = ref Data.empty } -let set env sym value = - match sym with - | T.Symbol { T.value = key } -> env.data := Data.add key value !(env.data) - | _ -> raise (Invalid_argument "set requires a Symbol for its key") +let set env key value = + env.data := Data.add key value !(env.data) -let rec find env sym = - match sym with - | T.Symbol { T.value = key } -> - (if Data.mem key !(env.data) then - Some env - else - match env.outer with - | Some outer -> find outer sym - | None -> None) - | _ -> raise (Invalid_argument "find requires a Symbol for its key") - -let get env sym = - match sym with - | T.Symbol { T.value = key } -> - (match find env sym with - | Some found_env -> Data.find key !(found_env.data) - | None -> raise (Invalid_argument ("'" ^ key ^ "' not found"))) - | _ -> raise (Invalid_argument "get requires a Symbol for its key") +let rec get env key = + match Data.find_opt key !(env.data) with + | Some value -> Some value + | None -> match env.outer with + | Some outer -> get outer key + | None -> None diff --git a/impls/ocaml/printer.ml b/impls/ocaml/printer.ml index 74a8c64502..ed4a21d6c5 100644 --- a/impls/ocaml/printer.ml +++ b/impls/ocaml/printer.ml @@ -5,7 +5,6 @@ let meta obj = | T.List { T.meta = meta } -> meta | T.Map { T.meta = meta } -> meta | T.Vector { T.meta = meta } -> meta - | T.Symbol { T.meta = meta } -> meta | T.Fn { T.meta = meta } -> meta | _ -> T.Nil @@ -13,7 +12,7 @@ let rec pr_str mal_obj print_readably = let r = print_readably in match mal_obj with | T.Int i -> string_of_int i - | T.Symbol { T.value = s } -> s + | T.Symbol s -> s | T.Keyword s -> ":" ^ s | T.Nil -> "nil" | T.Bool true -> "true" diff --git a/impls/ocaml/reader.ml b/impls/ocaml/reader.ml index b9e2bce753..b96561f71b 100644 --- a/impls/ocaml/reader.ml +++ b/impls/ocaml/reader.ml @@ -52,22 +52,20 @@ let read_atom token = match token.[0] with | '0'..'9' -> T.Int (int_of_string token) | '-' -> (match String.length token with - | 1 -> Types.symbol token + | 1 -> T.Symbol token | _ -> (match token.[1] with | '0'..'9' -> T.Int (int_of_string token) - | _ -> Types.symbol token)) + | _ -> T.Symbol token)) | '"' -> T.String (unescape_string token) | ':' -> T.Keyword (Str.replace_first (Str.regexp "^:") "" token) - | _ -> Types.symbol token + | _ -> T.Symbol token let with_meta obj meta = match obj with - | T.List { T.value = v } - -> T.List { T.value = v; T.meta = meta }; | T.Map { T.value = v } - -> T.Map { T.value = v; T.meta = meta }; | T.Vector { T.value = v } - -> T.Vector { T.value = v; T.meta = meta }; | T.Symbol { T.value = v } - -> T.Symbol { T.value = v; T.meta = meta }; | T.Fn { T.value = v } - -> T.Fn { T.value = v; T.meta = meta }; + | T.List { T.value = v } -> T.List { T.value = v; T.meta = meta } + | T.Map { T.value = v } -> T.Map { T.value = v; T.meta = meta } + | T.Vector { T.value = v } -> T.Vector { T.value = v; T.meta = meta } + | T.Fn { T.value = v } -> T.Fn { T.value = v; T.meta = meta } | _ -> raise (Invalid_argument "metadata not supported on this type") let rec read_list eol list_reader = @@ -87,7 +85,7 @@ let rec read_list eol list_reader = tokens = reader.tokens} and read_quote sym tokens = let reader = read_form tokens in - {form = Types.list [ Types.symbol sym; reader.form ]; + {form = Types.list [ T.Symbol sym; reader.form ]; tokens = reader.tokens} and read_form all_tokens = match all_tokens with @@ -103,7 +101,7 @@ and read_form all_tokens = let meta = read_form tokens in let value = read_form meta.tokens in {(*form = with_meta value.form meta.form;*) - form = Types.list [Types.symbol "with-meta"; value.form; meta.form]; + form = Types.list [T.Symbol "with-meta"; value.form; meta.form]; tokens = value.tokens} | "(" -> let list_reader = read_list ")" {list_form = []; tokens = tokens} in diff --git a/impls/ocaml/step2_eval.ml b/impls/ocaml/step2_eval.ml index ce4b5dcff2..85f98b97be 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 } -> + | T.Symbol 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..f2bd067112 100644 --- a/impls/ocaml/step3_env.ml +++ b/impls/ocaml/step3_env.ml @@ -8,18 +8,24 @@ let num_fun f = Types.fn let repl_env = Env.make None let init_repl env = begin - Env.set env (Types.symbol "+") (num_fun ( + )); - Env.set env (Types.symbol "-") (num_fun ( - )); - Env.set env (Types.symbol "*") (num_fun ( * )); - Env.set env (Types.symbol "/") (num_fun ( / )); + Env.set env "+" (num_fun ( + )); + Env.set env "-" (num_fun ( - )); + Env.set env "*" (num_fun ( * )); + Env.set env "/" (num_fun ( / )); end -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -30,29 +36,26 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) 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..977f5083c6 100644 --- a/impls/ocaml/step4_if_fn_do.ml +++ b/impls/ocaml/step4_if_fn_do.ml @@ -2,12 +2,18 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,50 +24,47 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> 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 } -> 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..350027a9aa 100644 --- a/impls/ocaml/step6_file.ml +++ b/impls/ocaml/step6_file.ml @@ -2,12 +2,18 @@ module T = Types.Types let repl_env = Env.make (Some Core.ns) -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -18,50 +24,47 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> 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 } -> 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 @@ -70,11 +73,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) else [])); - Env.set repl_env (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl_env); ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); diff --git a/impls/ocaml/step7_quote.ml b/impls/ocaml/step7_quote.ml index dcad28fe54..0da8bef8ec 100644 --- a/impls/ocaml/step7_quote.ml +++ b/impls/ocaml/step7_quote.ml @@ -4,24 +4,30 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast + | T.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | 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] + | T.List {T.value = [T.Symbol "splice-unquote"; x]} -> Types.list [T.Symbol "concat"; x; acc] + | _ -> Types.list [T.Symbol "cons"; quasiquote elt; acc] -let rec eval_ast ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -32,55 +38,50 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call")) 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] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 } -> 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 @@ -89,11 +90,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) else [])); - Env.set repl_env (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl_env); ignore (rep "(def! not (fn* (a) (if a false true)))" repl_env); diff --git a/impls/ocaml/step8_macros.ml b/impls/ocaml/step8_macros.ml index b9f35df5ed..87ed34eafd 100644 --- a/impls/ocaml/step8_macros.ml +++ b/impls/ocaml/step8_macros.ml @@ -4,43 +4,30 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast + | T.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | 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] + | T.List {T.value = [T.Symbol "splice-unquote"; x]} -> Types.list [T.Symbol "concat"; x; acc] + | _ -> Types.list [T.Symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 = - 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,60 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol key; expr] } -> (match (eval expr env) with | T.Fn { T.value = f; T.meta = meta } -> let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]} in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call")) 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] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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 @@ -116,11 +100,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) else [])); - Env.set repl_env (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl_env); diff --git a/impls/ocaml/step9_try.ml b/impls/ocaml/step9_try.ml index ba68aab346..ed49e897a8 100644 --- a/impls/ocaml/step9_try.ml +++ b/impls/ocaml/step9_try.ml @@ -4,43 +4,30 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast + | T.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | 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] + | T.List {T.value = [T.Symbol "splice-unquote"; x]} -> Types.list [T.Symbol "concat"; x; acc] + | _ -> Types.list [T.Symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 = - 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,56 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol key; expr] } -> (match (eval expr env) with | T.Fn { T.value = f; T.meta = meta } -> let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]} in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call")) 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] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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]} -> + | T.List { T.value = [T.Symbol "try*"; scary]} -> (eval scary env) - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> + | T.List { T.value = [T.Symbol "try*"; scary ; + T.List { T.value = [T.Symbol "catch*"; + T.Symbol local ; handler]}]} -> (try (eval scary env) with exn -> let value = match exn with @@ -117,11 +97,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 @@ -130,11 +114,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) else [])); - Env.set repl_env (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" repl_env); diff --git a/impls/ocaml/stepA_mal.ml b/impls/ocaml/stepA_mal.ml index d9f56be6f4..0e2d86961b 100644 --- a/impls/ocaml/stepA_mal.ml +++ b/impls/ocaml/stepA_mal.ml @@ -4,43 +4,30 @@ let repl_env = Env.make (Some Core.ns) let rec quasiquote ast = match ast with - | T.List { T.value = [T.Symbol {T.value = "unquote"}; ast] } -> ast + | T.List { T.value = [T.Symbol "unquote"; ast] } -> ast | T.List {T.value = xs} -> List.fold_right qq_folder xs (Types.list []) - | T.Vector {T.value = xs} -> Types.list [Types.symbol "vec"; + | T.Vector {T.value = xs} -> Types.list [T.Symbol "vec"; List.fold_right qq_folder xs (Types.list [])] - | T.Map _ -> Types.list [Types.symbol "quote"; ast] - | T.Symbol _ -> Types.list [Types.symbol "quote"; ast] + | T.Map _ -> Types.list [T.Symbol "quote"; ast] + | T.Symbol _ -> Types.list [T.Symbol "quote"; ast] | _ -> ast and qq_folder elt acc = match elt with - | 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] + | T.List {T.value = [T.Symbol "splice-unquote"; x]} -> Types.list [T.Symbol "concat"; x; acc] + | _ -> Types.list [T.Symbol "cons"; quasiquote elt; acc] -let is_macro_call ast env = +let rec eval ast env = + (match Env.get env "DEBUG-EVAL" with + | None -> () + | Some T.Nil -> () + | Some (T.Bool false) -> () + | Some _ -> + output_string stderr ("EVAL: " ^ (Printer.pr_str ast true) ^ "\n"); + flush stderr); 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 = - 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.Symbol s -> (match Env.get env s with + | Some v -> v + | None -> raise (Invalid_argument ("'" ^ s ^ "' not found"))) | T.Vector { T.value = xs; T.meta = meta } -> T.Vector { T.value = (List.map (fun x -> eval x env) xs); T.meta = meta } @@ -51,63 +38,56 @@ 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] } -> + | T.List { T.value = [T.Symbol "def!"; T.Symbol key; expr] } -> let value = (eval expr env) in Env.set env key value; value - | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } -> + | T.List { T.value = [T.Symbol "defmacro!"; T.Symbol key; expr] } -> (match (eval expr env) with | T.Fn { T.value = f; T.meta = meta } -> let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]} in Env.set env key fn; fn | _ -> raise (Invalid_argument "defmacro! value must be a fn")) - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] } - | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.List { T.value = bindings }); body] } -> + | T.List { T.value = [T.Symbol "let*"; (T.Vector { T.value = bindings }); body] } + | T.List { T.value = [T.Symbol "let*"; (T.List { T.value = bindings }); body] } -> (let sub_env = Env.make (Some env) in let rec bind_pairs = (function - | sym :: expr :: more -> + | T.Symbol sym :: expr :: more -> Env.set sub_env sym (eval expr sub_env); bind_pairs more + | _ :: _ :: _ -> raise (Invalid_argument "let* keys must be symbols") | _::[] -> raise (Invalid_argument "let* bindings must be an even number of forms") | [] -> ()) in bind_pairs bindings; eval body sub_env) - | T.List { T.value = ((T.Symbol { T.value = "do" }) :: body) } -> + | T.List { T.value = (T.Symbol "do" :: body) } -> List.fold_left (fun x expr -> eval expr env) T.Nil body - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr; else_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr; else_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else (eval else_expr env) - | T.List { T.value = [T.Symbol { T.value = "if" }; test; then_expr] } -> + | T.List { T.value = [T.Symbol "if"; test; then_expr] } -> if Types.to_bool (eval test env) then (eval then_expr env) else T.Nil - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.Vector { T.value = arg_names }; expr] } - | T.List { T.value = [T.Symbol { T.value = "fn*" }; T.List { T.value = arg_names }; expr] } -> + | T.List { T.value = [T.Symbol "fn*"; T.Vector { T.value = arg_names }; expr] } + | T.List { T.value = [T.Symbol "fn*"; T.List { T.value = arg_names }; expr] } -> Types.fn (function args -> let sub_env = Env.make (Some env) in let rec bind_args a b = (match a, b with - | [T.Symbol { T.value = "&" }; name], args -> Env.set sub_env name (Types.list args); - | (name :: names), (arg :: args) -> + | [T.Symbol "&"; T.Symbol name], args -> Env.set sub_env name (Types.list args); + | (T.Symbol name :: names), (arg :: args) -> Env.set sub_env name arg; bind_args names args; | [], [] -> () | _ -> raise (Invalid_argument "Bad param count in fn call")) 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] } -> + | T.List { T.value = [T.Symbol "quote"; ast] } -> ast + | T.List { T.value = [T.Symbol "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]} -> + | T.List { T.value = [T.Symbol "try*"; scary]} -> (eval scary env) - | T.List { T.value = [T.Symbol { T.value = "try*" }; scary ; - T.List { T.value = [T.Symbol { T.value = "catch*" }; - local ; handler]}]} -> + | T.List { T.value = [T.Symbol "try*"; scary ; + T.List { T.value = [T.Symbol "catch*"; + T.Symbol local ; handler]}]} -> (try (eval scary env) with exn -> let value = match exn with @@ -117,11 +97,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 @@ -130,11 +114,11 @@ let rep str env = print (eval (read str) env) let rec main = try Core.init Core.ns; - Env.set repl_env (Types.symbol "*ARGV*") + Env.set repl_env "*ARGV*" (Types.list (if Array.length Sys.argv > 1 then (List.map (fun x -> T.String x) (List.tl (List.tl (Array.to_list Sys.argv)))) else [])); - Env.set repl_env (Types.symbol "eval") + Env.set repl_env "eval" (Types.fn (function [ast] -> eval ast repl_env | _ -> T.Nil)); ignore (rep "(def! *host-language* \"ocaml\")" repl_env); diff --git a/impls/ocaml/types.ml b/impls/ocaml/types.ml index 45d10bdb30..9d98d566cf 100644 --- a/impls/ocaml/types.ml +++ b/impls/ocaml/types.ml @@ -6,7 +6,7 @@ module rec Types | Vector of t list with_meta | Map of t MalMap.t with_meta | Int of int - | Symbol of string with_meta + | Symbol of string | Keyword of string | Nil | Bool of bool @@ -40,7 +40,6 @@ type mal_type = MalValue.t let list x = Types.List { Types.value = x; meta = Types.Nil } let map x = Types.Map { Types.value = x; meta = Types.Nil } let vector x = Types.Vector { Types.value = x; meta = Types.Nil } -let symbol x = Types.Symbol { Types.value = x; meta = Types.Nil } let fn f = Types.Fn { Types.value = f; meta = Types.Nil } let rec list_into_map target source = diff --git a/impls/perl/env.pm b/impls/perl/env.pm index 5614b2eb87..873cbb7739 100644 --- a/impls/perl/env.pm +++ b/impls/perl/env.pm @@ -23,22 +23,16 @@ use Exporter 'import'; } bless $data => $class } - sub find { + sub get { my ($self, $key) = @_; - if (exists $self->{$$key}) { return $self; } - elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); } + if (exists $self->{$key}) { return $self->{$key}; } + elsif ($self->{__outer__}) { return $self->{__outer__}->get($key); } else { return undef; } } sub set { my ($self, $key, $value) = @_; - $self->{$$key} = $value; - return $value - } - sub get { - my ($self, $key) = @_; - my $env = $self->find($key); - die "'$$key' not found\n" unless $env; - return $env->{$$key}; + $self->{$key} = $value; + return $value; } } @@ -55,9 +49,7 @@ use Exporter 'import'; #$e3->set('ghi', 1024); #print Dumper($e3); # -#print Dumper($e3->find('abc')); #print Dumper($e3->get('abc')); -#print Dumper($e3->find('def')); #print Dumper($e3->get('def')); 1; 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..5e6baa1a16 100644 --- a/impls/perl/step3_env.pl +++ b/impls/perl/step3_env.pl @@ -10,7 +10,7 @@ use Scalar::Util qw(blessed); use readline qw(mal_readline set_rl_mode); -use types; +use types qw($nil $false); use reader; use printer; use env; @@ -22,46 +22,48 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } 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); } } } @@ -79,13 +81,13 @@ sub REP { return PRINT(EVAL(READ($str), $repl_env)); } -$repl_env->set(Mal::Symbol->new('+'), +$repl_env->set('+', sub { Mal::Integer->new(${$_[0]} + ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('-'), +$repl_env->set('-', sub { Mal::Integer->new(${$_[0]} - ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('*'), +$repl_env->set('*', sub { Mal::Integer->new(${$_[0]} * ${$_[1]}) } ); -$repl_env->set(Mal::Symbol->new('/'), +$repl_env->set('/', sub { Mal::Integer->new(${$_[0]} / ${$_[1]}) } ); if (@ARGV && $ARGV[0] eq "--raw") { diff --git a/impls/perl/step4_if_fn_do.pl b/impls/perl/step4_if_fn_do.pl index be0611bd5e..3958796d27 100644 --- a/impls/perl/step4_if_fn_do.pl +++ b/impls/perl/step4_if_fn_do.pl @@ -23,47 +23,49 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } return EVAL($body, $let_env); } 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 +84,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); } } } @@ -104,7 +106,7 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } # core.mal: defined using the language itself diff --git a/impls/perl/step5_tco.pl b/impls/perl/step5_tco.pl index 2c726ecaa3..c7fd80e3e9 100644 --- a/impls/perl/step5_tco.pl +++ b/impls/perl/step5_tco.pl @@ -23,41 +23,41 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -65,7 +65,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 +88,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; } } @@ -110,7 +111,7 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } # core.mal: defined using the language itself diff --git a/impls/perl/step6_file.pl b/impls/perl/step6_file.pl index 631d4c59ae..46d12a809b 100644 --- a/impls/perl/step6_file.pl +++ b/impls/perl/step6_file.pl @@ -23,41 +23,41 @@ sub READ { } # eval -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -65,7 +65,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 +88,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; } } @@ -110,12 +111,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step7_quote.pl b/impls/perl/step7_quote.pl index af87a29391..2e52f77bbb 100644 --- a/impls/perl/step7_quote.pl +++ b/impls/perl/step7_quote.pl @@ -54,41 +54,41 @@ sub quasiquote { } } -sub eval_ast { +sub EVAL { my($ast, $env) = @_; + + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; + } + if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -96,9 +96,6 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; @@ -106,7 +103,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 +126,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; } } @@ -151,12 +149,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step8_macros.pl b/impls/perl/step8_macros.pl index 727d2eec7f..6301e9879a 100644 --- a/impls/perl/step8_macros.pl +++ b/impls/perl/step8_macros.pl @@ -54,70 +54,41 @@ 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 EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -125,25 +96,18 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } 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 +130,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; } } @@ -188,12 +157,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/step9_try.pl b/impls/perl/step9_try.pl index dd1ca1430c..37d7eda227 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,70 +54,41 @@ 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 EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -126,20 +96,13 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } when ('try*') { my (undef, $try, $catch) = @$ast; @@ -165,7 +128,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 +151,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; } } @@ -210,12 +178,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! not (fn* (a) (if a false true)))]); diff --git a/impls/perl/stepA_mal.pl b/impls/perl/stepA_mal.pl index f62aa5a7d8..12364e6611 100644 --- a/impls/perl/stepA_mal.pl +++ b/impls/perl/stepA_mal.pl @@ -54,70 +54,41 @@ 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 EVAL { + my($ast, $env) = @_; -sub macroexpand { - my ($ast, $env) = @_; - while (is_macro_call($ast, $env)) { - my @args = @$ast; - my $mac = $env->get(shift @args); - $ast = &$mac(@args); + my $dbgeval = $env->get('DEBUG-EVAL'); + if ($dbgeval and $dbgeval ne $nil and $dbgeval ne $false) { + print "EVAL: " . printer::_pr_str($ast) . "\n"; } - return $ast; -} - -sub eval_ast { - my($ast, $env) = @_; if ($ast->isa('Mal::Symbol')) { - return $env->get($ast); - } elsif ($ast->isa('Mal::Sequence')) { + my $val = $env->get($$ast); + die "'$$ast' not found\n" unless $val; + return $val; + } 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; given ($a0->isa('Mal::Symbol') ? $$a0 : $a0) { when ('def!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, EVAL($val, $env)); + return $env->set($$sym, EVAL($val, $env)); } when ('let*') { my (undef, $bindings, $body) = @$ast; my $let_env = Mal::Env->new($env); foreach my $pair (pairs @$bindings) { my ($k, $v) = @$pair; - $let_env->set($k, EVAL($v, $let_env)); + $let_env->set($$k, EVAL($v, $let_env)); } @_ = ($body, $let_env); goto &EVAL; @@ -125,20 +96,13 @@ sub EVAL { when ('quote') { return $ast->[1]; } - when ('quasiquoteexpand') { - return quasiquote($ast->[1]); - } when ('quasiquote') { @_ = (quasiquote($ast->[1]), $env); goto &EVAL; } when ('defmacro!') { my (undef, $sym, $val) = @$ast; - return $env->set($sym, Mal::Macro->new(EVAL($val, $env)->clone)); - } - when ('macroexpand') { - @_ = ($ast->[1], $env); - goto ¯oexpand; + return $env->set($$sym, Mal::Macro->new(EVAL($val, $env)->clone)); } when ('try*') { my (undef, $try, $catch) = @$ast; @@ -164,7 +128,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 +151,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; } } @@ -209,12 +178,12 @@ sub REP { # core.pl: defined using perl foreach my $n (keys %core::ns) { - $repl_env->set(Mal::Symbol->new($n), $core::ns{$n}); + $repl_env->set($n, $core::ns{$n}); } -$repl_env->set(Mal::Symbol->new('eval'), +$repl_env->set('eval', Mal::Function->new(sub { EVAL($_[0], $repl_env) })); my @_argv = map {Mal::String->new($_)} @ARGV[1..$#ARGV]; -$repl_env->set(Mal::Symbol->new('*ARGV*'), Mal::List->new(\@_argv)); +$repl_env->set('*ARGV*', Mal::List->new(\@_argv)); # core.mal: defined using the language itself REP(q[(def! *host-language* "perl")]); diff --git a/impls/perl6/env.pm b/impls/perl6/env.pm index c0f483726c..533e915f81 100644 --- a/impls/perl6/env.pm +++ b/impls/perl6/env.pm @@ -26,11 +26,8 @@ method set ($key, $value) { %.data{$key} = $value; } -method find ($key) { - return %.data{$key} ?? self !! $.outer && $.outer.find($key); -} - method get ($key) { - my $env = self.find($key) or die X::MalNotFound.new(name => $key); - return $env.data{$key}; + return %.data{$key} if %.data{$key}; + return $.outer.get($key) if $.outer; + return 0; } diff --git a/impls/perl6/step2_eval.pl b/impls/perl6/step2_eval.pl index a2d010f91b..d4cedad890 100644 --- a/impls/perl6/step2_eval.pl +++ b/impls/perl6/step2_eval.pl @@ -8,21 +8,21 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + # say "EVAL: " ~ print($ast); + given $ast { - when MalSymbol { $env{$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 } + when MalSymbol { return $env{$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 } } -} -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; return $ast if !$ast.elems; - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.map({ eval($_, $env) }); my $arglist = MalList(@args); return $func.apply($arglist); } diff --git a/impls/perl6/step3_env.pl b/impls/perl6/step3_env.pl index 2730211ced..cb011b42f1 100644 --- a/impls/perl6/step3_env.pl +++ b/impls/perl6/step3_env.pl @@ -9,18 +9,18 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + 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 } + 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 } } -} -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -36,8 +36,8 @@ ($ast, $env) return eval($a2, $new_env); } default { - my ($func, @args) = eval_ast($ast, $env).val; - return $func.apply(|@args); + my ($func, @args) = $ast.map({ eval($_, $env) }); + return $func.apply(@args); } } } diff --git a/impls/perl6/step4_if_fn_do.pl b/impls/perl6/step4_if_fn_do.pl index 0aa8d61598..b712de5951 100644 --- a/impls/perl6/step4_if_fn_do.pl +++ b/impls/perl6/step4_if_fn_do.pl @@ -10,18 +10,18 @@ ($str) return read_str($str); } -sub eval_ast ($ast, $env) { +sub eval ($ast, $env) { + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + 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 } + 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 } } -} -sub eval ($ast, $env) { - return eval_ast($ast, $env) if $ast !~~ MalList; return $ast if !$ast.elems; my ($a0, $a1, $a2, $a3) = $ast.val; @@ -37,7 +37,8 @@ ($ast, $env) return eval($a2, $new_env); } when 'do' { - return eval_ast(MalList([$ast[1..*]]), $env)[*-1]; + $ast[1..*-2].map({ eval($_, $env) }); + return eval($ast[*-1], $env); } when 'if' { return eval($a1, $env) !~~ MalNil|MalFalse @@ -51,7 +52,7 @@ ($ast, $env) }); } default { - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.map({ eval($_, $env) }); return $func.apply(|@args); } } diff --git a/impls/perl6/step5_tco.pl b/impls/perl6/step5_tco.pl index 7e7cbb7eed..8c253faccb 100644 --- a/impls/perl6/step5_tco.pl +++ b/impls/perl6/step5_tco.pl @@ -10,19 +10,19 @@ ($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 eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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; @@ -39,7 +39,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' { @@ -59,7 +59,7 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } default { - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.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/perl6/step6_file.pl b/impls/perl6/step6_file.pl index 8d97c1754f..7b22c1d3ba 100644 --- a/impls/perl6/step6_file.pl +++ b/impls/perl6/step6_file.pl @@ -10,19 +10,19 @@ ($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 eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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; @@ -39,7 +39,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' { @@ -59,7 +59,7 @@ ($ast is copy, $env is copy) return MalFunction($a2, $env, @binds, &fn); } default { - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.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/perl6/step7_quote.pl b/impls/perl6/step7_quote.pl index 8b8379f161..fbb6e8c191 100644 --- a/impls/perl6/step7_quote.pl +++ b/impls/perl6/step7_quote.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 { @@ -52,7 +42,17 @@ ($ast) sub eval ($ast is copy, $env is copy) { loop { - return eval_ast($ast, $env) if $ast !~~ MalList; + + say "EVAL: " ~ print($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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; @@ -69,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' { @@ -89,10 +89,9 @@ ($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) } default { - my ($func, @args) = eval_ast($ast, $env).val; + my ($func, @args) = $ast.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/perl6/step8_macros.pl b/impls/perl6/step8_macros.pl index 432d1d2e91..eb8318346c 100644 --- a/impls/perl6/step8_macros.pl +++ b/impls/perl6/step8_macros.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($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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,9 +96,14 @@ ($ast is copy, $env is copy) $func.is_macro = True; return $env.set($a1.val, $func); } - when 'macroexpand' { return macroexpand($a1, $env) } 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/perl6/step9_try.pl b/impls/perl6/step9_try.pl index bd77f2ca20..83caa754a4 100644 --- a/impls/perl6/step9_try.pl +++ b/impls/perl6/step9_try.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($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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/perl6/stepA_mal.pl b/impls/perl6/stepA_mal.pl index e7beec30d9..a80161301f 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($ast) unless $env.get('DEBUG-EVAL') ~~ 0|MalNil|MalFalse; + + 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/env.php b/impls/php/env.php index a660d3b9d4..839da55318 100644 --- a/impls/php/env.php +++ b/impls/php/env.php @@ -31,7 +31,7 @@ public function __construct($outer, $binds=NULL, $exprs=NULL) { } } public function find($key) { - if (array_key_exists($key->value, $this->data)) { + if (array_key_exists($key, $this->data)) { return $this; } elseif ($this->outer) { return $this->outer->find($key); @@ -46,9 +46,9 @@ public function set($key, $value) { public function get($key) { $env = $this->find($key); if (!$env) { - throw new Exception("'" . $key->value . "' not found"); + throw new Exception("'" . $key . "' not found"); } else { - return $env->data[$key->value]; + return $env->data[$key]; } } } diff --git a/impls/php/step2_eval.php b/impls/php/step2_eval.php index 7d5a822359..03135bcc96 100644 --- a/impls/php/step2_eval.php +++ b/impls/php/step2_eval.php @@ -11,15 +11,13 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + // echo "EVAL: " . _pr_str($ast) . "\n"; + if (_symbol_Q($ast)) { return $env[$ast->value]; - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -28,23 +26,20 @@ 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) { - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } // apply list - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } // print diff --git a/impls/php/step3_env.php b/impls/php/step3_env.php index 4fb25bd632..3000fb08d4 100644 --- a/impls/php/step3_env.php +++ b/impls/php/step3_env.php @@ -12,15 +12,19 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -29,16 +33,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) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -58,9 +56,11 @@ function MAL_EVAL($ast, $env) { } return MAL_EVAL($ast[2], $let_env); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } } diff --git a/impls/php/step4_if_fn_do.php b/impls/php/step4_if_fn_do.php index 2d2ab1ec01..54610a5373 100644 --- a/impls/php/step4_if_fn_do.php +++ b/impls/php/step4_if_fn_do.php @@ -13,15 +13,19 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,16 +34,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) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!_list_Q($ast)) { - return eval_ast($ast, $env); - } if ($ast->count() === 0) { return $ast; } @@ -59,9 +57,8 @@ function MAL_EVAL($ast, $env) { } return MAL_EVAL($ast[2], $let_env); case "do": - #$el = eval_ast(array_slice($ast->getArrayCopy(), 1), $env); - $el = eval_ast($ast->slice(1), $env); - return $el[count($el)-1]; + foreach ($ast->slice(1, -1) as $a) { MAL_EVAL($a, $env); } + return MAL_EVAL($ast[count($ast)-1], $env); case "if": $cond = MAL_EVAL($ast[1], $env); if ($cond === NULL || $cond === false) { @@ -76,9 +73,11 @@ function MAL_EVAL($ast, $env) { return MAL_EVAL($ast[2], $fn_env); }; default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - return call_user_func_array($f, array_slice($el->getArrayCopy(), 1)); + $args = array_slice($el, 1); + return call_user_func_array($f, $args); } } diff --git a/impls/php/step5_tco.php b/impls/php/step5_tco.php index 65051fc34e..6ed2dc774c 100644 --- a/impls/php/step5_tco.php +++ b/impls/php/step5_tco.php @@ -13,15 +13,21 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,18 +36,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); - } if ($ast->count() === 0) { return $ast; } @@ -63,7 +61,7 @@ function MAL_EVAL($ast, $env) { $env = $let_env; break; // Continue loop (TCO) 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": @@ -79,9 +77,10 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); diff --git a/impls/php/step6_file.php b/impls/php/step6_file.php index 97536767ab..6939535e33 100644 --- a/impls/php/step6_file.php +++ b/impls/php/step6_file.php @@ -13,15 +13,21 @@ function READ($str) { } // eval -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -30,18 +36,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); - } if ($ast->count() === 0) { return $ast; } @@ -63,7 +61,7 @@ function MAL_EVAL($ast, $env) { $env = $let_env; break; // Continue loop (TCO) 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": @@ -79,9 +77,10 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); diff --git a/impls/php/step7_quote.php b/impls/php/step7_quote.php index a3f2b1f59d..af84cef040 100644 --- a/impls/php/step7_quote.php +++ b/impls/php/step7_quote.php @@ -46,15 +46,21 @@ function quasiquote($ast) { } } -function eval_ast($ast, $env) { +function MAL_EVAL($ast, $env) { + while (true) { + + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } + } + if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -63,18 +69,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); - } if ($ast->count() === 0) { return $ast; } @@ -97,13 +95,11 @@ 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) 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": @@ -119,9 +115,10 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); default: - $el = eval_ast($ast, $env); + $el = []; + foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); + $args = array_slice($el, 1); if ($f->type === 'native') { $ast = $f->ast; $env = $f->gen_env($args); diff --git a/impls/php/step8_macros.php b/impls/php/step8_macros.php index 1ada35f4b9..dff99689f0 100644 --- a/impls/php/step8_macros.php +++ b/impls/php/step8_macros.php @@ -46,32 +46,21 @@ 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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - return $ast; -} -function eval_ast($ast, $env) { if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -80,24 +69,11 @@ 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; } @@ -119,8 +95,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) @@ -129,10 +103,8 @@ 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 "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": @@ -148,9 +120,14 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); 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); + break; // Continue loop (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/php/step9_try.php b/impls/php/step9_try.php index 16927a60f1..c839bd8036 100644 --- a/impls/php/step9_try.php +++ b/impls/php/step9_try.php @@ -46,32 +46,21 @@ 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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - return $ast; -} -function eval_ast($ast, $env) { if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -80,24 +69,11 @@ 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; } @@ -119,8 +95,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) @@ -129,8 +103,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 "try*": $a1 = $ast[1]; $a2 = $ast[2]; @@ -150,7 +122,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": @@ -166,9 +138,14 @@ function MAL_EVAL($ast, $env) { return _function('MAL_EVAL', 'native', $ast[2], $env, $ast[1]); 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); + break; // Continue loop (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/php/stepA_mal.php b/impls/php/stepA_mal.php index 6e57ab6445..94bf1568f7 100644 --- a/impls/php/stepA_mal.php +++ b/impls/php/stepA_mal.php @@ -47,32 +47,21 @@ 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); + $dbgenv = $env->find("DEBUG-EVAL"); + if ($dbgenv) { + $dbgeval = $env->get("DEBUG-EVAL"); + if ($dbgeval !== NULL && $dbgeval !== false) { + echo "EVAL: " . _pr_str($ast) . "\n"; + } } - return $ast; -} -function eval_ast($ast, $env) { if (_symbol_Q($ast)) { - return $env->get($ast); - } elseif (_sequential_Q($ast)) { - if (_list_Q($ast)) { - $el = _list(); - } else { + return $env->get($ast->value); + } elseif (_vector_Q($ast)) { $el = _vector(); - } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; } elseif (_hash_map_Q($ast)) { @@ -81,24 +70,11 @@ 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 +96,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 +104,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 +126,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 +144,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); + break; // Continue loop (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/step3_env.pl b/impls/prolog/step3_env.pl index b7518c9db5..100b31a7f0 100644 --- a/impls/prolog/step3_env.pl +++ b/impls/prolog/step3_env.pl @@ -43,10 +43,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, diff --git a/impls/prolog/step4_if_fn_do.pl b/impls/prolog/step4_if_fn_do.pl index 38ce02c38c..b481e639e0 100644 --- a/impls/prolog/step4_if_fn_do.pl +++ b/impls/prolog/step4_if_fn_do.pl @@ -75,10 +75,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, diff --git a/impls/prolog/step6_file.pl b/impls/prolog/step6_file.pl index 401ee76906..8c262cef37 100644 --- a/impls/prolog/step6_file.pl +++ b/impls/prolog/step6_file.pl @@ -75,10 +75,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, diff --git a/impls/prolog/step7_quote.pl b/impls/prolog/step7_quote.pl index 2a0d61fcb6..03887cb58b 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), @@ -114,10 +110,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, diff --git a/impls/prolog/step8_macros.pl b/impls/prolog/step8_macros.pl index ffb5de38e9..6e0099309e 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) :- @@ -142,10 +125,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, @@ -163,8 +150,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..006cdc7284 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) :- @@ -155,10 +138,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, @@ -176,8 +163,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..a0b27763af 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) :- @@ -155,10 +138,14 @@ % The eval function itself. -% Uncomment this to get a trace with environments. -%% eval(Env, Ast, _) :- -%% format("EVAL: ~F in ~V\n", [Ast, Env]), -%% fail. % Proceed with normal alternatives. +debug_eval(_, _, nil). +debug_eval(_, _, false). +debug_eval(Env, Ast, _) :- format("EVAL: ~F in ~V\n", [Ast, Env]). + +eval(Env, Ast, _) :- + env_get(Env, 'DEBUG-EVAL', Flag), + debug_eval(Env, Ast, Flag), + fail. % Proceed with normal alternatives. eval(Env, List, Res) :- list([First | Args], List), !, @@ -176,8 +163,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/env.ps b/impls/ps/env.ps index f6d5b88fe4..3d7614d04c 100644 Binary files a/impls/ps/env.ps and b/impls/ps/env.ps differ diff --git a/impls/ps/step2_eval.ps b/impls/ps/step2_eval.ps index 57bed6d928..48c9dc914a 100644 Binary files a/impls/ps/step2_eval.ps and b/impls/ps/step2_eval.ps differ diff --git a/impls/ps/step3_env.ps b/impls/ps/step3_env.ps index 0db73a2dfc..89d2a8ca4d 100644 Binary files a/impls/ps/step3_env.ps and b/impls/ps/step3_env.ps differ diff --git a/impls/ps/step4_if_fn_do.ps b/impls/ps/step4_if_fn_do.ps index 87b43cf3db..68307fab08 100644 Binary files a/impls/ps/step4_if_fn_do.ps and b/impls/ps/step4_if_fn_do.ps differ diff --git a/impls/ps/step5_tco.ps b/impls/ps/step5_tco.ps index 5b24490e16..7a224223b2 100644 Binary files a/impls/ps/step5_tco.ps and b/impls/ps/step5_tco.ps differ diff --git a/impls/ps/step6_file.ps b/impls/ps/step6_file.ps index 9173cde0e6..fcf3473185 100644 Binary files a/impls/ps/step6_file.ps and b/impls/ps/step6_file.ps differ diff --git a/impls/ps/step7_quote.ps b/impls/ps/step7_quote.ps index c26c78870f..45eef62f7d 100644 Binary files a/impls/ps/step7_quote.ps and b/impls/ps/step7_quote.ps differ diff --git a/impls/ps/step8_macros.ps b/impls/ps/step8_macros.ps index b79966804b..07a64b0500 100644 Binary files a/impls/ps/step8_macros.ps and b/impls/ps/step8_macros.ps differ diff --git a/impls/ps/step9_try.ps b/impls/ps/step9_try.ps index e13f2a8a87..4e72356d25 100644 Binary files a/impls/ps/step9_try.ps and b/impls/ps/step9_try.ps differ diff --git a/impls/ps/stepA_mal.ps b/impls/ps/stepA_mal.ps index 53c087478f..5254e4ff80 100644 Binary files a/impls/ps/stepA_mal.ps and b/impls/ps/stepA_mal.ps differ diff --git a/impls/python.2/stepA_mal.py b/impls/python.2/stepA_mal.py index 0cbb09f4a3..7269ec71f5 100644 --- a/impls/python.2/stepA_mal.py +++ b/impls/python.2/stepA_mal.py @@ -27,21 +27,6 @@ def READ(x: str) -> 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/env.py b/impls/python/env.py index 4cd8e0574d..d2efb88d5b 100644 --- a/impls/python/env.py +++ b/impls/python/env.py @@ -26,3 +26,7 @@ def get(self, key): env = self.find(key) if not env: raise Exception("'" + key + "' not found") return env.data[key] + + def get_or_nil(self, key): + env = self.find(key) + if env: return env.data[key] diff --git a/impls/python/step2_eval.py b/impls/python/step2_eval.py index b2f17f1822..8a40d836c2 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: ' + 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..73f9699e2d 100644 --- a/impls/python/step3_env.py +++ b/impls/python/step3_env.py @@ -9,22 +9,20 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +39,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..e04e98e5ef 100644 --- a/impls/python/step4_if_fn_do.py +++ b/impls/python/step4_if_fn_do.py @@ -10,22 +10,20 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +40,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 +55,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..74eedbee09 100644 --- a/impls/python/step5_tco.py +++ b/impls/python/step5_tco.py @@ -10,23 +10,22 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +44,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 +61,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..4c0278e977 100644 --- a/impls/python/step6_file.py +++ b/impls/python/step6_file.py @@ -10,23 +10,22 @@ def READ(str): return reader.read_str(str) # eval -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +44,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 +61,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..89e8265cb1 100644 --- a/impls/python/step7_quote.py +++ b/impls/python/step7_quote.py @@ -33,23 +33,22 @@ def quasiquote(ast): else: return ast -def eval_ast(ast, env): +def EVAL(ast, env): + while True: + + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +68,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 +89,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..25044b5235 100644 --- a/impls/python/step8_macros.py +++ b/impls/python/step8_macros.py @@ -33,40 +33,24 @@ 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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +68,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 +75,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 +93,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..17aff4d171 100644 --- a/impls/python/step9_try.py +++ b/impls/python/step9_try.py @@ -33,40 +33,24 @@ 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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +68,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 +75,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 +95,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 +112,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..b8455ac105 100644 --- a/impls/python/stepA_mal.py +++ b/impls/python/stepA_mal.py @@ -33,40 +33,24 @@ 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 EVAL(ast, env): + while True: -def macroexpand(ast, env): - while is_macro_call(ast, env): - mac = env.get(ast[0]) - ast = mac(*ast[1:]) - return ast + dbgeval = env.get_or_nil('DEBUG-EVAL') + if dbgeval is not None and dbgeval is not False: + print('EVAL: ' + 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 +68,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 +75,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 +101,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 +118,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.2/env.rb b/impls/ruby.2/env.rb index e6bb765bbd..0e8d612545 100644 --- a/impls/ruby.2/env.rb +++ b/impls/ruby.2/env.rb @@ -26,29 +26,14 @@ def set(k, v) @data[k] = v end - def find(k) + def get(k) if @data.key?(k) - self + @data[k] elsif !@outer.nil? - @outer.find(k) + @outer.get(k) else - Types::Nil.instance - end - end - - def get(k) - environment = find(k) - - case environment - when self.class - environment.get_value(k) - when Types::Nil - raise SymbolNotFoundError, "'#{k.value}' not found" + 0 end end - - def get_value(k) - @data[k] - end end end diff --git a/impls/ruby.2/step2_eval.rb b/impls/ruby.2/step2_eval.rb index 5642d4e53b..681068ebd4 100644 --- a/impls/ruby.2/step2_eval.rb +++ b/impls/ruby.2/step2_eval.rb @@ -19,8 +19,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 - evaluated = eval_ast(ast, environment) + # puts "EVAL: #{pr_str(ast, true)}" + + + case ast + when Types::Symbol + if @repl_env.key?(ast.value) + @repl_env[ast.value] + else + raise SymbolNotFoundError, "Error! Symbol #{ast.value} not found." + end + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end + + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) @@ -28,10 +51,8 @@ def EVAL(ast, environment) else raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -59,30 +80,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - if @repl_env.key?(mal.value) - @repl_env[mal.value] - else - raise SymbolNotFoundError, "Error! Symbol #{mal.value} not found." - end - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end while input = Readline.readline("user> ") diff --git a/impls/ruby.2/step3_env.rb b/impls/ruby.2/step3_env.rb index dc908a70b6..59d08f0868 100644 --- a/impls/ruby.2/step3_env.rb +++ b/impls/ruby.2/step3_env.rb @@ -19,7 +19,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -47,7 +71,8 @@ def EVAL(ast, environment) Types::Nil.instance end else - evaluated = eval_ast(ast, environment) + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) @@ -56,10 +81,8 @@ def EVAL(ast, environment) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -87,26 +110,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end while input = Readline.readline("user> ") diff --git a/impls/ruby.2/step4_if_fn_do.rb b/impls/ruby.2/step4_if_fn_do.rb index 5133f51756..506026facb 100644 --- a/impls/ruby.2/step4_if_fn_do.rb +++ b/impls/ruby.2/step4_if_fn_do.rb @@ -24,7 +24,31 @@ def READ(input) end def EVAL(ast, environment) - if Types::List === ast && ast.size > 0 + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -89,7 +113,8 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) + evaluated = Types::List.new + ast.each { |i| evaluated << EVAL(i, environment) } maybe_callable = evaluated.first if maybe_callable.respond_to?(:call) @@ -98,10 +123,8 @@ def EVAL(ast, environment) raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." end end - elsif Types::List === ast && ast.size == 0 - ast else - eval_ast(ast, environment) + return ast end end @@ -129,26 +152,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step5_tco.rb b/impls/ruby.2/step5_tco.rb index d6b4085c78..311468527a 100644 --- a/impls/ruby.2/step5_tco.rb +++ b/impls/ruby.2/step5_tco.rb @@ -25,7 +25,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -93,27 +118,26 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) - elsif maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -142,26 +166,6 @@ def rep(input) "Error! Detected unbalanced list. Check for matching ']'." end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step6_file.rb b/impls/ruby.2/step6_file.rb index 3325d5e7eb..4efc9e8449 100644 --- a/impls/ruby.2/step6_file.rb +++ b/impls/ruby.2/step6_file.rb @@ -44,7 +44,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -112,27 +137,26 @@ def EVAL(ast, environment) EVAL(to_eval, Env.new(environment, binds, exprs)) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -163,26 +187,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end end Mal.boot_repl! diff --git a/impls/ruby.2/step7_quote.rb b/impls/ruby.2/step7_quote.rb index 837ac721e0..7d362fa806 100644 --- a/impls/ruby.2/step7_quote.rb +++ b/impls/ruby.2/step7_quote.rb @@ -44,7 +44,32 @@ def READ(input) def EVAL(ast, environment) loop do - if Types::List === ast && ast.size > 0 + + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -117,31 +142,27 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + args = Types::List.new + ast[1..].each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -172,27 +193,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new diff --git a/impls/ruby.2/step8_macros.rb b/impls/ruby.2/step8_macros.rb index f65deea581..1ed751d010 100644 --- a/impls/ruby.2/step8_macros.rb +++ b/impls/ruby.2/step8_macros.rb @@ -26,8 +26,12 @@ def boot_repl! Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") - Mal.rep("(def! *ARGV* (list))") if !run_application? Mal.rep("(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)))))))") + + if !run_application? + Mal.rep("(def! *ARGV* (list))") + Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") + end end def run_application? @@ -45,9 +49,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -62,9 +89,6 @@ def EVAL(ast, environment) else raise TypeError end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -133,31 +157,36 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -190,27 +219,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -256,29 +264,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby.2/step9_try.rb b/impls/ruby.2/step9_try.rb index 9cfa409c89..f2c901921b 100644 --- a/impls/ruby.2/step9_try.rb +++ b/impls/ruby.2/step9_try.rb @@ -20,14 +20,18 @@ def boot_repl! Types::Symbol.for("eval"), Types::Builtin.new("eval") do |mal| - Mal.EVAL(mal.first, @repl_env) + Mal.EVAL(mal, @repl_env) end ) Mal.rep("(def! not (fn* (a) (if a false true)))") Mal.rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))") - Mal.rep("(def! *ARGV* (list))") if !run_application? Mal.rep("(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)))))))") + + if !run_application? + Mal.rep("(def! *ARGV* (list))") + Mal.rep("(println (str \"Mal [\" \*host-language\* \"]\"))") + end end def run_application? @@ -43,7 +47,11 @@ def run! Mal.rep("(def! *ARGV* (list))") end - puts Mal.rep("(load-file #{ARGV.first.inspect})") + file = File.absolute_path(ARGV.first) + + Dir.chdir(File.dirname(file)) do + Mal.rep("(load-file #{file.inspect})") + end end def READ(input) @@ -52,9 +60,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -69,9 +100,6 @@ def EVAL(ast, environment) else raise TypeError end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -140,9 +168,6 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast @@ -171,27 +196,35 @@ def EVAL(ast, environment) ) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - return maybe_callable.call(Types::Args.new(evaluated[1..])) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new(args)) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -226,27 +259,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -292,29 +304,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby.2/stepA_mal.rb b/impls/ruby.2/stepA_mal.rb index 16283a15c4..6ccb1ca05d 100644 --- a/impls/ruby.2/stepA_mal.rb +++ b/impls/ruby.2/stepA_mal.rb @@ -61,9 +61,32 @@ def READ(input) def EVAL(ast, environment) loop do - ast = macro_expand(ast, environment) - if Types::List === ast && ast.size > 0 + case environment.get(Types::Symbol.for("DEBUG-EVAL")) + when 0, Types::Nil, Types::False + else + puts "EVAL: #{pr_str(ast, true)}" + end + + case ast + when Types::Symbol + value = environment.get(ast) + if value == 0 + raise SymbolNotFoundError, "'#{ast.value}' not found" + end + return value + when Types::Vector + vec = Types::Vector.new + ast.each { |i| vec << EVAL(i, environment) } + return vec + when Types::Hashmap + hashmap = Types::Hashmap.new + ast.each { |k, v| hashmap[k] = EVAL(v, environment) } + return hashmap + when Types::List + if ast.size == 0 + return ast + end case ast.first when Types::Symbol.for("def!") _, sym, val = ast @@ -78,9 +101,6 @@ def EVAL(ast, environment) else raise TypeError, "defmacro! must be bound to a function" end - when Types::Symbol.for("macroexpand") - _, ast_rest = ast - return macro_expand(ast_rest, environment) when Types::Symbol.for("let*") e = Env.new(environment) _, bindings, val = ast @@ -150,9 +170,6 @@ def EVAL(ast, environment) when Types::Symbol.for("quasiquote") _, ast_rest = ast ast = quasiquote(ast_rest) - when Types::Symbol.for("quasiquoteexpand") - _, ast_rest = ast - return quasiquote(ast_rest) when Types::Symbol.for("try*") _, to_try, catch_list = ast @@ -181,31 +198,37 @@ def EVAL(ast, environment) ) end else - evaluated = eval_ast(ast, environment) - maybe_callable = evaluated.first - - if maybe_callable.respond_to?(:call) && maybe_callable.is_mal_fn? + maybe_callable = EVAL(ast.first, environment) + if !maybe_callable.respond_to?(:call) + raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + end + raw_args = ast[1..] + if maybe_callable.is_macro? + if raw_args.any? + ast = maybe_callable.call(Types::Args.new(raw_args)) + else + ast = maybe_callable.call + end + next + end + args = Types::List.new + raw_args.each { |i| args << EVAL(i, environment) } + if maybe_callable.is_mal_fn? # Continue loop ast = maybe_callable.ast environment = Env.new( maybe_callable.env, maybe_callable.params, - evaluated[1..], + args, ) - elsif maybe_callable.respond_to?(:call) && !maybe_callable.is_mal_fn? - if (args = evaluated[1..]).any? - return maybe_callable.call(Types::Args.new(args)) - else - return maybe_callable.call(Types::Args.new) - end + elsif args.any? + return maybe_callable.call(Types::Args.new(args)) else - raise NotCallableError, "Error! #{PRINT(maybe_callable)} is not callable." + return maybe_callable.call(Types::Args.new) end end - elsif Types::List === ast && ast.size == 0 - return ast else - return eval_ast(ast, environment) + return ast end end end @@ -240,27 +263,6 @@ def rep(input) nil end - def eval_ast(mal, environment) - case mal - when Types::Symbol - environment.get(mal) - when Types::List - list = Types::List.new - mal.each { |i| list << EVAL(i, environment) } - list - when Types::Vector - vec = Types::Vector.new - mal.each { |i| vec << EVAL(i, environment) } - vec - when Types::Hashmap - hashmap = Types::Hashmap.new - mal.each { |k, v| hashmap[k] = EVAL(v, environment) } - hashmap - else - mal - end - end - def quasiquote_list(mal) result = Types::List.new @@ -306,29 +308,6 @@ def quasiquote(mal) end end - def is_macro_call?(mal, env) - return false unless Types::List === mal - return false unless Types::Symbol === mal.first - val = env.get(mal.first) - return false unless Types::Callable === val - val.is_macro? - rescue SymbolNotFoundError - false - end - - def macro_expand(mal, env) - while is_macro_call?(mal, env) - macro_fn = env.get(mal.first) - - if (args = mal[1..]).any? - mal = macro_fn.call(Types::Args.new(mal[1..])) - else - mal = macro_fn.call - end - end - - mal - end end Mal.boot_repl! diff --git a/impls/ruby/env.rb b/impls/ruby/env.rb index 97dfa13ef6..d67a65b8e0 100644 --- a/impls/ruby/env.rb +++ b/impls/ruby/env.rb @@ -34,4 +34,10 @@ def get(key) raise "'" + key.to_s + "' not found" if not env env.data[key] end + + def get_or_nil(key) + env = find(key) + return nil if not env + env.data[key] + end end 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..258e2e815d 100644 --- a/impls/ruby/step3_env.rb +++ b/impls/ruby/step3_env.rb @@ -10,34 +10,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + 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 +45,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..d0e8983bd7 100644 --- a/impls/ruby/step4_if_fn_do.rb +++ b/impls/ruby/step4_if_fn_do.rb @@ -11,34 +11,30 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + 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 +46,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 +61,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..f149c4f55f 100644 --- a/impls/ruby/step5_tco.rb +++ b/impls/ruby/step5_tco.rb @@ -11,36 +11,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + 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 +49,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 +64,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..a4828e8640 100644 --- a/impls/ruby/step6_file.rb +++ b/impls/ruby/step6_file.rb @@ -11,36 +11,32 @@ def READ(str) end # eval -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + 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 +49,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 +64,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..19d0fe7574 100644 --- a/impls/ruby/step7_quote.rb +++ b/impls/ruby/step7_quote.rb @@ -42,36 +42,32 @@ def quasiquote(ast) end end -def eval_ast(ast, env) - return case ast +def EVAL(ast, env) + while true + + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" + end + + 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 +81,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 +99,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..3b6873ccc8 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,28 @@ 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)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -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 +81,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 +103,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..2ddb775234 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,28 @@ 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)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -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 +81,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 +103,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 +118,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..34cc005eee 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,28 @@ 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)] + if env.get_or_nil(:"DEBUG-EVAL") + puts "EVAL: #{_pr_str(ast, true)}" end - return ast -end -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 +81,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 +109,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 +124,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/step2_eval.tcl b/impls/tcl/step2_eval.tcl index 70001493a9..2cb8e0822f 100644 --- a/impls/tcl/step2_eval.tcl +++ b/impls/tcl/step2_eval.tcl @@ -7,7 +7,7 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { switch [obj_type $ast] { "symbol" { set varname [obj_val $ast] @@ -18,11 +18,6 @@ proc eval_ast {ast env} { } } "list" { - set res {} - foreach element [obj_val $ast] { - lappend res [EVAL $element $env] - } - return [list_new $res] } "vector" { set res {} @@ -39,19 +34,16 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast } - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] apply $f $call_args diff --git a/impls/tcl/step3_env.tcl b/impls/tcl/step3_env.tcl index 69f5a9a3c3..f6fbebbb31 100644 --- a/impls/tcl/step3_env.tcl +++ b/impls/tcl/step3_env.tcl @@ -8,18 +8,22 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + 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 {} @@ -36,13 +40,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } set a0 [lindex [obj_val $ast] 0] if {$a0 == ""} { return $ast @@ -64,8 +63,10 @@ proc EVAL {ast env} { return [EVAL $a2 $letenv] } default { - set lst_obj [eval_ast $ast $env] - set lst [obj_val $lst_obj] + set lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] return [apply $f $call_args] diff --git a/impls/tcl/step4_if_fn_do.tcl b/impls/tcl/step4_if_fn_do.tcl index 4e2ae2f630..c29f8ece6f 100644 --- a/impls/tcl/step4_if_fn_do.tcl +++ b/impls/tcl/step4_if_fn_do.tcl @@ -9,18 +9,22 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + 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 {} @@ -37,13 +41,8 @@ proc eval_ast {ast env} { return [hashmap_new $res] } default { return $ast } - } -} + } -proc EVAL {ast env} { - if {![list_q $ast]} { - return [eval_ast $ast $env] - } lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -63,8 +62,9 @@ proc EVAL {ast env} { return [EVAL $a2 $letenv] } "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 + } return [EVAL [lindex [obj_val $ast] end] $env] } "if" { @@ -85,8 +85,10 @@ 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 lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { diff --git a/impls/tcl/step5_tco.tcl b/impls/tcl/step5_tco.tcl index 3e1f62bb27..61b17109a6 100644 --- a/impls/tcl/step5_tco.tcl +++ b/impls/tcl/step5_tco.tcl @@ -9,18 +9,24 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + 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 {} @@ -37,14 +43,8 @@ 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] } + lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -66,8 +66,9 @@ proc EVAL {ast env} { # TCO: Continue loop } "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 } @@ -91,8 +92,10 @@ 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 lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { diff --git a/impls/tcl/step6_file.tcl b/impls/tcl/step6_file.tcl index 193df2c122..dd4bb8c908 100644 --- a/impls/tcl/step6_file.tcl +++ b/impls/tcl/step6_file.tcl @@ -9,18 +9,24 @@ proc READ str { read_str $str } -proc eval_ast {ast env} { +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + 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 {} @@ -37,14 +43,8 @@ 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] } + lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -66,8 +66,9 @@ proc EVAL {ast env} { # TCO: Continue loop } "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 } @@ -91,8 +92,10 @@ 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 lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { diff --git a/impls/tcl/step7_quote.tcl b/impls/tcl/step7_quote.tcl index 41d76ea900..3cd5f6b808 100644 --- a/impls/tcl/step7_quote.tcl +++ b/impls/tcl/step7_quote.tcl @@ -55,18 +55,24 @@ proc quasiquote {ast} { } } -proc eval_ast {ast env} { +proc EVAL {ast env} { + while {true} { + + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } + } + 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 {} @@ -83,14 +89,8 @@ 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] } + lassign [obj_val $ast] a0 a1 a2 a3 if {$a0 == ""} { return $ast @@ -114,15 +114,13 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } "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 } @@ -146,8 +144,10 @@ 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 lst {} + foreach element [obj_val $ast] { + lappend lst [EVAL $element $env] + } set f [lindex $lst 0] set call_args [lrange $lst 1 end] switch [obj_type $f] { diff --git a/impls/tcl/step8_macros.tcl b/impls/tcl/step8_macros.tcl index 6bdf1994f3..c408e5c01d 100644 --- a/impls/tcl/step8_macros.tcl +++ b/impls/tcl/step8_macros.tcl @@ -55,51 +55,24 @@ 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 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]]] +proc EVAL {ast env} { + while {true} { - 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] + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } } - 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 +89,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 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,12 +122,10 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $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 } @@ -193,10 +149,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/tcl/step9_try.tcl b/impls/tcl/step9_try.tcl index 6518536a31..ee63ed3ec3 100644 --- a/impls/tcl/step9_try.tcl +++ b/impls/tcl/step9_try.tcl @@ -55,51 +55,24 @@ 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 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]]] +proc EVAL {ast env} { + while {true} { - 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] + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } } - 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 +89,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 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +122,6 @@ proc EVAL {ast env} { set value [EVAL $a2 $env] return [$env set $varname [macro_new $value]] } - "macroexpand" { - return [macroexpand $a1 $env] - } "try*" { if {$a2 == ""} { return [EVAL $a1 $env] @@ -186,8 +141,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 } @@ -211,10 +167,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/tcl/stepA_mal.tcl b/impls/tcl/stepA_mal.tcl index 1857a9a5ef..88d4445fa5 100644 --- a/impls/tcl/stepA_mal.tcl +++ b/impls/tcl/stepA_mal.tcl @@ -55,51 +55,24 @@ 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 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]]] +proc EVAL {ast env} { + while {true} { - 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] + set dbgenv [$env find "DEBUG-EVAL"] + if {$dbgenv != 0} { + set dbgeval [$env get "DEBUG-EVAL"] + if {![false_q $dbgeval] && ![nil_q $dbgeval]} { + set img [PRINT $ast] + puts "EVAL: ${img}" + } } - 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 +89,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 +114,6 @@ proc EVAL {ast env} { "quote" { return $a1 } - "quasiquoteexpand" { - return [quasiquote $a1] - } "quasiquote" { set ast [quasiquote $a1] } @@ -164,9 +122,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 +144,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 +170,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/step3_env.mal b/impls/tests/step3_env.mal index a3554544cb..8fca4f6aba 100644 --- a/impls/tests/step3_env.mal +++ b/impls/tests/step3_env.mal @@ -85,3 +85,23 @@ y ;; Check that last assignment takes priority (let* (x 2 x 3) x) ;=>3 + +;; Check DEBUG-EVAL +(let* (DEBUG-EVAL false) (- 3 1)) +;=>2 +(let* (DEBUG-EVAL nil) (- 3 1)) +;=>2 +;;; Some implementations avoid a recursive EVAL when the first element +;;; is a symbol or when map(EVAL, list) encounters a number. +(let* (a 3 b 2 DEBUG-EVAL true) (- a b)) +;/EVAL: \(- a b\).*\n1 +;; Check the readably pretty-printing option +(let* (DEBUG-EVAL 1) "a") +;/EVAL: "a".*\n"a" +;; Usually false values +(let* (a 3 DEBUG-EVAL ()) a) +;/EVAL: a.*\n3 +(let* (a 3 DEBUG-EVAL 0) a) +;/EVAL: a.*\n3 +(let* (a 3 DEBUG-EVAL "") a) +;/EVAL: a.*\n3 diff --git a/impls/tests/step7_quote.mal b/impls/tests/step7_quote.mal index ef80c8259a..b757726019 100644 --- a/impls/tests/step7_quote.mal +++ b/impls/tests/step7_quote.mal @@ -76,8 +76,6 @@ b ;=>(1 () 2) (quasiquote (())) ;=>(()) -;; (quasiquote (f () g (h) i (j k) l)) -;; =>(f () g (h) i (j k) l) ;; Testing unquote (quasiquote (unquote 7)) @@ -278,72 +276,21 @@ a `[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) ())))))))) +(let* (DEBUG-EVAL true) `nil) +;/EVAL: nil.*\nnil +(let* (DEBUG-EVAL true) `7) +;/EVAL: 7.*\n7 +(let* (DEBUG-EVAL true) `a) +;/EVAL: \(quote a\).*\na +(let* (DEBUG-EVAL true) `{"a" b}) +;/EVAL: \(quote \{"a" b\}\).*\n\{"a" b\} +(let* (DEBUG-EVAL true) `()) +;/EVAL: \(\).*\n\(\) +(let* (DEBUG-EVAL true) `(a 2)) +;/EVAL: \(cons \(quote a\) \(cons 2 \(\)\)\).*\n\(a 2\) +(let* (DEBUG-EVAL true) `(~a 3)) +;/EVAL: \(cons a \(cons 3 \(\)\)\).*\n\(8 3\) +(let* (DEBUG-EVAL true) `(1 ~@c 3)) +;/EVAL: \(cons 1 \(concat c \(cons 3 \(\)\)\)\).*\n\(1 1 "b" "d" 3\) +(let* (DEBUG-EVAL true) `[]) +;/EVAL: \(vec \(\)\).*\n\[\] diff --git a/impls/tests/step8_macros.mal b/impls/tests/step8_macros.mal index 6fd1ef9d94..a252ec4cdd 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) @@ -163,3 +145,10 @@ x ;=>2 (let* (x 3) (a)) ;=>2 + +(let* (DEBUG-EVAL true) (unless x foo (- 4 3))) +;/EVAL: \(if x \(- 4 3\) foo\).*\n1 +(let* (DEBUG-EVAL true) (unless2 x foo (- 4 3))) +;/EVAL: \(if \(not x\) foo \(- 4 3\)\).*\n1 +(let* (DEBUG-EVAL true) (cond x (- 4 3) foo bar)) +;/EVAL: \(if x \(- 4 3\) \(cond foo bar\)\).*\n1 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/env.vb b/impls/vb/env.vb index a2c46289a3..6a7200e4e9 100644 --- a/impls/vb/env.vb +++ b/impls/vb/env.vb @@ -26,26 +26,16 @@ Namespace Mal Next End Sub - Public Function find(key As MalSymbol) As Env - If data.ContainsKey(key.getName()) Then - return Me + Public Function do_get(key As String) As MalVal + If data.ContainsKey(key) Then + return data.(key) Else If outer IsNot Nothing Then - return outer.find(key) + return outer.do_get(key) Else return Nothing End If End Function - Public Function do_get(key As MalSymbol) As MalVal - Dim e As Env = find(key) - If e Is Nothing Then - throw New Mal.types.MalException( - "'" & key.getName() & "' not found") - Else - return e.data(key.getName()) - End If - End Function - Public Function do_set(key As MalSymbol, value As MalVal) As Env data(key.getName()) = value return Me diff --git a/impls/vb/step2_eval.vb b/impls/vb/step2_eval.vb index 6e45efe85f..0856cffcf2 100644 --- a/impls/vb/step2_eval.vb +++ b/impls/vb/step2_eval.vb @@ -18,40 +18,31 @@ Namespace Mal End Function ' eval - Shared Function eval_ast(ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal - If TypeOf ast Is MalSymbol Then + Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal + + 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + + If TypeOf orig_ast Is MalSymbol Then Dim sym As MalSymbol = DirectCast(ast, MalSymbol) return env.Item(sym.getName()) - Else If TypeOf ast Is MalList Then - Dim old_lst As MalList = DirectCast(ast, MalList) + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + 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(ast,MalHashMap).getValue() + 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 - return ast - End If - return ast - End Function - - Shared Function EVAL(orig_ast As MalVal, env As Dictionary(Of String, MalVal)) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -59,8 +50,11 @@ Namespace Mal If ast.size() = 0 Then return ast End If - Dim a0 As MalVal = ast(0) - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Function diff --git a/impls/vb/step3_env.vb b/impls/vb/step3_env.vb index dfee614b74..9a64659391 100644 --- a/impls/vb/step3_env.vb +++ b/impls/vb/step3_env.vb @@ -19,39 +19,38 @@ Namespace Mal End Function ' eval - 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(orig_ast As MalVal, env As MalEnv) As MalVal + + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + 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(ast,MalHashMap).getValue() + 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 - return ast - End If - return ast - End Function - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Else If not orig_ast.list_Q() Then + return orig_ast End If ' apply list @@ -80,7 +79,11 @@ Namespace Mal Next return EVAL(a2, let_env) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select diff --git a/impls/vb/step4_if_fn_do.vb b/impls/vb/step4_if_fn_do.vb index 470ae86661..886cabe1be 100644 --- a/impls/vb/step4_if_fn_do.vb +++ b/impls/vb/step4_if_fn_do.vb @@ -19,34 +19,6 @@ Namespace Mal End Function ' eval - 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) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - 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 Class FClosure @@ -59,9 +31,36 @@ Namespace Mal End Class Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + 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 @@ -97,9 +96,10 @@ Namespace Mal Next return EVAL(a2, let_env) Case "do" - Dim el As MalList = DirectCast(eval_ast(ast.rest(), env), _ - MalLIst) - return el(el.size()-1) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next + return EVAL(ast(ast.size()-1), env) Case "if" Dim a1 As MalVal = ast(1) Dim cond As MalVal = EVAL(a1, env) @@ -126,7 +126,11 @@ Namespace Mal Dim mf As new MalFunc(f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Return f.apply(el.rest()) End Select diff --git a/impls/vb/step5_tco.vb b/impls/vb/step5_tco.vb index bb36b22bbf..11b26bfa55 100644 --- a/impls/vb/step5_tco.vb +++ b/impls/vb/step5_tco.vb @@ -19,34 +19,6 @@ Namespace Mal End Function ' eval - 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) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - 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 Class FClosure @@ -61,9 +33,36 @@ Namespace Mal Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + 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 @@ -100,7 +99,9 @@ Namespace Mal orig_ast = a2 env = let_env Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -127,7 +128,11 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing diff --git a/impls/vb/step6_file.vb b/impls/vb/step6_file.vb index 8c9c43504b..6602445446 100644 --- a/impls/vb/step6_file.vb +++ b/impls/vb/step6_file.vb @@ -20,34 +20,6 @@ Namespace Mal End Function ' eval - 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) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - 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 Class FClosure @@ -62,9 +34,36 @@ Namespace Mal Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + 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 @@ -101,7 +100,9 @@ Namespace Mal orig_ast = a2 env = let_env Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -128,7 +129,11 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing diff --git a/impls/vb/step7_quote.vb b/impls/vb/step7_quote.vb index 3303f31861..27c059ab27 100644 --- a/impls/vb/step7_quote.vb +++ b/impls/vb/step7_quote.vb @@ -61,36 +61,6 @@ Namespace Mal return result 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) - Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else - new_lst = DirectCast(New MalVector, MalList) - End If - Dim mv As MalVal - For Each mv in old_lst.getValue() - 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 Class FClosure Public ast As MalVal @@ -104,9 +74,36 @@ Namespace Mal Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal Do - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) + Dim new_lst As MalList + new_lst = DirectCast(New MalVector, MalList) + Dim mv As MalVal + For Each mv in old_lst.getValue() + new_lst.conj_BANG(EVAL(mv, env)) + Next + return new_lst + 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 @@ -144,12 +141,12 @@ Namespace Mal env = let_env Case "quote" return ast(1) - Case "quasiquoteexpand" - return quasiquote(ast(1)) Case "quasiquote" orig_ast = quasiquote(ast(1)) Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -176,7 +173,11 @@ Namespace Mal DirectCast(ast(1),MalList), f) return DirectCast(mf,MalVal) Case Else - Dim el As MalList = DirectCast(eval_ast(ast, env), MalList) + Dim el As MalList = New MalList + Dim mv As MalVal + For Each mv In ast.getValue() + el.conj_BANG(EVAL(mv, env)) + Next Dim f As MalFunc = DirectCast(el(0), MalFunc) Dim fnast As MalVal = f.getAst() If not fnast Is Nothing diff --git a/impls/vb/step8_macros.vb b/impls/vb/step8_macros.vb index 43befb9eba..dc0f530ef6 100644 --- a/impls/vb/step8_macros.vb +++ b/impls/vb/step8_macros.vb @@ -61,83 +61,53 @@ 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 + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class - 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(orig_ast As MalVal, env As MalEnv) As MalVal + Do - 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) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + 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(ast,MalHashMap).getValue() + 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 - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + 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 +142,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,11 +151,10 @@ 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 "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -214,14 +181,21 @@ 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 = New MalList + For Each i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next 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/vb/step9_try.vb b/impls/vb/step9_try.vb index e8f35a0b4c..0f5a597679 100644 --- a/impls/vb/step9_try.vb +++ b/impls/vb/step9_try.vb @@ -61,83 +61,53 @@ 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 + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class - 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(orig_ast As MalVal, env As MalEnv) As MalVal + Do - 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) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + 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(ast,MalHashMap).getValue() + 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 - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + 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 +142,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 +151,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) @@ -210,7 +175,9 @@ Namespace Mal Throw e End Try Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -237,14 +204,21 @@ 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 = New MalList + For Each i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next 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/vb/stepA_mal.vb b/impls/vb/stepA_mal.vb index ba289f5c3c..6d435539fc 100644 --- a/impls/vb/stepA_mal.vb +++ b/impls/vb/stepA_mal.vb @@ -61,83 +61,53 @@ 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 + ' TODO: move to types.vb when it is ported + Class FClosure + Public ast As MalVal + Public params As MalList + Public env As MalEnv + Function fn(args as MalList) As MalVal + return EVAL(ast, new MalEnv(env, params, args)) + End Function + End Class - 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(orig_ast As MalVal, env As MalEnv) As MalVal + Do - 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) + Dim dbgeval As MalVal = env.do_get("DEBUG-EVAL") + If dbgeval IsNot Nothing and dbgeval IsNot Mal.types.Nil and dbgeval IsNot Mal.types.MalFalse Then + Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) + End If + + If TypeOf orig_ast Is MalSymbol Then + Dim key As String = DirectCast(orig_ast, MalSymbol).getName() + Dim result As MalVal = env.do_get(key) + If result Is Nothing Then + throw New Mal.types.MalException("'" & key & "' not found") + End If + return result + Else If TypeOf orig_ast Is MalVector Then + Dim old_lst As MalList = DirectCast(orig_ast, MalList) Dim new_lst As MalList - If ast.list_Q() Then - new_lst = New MalList - Else new_lst = DirectCast(New MalVector, MalList) - End If Dim mv As MalVal For Each mv in old_lst.getValue() new_lst.conj_BANG(EVAL(mv, env)) Next return new_lst - Else If TypeOf ast Is MalHashMap Then + 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(ast,MalHashMap).getValue() + 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 - return ast - End If - return ast - End Function - - ' TODO: move to types.vb when it is ported - Class FClosure - Public ast As MalVal - Public params As MalList - Public env As MalEnv - Function fn(args as MalList) As MalVal - return EVAL(ast, new MalEnv(env, params, args)) - End Function - End Class - - Shared Function EVAL(orig_ast As MalVal, env As MalEnv) As MalVal - Do - - 'Console.WriteLine("EVAL: {0}", printer._pr_str(orig_ast, true)) - If not orig_ast.list_Q() Then - return eval_ast(orig_ast, env) + 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 +142,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 +151,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) @@ -210,7 +175,9 @@ Namespace Mal Throw e End Try Case "do" - eval_ast(ast.slice(1, ast.size()-1), env) + For i As Integer = 1 To ast.size()-2 + EVAL(ast(i), env) + Next orig_ast = ast(ast.size()-1) Case "if" Dim a1 As MalVal = ast(1) @@ -237,14 +204,21 @@ 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 = New MalList + For Each i As Integer = 1 To ast.size()-1 + args.conj_BANG(EVAL(ast(i), env)) + Next 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..926c004374 100644 --- a/impls/wren/stepA_mal.wren +++ b/impls/wren/stepA_mal.wren @@ -45,28 +45,20 @@ 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 eval(ast, env) { - static macroexpand(ast, env) { - while (isMacro(ast, env)) { - var macro = env.get(ast[0].value) - ast = macro.call(ast.elements[1..-1]) - } - return ast - } + while (true) { + + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } - static eval_ast(ast, env) { + // Proceed non-list types (todo: indent right) 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) + // The only case leading after this switch. } else if (ast is MalVector) { return MalVector.new(ast.elements.map { |e| eval(e, env) }.toList) } else if (ast is MalMap) { @@ -78,14 +70,7 @@ class Mal { } else { 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) + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { if (ast[0].value == "def!") { @@ -99,18 +84,14 @@ class Mal { } ast = ast[2] env = letEnv - tco = true + continue } 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 + continue } 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) } @@ -130,7 +111,7 @@ class Mal { eval(ast[i], env) } ast = ast[-1] - tco = true + continue } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { @@ -139,21 +120,22 @@ class Mal { if (ast.count <= 3) return null ast = ast[3] } - tco = true + continue } else if (ast[0].value == "fn*") { return MalFn.new(ast[2], ast[1].elements, env, Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) }) } } - if (!tco) { - var evaled_ast = eval_ast(ast, env) - var f = evaled_ast[0] + var f = eval(ast[0], env) + if (f is MalNativeFn && f.isMacro) { + ast = f.call(ast.elements[1..-1]) + } else { + var args = ast.elements[1..-1].map { |e| eval(e, env) } if (f is MalNativeFn) { - return f.call(evaled_ast[1..-1]) + return f.call(args) } else if (f is MalFn) { ast = f.ast - env = Env.new(f.env, f.params, evaled_ast[1..-1]) - tco = true + env = Env.new(f.env, f.params, args) } else { Fiber.abort("unknown function type") } diff --git a/impls/yorick/step2_eval.i b/impls/yorick/step2_eval.i index 4b9cb6861f..817e59d0fa 100644 --- a/impls/yorick/step2_eval.i +++ b/impls/yorick/step2_eval.i @@ -8,23 +8,18 @@ func READ(str) return read_str(str) } -func eval_ast(ast, env) +func EVAL(ast, env) { + // write, format="EVAL: %s\n", pr_str(ast, 1) + + // Process non-list types. type = structof(ast) if (type == MalSymbol) { val = h_get(env, ast.val) if (is_void(val)) return MalError(message=("'" + ast.val + "' not found")) return 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -46,16 +41,16 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) - if (numberof(*ast.val) == 0) return ast - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + // ast is a list + lst = *ast.val + if (numberof(lst) == 0) return ast + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } diff --git a/impls/yorick/step3_env.i b/impls/yorick/step3_env.i index cf56f84c37..fdaa0f8d90 100644 --- a/impls/yorick/step3_env.i +++ b/impls/yorick/step3_env.i @@ -9,21 +9,19 @@ func READ(str) return read_str(str) } -func eval_ast(ast, env) +func EVAL(ast, env) { + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + + // Process non-list types. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -45,12 +43,8 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // ast is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -69,9 +63,12 @@ func EVAL(ast, env) } return EVAL(*lst(3), let_env) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) } diff --git a/impls/yorick/step4_if_fn_do.i b/impls/yorick/step4_if_fn_do.i index 8c20c070d9..6236823e7a 100644 --- a/impls/yorick/step4_if_fn_do.i +++ b/impls/yorick/step4_if_fn_do.i @@ -9,21 +9,19 @@ func READ(str) return read_str(str) } -func eval_ast(ast, env) +func EVAL(ast, env) { + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + + // Process non-list types. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -45,12 +43,8 @@ func eval_ast(ast, env) } return MalHashmap(val=&res) } else return ast -} - -func EVAL(ast, env) -{ if (structof(ast) == MalError) return ast - if (structof(ast) != MalList) return eval_ast(ast, env) + // ast is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -90,9 +84,12 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) diff --git a/impls/yorick/step5_tco.i b/impls/yorick/step5_tco.i index 159d95640c..67a06dc8aa 100644 --- a/impls/yorick/step5_tco.i +++ b/impls/yorick/step5_tco.i @@ -9,21 +9,21 @@ func READ(str) return read_str(str) } -func eval_ast(ast, env) +func EVAL(ast, env) { + while (1) { + + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -45,13 +45,8 @@ func eval_ast(ast, env) } 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 is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -94,9 +89,12 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) diff --git a/impls/yorick/step6_file.i b/impls/yorick/step6_file.i index 3ae3a8dabd..e010d7ceca 100644 --- a/impls/yorick/step6_file.i +++ b/impls/yorick/step6_file.i @@ -9,21 +9,21 @@ func READ(str) return read_str(str) } -func eval_ast(ast, env) +func EVAL(ast, env) { + while (1) { + + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -45,13 +45,8 @@ func eval_ast(ast, env) } 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 is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -94,9 +89,12 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) diff --git a/impls/yorick/step7_quote.i b/impls/yorick/step7_quote.i index 273aa0efe4..1c5724ff05 100644 --- a/impls/yorick/step7_quote.i +++ b/impls/yorick/step7_quote.i @@ -47,21 +47,21 @@ func quasiquote(ast) } } -func eval_ast(ast, env) +func EVAL(ast, env) { + while (1) { + + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } + + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -83,13 +83,8 @@ func eval_ast(ast, env) } 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 is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -111,8 +106,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 == "do") { @@ -138,9 +131,12 @@ func EVAL(ast, env) } else if (a1 == "fn*") { return MalFunction(env=&env, binds=lst(2)->val, ast=lst(3)) } else { - el = eval_ast(ast, env) - if (structof(el) == MalError) return el - seq = *el.val + seq = array(pointer, numberof(lst)) + for (i = 1; i <= numberof(args); ++i) { + e = EVAL(*lst(1+i), env) + if (structof(e) == MalError) return e + seq(i) = &e + } if (structof(*seq(1)) == MalNativeFunction) { args = (numberof(seq) > 1) ? seq(2:) : [] return call_core_fn(seq(1)->val, args) diff --git a/impls/yorick/step8_macros.i b/impls/yorick/step8_macros.i index a52a0d3b6b..9e34d09551 100644 --- a/impls/yorick/step8_macros.i +++ b/impls/yorick/step8_macros.i @@ -47,46 +47,21 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) +func EVAL(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) -} + while (1) { -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 -} + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } -func eval_ast(ast, env) -{ + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +83,8 @@ func eval_ast(ast, env) } 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) + // ast is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +106,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 +113,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 == "do") { for (i = 2; i < numberof(lst); ++i) { ret = EVAL(*lst(i), env) @@ -172,16 +136,29 @@ 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 + } + // Evaluate arguments + 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 + } + } + // Apply + 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 diff --git a/impls/yorick/step9_try.i b/impls/yorick/step9_try.i index 6d46571ddc..2a2a241f6d 100644 --- a/impls/yorick/step9_try.i +++ b/impls/yorick/step9_try.i @@ -47,46 +47,21 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) +func EVAL(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) -} + while (1) { -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 -} + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } -func eval_ast(ast, env) -{ + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +83,8 @@ func eval_ast(ast, env) } 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) + // ast is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +106,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 +113,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 +150,29 @@ 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 + } + // Evaluate arguments + 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 + } + } + // Apply + 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 diff --git a/impls/yorick/stepA_mal.i b/impls/yorick/stepA_mal.i index fe90a24892..7866ee972b 100644 --- a/impls/yorick/stepA_mal.i +++ b/impls/yorick/stepA_mal.i @@ -47,46 +47,21 @@ func quasiquote(ast) } } -func is_macro_call(ast, env) +func EVAL(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) -} + while (1) { -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 -} + dbgeval = structof(env_get(env, "DEBUG-EVAL")) + if ((dbgeval != MalError) && (dbgeval != MalNil) && (dbgeval != MalFalse)) { + write, format="EVAL: %s\n", pr_str(ast, 1) + } -func eval_ast(ast, env) -{ + // Process non-list types. Indentation is historical. 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) + // Proceed after this switch. } else if (type == MalVector) { seq = *(ast.val) if (numberof(seq) == 0) return ast @@ -108,15 +83,8 @@ func eval_ast(ast, env) } 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) + // ast is a list lst = *ast.val if (numberof(lst) == 0) return ast a1 = lst(1)->val @@ -138,8 +106,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 +113,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 +150,29 @@ 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 + } + // Evaluate arguments + 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 + } + } + // Apply + 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 diff --git a/process/guide.md b/process/guide.md index ec3deaaaeb..c3e3ca43fb 100644 --- a/process/guide.md +++ b/process/guide.md @@ -541,23 +541,17 @@ 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 - * otherwise just return the original `ast` value + the value. + If the key is missing, throw/raise a "not found" error. -* 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. + * `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 If your target language does not have full variable length argument support (e.g. variadic, vararg, splats, apply) then you will need to @@ -585,8 +579,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`: +* Add a print statement at the top of the main `eval` function, for + debugging issues or simply figuring how evaluation works. + The statement should be active when `env` contains the `DEBUG-EVAL` + key and the associated value is neither `nil` nor `false`. + For consistency, it should print "EVAL: " followed by the current + value of `ast` formatted with `pr_str` with the readably flag set. + Feel free to add any information you see fit, for example the + contents of `env`. + +* `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 @@ -634,19 +637,19 @@ diff -urp ../process/step2_eval.txt ../process/step3_env.txt * Define three methods for the Env object: * set: takes a symbol key and a mal value and adds to the `data` structure - * find: takes a symbol key and if the current environment contains - that key then return the environment. If no key is found and outer - is not `nil` then call find (recurse) on the outer environment. - * get: takes a symbol key and uses the `find` method to locate the - environment with the key, then returns the matching value. If no - key is found up the outer chain, then throws/raises a "not found" - error. + * get: takes a symbol key and if the current environment contains + that key then return the matching value. If no key is found and outer + is not `nil` then call get (recurse) on the outer environment. + Depending on the host language, a loop structure may be more + simple or efficient than a recursion. + If no key is found up the outer chain, then report that the key is + missing with the most idiomatic mechanism. * Update `step3_env.qx` to use the new `Env` type to create the 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 +670,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 +759,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 +907,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 +932,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 +1218,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 +1232,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 +1316,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 +1348,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..d24a365a0e 100644 --- a/process/step2_eval.txt +++ b/process/step2_eval.txt @@ -3,18 +3,17 @@ 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) + OR raise "'"+k+"' not found" + [form1 ..]: return [EVAL(form1, env) ..] + {key1 value1 ..}: return {key1 EVAL(value1, env) ..} + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) diff --git a/process/step3_env.txt b/process/step3_env.txt index 0210efccf8..bf2daf7d42 100644 --- a/process/step3_env.txt +++ b/process/step3_env.txt @@ -3,21 +3,23 @@ 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): + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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) + args = [EVAL(arg1, env) ..] + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -35,5 +37,4 @@ main loop: class Env (outer=null) data = hash_map() set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) diff --git a/process/step4_if_fn_do.txt b/process/step4_if_fn_do.txt index f92e141c60..246b1ab721 100644 --- a/process/step4_if_fn_do.txt +++ b/process/step4_if_fn_do.txt @@ -3,24 +3,35 @@ 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): + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then: return EVAL(yes, env) + else: return EVAL(no, env) + ('if tst yes): if EVAL(tst, 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) + args = [EVAL(arg1, env) ..] + if malfn?(f): + return EVAL(f.impl, + new Env(f.env, f.parm, args)) + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -44,8 +55,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step5_tco.txt b/process/step5_tco.txt index cb1d4125b4..2132c0c6e6 100644 --- a/process/step5_tco.txt +++ b/process/step5_tco.txt @@ -3,26 +3,34 @@ 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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -46,8 +54,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step6_file.txt b/process/step6_file.txt index ca4f7061ac..4ffd32a7e6 100644 --- a/process/step6_file.txt +++ b/process/step6_file.txt @@ -3,26 +3,34 @@ 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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -51,8 +59,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step7_quote.txt b/process/step7_quote.txt index fb29c98bb3..e84f77af1c 100644 --- a/process/step7_quote.txt +++ b/process/step7_quote.txt @@ -5,28 +5,36 @@ 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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[key1 ..]) + ('fn* ['key1 ..] impl): // idem + ('quote form): return form + ('quasiquote form): ast = quasiquote(form) + (callable arg1 ..): f = EVAL(callable, env) + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -55,8 +63,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step8_macros.txt b/process/step8_macros.txt index 52f01e33f6..ef7a75c8e0 100644 --- a/process/step8_macros.txt +++ b/process/step8_macros.txt @@ -5,37 +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) - '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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[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 ..]) + continue + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -65,8 +67,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/step9_try.txt b/process/step9_try.txt index 35217b98ee..b2054c7d4a 100644 --- a/process/step9_try.txt +++ b/process/step9_try.txt @@ -5,38 +5,44 @@ 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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[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 then: + 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 ..]) + continue + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -66,8 +72,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?, diff --git a/process/stepA_mal.txt b/process/stepA_mal.txt index 1ea14698f8..e5e184cdfd 100644 --- a/process/stepA_mal.txt +++ b/process/stepA_mal.txt @@ -5,38 +5,44 @@ 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: + if env.get('DEBUG-EVAL) then prn('EVAL ast) + match ast: + 'key: return env.get(key) + OR raise "'"+k+"' not found" + [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 tst yes no): if EVAL(tst, env) then ast = yes else ast = no + ('if tst yes): if EVAL(tst, env) then ast = yes else return nil + ('fn* ('key1 ..) impl): return new MalFn(env, impl, parm=[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 then: + 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 ..]) + continue + args = [EVAL(arg1, env) ..] + if malfn?(f): env = new Env(f.env, f.parm, args) + ast = f.impl + continue + return apply(f, args) + otherwise: return ast PRINT(exp): return printer.pr_str(exp) @@ -68,8 +74,7 @@ class Env (outer=null,binds=[],exprs=[]) if binds[i] == '&: data[binds[i+1]] = exprs.drop(i); break else: data[binds[i]] = exprs[i] set(k,v): return data.set(k,v) - find(k): return data.has(k) ? this : (if outer ? find(outer) : null) - get(k): return data.find(k).get(k) OR raise "'" + k + "' not found" + get(k): return data.has(k) ? data.get(k) : (outer ? outer.get(k) : null) --- core module --------------------------------- ns = {'=: equal?,