Implement suggestions from issue kanaka#587 in stepA of several langu…

…ages

* Merge eval-ast and eval into a single conditional.

* Print "EVAL: $ast" at the top of EVAL.

* Expand macros during the apply phase, removing lots of duplicate
  tests, and increasing the overall consistency by allowing the macro
  to be computed instead of referenced by name (`((defmacro! cond
  (...)))` is currently illegal for example).

Each change was already applied by some implementations.

With the two last changes, macroexpand and quasiquoteexpand special
forms are not needed anymore.

Not tested locally: common-lisp, julia, io, logo, lua, matlab, vhdl,
vimscript

If macroexpand is kept:

* an optional test should be added for `(macroexpand ())`, which
  currently fails on several implementations,

* it should only apply one macro at a time.  The purpose being
  debugging, hiding an iteration does not help.  Moreover, the loop is
  currently untested (and probably wrong in nim).

impls/ada.2/stepa_mal.adb

@@ -60,7 +60,6 @@ procedure StepA_Mal is
  -- True when the environment has been created in this recursion
  -- level, and has not yet been referenced by a closure. If so,
  -- we can reuse it instead of creating a subenvironment.
- Macroexpanding : Boolean := False;
  First : Types.T;
  begin
  <<Restart>>
@@ -184,14 +183,6 @@ procedure StepA_Mal is
  Ast => Ast.Sequence.all.Data (3),
  Env => Env));
  end;
- elsif First.Str.all = "macroexpand" then
- Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
- Macroexpanding := True;
- Ast := Ast.Sequence.all.Data (2);
- goto Restart;
- elsif First.Str.all = "quasiquoteexpand" then
- Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
- return Quasiquote (Ast.Sequence.all.Data (2));
  elsif First.Str.all = "quasiquote" then
  Err.Check (Ast.Sequence.all.Length = 2, "expected 1 parameter");
  Ast := Quasiquote (Ast.Sequence.all.Data (2));
@@ -248,24 +239,10 @@ procedure StepA_Mal is
  case First.Kind is
  when Kind_Macro =>
  -- Use the unevaluated arguments.
- if Macroexpanding then
- -- Evaluate the macro with tail call optimization.
- if not Env_Reusable then
- Env := Envs.New_Env (Outer => First.Fn.all.Env);
- Env_Reusable := True;
- end if;
- Env.all.Set_Binds
- (Binds => First.Fn.all.Params.all.Data,
- Exprs => Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
- Ast := First.Fn.all.Ast;
- goto Restart;
- else
- -- Evaluate the macro normally.
- Ast := First.Fn.all.Apply
- (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
- -- Then evaluate the result with TCO.
- goto Restart;
- end if;
+ Ast := First.Fn.all.Apply
+ (Ast.Sequence.all.Data (2 .. Ast.Sequence.all.Length));
+ -- Then evaluate the result with TCO.
+ goto Restart;
  when Types.Kind_Function =>
  null;
  when others =>
@@ -296,11 +273,7 @@ procedure StepA_Mal is
  end;
  exception
  when Err.Error =>
- if Macroexpanding then
- Err.Add_Trace_Line ("macroexpand", Ast);
- else
- Err.Add_Trace_Line ("eval", Ast);
- end if;
+ Err.Add_Trace_Line ("eval", Ast);
  raise;
  end Eval;
 

impls/ada/stepa_mal.adb

@@ -55,54 +55,6 @@ procedure StepA_Mal is
  return Res;
  end Def_Macro;
 
-
- function Macro_Expand (Ast : Mal_Handle; Env : Envs.Env_Handle)
- return Mal_Handle is
- Res : Mal_Handle;
- E : Envs.Env_Handle;
- LMT : List_Mal_Type;
- LP : Lambda_Ptr;
- begin
-
- Res := Ast;
- E := Env;
-
- 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, E);
-
- 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 (E);
-
- 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
@@ -125,45 +77,6 @@ procedure StepA_Mal is
  end Eval_As_Boolean;
 
 
- function Eval_Ast
- (Ast : Mal_Handle; Env : Envs.Env_Handle)
- return Mal_Handle is
-
- function Call_Eval (A : Mal_Handle) return Mal_Handle is
- begin
- return Eval (A, Env);
- end Call_Eval;
-
- begin
-
- case Deref (Ast).Sym_Type is
-
- when Sym =>
-
- declare
- Sym : Mal_String := Deref_Sym (Ast).Get_Sym;
- begin
- -- if keyword, return it. Otherwise look it up in the environment.
- if Sym(1) = ':' then
- return Ast;
- else
- return Envs.Get (Env, Sym);
- end if;
- exception
- when Envs.Not_Found =>
- raise Envs.Not_Found with ("'" & Sym & "' not found");
- end;
-
- when List =>
-
- return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
-
- when others => return Ast;
-
- end case;
-
- end Eval_Ast;
-
  function Starts_With (Ast : Mal_Handle; Symbol : String) return Boolean is
  A0 : Mal_Handle;
  begin
@@ -273,6 +186,12 @@ procedure StepA_Mal is
  Env : Envs.Env_Handle;
  First_Param, Rest_Params : Mal_Handle;
  Rest_List, Param_List : List_Mal_Type;
+
+ function Call_Eval (A : Mal_Handle) return Mal_Handle is
+ begin
+ return Eval (A, Env);
+ end Call_Eval;
+
  begin
 
  Param := AParam;
@@ -284,14 +203,30 @@ procedure StepA_Mal is
  Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
  end if;
 
- Param := Macro_Expand (Param, Env);
+ case Deref (Param).Sym_Type is
+ when Sym =>
 
- if Debug then
- Ada.Text_IO.Put_Line ("After expansion " & Deref (Param).To_String);
- end if;
+ declare
+ Sym : Mal_String := Deref_Sym (Param).Get_Sym;
+ begin
+ -- if keyword, return it. Otherwise look it up in the environment.
+ if Sym(1) = ':' then
+ return Param;
+ else
+ return Envs.Get (Env, Sym);
+ end if;
+ exception
+ when Envs.Not_Found =>
+ raise Envs.Not_Found with ("'" & Sym & "' not found");
+ end;
 
- if Deref (Param).Sym_Type = List and then
- Deref_List (Param).Get_List_Type = List_List then
+ when List =>
+ case Deref_List (Param).Get_List_Type is
+ when Hashed_List | Vector_List =>
+
+ return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Param).all);
+
+ when List_List =>
 
  Param_List := Deref_List (Param).all;
 
@@ -310,9 +245,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
@@ -407,11 +339,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
 
@@ -448,18 +375,11 @@ procedure StepA_Mal is
  else
 
  -- The APPLY section.
- declare
- Evaled_H : Mal_Handle;
- begin
- Evaled_H := Eval_Ast (Param, Env);
 
- Param_List := Deref_List (Evaled_H).all;
-
- First_Param := Car (Param_List);
- Rest_Params := Cdr (Param_List);
- Rest_List := Deref_List (Rest_Params).all;
+ First_Param := Eval (First_Param, Env);
 
  if Deref (First_Param).Sym_Type = Func then
+ Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List);
  return Call_Func (Deref_Func (First_Param).all, Rest_Params);
  elsif Deref (First_Param).Sym_Type = Lambda then
  declare
@@ -472,6 +392,16 @@ procedure StepA_Mal is
  begin
 
  L := Deref_Lambda (First_Param).all;
+
+ if L.Get_Is_Macro then
+ -- Apply to *unevaluated* arguments
+ Param := L.Apply (Rest_Params);
+ -- then EVAL the result.
+ goto Tail_Call_Opt;
+ end if;
+
+ Rest_Params := Map (Call_Eval'Unrestricted_Access, Rest_List);
+
  E := Envs.New_Env (L.Get_Env);
 
  Param_Names := Deref_List (L.Get_Params).all;
@@ -495,15 +425,14 @@ procedure StepA_Mal is
  raise Runtime_Exception with "Deref called on non-Func/Lambda";
  end if;
 
- end;
-
  end if;
 
- else -- not a List_List
+ end case;
+ when others => -- not a list, map, symbol or vector
 
- return Eval_Ast (Param, Env);
+ return Param;
 
- end if;
+ end case;
 
  end Eval;