mirror of
https://github.com/kanaka/mal.git
synced 2024-09-11 13:55:55 +03:00
Merge eval-ast and macro expansion into EVAL, add DEBUG-EVAL
See issue #587. * Merge eval-ast and eval into a single conditional. * Expand macros during the apply phase, removing lots of duplicate tests, and increasing the overall consistency by allowing the macro to be computed instead of referenced by name (`((defmacro! cond (...)))` is currently illegal for example). * Print "EVAL: $ast" at the top of EVAL if DEBUG-EVAL exists in the MAL environment. * Remove macroexpand and quasiquoteexpand special forms. * Use pattern-matching style in process/step*.txt. Unresolved issues: c.2: unable to reproduce with gcc 11.12.0. elm: the directory is unchanged. groovy: sometimes fail, but not on each rebuild. nasm: fails some new soft tests, but the issue is unreproducible when running the interpreter manually. objpascal: unreproducible with fpc 3.2.2. ocaml: unreproducible with 4.11.1. perl6: unreproducible with rakudo 2021.09. Unrelated changes: Reduce diff betweens steps. Prevent defmacro! from mutating functions: c forth logo miniMAL vb. dart: fix recent errors and warnings ocaml: remove metadata from symbols. Improve the logo implementation. Encapsulate all representation in types.lg and env.lg, unwrap numbers. Replace some manual iterations with logo control structures. Reduce the diff between steps. Use native iteration in env_get and env_map Rewrite the reader with less temporary strings. Reduce the number of temporary lists (for example, reverse iteration with butlast requires O(n^2) allocations). It seems possible to remove a few exceptions: GC settings (Dockerfile), NO_SELF_HOSTING (IMPLS.yml) and step5_EXCLUDES (Makefile.impls) .
This commit is contained in:
parent
cb333f1387
commit
033892777a
@ -49,7 +49,7 @@ IMPL:
|
||||
- {IMPL: julia}
|
||||
- {IMPL: kotlin}
|
||||
- {IMPL: livescript}
|
||||
- {IMPL: logo, NO_SELF_HOST: 1} # step4 timeout
|
||||
- {IMPL: logo}
|
||||
- {IMPL: lua}
|
||||
- {IMPL: make, NO_SELF_HOST: 1} # step4 timeout
|
||||
- {IMPL: mal, MAL_IMPL: js, BUILD_IMPL: js, NO_SELF_HOST: 1}
|
||||
|
@ -43,7 +43,6 @@ IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lis
|
||||
|
||||
step5_EXCLUDES += bash # never completes at 10,000
|
||||
step5_EXCLUDES += basic # too slow, and limited to ints of 2^16
|
||||
step5_EXCLUDES += logo # too slow for 10,000
|
||||
step5_EXCLUDES += make # no TCO capability (iteration or recursion)
|
||||
step5_EXCLUDES += mal # host impl dependent
|
||||
step5_EXCLUDES += matlab # never completes at 10,000
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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,8 +13,6 @@ with Types.Strings;
|
||||
|
||||
procedure Step2_Eval is
|
||||
|
||||
Dbgeval : constant Boolean := Ada.Environment_Variables.Exists ("dbgeval");
|
||||
|
||||
use type Types.T;
|
||||
use all type Types.Kind_Type;
|
||||
|
||||
@ -52,12 +49,8 @@ procedure Step2_Eval is
|
||||
is
|
||||
First : Types.T;
|
||||
begin
|
||||
if Dbgeval then
|
||||
Ada.Text_IO.New_Line;
|
||||
Ada.Text_IO.Put ("EVAL: ");
|
||||
Print (Ast);
|
||||
end if;
|
||||
|
||||
-- Ada.Text_IO.Put ("EVAL: ");
|
||||
-- Print (Ast);
|
||||
case Ast.Kind is
|
||||
when Kind_Nil | Kind_Atom | Kind_Boolean | Kind_Number | Types.Kind_Key
|
||||
| Kind_Macro | Types.Kind_Function =>
|
||||
|
@ -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,7 @@ 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 +207,7 @@ begin
|
||||
-- Collect garbage.
|
||||
Err.Data := Types.Nil;
|
||||
Repl.all.Keep;
|
||||
Dbgeval.Keep;
|
||||
Garbage_Collected.Clean;
|
||||
end loop;
|
||||
Ada.Text_IO.New_Line;
|
||||
|
@ -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,7 @@ 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 +79,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 +245,7 @@ begin
|
||||
-- Collect garbage.
|
||||
Err.Data := Types.Nil;
|
||||
Repl.all.Keep;
|
||||
Dbgeval.Keep;
|
||||
Garbage_Collected.Clean;
|
||||
end loop;
|
||||
Ada.Text_IO.New_Line;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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
|
||||
<<Restart>>
|
||||
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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -109,6 +109,19 @@ procedure Step2_Eval is
|
||||
end Call_Eval;
|
||||
|
||||
begin
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
|
||||
function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map)
|
||||
return Mal_Handle is
|
||||
First_Elem : Mal_Handle;
|
||||
Ast : Mal_Handle renames Param; -- Historic
|
||||
begin
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
case Deref (Ast).Sym_Type is
|
||||
|
||||
@ -129,27 +142,10 @@ procedure Step2_Eval is
|
||||
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 (Param : Mal_Handle; Env : String_Mal_Hash.Map)
|
||||
return Mal_Handle is
|
||||
First_Elem : Mal_Handle;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
case Deref_List (Param).Get_List_Type is
|
||||
when Hashed_List | Vector_List =>
|
||||
return Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
declare
|
||||
Evaled_H, First_Param : Mal_Handle;
|
||||
@ -169,12 +165,10 @@ procedure Step2_Eval is
|
||||
return Call_Func (Deref_Func (First_Param).all, Cdr (Evaled_List));
|
||||
end;
|
||||
|
||||
else -- Not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -65,8 +65,6 @@ procedure Step3_Env is
|
||||
function Eval (Param : Types.Mal_Handle; Env : Envs.Env_Handle)
|
||||
return Types.Mal_Handle;
|
||||
|
||||
Debug : Boolean := False;
|
||||
|
||||
|
||||
function Read (Param : String) return Types.Mal_Handle is
|
||||
begin
|
||||
@ -112,6 +110,31 @@ procedure Step3_Env is
|
||||
end Call_Eval;
|
||||
|
||||
begin
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
|
||||
function Eval (Param : Mal_Handle; Env : Envs.Env_Handle)
|
||||
return Mal_Handle is
|
||||
Ast : Mal_Handle renames Param; -- Historic
|
||||
begin
|
||||
declare
|
||||
M : Mal_Handle;
|
||||
B : Boolean;
|
||||
begin
|
||||
M := Envs.Get (Env, "DEBUG-EVAL");
|
||||
case Deref (M).Sym_Type is
|
||||
when Bool => B := Deref_Bool (M).Get_Bool;
|
||||
when Nil => B := False;
|
||||
when others => B := True;
|
||||
end case;
|
||||
if B then
|
||||
Ada.Text_IO.Put_Line ("EVAL: " & Deref (Param).To_String);
|
||||
end if;
|
||||
exception
|
||||
when Envs.Not_Found => null;
|
||||
end;
|
||||
|
||||
case Deref (Ast).Sym_Type is
|
||||
|
||||
@ -132,27 +155,10 @@ procedure Step3_Env is
|
||||
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 (Param : Mal_Handle; Env : Envs.Env_Handle)
|
||||
return Mal_Handle is
|
||||
First_Elem : Mal_Handle;
|
||||
begin
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
case Deref_List (Param).Get_List_Type is
|
||||
when Hashed_List | Vector_List =>
|
||||
return Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
declare
|
||||
Evaled_H, First_Param, Rest_List : Mal_Handle;
|
||||
@ -184,12 +190,10 @@ procedure Step3_Env is
|
||||
|
||||
end;
|
||||
|
||||
else -- Not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
@ -244,12 +248,6 @@ begin
|
||||
-- as we know Eval will be in scope for the lifetime of the program.
|
||||
Eval_Callback.Eval := Eval'Unrestricted_Access;
|
||||
|
||||
if Ada.Command_Line.Argument_Count > 0 then
|
||||
if Ada.Command_Line.Argument (1) = "-d" then
|
||||
Debug := True;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Repl_Env := Envs.New_Env;
|
||||
|
||||
Init (Repl_Env);
|
||||
|
@ -102,6 +102,23 @@ procedure Step4_If_Fn_Do is
|
||||
end Call_Eval;
|
||||
|
||||
begin
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
|
||||
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;
|
||||
Ast : Mal_Handle renames Param; -- Historic
|
||||
begin
|
||||
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 (Ast).Sym_Type is
|
||||
|
||||
@ -122,27 +139,10 @@ procedure Step4_If_Fn_Do is
|
||||
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 (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
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
case Deref_List (Param).Get_List_Type is
|
||||
when Hashed_List | Vector_List =>
|
||||
return Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -234,12 +234,10 @@ procedure Step4_If_Fn_Do is
|
||||
|
||||
end if;
|
||||
|
||||
else -- Not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -71,6 +71,31 @@ procedure Step5_TCO is
|
||||
end Call_Eval;
|
||||
|
||||
begin
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
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;
|
||||
Ast : Mal_Handle renames Param; -- Historic
|
||||
begin
|
||||
|
||||
Param := AParam;
|
||||
Env := AnEnv;
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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 (Ast).Sym_Type is
|
||||
|
||||
@ -91,35 +116,10 @@ procedure Step5_TCO is
|
||||
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;
|
||||
begin
|
||||
|
||||
Param := AParam;
|
||||
Env := AnEnv;
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
case Deref_List (Param).Get_List_Type is
|
||||
when Hashed_List | Vector_List =>
|
||||
return Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -278,12 +278,10 @@ procedure Step5_TCO is
|
||||
|
||||
end if;
|
||||
|
||||
else -- Not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -74,6 +74,33 @@ procedure Step6_File is
|
||||
end Call_Eval;
|
||||
|
||||
begin
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
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;
|
||||
Ast : Mal_Handle renames Param; -- Historic
|
||||
begin
|
||||
|
||||
Param := AParam;
|
||||
Env := AnEnv;
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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 (Ast).Sym_Type is
|
||||
|
||||
@ -94,35 +121,10 @@ procedure Step6_File is
|
||||
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;
|
||||
begin
|
||||
|
||||
Param := AParam;
|
||||
Env := AnEnv;
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
case Deref_List (Param).Get_List_Type is
|
||||
when Hashed_List | Vector_List =>
|
||||
return Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -281,12 +283,10 @@ procedure Step6_File is
|
||||
|
||||
end if;
|
||||
|
||||
else -- not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -71,33 +71,8 @@ procedure Step7_Quote is
|
||||
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;
|
||||
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
@ -190,12 +165,34 @@ procedure Step7_Quote is
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
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 Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -305,11 +302,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
|
||||
|
||||
@ -370,12 +362,10 @@ procedure Step7_Quote is
|
||||
|
||||
end if;
|
||||
|
||||
else -- not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -59,52 +59,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
|
||||
@ -137,33 +91,8 @@ procedure Step8_Macros is
|
||||
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;
|
||||
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
@ -256,18 +185,34 @@ procedure Step8_Macros is
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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);
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
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 Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -286,9 +231,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 +325,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 +334,10 @@ 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 := Eval_Ast (Rest_Params, Env);
|
||||
return Call_Func (Deref_Func (First_Param).all, Rest_Params);
|
||||
elsif Deref (First_Param).Sym_Type = Lambda then
|
||||
declare
|
||||
@ -421,6 +350,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 := Eval_Ast (Rest_Params, Env);
|
||||
|
||||
E := Envs.New_Env (L.Get_Env);
|
||||
|
||||
Param_Names := Deref_List (L.Get_Params).all;
|
||||
@ -444,16 +383,12 @@ procedure Step8_Macros is
|
||||
raise Runtime_Exception with "Deref called on non-Func/Lambda";
|
||||
end if;
|
||||
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
||||
else -- not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -59,52 +59,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
|
||||
@ -137,33 +91,8 @@ procedure Step9_Try is
|
||||
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;
|
||||
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
@ -282,18 +211,34 @@ procedure Step9_Try is
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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);
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
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 Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -312,9 +257,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 +351,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 +387,10 @@ 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 := Eval_Ast (Rest_Params, Env);
|
||||
return Call_Func (Deref_Func (First_Param).all, Rest_Params);
|
||||
elsif Deref (First_Param).Sym_Type = Lambda then
|
||||
declare
|
||||
@ -474,6 +403,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 := Eval_Ast (Rest_Params, Env);
|
||||
|
||||
E := Envs.New_Env (L.Get_Env);
|
||||
|
||||
Param_Names := Deref_List (L.Get_Params).all;
|
||||
@ -497,16 +436,12 @@ procedure Step9_Try is
|
||||
raise Runtime_Exception with "Deref called on non-Func/Lambda";
|
||||
end if;
|
||||
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
||||
else -- not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -59,53 +59,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
|
||||
@ -138,33 +91,8 @@ procedure StepA_Mal is
|
||||
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;
|
||||
|
||||
pragma Assert (Deref (Ast).Sym_Type = List); -- list, map or vector
|
||||
return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
|
||||
end Eval_Ast;
|
||||
|
||||
function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
|
||||
@ -283,18 +211,34 @@ procedure StepA_Mal is
|
||||
|
||||
<<Tail_Call_Opt>>
|
||||
|
||||
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);
|
||||
|
||||
if Debug then
|
||||
Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String);
|
||||
end if;
|
||||
|
||||
if Deref (Param).Sym_Type = List and then
|
||||
Deref_List (Param).Get_List_Type = List_List then
|
||||
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 Eval_Ast (Param, Env);
|
||||
when List_List =>
|
||||
|
||||
Param_List := Deref_List (Param).all;
|
||||
|
||||
@ -313,9 +257,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 +351,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 +387,10 @@ 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 := Eval_Ast (Rest_Params, Env);
|
||||
return Call_Func (Deref_Func (First_Param).all, Rest_Params);
|
||||
elsif Deref (First_Param).Sym_Type = Lambda then
|
||||
declare
|
||||
@ -475,6 +403,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 := Eval_Ast (Rest_Params, Env);
|
||||
|
||||
E := Envs.New_Env (L.Get_Env);
|
||||
|
||||
Param_Names := Deref_List (L.Get_Params).all;
|
||||
@ -498,16 +436,12 @@ procedure StepA_Mal is
|
||||
raise Runtime_Exception with "Deref called on non-Func/Lambda";
|
||||
end if;
|
||||
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
||||
else -- not a List_List
|
||||
|
||||
return Eval_Ast (Param, Env);
|
||||
|
||||
end if;
|
||||
|
||||
end case;
|
||||
when others => -- not a list, map, symbol or vector
|
||||
return Param;
|
||||
end case;
|
||||
end Eval;
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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) "."
|
||||
}
|
||||
|
@ -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 /^\$/:
|
||||
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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 !~ /^\(/) {
|
||||
|
||||
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
|
||||
}
|
||||
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 !~ /^\(/) {
|
||||
ret = eval_ast(ast, env)
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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 !~ /^\(/) {
|
||||
|
||||
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
|
||||
}
|
||||
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 !~ /^\(/) {
|
||||
ret = eval_ast(ast, env)
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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 !~ /^\(/) {
|
||||
|
||||
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
|
||||
}
|
||||
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 !~ /^\(/) {
|
||||
ret = eval_ast(ast, env)
|
||||
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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -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,27 +34,17 @@ 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}"
|
||||
_map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${r}"
|
||||
|
@ -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,7 +71,7 @@ EVAL () {
|
||||
done
|
||||
EVAL "${a2}" "${let_env}"
|
||||
return ;;
|
||||
*) EVAL_AST "${ast}" "${env}"
|
||||
*) _map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && r= && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${r}"
|
||||
|
@ -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,7 +95,7 @@ EVAL () {
|
||||
fn__STAR__) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \
|
||||
EVAL \"${a2}\" \"\${r}\""
|
||||
return ;;
|
||||
*) EVAL_AST "${ast}" "${env}"
|
||||
*) _map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && r= && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${ANON["${r}"]}"
|
||||
|
@ -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,7 +105,7 @@ EVAL () {
|
||||
EVAL \"${a2}\" \"\${r}\"" \
|
||||
"${a2}" "${env}" "${a1}"
|
||||
return ;;
|
||||
*) EVAL_AST "${ast}" "${env}"
|
||||
*) _map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && r= && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${ANON["${r}"]}"
|
||||
|
@ -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,7 +105,7 @@ EVAL () {
|
||||
EVAL \"${a2}\" \"\${r}\"" \
|
||||
"${a2}" "${env}" "${a1}"
|
||||
return ;;
|
||||
*) EVAL_AST "${ast}" "${env}"
|
||||
*) _map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && r= && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${ANON["${r}"]}"
|
||||
|
@ -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,7 +156,7 @@ EVAL () {
|
||||
EVAL \"${a2}\" \"\${r}\"" \
|
||||
"${a2}" "${env}" "${a1}"
|
||||
return ;;
|
||||
*) EVAL_AST "${ast}" "${env}"
|
||||
*) _map_with_type _list EVAL "${ast}" "${env}"
|
||||
[[ "${__ERROR}" ]] && r= && return 1
|
||||
local el="${r}"
|
||||
_first "${el}"; local f="${ANON["${r}"]}"
|
||||
|
@ -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
|
||||
_symbol DEBUG-EVAL; debug_eval="$r"
|
||||
|
||||
EVAL () {
|
||||
local ast="${1}" env="${2}"
|
||||
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
|
||||
return 1
|
||||
}
|
||||
|
||||
MACROEXPAND () {
|
||||
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}"
|
||||
}
|
||||
|
||||
|
||||
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//@/ }
|
||||
|
@ -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
|
||||
_symbol DEBUG-EVAL; debug_eval="$r"
|
||||
|
||||
EVAL () {
|
||||
local ast="${1}" env="${2}"
|
||||
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
|
||||
return 1
|
||||
}
|
||||
|
||||
MACROEXPAND () {
|
||||
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}"
|
||||
}
|
||||
|
||||
|
||||
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//@/ }
|
||||
|
@ -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
|
||||
_symbol DEBUG-EVAL; debug_eval="$r"
|
||||
|
||||
EVAL () {
|
||||
local ast="${1}" env="${2}"
|
||||
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
|
||||
return 1
|
||||
}
|
||||
|
||||
MACROEXPAND () {
|
||||
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}"
|
||||
}
|
||||
|
||||
|
||||
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//@/ }
|
||||
|
@ -1,39 +1,36 @@
|
||||
REM > env library for mal in BBC BASIC
|
||||
|
||||
DEF FNnew_env(outer%, binds%, exprs%)
|
||||
LOCAL env%
|
||||
LOCAL env%, key$
|
||||
env% = FNalloc_environment(outer%)
|
||||
WHILE NOT FNis_empty(binds%)
|
||||
IF FNunbox_symbol(FNfirst(binds%)) = "&" THEN
|
||||
PROCenv_set(env%, FNnth(binds%, 1), FNas_list(exprs%))
|
||||
key$ = FNunbox_symbol(FNfirst(binds%))
|
||||
IF key$ = "&" THEN
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(binds%, 1)), FNas_list(exprs%))
|
||||
binds% = FNempty
|
||||
ELSE
|
||||
PROCenv_set(env%, FNfirst(binds%), FNfirst(exprs%))
|
||||
PROCenv_set(env%, key$, FNfirst(exprs%))
|
||||
binds% = FNrest(binds%) : exprs% = FNrest(exprs%)
|
||||
ENDIF
|
||||
ENDWHILE
|
||||
=env%
|
||||
|
||||
DEF PROCenv_set(env%, keysym%, val%)
|
||||
DEF PROCenv_set(env%, key$, val%)
|
||||
LOCAL data%
|
||||
data% = FNenvironment_data(env%)
|
||||
data% = FNhashmap_set(data%, FNunbox_symbol(keysym%), val%)
|
||||
data% = FNhashmap_set(data%, key$, val%)
|
||||
PROCenvironment_set_data(env%, data%)
|
||||
ENDPROC
|
||||
|
||||
DEF FNenv_find(env%, keysym%)
|
||||
LOCAL val%, outer%, key$
|
||||
key$ = FNunbox_symbol(keysym%)
|
||||
DEF FNenv_find(env%, key$)
|
||||
WHILE NOT FNis_nil(env%)
|
||||
IF FNhashmap_contains(FNenvironment_data(env%), key$) THEN =env%
|
||||
env% = FNenvironment_outer(env%)
|
||||
ENDWHILE
|
||||
=FNnil
|
||||
|
||||
DEF FNenv_get(env%, keysym%)
|
||||
LOCAL key$
|
||||
env% = FNenv_find(env%, keysym%)
|
||||
key$ = FNunbox_symbol(keysym%)
|
||||
DEF FNenv_get(env%, key$)
|
||||
env% = FNenv_find(env%, key$)
|
||||
IF FNis_nil(env%) THEN ERROR &40E80922, "'"+key$+"' not found"
|
||||
=FNhashmap_get(FNenvironment_data(env%), key$)
|
||||
|
||||
|
@ -30,10 +30,28 @@ DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNEVAL(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
LOCAL car%, val%, key$
|
||||
REM PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
IF FNis_symbol(ast%) THEN
|
||||
val% = FNhashmap_get(env%, FNunbox_symbol(ast%))
|
||||
IF val% = FNnil THEN ERROR &40E80922, "Symbol not in environment"
|
||||
=val%
|
||||
ENDIF
|
||||
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% = FNeval_ast(ast%, env%)
|
||||
=FNcore_call(FNunbox_corefn(FNfirst(ast%)), FNrest(ast%))
|
||||
car% = FNEVAL(FNfirst(ast%), env%)
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(car%, FNeval_ast(FNrest(ast%), env%))
|
||||
=FNcore_call(FNunbox_corefn(car%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -42,30 +60,8 @@ 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
|
||||
val% = FNhashmap_get(env%, FNunbox_symbol(ast%))
|
||||
IF val% = FNnil THEN ERROR &40E80922, "Symbol not in environment"
|
||||
=val%
|
||||
ENDIF
|
||||
IF FNis_seq(ast%) THEN
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
REM Call a core function, taking the function number and a mal list of
|
||||
REM objects to pass as arguments.
|
||||
|
@ -9,10 +9,10 @@ PROCtypes_init
|
||||
|
||||
REM These correspond with the CASE statement in FNcore_call
|
||||
repl_env% = FNalloc_environment(FNnil)
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("+"), FNalloc_corefn(0))
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("-"), FNalloc_corefn(1))
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*"), FNalloc_corefn(2))
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("/"), FNalloc_corefn(3))
|
||||
PROCenv_set(repl_env%, "+", FNalloc_corefn(0))
|
||||
PROCenv_set(repl_env%, "-", FNalloc_corefn(1))
|
||||
PROCenv_set(repl_env%, "*", FNalloc_corefn(2))
|
||||
PROCenv_set(repl_env%, "/", FNalloc_corefn(3))
|
||||
|
||||
sav% = FNgc_save
|
||||
REPEAT
|
||||
@ -31,31 +31,53 @@ DEF FNREAD(a$)
|
||||
=FNread_str(FNalloc_string(a$))
|
||||
|
||||
DEF FNEVAL(ast%, env%)
|
||||
LOCAL car%
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
LOCAL val%
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
=val%
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
LOCAL bindings%
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
=FNEVAL(FNnth(ast%, 2), env%)
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
=FNEVAL(FNnth(ast%, 2), env%)
|
||||
OTHERWISE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
=FNcore_call(FNunbox_corefn(FNfirst(ast%)), FNrest(ast%))
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -64,26 +86,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
REM Call a core function, taking the function number and a mal list of
|
||||
REM objects to pass as arguments.
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -41,53 +41,71 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
LOCAL val%
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
=val%
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
LOCAL bindings%
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
=FNEVAL(FNnth(ast%, 2), env%)
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
=FNEVAL(FNnth(ast%, 2), env%)
|
||||
WHEN "do"
|
||||
LOCAL val%
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
REPEAT
|
||||
val% = FNfirst(ast%)
|
||||
ast% = FNrest(ast%)
|
||||
UNTIL FNis_empty(ast%)
|
||||
=val%
|
||||
WHILE TRUE
|
||||
ast% = FNrest(ast%)
|
||||
IF FNis_empty(ast%) THEN = val%
|
||||
val% = FNEVAL(FNfirst(ast%), env%)
|
||||
ENDWHILE
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
=FNEVAL(FNnth(ast%, 2), env%)
|
||||
ENDIF
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
=FNEVAL(FNnth(ast%, 3), env%)
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN =FNEVAL(FNnth(ast%, 2), env%)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
=FNEVAL(FNnth(ast%, 3), env%)
|
||||
WHEN "fn*"
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
OTHERWISE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
=FNEVAL(FNfn_ast(car%), env%)
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
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%), ast%)
|
||||
=FNEVAL(FNfn_ast(car%), env%)
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
@ -98,26 +116,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
REM Local Variables:
|
||||
REM indent-tabs-mode: nil
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -40,30 +40,47 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%
|
||||
car% = FNfirst(ast%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -75,35 +92,34 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -112,26 +128,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
REM Local Variables:
|
||||
REM indent-tabs-mode: nil
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -30,9 +30,9 @@ UNTIL form$ = ""
|
||||
argv% = FNget_argv
|
||||
|
||||
IF FNis_empty(argv%) THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty)
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNempty)
|
||||
ELSE
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%))
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%))
|
||||
val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")")
|
||||
END
|
||||
ENDIF
|
||||
@ -58,30 +58,47 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%
|
||||
car% = FNfirst(ast%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -93,35 +110,34 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=FNalloc_fn(FNnth(ast%, 2), FNnth(ast%, 1), env%)
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -130,26 +146,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNget_argv
|
||||
PROCgc_enter
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -30,9 +30,9 @@ UNTIL form$ = ""
|
||||
argv% = FNget_argv
|
||||
|
||||
IF FNis_empty(argv%) THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty)
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNempty)
|
||||
ELSE
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%))
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%))
|
||||
val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")")
|
||||
END
|
||||
ENDIF
|
||||
@ -86,30 +86,47 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%
|
||||
car% = FNfirst(ast%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -121,42 +138,39 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=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
|
||||
GOTO 31416
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(FNrest(ast%), env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -165,26 +179,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNget_argv
|
||||
PROCgc_enter
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -31,9 +31,9 @@ UNTIL form$ = ""
|
||||
argv% = FNget_argv
|
||||
|
||||
IF FNis_empty(argv%) THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty)
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNempty)
|
||||
ELSE
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%))
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%))
|
||||
val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")")
|
||||
END
|
||||
ENDIF
|
||||
@ -82,63 +82,57 @@ 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 FNEVAL(ast%, env%)
|
||||
PROCgc_enter
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "defmacro!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
IF FNis_fn(val%) THEN val% = FNas_macro(val%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -150,44 +144,44 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=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%)
|
||||
GOTO 31416
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNrest(ast%)
|
||||
IF FNis_macro(car%) THEN
|
||||
ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%))
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -196,26 +190,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNget_argv
|
||||
PROCgc_enter
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -31,9 +31,9 @@ UNTIL form$ = ""
|
||||
argv% = FNget_argv
|
||||
|
||||
IF FNis_empty(argv%) THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty)
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNempty)
|
||||
ELSE
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%))
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%))
|
||||
val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")")
|
||||
END
|
||||
ENDIF
|
||||
@ -82,27 +82,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*'.
|
||||
@ -150,37 +129,52 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "defmacro!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
IF FNis_fn(val%) THEN val% = FNas_macro(val%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -192,46 +186,46 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=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%)
|
||||
GOTO 31416
|
||||
WHEN "try*"
|
||||
=FNtry_catch(ast%, env%)
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNrest(ast%)
|
||||
IF FNis_macro(car%) THEN
|
||||
ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%))
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -240,26 +234,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNget_argv
|
||||
PROCgc_enter
|
||||
|
@ -13,7 +13,7 @@ PROCcore_ns : REM This sets the data pointer
|
||||
REPEAT
|
||||
READ sym$, i%
|
||||
IF sym$ <> "" THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
|
||||
PROCenv_set(repl_env%, sym$, FNalloc_corefn(i%))
|
||||
ENDIF
|
||||
UNTIL sym$ = ""
|
||||
|
||||
@ -32,9 +32,9 @@ UNTIL form$ = ""
|
||||
argv% = FNget_argv
|
||||
|
||||
IF FNis_empty(argv%) THEN
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNempty)
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNempty)
|
||||
ELSE
|
||||
PROCenv_set(repl_env%, FNalloc_symbol("*ARGV*"), FNrest(argv%))
|
||||
PROCenv_set(repl_env%, "*ARGV*", FNrest(argv%))
|
||||
val$ = FNrep("(load-file " + FNunbox_string(FNpr_str(FNfirst(argv%), TRUE)) + ")")
|
||||
END
|
||||
ENDIF
|
||||
@ -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,37 +131,52 @@ DEF FNEVAL(ast%, env%)
|
||||
=FNgc_exit(FNEVAL_(ast%, env%))
|
||||
|
||||
DEF FNEVAL_(ast%, env%)
|
||||
LOCAL car%, specialform%, val%, bindings%
|
||||
REPEAT
|
||||
LOCAL car%, val%, bindings%, key$
|
||||
31416 REM tail call optimization loop
|
||||
PROCgc_keep_only2(ast%, env%)
|
||||
IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
|
||||
val% = FNenv_find(env%, "DEBUG-EVAL")
|
||||
IF NOT FNis_nil(val%) THEN
|
||||
IF FNis_truish(FNenv_get(val%, "DEBUG-EVAL")) THEN
|
||||
PRINT "EVAL: " + FNunbox_string(FNpr_str(ast%, TRUE))
|
||||
ENDIF
|
||||
ENDIF
|
||||
IF FNis_symbol(ast%) THEN =FNenv_get(env%, FNunbox_symbol(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%)
|
||||
specialform% = FALSE
|
||||
IF FNis_vector(ast%) THEN =FNalloc_vector_pair(FNEVAL(car%, env%), FNeval_ast(FNrest(ast%), env%))
|
||||
IF FNis_symbol(car%) THEN
|
||||
specialform% = TRUE
|
||||
CASE FNunbox_symbol(car%) OF
|
||||
key$ = FNunbox_symbol(car%)
|
||||
CASE key$ OF
|
||||
REM Special forms
|
||||
WHEN "def!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "defmacro!"
|
||||
val% = FNEVAL(FNnth(ast%, 2), env%)
|
||||
IF FNis_fn(val%) THEN val% = FNas_macro(val%)
|
||||
PROCenv_set(env%, FNnth(ast%, 1), val%)
|
||||
PROCenv_set(env%, FNunbox_symbol(FNnth(ast%, 1)), val%)
|
||||
=val%
|
||||
WHEN "let*"
|
||||
env% = FNalloc_environment(env%)
|
||||
bindings% = FNnth(ast%, 1)
|
||||
WHILE NOT FNis_empty(bindings%)
|
||||
PROCenv_set(env%, FNfirst(bindings%), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
PROCenv_set(env%, FNunbox_symbol(FNfirst(bindings%)), FNEVAL(FNnth(bindings%, 1), env%))
|
||||
bindings% = FNrest(FNrest(bindings%))
|
||||
ENDWHILE
|
||||
ast% = FNnth(ast%, 2)
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "do"
|
||||
REM The guide has us call FNeval_ast on the sub-list that excludes
|
||||
REM the last element of ast%, but that's a bit painful without
|
||||
@ -194,46 +188,46 @@ DEF FNEVAL_(ast%, env%)
|
||||
ast% = FNrest(ast%)
|
||||
ENDWHILE
|
||||
ast% = FNfirst(ast%)
|
||||
GOTO 31416
|
||||
WHEN "if"
|
||||
IF FNis_truish(FNEVAL(FNnth(ast%, 1), env%)) THEN
|
||||
ast% = FNnth(ast%, 2)
|
||||
ELSE
|
||||
IF FNcount(ast%) = 3 THEN =FNnil ELSE ast% = FNnth(ast%, 3)
|
||||
IF FNcount(ast%) = 3 THEN =FNnil
|
||||
ast% = FNnth(ast%, 3)
|
||||
ENDIF
|
||||
REM Loop round for tail-call optimisation.
|
||||
GOTO 31416
|
||||
WHEN "fn*"
|
||||
=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%)
|
||||
GOTO 31416
|
||||
WHEN "try*"
|
||||
=FNtry_catch(ast%, env%)
|
||||
OTHERWISE
|
||||
specialform% = FALSE
|
||||
car% = FNenv_get(env%, key$)
|
||||
ENDCASE
|
||||
ELSE
|
||||
car% = FNEVAL(car%, env%)
|
||||
ENDIF
|
||||
IF NOT specialform% THEN
|
||||
REM This is the "apply" part.
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
car% = FNfirst(ast%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), FNrest(ast%))
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNrest(ast%))
|
||||
ast% = FNfn_ast(car%)
|
||||
REM Loop round for tail-call optimisation.
|
||||
ELSE
|
||||
ERROR &40E80918, "Not a function"
|
||||
ENDIF
|
||||
REM This is the "apply" part.
|
||||
ast% = FNrest(ast%)
|
||||
IF FNis_macro(car%) THEN
|
||||
ast% = FNEVAL(FNfn_ast(car%), FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%))
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
UNTIL FALSE
|
||||
ast% = FNeval_ast(ast%, env%)
|
||||
IF FNis_corefn(car%) THEN
|
||||
=FNcore_call(FNunbox_corefn(car%), ast%)
|
||||
ENDIF
|
||||
IF FNis_fn(car%) THEN
|
||||
env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), ast%)
|
||||
ast% = FNfn_ast(car%)
|
||||
GOTO 31416
|
||||
ENDIF
|
||||
ERROR &40E80918, "Not a function"
|
||||
|
||||
DEF FNPRINT(a%)
|
||||
=FNunbox_string(FNpr_str(a%, TRUE))
|
||||
@ -242,26 +236,8 @@ 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
|
||||
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%
|
||||
=FNalloc_pair(FNEVAL(FNfirst(ast%), env%), FNeval_ast(FNrest(ast%), env%))
|
||||
|
||||
DEF FNget_argv
|
||||
PROCgc_enter
|
||||
|
@ -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));
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -21,13 +21,41 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
|
||||
/* printf("EVAL: %s\n", pr_str(ast, READABLY)); */
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -35,12 +63,10 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
/* list */
|
||||
|
||||
/* evaluate the list */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -112,58 +138,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;
|
||||
|
@ -24,15 +24,45 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env* env);
|
||||
MalType* eval_letstar(MalType* ast, Env* env);
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -52,12 +82,10 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -92,10 +120,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 +150,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 +161,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 +182,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*/
|
||||
}
|
||||
|
@ -28,18 +28,48 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env* env);
|
||||
MalType* eval_letstar(MalType* ast, Env* env);
|
||||
MalType* eval_if(MalType* ast, Env* env);
|
||||
MalType* eval_fnstar(MalType* ast, Env* env);
|
||||
MalType* eval_do(MalType* ast, Env* env);
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -68,12 +98,10 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -131,7 +159,7 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +194,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 +212,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 +248,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);
|
||||
|
@ -28,7 +28,9 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -38,11 +40,39 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
/* Use goto to jump here rather than calling eval for tail-call elimination */
|
||||
TCE_entry_point:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -86,10 +116,10 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -151,7 +181,7 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +216,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 +234,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 +276,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;
|
||||
}
|
||||
|
||||
|
@ -28,7 +28,9 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -38,11 +40,39 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
/* Use goto to jump here rather than calling eval for tail-call elimination */
|
||||
TCE_entry_point:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -86,12 +116,10 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -159,13 +187,13 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +205,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 +246,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 +264,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 +306,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;
|
||||
}
|
||||
|
||||
|
@ -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,9 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -41,16 +42,43 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
MalType* eval_do(MalType* ast, Env* env);
|
||||
MalType* eval_quote(MalType* ast);
|
||||
MalType* eval_quasiquote(MalType* ast);
|
||||
MalType* eval_quasiquoteexpand(MalType* ast);
|
||||
|
||||
/* Use goto to jump here rather than calling eval for tail-call elimination */
|
||||
TCE_entry_point:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -102,20 +130,13 @@ 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);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
list evlst = evaluate_list(ast->value.mal_list, env);
|
||||
if (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)) {
|
||||
@ -183,13 +204,13 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +222,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 +263,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 +281,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 +323,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;
|
||||
}
|
||||
|
||||
|
@ -19,11 +19,9 @@
|
||||
#define SYMBOL_FNSTAR "fn*"
|
||||
#define SYMBOL_QUOTE "quote"
|
||||
#define SYMBOL_QUASIQUOTE "quasiquote"
|
||||
#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
|
||||
#define SYMBOL_UNQUOTE "unquote"
|
||||
#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
|
||||
#define SYMBOL_DEFMACROBANG "defmacro!"
|
||||
#define SYMBOL_MACROEXPAND "macroexpand"
|
||||
|
||||
#define PROMPT_STRING "user> "
|
||||
|
||||
@ -35,7 +33,10 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
MalType* apply(MalType* fn, list args);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -43,23 +44,44 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
MalType* eval_do(MalType* ast, Env* env);
|
||||
MalType* eval_quote(MalType* ast);
|
||||
MalType* eval_quasiquote(MalType* ast);
|
||||
MalType* eval_quasiquoteexpand(MalType* ast);
|
||||
MalType* eval_defmacrobang(MalType*, Env** env);
|
||||
MalType* eval_macroexpand(MalType* ast, Env* env);
|
||||
MalType* macroexpand(MalType* ast, Env* env);
|
||||
|
||||
/* Use goto to jump here rather than calling eval for tail-call elimination */
|
||||
TCE_entry_point:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
/* 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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -111,30 +133,25 @@ 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);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
MalType* func = EVAL(first, env);
|
||||
if (is_error(func)) { return func; }
|
||||
if (func->is_macro) {
|
||||
ast = apply(func, ast->value.mal_list->next);
|
||||
if (is_error(ast)) { return ast; }
|
||||
goto TCE_entry_point;
|
||||
}
|
||||
list evlst = evaluate_list(ast->value.mal_list->next, 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 +159,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 +170,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; }
|
||||
@ -198,13 +215,13 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +233,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 +274,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 +292,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 +334,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 +633,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 +791,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);
|
||||
}
|
||||
}
|
||||
|
@ -19,11 +19,9 @@
|
||||
#define SYMBOL_FNSTAR "fn*"
|
||||
#define SYMBOL_QUOTE "quote"
|
||||
#define SYMBOL_QUASIQUOTE "quasiquote"
|
||||
#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
|
||||
#define SYMBOL_UNQUOTE "unquote"
|
||||
#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
|
||||
#define SYMBOL_DEFMACROBANG "defmacro!"
|
||||
#define SYMBOL_MACROEXPAND "macroexpand"
|
||||
#define SYMBOL_TRYSTAR "try*"
|
||||
#define SYMBOL_CATCHSTAR "catch*"
|
||||
|
||||
@ -37,7 +35,10 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
MalType* apply(MalType* fn, list args);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -45,24 +46,45 @@ 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:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
/* 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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -114,17 +136,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 +149,19 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
MalType* func = EVAL(first, env);
|
||||
if (is_error(func)) { return func; }
|
||||
if (func->is_macro) {
|
||||
ast = apply(func, ast->value.mal_list->next);
|
||||
if (is_error(ast)) { return ast; }
|
||||
goto TCE_entry_point;
|
||||
}
|
||||
list evlst = evaluate_list(ast->value.mal_list->next, 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 +169,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 +180,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; }
|
||||
@ -209,13 +226,13 @@ int main(int argc, char** argv) {
|
||||
char* symbol = mappings->data;
|
||||
MalType*(*function)(list) = (MalType*(*)(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 +244,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 +285,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 +303,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 +345,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 +644,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 +698,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 +861,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);
|
||||
}
|
||||
}
|
||||
|
@ -20,11 +20,9 @@
|
||||
#define SYMBOL_FNSTAR "fn*"
|
||||
#define SYMBOL_QUOTE "quote"
|
||||
#define SYMBOL_QUASIQUOTE "quasiquote"
|
||||
#define SYMBOL_QUASIQUOTEEXPAND "quasiquoteexpand"
|
||||
#define SYMBOL_UNQUOTE "unquote"
|
||||
#define SYMBOL_SPLICE_UNQUOTE "splice-unquote"
|
||||
#define SYMBOL_DEFMACROBANG "defmacro!"
|
||||
#define SYMBOL_MACROEXPAND "macroexpand"
|
||||
#define SYMBOL_TRYSTAR "try*"
|
||||
#define SYMBOL_CATCHSTAR "catch*"
|
||||
|
||||
@ -38,7 +36,10 @@ MalType* READ(char* str) {
|
||||
MalType* EVAL(MalType* ast, Env* env) {
|
||||
|
||||
/* forward references */
|
||||
MalType* eval_ast(MalType* ast, Env* env);
|
||||
MalType* apply(MalType* fn, list args);
|
||||
list evaluate_list(list lst, Env* env);
|
||||
list evaluate_vector(list lst, Env* env);
|
||||
list evaluate_hashmap(list lst, Env* env);
|
||||
MalType* eval_defbang(MalType* ast, Env** env);
|
||||
void eval_letstar(MalType** ast, Env** env);
|
||||
void eval_if(MalType** ast, Env** env);
|
||||
@ -46,24 +47,45 @@ 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:
|
||||
|
||||
MalType* dbgeval = env_get(env, "DEBUG-EVAL");
|
||||
if (dbgeval && ! is_false(dbgeval) && ! is_nil(dbgeval))
|
||||
printf("EVAL: %s\n", pr_str(ast, READABLY));
|
||||
|
||||
/* NULL */
|
||||
if (!ast) { return make_nil(); }
|
||||
|
||||
/* 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; }
|
||||
|
||||
/* empty list */
|
||||
if (ast->value.mal_list == NULL) { return ast; }
|
||||
@ -115,17 +137,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 +150,19 @@ MalType* EVAL(MalType* ast, Env* env) {
|
||||
}
|
||||
}
|
||||
/* first element is not a special symbol */
|
||||
MalType* evaluated_list = eval_ast(ast, env);
|
||||
|
||||
if (is_error(evaluated_list)) { return evaluated_list; }
|
||||
MalType* func = EVAL(first, env);
|
||||
if (is_error(func)) { return func; }
|
||||
if (func->is_macro) {
|
||||
ast = apply(func, ast->value.mal_list->next);
|
||||
if (is_error(ast)) { return ast; }
|
||||
goto TCE_entry_point;
|
||||
}
|
||||
list evlst = evaluate_list(ast->value.mal_list->next, 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 +170,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 +181,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 +250,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 +269,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 +310,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 +328,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 +370,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 +669,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 +723,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 +886,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);
|
||||
}
|
||||
}
|
||||
|
@ -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);
|
||||
}
|
||||
|
@ -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));
|
||||
|
@ -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()
|
||||
|
@ -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));
|
||||
}
|
||||
|
||||
|
@ -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));
|
||||
}
|
||||
|
||||
|
@ -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)))");
|
||||
|
@ -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)))");
|
||||
|
@ -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)))");
|
||||
|
@ -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)))");
|
||||
|
@ -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\")");
|
||||
|
@ -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
|
||||
|
@ -10,36 +10,32 @@
|
||||
(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 (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
;; 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)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)]
|
||||
(apply f args)))))
|
||||
(apply f args)))
|
||||
|
||||
:else ;; not a list, map, symbol or vector
|
||||
ast))
|
||||
|
||||
;; print
|
||||
(defn PRINT [exp] (printer/pr-str exp))
|
||||
|
@ -11,26 +11,24 @@
|
||||
(reader/read-string strng))
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn eval-ast [ast env]
|
||||
(defn EVAL [ast env]
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(seq? ast) (doall (map #(EVAL % env) ast))
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
;; 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]
|
||||
@ -48,10 +46,13 @@
|
||||
(EVAL a2 let-env))
|
||||
|
||||
;; apply
|
||||
(let [el (eval-ast ast env)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)]
|
||||
(apply f args))))))
|
||||
(apply f args))))
|
||||
|
||||
:else ;; not a list, map, symbol or vector
|
||||
ast))
|
||||
|
||||
;; print
|
||||
(defn PRINT [exp] (printer/pr-str exp))
|
||||
|
@ -12,26 +12,24 @@
|
||||
(reader/read-string strng))
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
(defn eval-ast [ast env]
|
||||
(defn EVAL [ast env]
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(seq? ast) (doall (map #(EVAL % env) ast))
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
;; 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]
|
||||
@ -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,13 @@
|
||||
(EVAL a2 (env/env env a1 (or args '()))))
|
||||
|
||||
;; apply
|
||||
(let [el (eval-ast ast env)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)]
|
||||
(apply f args))))))
|
||||
(apply f args))))
|
||||
|
||||
:else ;; not a list, map, symbol or vector
|
||||
ast))
|
||||
|
||||
;; print
|
||||
(defn PRINT [exp] (printer/pr-str exp))
|
||||
|
@ -12,27 +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))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
@ -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,17 @@
|
||||
:parameters a1})
|
||||
|
||||
;; apply
|
||||
(let [el (eval-ast ast env)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)
|
||||
{: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))
|
||||
|
@ -12,27 +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))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
@ -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,17 @@
|
||||
:parameters a1})
|
||||
|
||||
;; apply
|
||||
(let [el (eval-ast ast env)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)
|
||||
{: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))
|
||||
|
@ -12,8 +12,6 @@
|
||||
(reader/read-string strng))
|
||||
|
||||
;; eval
|
||||
(declare EVAL)
|
||||
|
||||
(declare quasiquote)
|
||||
(defn starts_with [ast sym]
|
||||
(and (seq? ast)
|
||||
@ -27,32 +25,32 @@
|
||||
(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))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
@ -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,17 @@
|
||||
:parameters a1})
|
||||
|
||||
;; apply
|
||||
(let [el (eval-ast ast env)
|
||||
(let [el (map #(EVAL % env) ast)
|
||||
f (first el)
|
||||
args (rest el)
|
||||
{: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))
|
||||
|
@ -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,46 +31,28 @@
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
(symbol? (first ast))
|
||||
(env/env-find env (first ast))
|
||||
(:ismacro (meta (env/env-get env (first ast))))))
|
||||
|
||||
(defn macroexpand [ast env]
|
||||
(loop [ast ast]
|
||||
(if (is-macro-call ast env)
|
||||
;; Get original unadorned function because ClojureScript (1.10)
|
||||
;; limits functions with meta on them to arity 20
|
||||
(let [mac (:orig (meta (env/env-get env (first ast))))]
|
||||
(recur (apply mac (rest ast))))
|
||||
ast)))
|
||||
|
||||
(defn eval-ast [ast env]
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(seq? ast) (doall (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
(let [ast (macroexpand ast env)]
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
(condp = a0
|
||||
nil
|
||||
@ -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))
|
||||
|
@ -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,46 +31,28 @@
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
(symbol? (first ast))
|
||||
(env/env-find env (first ast))
|
||||
(:ismacro (meta (env/env-get env (first ast))))))
|
||||
|
||||
(defn macroexpand [ast env]
|
||||
(loop [ast ast]
|
||||
(if (is-macro-call ast env)
|
||||
;; Get original unadorned function because ClojureScript (1.10)
|
||||
;; limits functions with meta on them to arity 20
|
||||
(let [mac (:orig (meta (env/env-get env (first ast))))]
|
||||
(recur (apply mac (rest ast))))
|
||||
ast)))
|
||||
|
||||
(defn eval-ast [ast env]
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(seq? ast) (doall (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
(let [ast (macroexpand ast env)]
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
(condp = a0
|
||||
nil
|
||||
@ -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))
|
||||
|
@ -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,46 +31,28 @@
|
||||
(or (symbol? ast) (map? ast)) (list 'quote ast)
|
||||
:else ast))
|
||||
|
||||
(defn is-macro-call [ast env]
|
||||
(and (seq? ast)
|
||||
(symbol? (first ast))
|
||||
(env/env-find env (first ast))
|
||||
(:ismacro (meta (env/env-get env (first ast))))))
|
||||
|
||||
(defn macroexpand [ast env]
|
||||
(loop [ast ast]
|
||||
(if (is-macro-call ast env)
|
||||
;; Get original unadorned function because ClojureScript (1.10)
|
||||
;; limits functions with meta on them to arity 20
|
||||
(let [mac (:orig (meta (env/env-get env (first ast))))]
|
||||
(recur (apply mac (rest ast))))
|
||||
ast)))
|
||||
|
||||
(defn eval-ast [ast env]
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(seq? ast) (doall (map #(EVAL % env) ast))
|
||||
|
||||
(vector? ast) (vec (doall (map #(EVAL % env) ast)))
|
||||
|
||||
(map? ast) (apply hash-map (doall (map #(EVAL % env)
|
||||
(mapcat identity ast))))
|
||||
|
||||
:else ast))
|
||||
|
||||
(defn EVAL [ast env]
|
||||
(loop [ast ast
|
||||
env env]
|
||||
;;(prn "EVAL" ast (keys @env)) (flush)
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
(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)))))
|
||||
|
||||
(cond
|
||||
(symbol? ast) (env/env-get env ast)
|
||||
|
||||
(vector? ast) (vec (map #(EVAL % env) ast))
|
||||
|
||||
(map? ast) (apply hash-map (map #(EVAL % env) (mapcat identity ast)))
|
||||
|
||||
(seq? ast)
|
||||
;; apply list
|
||||
(let [ast (macroexpand ast env)]
|
||||
(if (not (seq? ast))
|
||||
(eval-ast ast env)
|
||||
|
||||
;; indented to match later steps
|
||||
(let [[a0 a1 a2 a3] ast]
|
||||
(condp = a0
|
||||
nil
|
||||
@ -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))
|
||||
|
@ -12,9 +12,7 @@ exports.Env = class Env
|
||||
else
|
||||
@data[b.name] = @exprs[i]
|
||||
find: (key) ->
|
||||
if not types._symbol_Q(key)
|
||||
throw new Error("env.find key must be symbol")
|
||||
if key.name of @data then @
|
||||
if key of @data then @
|
||||
else if @outer then @outer.find(key)
|
||||
else null
|
||||
set: (key, value) ->
|
||||
@ -22,10 +20,8 @@ exports.Env = class Env
|
||||
throw new Error("env.set key must be symbol")
|
||||
@data[key.name] = value
|
||||
get: (key) ->
|
||||
if not types._symbol_Q(key)
|
||||
throw new Error("env.get key must be symbol")
|
||||
env = @find(key)
|
||||
throw new Error("'" + key.name + "' not found") if !env
|
||||
env.data[key.name]
|
||||
throw new Error("'" + key + "' not found") if !env
|
||||
env.data[key]
|
||||
|
||||
# vim: ts=2:sw=2
|
||||
|
@ -7,24 +7,24 @@ printer = require "./printer.coffee"
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
eval_ast = (ast, env) ->
|
||||
if types._symbol_Q(ast) then env[ast.name]
|
||||
else if types._list_Q(ast) then ast.map((a) -> EVAL(a, env))
|
||||
EVAL = (ast, env) ->
|
||||
# console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env[ast.name]
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
f(args...)
|
||||
|
||||
|
||||
|
@ -8,20 +8,23 @@ Env = require("./env.coffee").Env
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
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) ->
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
@ -35,7 +38,7 @@ EVAL = (ast, env) ->
|
||||
let_env.set(a1[i], EVAL(a1[i+1], let_env))
|
||||
EVAL(a2, let_env)
|
||||
else
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
f(args...)
|
||||
|
||||
|
||||
|
@ -9,20 +9,23 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
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) ->
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
@ -36,7 +39,7 @@ EVAL = (ast, env) ->
|
||||
let_env.set(a1[i], EVAL(a1[i+1], let_env))
|
||||
EVAL(a2, let_env)
|
||||
when "do"
|
||||
el = eval_ast(ast[1..], env)
|
||||
el = ast[1..].map((a) -> EVAL(a, env))
|
||||
el[el.length-1]
|
||||
when "if"
|
||||
cond = EVAL(a1, env)
|
||||
@ -47,7 +50,7 @@ EVAL = (ast, env) ->
|
||||
when "fn*"
|
||||
(args...) -> EVAL(a2, new Env(env, a1, args))
|
||||
else
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
f(args...)
|
||||
|
||||
|
||||
|
@ -9,21 +9,24 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
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
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
@ -38,7 +41,7 @@ EVAL = (ast, env) ->
|
||||
ast = a2
|
||||
env = let_env
|
||||
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)
|
||||
@ -49,7 +52,7 @@ EVAL = (ast, env) ->
|
||||
when "fn*"
|
||||
return types._function(EVAL, a2, env, a1)
|
||||
else
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
if types._function_Q(f)
|
||||
ast = f.__ast__
|
||||
env = f.__gen_env__(args)
|
||||
|
@ -9,21 +9,24 @@ core = require("./core.coffee")
|
||||
READ = (str) -> reader.read_str str
|
||||
|
||||
# eval
|
||||
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
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
@ -38,7 +41,7 @@ EVAL = (ast, env) ->
|
||||
ast = a2
|
||||
env = let_env
|
||||
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)
|
||||
@ -49,7 +52,7 @@ EVAL = (ast, env) ->
|
||||
when "fn*"
|
||||
return types._function(EVAL, a2, env, a1)
|
||||
else
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
if types._function_Q(f)
|
||||
ast = f.__ast__
|
||||
env = f.__gen_env__(args)
|
||||
|
@ -25,21 +25,24 @@ quasiquote = (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
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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
|
||||
return new_hm
|
||||
else return ast
|
||||
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
#console.log "EVAL:", printer._pr_str ast
|
||||
if !types._list_Q ast then return eval_ast ast, env
|
||||
if ast.length == 0 then return ast
|
||||
|
||||
# apply list
|
||||
@ -55,12 +58,10 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
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)
|
||||
@ -71,7 +72,7 @@ EVAL = (ast, env) ->
|
||||
when "fn*"
|
||||
return types._function(EVAL, a2, env, a1)
|
||||
else
|
||||
[f, args...] = eval_ast ast, env
|
||||
[f, args...] = ast.map((a) -> EVAL(a, env))
|
||||
if types._function_Q(f)
|
||||
ast = f.__ast__
|
||||
env = f.__gen_env__(args)
|
||||
|
@ -23,36 +23,25 @@ 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__
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
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))
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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 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 +56,6 @@ EVAL = (ast, env) ->
|
||||
env = let_env
|
||||
when "quote"
|
||||
return a1
|
||||
when "quasiquoteexpand"
|
||||
return quasiquote(a1)
|
||||
when "quasiquote"
|
||||
ast = quasiquote(a1)
|
||||
when "defmacro!"
|
||||
@ -76,10 +63,8 @@ EVAL = (ast, env) ->
|
||||
f = types._clone(f)
|
||||
f.__ismacro__ = true
|
||||
return env.set(a1, f)
|
||||
when "macroexpand"
|
||||
return macroexpand(a1, env)
|
||||
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)
|
||||
@ -90,7 +75,11 @@ 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)
|
||||
|
@ -23,36 +23,25 @@ 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__
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
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))
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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 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 +56,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 +63,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
|
||||
@ -88,7 +73,7 @@ EVAL = (ast, env) ->
|
||||
else
|
||||
throw exc
|
||||
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)
|
||||
@ -99,7 +84,11 @@ 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)
|
||||
|
@ -23,36 +23,25 @@ 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__
|
||||
EVAL = (ast, env) ->
|
||||
loop
|
||||
dbgenv = env.find("DEBUG-EVAL")
|
||||
if dbgenv
|
||||
dbgeval = dbgenv.get("DEBUG-EVAL")
|
||||
if dbgeval != null and dbgeval != false
|
||||
console.log "EVAL:", printer._pr_str ast
|
||||
|
||||
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))
|
||||
if types._symbol_Q(ast) then return env.get ast.name
|
||||
else if types._list_Q(ast) then # exit this switch
|
||||
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 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 +56,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 +63,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 +76,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,7 +90,11 @@ 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)
|
||||
|
@ -4,7 +4,6 @@
|
||||
(:export :undefined-symbol
|
||||
:create-mal-env
|
||||
:get-env
|
||||
:find-env
|
||||
:set-env
|
||||
:mal-env-bindings))
|
||||
|
||||
@ -30,16 +29,12 @@
|
||||
(bindings (make-hash-table :test 'equal) :read-only t)
|
||||
(parent nil :read-only t))
|
||||
|
||||
(defun find-env (env symbol)
|
||||
(when env
|
||||
(or (gethash (mal-data-value symbol)
|
||||
(mal-env-bindings env))
|
||||
(find-env (mal-env-parent env) symbol))))
|
||||
|
||||
(defun get-env (env symbol)
|
||||
(or (find-env env symbol)
|
||||
(error 'undefined-symbol
|
||||
:symbol (format nil "~a" (mal-data-value symbol)))))
|
||||
(or (gethash symbol (mal-env-bindings env))
|
||||
(let ((outer (mal-env-parent env)))
|
||||
(if outer
|
||||
(get-env outer symbol)
|
||||
nil))))
|
||||
|
||||
(defun set-env (env symbol value)
|
||||
(setf (gethash (mal-data-value symbol) (mal-env-bindings env)) value))
|
||||
|
@ -17,37 +17,38 @@
|
||||
|
||||
(in-package :mal)
|
||||
|
||||
(defvar *repl-env* (make-mal-value-hash-table))
|
||||
(defvar *repl-env* (make-hash-table :test 'equal))
|
||||
|
||||
(setf (genhash:hashref (make-mal-symbol "+") *repl-env*)
|
||||
(setf (gethash "+" *repl-env*)
|
||||
(make-mal-builtin-fn (lambda (value1 value2)
|
||||
(make-mal-number (+ (mal-data-value value1)
|
||||
(mal-data-value value2))))))
|
||||
|
||||
(setf (genhash:hashref (make-mal-symbol "-") *repl-env*)
|
||||
(setf (gethash "-" *repl-env*)
|
||||
(make-mal-builtin-fn (lambda (value1 value2)
|
||||
(make-mal-number (- (mal-data-value value1)
|
||||
(mal-data-value value2))))))
|
||||
|
||||
(setf (genhash:hashref (make-mal-symbol "*") *repl-env*)
|
||||
(setf (gethash "*" *repl-env*)
|
||||
(make-mal-builtin-fn (lambda (value1 value2)
|
||||
(make-mal-number (* (mal-data-value value1)
|
||||
(mal-data-value value2))))))
|
||||
|
||||
(setf (genhash:hashref (make-mal-symbol "/") *repl-env*)
|
||||
(setf (gethash "/" *repl-env*)
|
||||
(make-mal-builtin-fn (lambda (value1 value2)
|
||||
(make-mal-number (/ (mal-data-value value1)
|
||||
(mal-data-value value2))))))
|
||||
|
||||
(defun lookup-env (symbol env)
|
||||
(let ((value (genhash:hashref symbol env)))
|
||||
(if value
|
||||
(let ((key (mal-data-value symbol)))
|
||||
(multiple-value-bind (value present-p) (gethash key env)
|
||||
(if present-p
|
||||
value
|
||||
(error 'env:undefined-symbol
|
||||
:symbol (format nil "~a" (mal-data-value symbol))))))
|
||||
:symbol (format nil "~a" key))))))
|
||||
|
||||
(defun eval-sequence (sequence env)
|
||||
(map 'list
|
||||
(defun eval-sequence (type sequence env)
|
||||
(map type
|
||||
(lambda (ast) (mal-eval ast env))
|
||||
(mal-data-value sequence)))
|
||||
|
||||
@ -60,25 +61,25 @@
|
||||
hash-map-value)
|
||||
(make-mal-hash-map new-hash-table)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(defun mal-eval (ast env)
|
||||
;; (write-line (format nil "EVAL: ~a" (pr-str ast)))
|
||||
;; (force-output *standard-output*)
|
||||
(switch-mal-type ast
|
||||
(types:symbol (lookup-env ast env))
|
||||
(types:list (eval-sequence ast env))
|
||||
(types:vector (make-mal-vector (apply 'vector (eval-sequence ast env))))
|
||||
(types:list (eval-list ast env))
|
||||
(types:vector (make-mal-vector (eval-sequence 'vector ast env)))
|
||||
(types:hash-map (eval-hash-map ast env ))
|
||||
(types:any ast)))
|
||||
|
||||
(defun mal-read (string)
|
||||
(reader:read-str string))
|
||||
|
||||
(defun mal-eval (ast env)
|
||||
(cond
|
||||
((not (mal-list-p ast)) (eval-ast ast env))
|
||||
((zerop (length (mal-data-value ast))) ast)
|
||||
(t (progn
|
||||
(let ((evaluated-list (eval-ast ast env)))
|
||||
(defun eval-list (ast env)
|
||||
(if (null (mal-data-value ast))
|
||||
ast
|
||||
(let ((evaluated-list (eval-sequence 'list ast env)))
|
||||
(apply (mal-data-value (car evaluated-list))
|
||||
(cdr evaluated-list)))))))
|
||||
(cdr evaluated-list)))))
|
||||
|
||||
(defun mal-print (expression)
|
||||
(printer:pr-str expression))
|
||||
|
@ -47,8 +47,8 @@
|
||||
(defvar mal-def! (make-mal-symbol "def!"))
|
||||
(defvar mal-let* (make-mal-symbol "let*"))
|
||||
|
||||
(defun eval-sequence (sequence env)
|
||||
(map 'list
|
||||
(defun eval-sequence (type sequence env)
|
||||
(map type
|
||||
(lambda (ast) (mal-eval ast env))
|
||||
(mal-data-value sequence)))
|
||||
|
||||
@ -61,11 +61,20 @@
|
||||
hash-map-value)
|
||||
(make-mal-hash-map new-hash-table)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(defun mal-eval (ast env)
|
||||
(let ((debug-eval (env:get-env env "DEBUG-EVAL")))
|
||||
(when (and debug-eval
|
||||
(not (mal-data-value= debug-eval mal-false))
|
||||
(not (mal-data-value= debug-eval mal-false)))
|
||||
(write-line (format nil "EVAL: ~a" (pr-str ast)))
|
||||
(force-output *standard-output*)))
|
||||
(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:symbol
|
||||
(let ((key (mal-data-value ast)))
|
||||
(or (env:get-env env key)
|
||||
(error 'undefined-symbol :symbol (format nil "~a" key)))))
|
||||
(types:list (eval-list ast env))
|
||||
(types:vector (make-mal-vector (eval-sequence 'vector ast env)))
|
||||
(types:hash-map (eval-hash-map ast env ))
|
||||
(types:any ast)))
|
||||
|
||||
@ -89,24 +98,18 @@
|
||||
(defun eval-list (ast env)
|
||||
(let ((forms (mal-data-value ast)))
|
||||
(cond
|
||||
((zerop (length forms)) ast)
|
||||
((mal-data-value= mal-def! (first forms))
|
||||
(env:set-env env (second forms) (mal-eval (third forms) env)))
|
||||
((mal-data-value= mal-let* (first forms))
|
||||
(eval-let* forms env))
|
||||
(t (let ((evaluated-list (eval-ast ast env)))
|
||||
(t (let ((evaluated-list (eval-sequence 'list ast env)))
|
||||
(apply (mal-data-value (car evaluated-list))
|
||||
(cdr evaluated-list)))))))
|
||||
|
||||
(defun mal-read (string)
|
||||
(reader:read-str string))
|
||||
|
||||
(defun mal-eval (ast env)
|
||||
(cond
|
||||
((null ast) mal-nil)
|
||||
((not (mal-list-p ast)) (eval-ast ast env))
|
||||
((zerop (length (mal-data-value ast))) ast)
|
||||
(t (eval-list ast env))))
|
||||
|
||||
(defun mal-print (expression)
|
||||
(printer:pr-str expression))
|
||||
|
||||
|
@ -30,8 +30,8 @@
|
||||
(defvar mal-if (make-mal-symbol "if"))
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
|
||||
(defun eval-sequence (sequence env)
|
||||
(map 'list
|
||||
(defun eval-sequence (type sequence env)
|
||||
(map type
|
||||
(lambda (ast) (mal-eval ast env))
|
||||
(mal-data-value sequence)))
|
||||
|
||||
@ -44,11 +44,20 @@
|
||||
hash-map-value)
|
||||
(make-mal-hash-map new-hash-table)))
|
||||
|
||||
(defun eval-ast (ast env)
|
||||
(defun mal-eval (ast env)
|
||||
(let ((debug-eval (env:get-env env "DEBUG-EVAL")))
|
||||
(when (and debug-eval
|
||||
(not (mal-data-value= debug-eval mal-false))
|
||||
(not (mal-data-value= debug-eval mal-false)))
|
||||
(write-line (format nil "EVAL: ~a" (pr-str ast)))
|
||||
(force-output *standard-output*)))
|
||||
(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:symbol
|
||||
(let ((key (mal-data-value ast)))
|
||||
(or (env:get-env env key)
|
||||
(error 'undefined-symbol :symbol (format nil "~a" key)))))
|
||||
(types:list (eval-list ast env))
|
||||
(types:vector (make-mal-vector (eval-sequence 'vector ast env)))
|
||||
(types:hash-map (eval-hash-map ast env))
|
||||
(types:any ast)))
|
||||
|
||||
@ -72,6 +81,7 @@
|
||||
(defun eval-list (ast env)
|
||||
(let ((forms (mal-data-value ast)))
|
||||
(cond
|
||||
((zerop (length forms)) ast)
|
||||
((mal-data-value= mal-def! (first forms))
|
||||
(env:set-env env (second forms) (mal-eval (third forms) env)))
|
||||
((mal-data-value= mal-let* (first forms))
|
||||
@ -83,7 +93,7 @@
|
||||
(let ((predicate (mal-eval (second forms) env)))
|
||||
(mal-eval (if (or (mal-data-value= predicate mal-nil)
|
||||
(mal-data-value= predicate mal-false))
|
||||
(fourth forms)
|
||||
(or (fourth forms) mal-nil)
|
||||
(third forms))
|
||||
env)))
|
||||
((mal-data-value= mal-fn* (first forms))
|
||||
@ -93,7 +103,7 @@
|
||||
(mal-eval body (env:create-mal-env :parent env
|
||||
:binds (listify (mal-data-value arglist))
|
||||
:exprs args))))))
|
||||
(t (let* ((evaluated-list (eval-ast ast env))
|
||||
(t (let* ((evaluated-list (eval-sequence 'list ast env))
|
||||
(function (car evaluated-list)))
|
||||
;; If first element is a mal function unwrap it
|
||||
(apply (mal-data-value function)
|
||||
@ -102,13 +112,6 @@
|
||||
(defun mal-read (string)
|
||||
(reader:read-str string))
|
||||
|
||||
(defun mal-eval (ast env)
|
||||
(cond
|
||||
((null ast) mal-nil)
|
||||
((not (mal-list-p ast)) (eval-ast ast env))
|
||||
((zerop (length (mal-data-value ast))) ast)
|
||||
(t (eval-list ast env))))
|
||||
|
||||
(defun mal-print (expression)
|
||||
(printer:pr-str expression))
|
||||
|
||||
|
@ -30,8 +30,8 @@
|
||||
(defvar mal-if (make-mal-symbol "if"))
|
||||
(defvar mal-fn* (make-mal-symbol "fn*"))
|
||||
|
||||
(defun eval-sequence (sequence env)
|
||||
(map 'list
|
||||
(defun eval-sequence (type sequence env)
|
||||
(map type
|
||||
(lambda (ast) (mal-eval ast env))
|
||||
(mal-data-value sequence)))
|
||||
|
||||
@ -44,25 +44,31 @@
|
||||
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 mal-read (string)
|
||||
(reader:read-str string))
|
||||
|
||||
(defun mal-eval (ast env)
|
||||
(loop
|
||||
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 (let ((debug-eval (env:get-env env "DEBUG-EVAL")))
|
||||
(when (and debug-eval
|
||||
(not (mal-data-value= debug-eval mal-false))
|
||||
(not (mal-data-value= debug-eval mal-false)))
|
||||
(write-line (format nil "EVAL: ~a" (pr-str ast)))
|
||||
(force-output *standard-output*)))
|
||||
do (switch-mal-type ast
|
||||
(types:symbol
|
||||
(return
|
||||
(let ((key (mal-data-value ast)))
|
||||
(or (env:get-env env key)
|
||||
(error 'undefined-symbol :symbol (format nil "~a" key))))))
|
||||
(types:vector (return (make-mal-vector (eval-sequence 'vector ast env))))
|
||||
(types:hash-map (return (eval-hash-map ast env)))
|
||||
(types:list
|
||||
(let ((forms (mal-data-value ast)))
|
||||
(cond
|
||||
((null forms)
|
||||
(return ast))
|
||||
|
||||
((mal-data-value= mal-def! (first forms))
|
||||
(return (env:set-env env (second forms) (mal-eval (third forms) env))))
|
||||
|
||||
@ -92,7 +98,7 @@
|
||||
(let ((predicate (mal-eval (second forms) env)))
|
||||
(setf ast (if (or (mal-data-value= predicate mal-nil)
|
||||
(mal-data-value= predicate mal-false))
|
||||
(fourth forms)
|
||||
(or (fourth forms) mal-nil)
|
||||
(third forms)))))
|
||||
|
||||
((mal-data-value= mal-fn* (first forms))
|
||||
@ -106,7 +112,7 @@
|
||||
(cons :ast body)
|
||||
(cons :env env))))))
|
||||
|
||||
(t (let* ((evaluated-list (eval-ast ast env))
|
||||
(t (let* ((evaluated-list (eval-sequence 'list ast env))
|
||||
(function (car evaluated-list)))
|
||||
;; If first element is a mal function unwrap it
|
||||
(if (not (mal-fn-p function))
|
||||
@ -118,7 +124,8 @@
|
||||
:binds (map 'list
|
||||
#'identity
|
||||
(mal-data-value (cdr (assoc :params attrs))))
|
||||
:exprs (cdr evaluated-list)))))))))))))
|
||||
:exprs (cdr evaluated-list))))))))))
|
||||
(types:any (return ast)))))
|
||||
|
||||
(defun mal-print (expression)
|
||||
(printer:pr-str expression))
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user