[jackhill/mal.git] / ada / step7_quote.adb

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Text_IO;
with Ada.IO_Exceptions;
with Core;
with Envs;
with Eval_Callback;
with Printer;
with Reader;
with Smart_Pointers;
with Types;

procedure Step7_Quote is

   use Types;

   function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle)
   return Types.Mal_Handle;

   Debug : Boolean := False;


   function Read (Param : String) return Types.Mal_Handle is
   begin
      return Reader.Read_Str (Param);
   end Read;


   function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle)
		   return Mal_Handle is
      Name, Fn_Body, Res : Mal_Handle;
   begin
      Name := Car (Args);
      pragma Assert (Deref (Name).Sym_Type = Sym,
                     "Def_Fn: expected atom as name");
      Fn_Body := Nth (Args, 1);
      Res := Eval (Fn_Body, Env);
      Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res);
      return Res;
   end Def_Fn;


   function Eval_As_Boolean (MH : Mal_Handle) return Boolean is
      Res : Boolean;
   begin
      case Deref (MH).Sym_Type is
         when Bool => 
            Res := Deref_Bool (MH).Get_Bool;
         when Nil =>
            return False;
--         when List =>
--            declare
--               L : List_Mal_Type;
--            begin
--               L := Deref_List (MH).all;
--               Res := not Is_Null (L);
--            end;
         when others => -- Everything else
            Res := True;
      end case;
      return Res;
   end Eval_As_Boolean;


   function Eval_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 Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
      Res, First_Elem, FE_0 : Mal_Handle;
      L : List_Ptr;
      D_Ptr, Ast_P : List_Class_Ptr;
   begin

      if Debug then
         Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
      end if;

      -- Create a New List for the result...
      Res := New_List_Mal_Type (List_List);
      L := Deref_List (Res);

      -- This is the equivalent of Is_Pair
      if Deref (Param).Sym_Type /= List or else
         Is_Null (Deref_List_Class (Param).all) then

         -- return a new list containing: a symbol named "quote" and ast.
         L.Append (New_Symbol_Mal_Type ("quote"));
         L.Append (Param);
         return Res;

      end if;

      -- Ast is a non-empty list at this point.

      Ast_P := Deref_List_Class (Param);

      First_Elem := Car (Ast_P.all);

      -- if the first element of ast is a symbol named "unquote":
      if Deref (First_Elem).Sym_Type = Sym and then
         Deref_Sym (First_Elem).Get_Sym = "unquote" then

         -- return the second element of ast.`
         D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
         return Car (D_Ptr.all);

      end if;

      -- if the first element of first element of `ast` (`ast[0][0]`)
      -- is a symbol named "splice-unquote"
      if Deref (First_Elem).Sym_Type = List and then
         not Is_Null (Deref_List_Class (First_Elem).all) then

         D_Ptr := Deref_List_Class (First_Elem);
         FE_0 := Car (D_Ptr.all);

         if Deref (FE_0).Sym_Type = Sym and then
            Deref_Sym (FE_0).Get_Sym = "splice-unquote" then

            -- return a new list containing: a symbol named "concat",
            L.Append (New_Symbol_Mal_Type ("concat"));

            -- the second element of first element of ast (ast[0][1]),
            D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
            L.Append (Car (D_Ptr.all));

            -- and the result of calling quasiquote with
            -- the second through last element of ast.
            L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));

            return Res;

         end if;

      end if;

      -- otherwise: return a new list containing: a symbol named "cons",
      L.Append (New_Symbol_Mal_Type ("cons"));

      -- the result of calling quasiquote on first element of ast (ast[0]),
      L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));

      -- and result of calling quasiquote with the second through last element of ast.
      L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));

      return Res;

   end Quasi_Quote_Processing;


   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

         Param_List := Deref_List (Param).all;
         First_Param := Car (Param_List);
         Rest_Params := Cdr (Param_List);
         Rest_List := Deref_List (Rest_Params).all;

         if Deref (First_Param).Sym_Type = Sym and then
            Deref_Sym (First_Param).Get_Sym = "def!" then
 	    return Def_Fn (Rest_List, Env);
         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "let*" then
            declare
               Defs, Expr, Res : Mal_Handle;
               E : Envs.Env_Handle;
            begin
               E := Envs.New_Env (Env);
               Defs := Car (Rest_List);
               Deref_List_Class (Defs).Add_Defs (E);
               Expr := Car (Deref_List (Cdr (Rest_List)).all);
	       Param := Expr;
	       Env := E;
	       goto Tail_Call_Opt;
               -- was:
               -- Res := Eval (Expr, E);
               -- return Res;
            end;
         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "do" then
            declare
               D : List_Mal_Type;
               E : Mal_Handle;
            begin

               if Debug then
                  Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List));
               end if;

               if Is_Null (Rest_List) then
                  return Rest_Params;
               end if;

               -- Loop processes Evals all but last entry
               D := Rest_List;
               loop
                  E := Car (D);
                  D := Deref_List (Cdr (D)).all;
               exit when Is_Null (D);
                  E := Eval (E, Env);
               end loop;

               Param := E;
               goto Tail_Call_Opt;

            end;
         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "if" then
 	    declare
	       Args : List_Mal_Type := Rest_List;

	       Cond, True_Part, False_Part : Mal_Handle;
	       Cond_Bool : Boolean;
	       pragma Assert (Length (Args) = 2 or Length (Args) = 3,
			      "If_Processing: not 2 or 3 parameters");
	       L : List_Mal_Type;
	    begin

	       Cond := Eval (Car (Args), Env);

	       Cond_Bool := Eval_As_Boolean (Cond);

	       if Cond_Bool then
	          L := Deref_List (Cdr (Args)).all;

	          Param := Car (L);
		  goto Tail_Call_Opt;
		  -- was: return Eval (Car (L), Env);
	       else
		  if Length (Args) = 3 then
		     L := Deref_List (Cdr (Args)).all;
		     L := Deref_List (Cdr (L)).all;

		     Param := Car (L);
		     goto Tail_Call_Opt;
		     -- was: return Eval (Car (L), Env);
	          else
		     return New_Nil_Mal_Type;
	          end if;
	       end if;
	    end;

         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "fn*" then

            return New_Lambda_Mal_Type
                     (Params => Car (Rest_List),
                      Expr => Nth (Rest_List, 1),
                      Env => Env);

         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "quote" then

            return Car (Rest_List);

         elsif Deref (First_Param).Sym_Type = Sym and then
               Deref_Sym (First_Param).Get_Sym = "quasiquote" then

            Param := Quasi_Quote_Processing (Car (Rest_List));
            goto Tail_Call_Opt;

         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;

               if Deref (First_Param).Sym_Type = Func then
                  return Call_Func (Deref_Func (First_Param).all, Rest_Params);
               elsif Deref (First_Param).Sym_Type = Lambda then
                  declare

                     L : Lambda_Mal_Type;
                     E : Envs.Env_Handle;
                     Param_Names : List_Mal_Type;
                     Res : Mal_Handle;

                  begin

                     L := Deref_Lambda (First_Param).all;
                     E := Envs.New_Env (L.Get_Env);

                     Param_Names := Deref_List (L.Get_Params).all;

                     if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then

			Param := L.Get_Expr;
                        Env := E;
			goto Tail_Call_Opt;
                        -- was: return Eval (L.Get_Expr, E); 

                     else

                        raise Mal_Exception with "Bind failed in Apply";

                     end if;

                  end;

               else  -- neither a Lambda or a Func
                  raise Mal_Exception;
               end if;

            end;

         end if;

      else

         return Eval_Ast (Param, Env);

      end if;

   end Eval;


   function Print (Param : Types.Mal_Handle) return String is
   begin
      return Printer.Pr_Str (Param);
   end Print;

   function Rep (Param : String; Env : Envs.Env_Handle) return String is
      AST, Evaluated_AST : Types.Mal_Handle;
   begin

      AST := Read (Param);

      if Types.Is_Null (AST) then
         return "";
      else
         Evaluated_AST := Eval (AST, Env);
         return Print (Evaluated_AST);
      end if;

   end Rep; 


   Repl_Env : Envs.Env_Handle;


   -- These two ops use Repl_Env directly.


   procedure RE (Str : Mal_String) is
      Discarded : Mal_Handle;
   begin
      Discarded := Eval (Read (Str), Repl_Env);
   end RE;


   function Do_Eval (Rest_Handle : Mal_Handle)
   return Types.Mal_Handle is
      First_Param : Mal_Handle;
      Rest_List : Types.List_Mal_Type;
   begin
      Rest_List := Deref_List (Rest_Handle).all;
      First_Param := Car (Rest_List);
      return Eval_Callback.Eval.all (First_Param, Repl_Env);
   end Do_Eval;


   S : String (1..Reader.Max_Line_Len);
   Last : Natural;
   Cmd_Args, File_Param : Natural;
   Command_Args : Types.Mal_Handle;
   Command_List : Types.List_Ptr;
   File_Processed : Boolean := False;

begin

   -- Save a function pointer back to the Eval function.
   -- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK
   -- as we know Eval will be in scope for the lifetime of the program.
   Eval_Callback.Eval := Eval'Unrestricted_Access;

   Repl_Env := Envs.New_Env;

   -- Core init also creates the first environment.
   -- This is needed for the def!'s below.
   Core.Init (Repl_Env);

   -- Register the eval command.  This needs to be done here rather than Core.Init
   -- as it requires direct access to Repl_Env.
   Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access));

   RE ("(def! not (fn* (a) (if a false true)))");

   RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");

   Cmd_Args := 0;
   Command_Args := Types.New_List_Mal_Type (Types.List_List);
   Command_List := Types.Deref_List (Command_Args);

   while Ada.Command_Line.Argument_Count > Cmd_Args loop

     Cmd_Args := Cmd_Args + 1;
     if Ada.Command_Line.Argument (Cmd_Args) = "-d" then
        Debug := True;
     elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then
        Envs.Debug := True;
     elsif not File_Processed then
        File_Param := Cmd_Args;
        File_Processed := True;
     else
        Command_List.Append
          (Types.New_Symbol_Mal_Type (Ada.Command_Line.Argument (Cmd_Args)));
     end if;

   end loop;

   Envs.Set (Repl_Env, "*ARGV*", Command_Args);

   if File_Processed then
      RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)");
   else
      loop
         begin
            Ada.Text_IO.Put ("user> ");
            Ada.Text_IO.Get_Line (S, Last);
            Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env));
         exception
            when Ada.IO_Exceptions.End_Error => raise;
            when E : others =>
               Ada.Text_IO.Put_Line
                 (Ada.Text_IO.Standard_Error,
                  Ada.Exceptions.Exception_Information (E));
         end;
      end loop;
   end if;

exception
   when Ada.IO_Exceptions.End_Error => null;
   -- i.e. exit without textual output
end Step7_Quote;
Commit	Line	Data
ebb6e9d3 CM	1	with Ada.Command_Line;
	2	with Ada.Exceptions;
	3	with Ada.Text_IO;
	4	with Ada.IO_Exceptions;
	5	with Core;
	6	with Envs;
18e21187	7	with Eval_Callback;
ebb6e9d3 CM	8	with Printer;
ebb6e9d3 CM	9	with Reader;
18e21187	10	with Smart_Pointers;
ebb6e9d3 CM	11	with Types;
	12
	13	procedure Step7_Quote is
	14
18e21187 CM	15	use Types;
18e21187 CM	16
18e21187 CM	17	function Eval (AParam : Types.Mal_Handle; AnEnv : Envs.Env_Handle)
	18	return Types.Mal_Handle;
	19
	20	Debug : Boolean := False;
	21
	22
b5bad5ea CM	23	function Read (Param : String) return Types.Mal_Handle is
	24	begin
	25	return Reader.Read_Str (Param);
	26	end Read;
	27
18e21187 CM	28
	29	function Def_Fn (Args : List_Mal_Type; Env : Envs.Env_Handle)
	30	return Mal_Handle is
	31	Name, Fn_Body, Res : Mal_Handle;
	32	begin
	33	Name := Car (Args);
	34	pragma Assert (Deref (Name).Sym_Type = Sym,
	35	"Def_Fn: expected atom as name");
b5bad5ea	36	Fn_Body := Nth (Args, 1);
18e21187	37	Res := Eval (Fn_Body, Env);
b5bad5ea	38	Envs.Set (Env, Deref_Sym (Name).Get_Sym, Res);
18e21187 CM	39	return Res;
	40	end Def_Fn;
	41
	42
	43	function Eval_As_Boolean (MH : Mal_Handle) return Boolean is
	44	Res : Boolean;
	45	begin
	46	case Deref (MH).Sym_Type is
	47	when Bool =>
	48	Res := Deref_Bool (MH).Get_Bool;
8083b525 CM	49	when Nil =>
8083b525 CM	50	return False;
18e21187 CM	51	-- when List =>
	52	-- declare
	53	-- L : List_Mal_Type;
	54	-- begin
	55	-- L := Deref_List (MH).all;
	56	-- Res := not Is_Null (L);
	57	-- end;
	58	when others => -- Everything else
	59	Res := True;
	60	end case;
	61	return Res;
	62	end Eval_As_Boolean;
	63
	64
	65	function Eval_Ast
	66	(Ast : Mal_Handle; Env : Envs.Env_Handle)
	67	return Mal_Handle is
	68
	69	function Call_Eval (A : Mal_Handle) return Mal_Handle is
	70	begin
	71	return Eval (A, Env);
	72	end Call_Eval;
	73
	74	begin
	75
	76	case Deref (Ast).Sym_Type is
	77
	78	when Sym =>
	79
	80	declare
	81	Sym : Mal_String := Deref_Sym (Ast).Get_Sym;
	82	begin
	83	-- if keyword, return it. Otherwise look it up in the environment.
	84	if Sym(1) = ':' then
	85	return Ast;
	86	else
	87	return Envs.Get (Env, Sym);
	88	end if;
	89	exception
	90	when Envs.Not_Found =>
	91	raise Envs.Not_Found with (" '" & Sym & "' not found ");
	92	end;
	93
	94	when List =>
	95
	96	return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
	97
18e21187 CM	98	when others => return Ast;
	99
	100	end case;
	101
	102	end Eval_Ast;
	103
	104
	105
	106
	107	function Quasi_Quote_Processing (Param : Mal_Handle) return Mal_Handle is
	108	Res, First_Elem, FE_0 : Mal_Handle;
	109	L : List_Ptr;
	110	D_Ptr, Ast_P : List_Class_Ptr;
	111	begin
	112
	113	if Debug then
	114	Ada.Text_IO.Put_Line ("QuasiQt " & Deref (Param).To_String);
	115	end if;
	116
	117	-- Create a New List for the result...
	118	Res := New_List_Mal_Type (List_List);
	119	L := Deref_List (Res);
	120
	121	-- This is the equivalent of Is_Pair
	122	if Deref (Param).Sym_Type /= List or else
	123	Is_Null (Deref_List_Class (Param).all) then
	124
	125	-- return a new list containing: a symbol named "quote" and ast.
	126	L.Append (New_Symbol_Mal_Type ("quote"));
	127	L.Append (Param);
	128	return Res;
	129
	130	end if;
	131
	132	-- Ast is a non-empty list at this point.
	133
	134	Ast_P := Deref_List_Class (Param);
	135
	136	First_Elem := Car (Ast_P.all);
	137
	138	-- if the first element of ast is a symbol named "unquote":
	139	if Deref (First_Elem).Sym_Type = Sym and then
	140	Deref_Sym (First_Elem).Get_Sym = "unquote" then
	141
	142	-- return the second element of ast.`
	143	D_Ptr := Deref_List_Class (Cdr (Ast_P.all));
	144	return Car (D_Ptr.all);
	145
	146	end if;
	147
	148	-- if the first element of first element of `ast` (`ast[0][0]`)
	149	-- is a symbol named "splice-unquote"
	150	if Deref (First_Elem).Sym_Type = List and then
	151	not Is_Null (Deref_List_Class (First_Elem).all) then
	152
	153	D_Ptr := Deref_List_Class (First_Elem);
	154	FE_0 := Car (D_Ptr.all);
	155
	156	if Deref (FE_0).Sym_Type = Sym and then
	157	Deref_Sym (FE_0).Get_Sym = "splice-unquote" then
	158
	159	-- return a new list containing: a symbol named "concat",
	160	L.Append (New_Symbol_Mal_Type ("concat"));
	161
162	-- the second element of first element of ast (ast[0][1]),
163	D_Ptr := Deref_List_Class (Cdr (D_Ptr.all));
164	L.Append (Car (D_Ptr.all));
165
166	-- and the result of calling quasiquote with
167	-- the second through last element of ast.
168	L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
169
170	return Res;
171
172	end if;
173
174	end if;
175
176	-- otherwise: return a new list containing: a symbol named "cons",
177	L.Append (New_Symbol_Mal_Type ("cons"));
178
179	-- the result of calling quasiquote on first element of ast (ast[0]),
180	L.Append (Quasi_Quote_Processing (Car (Ast_P.all)));
181
182	-- and result of calling quasiquote with the second through last element of ast.
183	L.Append (Quasi_Quote_Processing (Cdr (Ast_P.all)));
184
185	return Res;
186
187	end Quasi_Quote_Processing;
188
189
190	function Eval (AParam : Mal_Handle; AnEnv : Envs.Env_Handle)
191	return Mal_Handle is
192	Param : Mal_Handle;
193	Env : Envs.Env_Handle;
194	First_Param, Rest_Params : Mal_Handle;
195	Rest_List, Param_List : List_Mal_Type;
196	begin
197
198	Param := AParam;
199	Env := AnEnv;
200
b5bad5ea	201	<<Tail_Call_Opt>>
18e21187 CM	202
	203	if Debug then
	204	Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
	205	end if;
	206
	207	if Deref (Param).Sym_Type = List and then
	208	Deref_List (Param).Get_List_Type = List_List then
	209
	210	Param_List := Deref_List (Param).all;
	211	First_Param := Car (Param_List);
	212	Rest_Params := Cdr (Param_List);
	213	Rest_List := Deref_List (Rest_Params).all;
	214
	215	if Deref (First_Param).Sym_Type = Sym and then
	216	Deref_Sym (First_Param).Get_Sym = "def!" then
	217	return Def_Fn (Rest_List, Env);
	218	elsif Deref (First_Param).Sym_Type = Sym and then
	219	Deref_Sym (First_Param).Get_Sym = "let*" then
	220	declare
	221	Defs, Expr, Res : Mal_Handle;
	222	E : Envs.Env_Handle;
	223	begin
	224	E := Envs.New_Env (Env);
	225	Defs := Car (Rest_List);
	226	Deref_List_Class (Defs).Add_Defs (E);
	227	Expr := Car (Deref_List (Cdr (Rest_List)).all);
	228	Param := Expr;
	229	Env := E;
	230	goto Tail_Call_Opt;
	231	-- was:
	232	-- Res := Eval (Expr, E);
	233	-- return Res;
	234	end;
	235	elsif Deref (First_Param).Sym_Type = Sym and then
	236	Deref_Sym (First_Param).Get_Sym = "do" then
	237	declare
	238	D : List_Mal_Type;
	239	E : Mal_Handle;
	240	begin
	241
	242	if Debug then
	243	Ada.Text_IO.Put_Line ("Do-ing " & To_String (Rest_List));
	244	end if;
	245
	246	if Is_Null (Rest_List) then
	247	return Rest_Params;
	248	end if;
	249
	250	-- Loop processes Evals all but last entry
	251	D := Rest_List;
	252	loop
	253	E := Car (D);
	254	D := Deref_List (Cdr (D)).all;
	255	exit when Is_Null (D);
	256	E := Eval (E, Env);
	257	end loop;
	258
	259	Param := E;
	260	goto Tail_Call_Opt;
	261
	262	end;
	263	elsif Deref (First_Param).Sym_Type = Sym and then
	264	Deref_Sym (First_Param).Get_Sym = "if" then
	265	declare
266	Args : List_Mal_Type := Rest_List;
267
268	Cond, True_Part, False_Part : Mal_Handle;
269	Cond_Bool : Boolean;
270	pragma Assert (Length (Args) = 2 or Length (Args) = 3,
271	"If_Processing: not 2 or 3 parameters");
272	L : List_Mal_Type;
273	begin
274
275	Cond := Eval (Car (Args), Env);
276
277	Cond_Bool := Eval_As_Boolean (Cond);
278
279	if Cond_Bool then
280	L := Deref_List (Cdr (Args)).all;
281
282	Param := Car (L);
283	goto Tail_Call_Opt;
284	-- was: return Eval (Car (L), Env);
285	else
286	if Length (Args) = 3 then
287	L := Deref_List (Cdr (Args)).all;
288	L := Deref_List (Cdr (L)).all;
289
290	Param := Car (L);
291	goto Tail_Call_Opt;
292	-- was: return Eval (Car (L), Env);
293	else
8083b525	294	return New_Nil_Mal_Type;
18e21187 CM	295	end if;
	296	end if;
	297	end;
	298
	299	elsif Deref (First_Param).Sym_Type = Sym and then
	300	Deref_Sym (First_Param).Get_Sym = "fn*" then
	301
	302	return New_Lambda_Mal_Type
	303	(Params => Car (Rest_List),
	304	Expr => Nth (Rest_List, 1),
	305	Env => Env);
	306
	307	elsif Deref (First_Param).Sym_Type = Sym and then
	308	Deref_Sym (First_Param).Get_Sym = "quote" then
	309
	310	return Car (Rest_List);
	311
	312	elsif Deref (First_Param).Sym_Type = Sym and then
	313	Deref_Sym (First_Param).Get_Sym = "quasiquote" then
	314
	315	Param := Quasi_Quote_Processing (Car (Rest_List));
	316	goto Tail_Call_Opt;
	317
	318	else
	319
	320	-- The APPLY section.
	321	declare
	322	Evaled_H : Mal_Handle;
	323	begin
	324	Evaled_H := Eval_Ast (Param, Env);
	325
	326	Param_List := Deref_List (Evaled_H).all;
	327
	328	First_Param := Car (Param_List);
	329	Rest_Params := Cdr (Param_List);
	330	Rest_List := Deref_List (Rest_Params).all;
	331
	332	if Deref (First_Param).Sym_Type = Func then
1c28e560	333	return Call_Func (Deref_Func (First_Param).all, Rest_Params);
18e21187 CM	334	elsif Deref (First_Param).Sym_Type = Lambda then
	335	declare
	336
	337	L : Lambda_Mal_Type;
	338	E : Envs.Env_Handle;
	339	Param_Names : List_Mal_Type;
	340	Res : Mal_Handle;
	341
	342	begin
	343
	344	L := Deref_Lambda (First_Param).all;
	345	E := Envs.New_Env (L.Get_Env);
	346
	347	Param_Names := Deref_List (L.Get_Params).all;
	348
	349	if Envs.Bind (E, Param_Names, Deref_List (Rest_Params).all) then
	350
	351	Param := L.Get_Expr;
	352	Env := E;
	353	goto Tail_Call_Opt;
	354	-- was: return Eval (L.Get_Expr, E);
	355
	356	else
	357
	358	raise Mal_Exception with "Bind failed in Apply";
	359
	360	end if;
	361
	362	end;
	363
	364	else -- neither a Lambda or a Func
	365	raise Mal_Exception;
	366	end if;
	367
	368	end;
	369
	370	end if;
	371
	372	else
	373
	374	return Eval_Ast (Param, Env);
	375
	376	end if;
	377
	378	end Eval;
ebb6e9d3 CM	379
	380
	381	function Print (Param : Types.Mal_Handle) return String is
	382	begin
	383	return Printer.Pr_Str (Param);
	384	end Print;
	385
b5bad5ea CM	386	function Rep (Param : String; Env : Envs.Env_Handle) return String is
b5bad5ea CM	387	AST, Evaluated_AST : Types.Mal_Handle;
ebb6e9d3 CM	388	begin
ebb6e9d3 CM	389
b5bad5ea	390	AST := Read (Param);
ebb6e9d3	391
b5bad5ea CM	392	if Types.Is_Null (AST) then
	393	return "";
	394	else
	395	Evaluated_AST := Eval (AST, Env);
	396	return Print (Evaluated_AST);
	397	end if;
ebb6e9d3 CM	398
	399	end Rep;
	400
b5bad5ea CM	401
	402	Repl_Env : Envs.Env_Handle;
	403
	404
	405	-- These two ops use Repl_Env directly.
	406
	407
	408	procedure RE (Str : Mal_String) is
	409	Discarded : Mal_Handle;
	410	begin
	411	Discarded := Eval (Read (Str), Repl_Env);
	412	end RE;
	413
	414
1c28e560	415	function Do_Eval (Rest_Handle : Mal_Handle)
b5bad5ea CM	416	return Types.Mal_Handle is
	417	First_Param : Mal_Handle;
	418	Rest_List : Types.List_Mal_Type;
	419	begin
	420	Rest_List := Deref_List (Rest_Handle).all;
	421	First_Param := Car (Rest_List);
	422	return Eval_Callback.Eval.all (First_Param, Repl_Env);
	423	end Do_Eval;
	424
	425
ebb6e9d3 CM	426	S : String (1..Reader.Max_Line_Len);
ebb6e9d3 CM	427	Last : Natural;
f049dc3a	428	Cmd_Args, File_Param : Natural;
ebb6e9d3 CM	429	Command_Args : Types.Mal_Handle;
	430	Command_List : Types.List_Ptr;
	431	File_Processed : Boolean := False;
	432
	433	begin
	434
18e21187 CM	435	-- Save a function pointer back to the Eval function.
	436	-- Can't use 'Access here because of Ada rules but 'Unrestricted_Access is OK
	437	-- as we know Eval will be in scope for the lifetime of the program.
	438	Eval_Callback.Eval := Eval'Unrestricted_Access;
	439
b5bad5ea CM	440	Repl_Env := Envs.New_Env;
b5bad5ea CM	441
ebb6e9d3 CM	442	-- Core init also creates the first environment.
ebb6e9d3 CM	443	-- This is needed for the def!'s below.
b5bad5ea CM	444	Core.Init (Repl_Env);
	445
	446	-- Register the eval command. This needs to be done here rather than Core.Init
	447	-- as it requires direct access to Repl_Env.
	448	Envs.Set (Repl_Env, "eval", New_Func_Mal_Type ("eval", Do_Eval'Unrestricted_Access));
	449
	450	RE ("(def! not (fn* (a) (if a false true)))");
	451
	452	RE ("(def! load-file (fn* (f) (eval (read-string (str ""(do "" (slurp f) "")"")))))");
ebb6e9d3 CM	453
	454	Cmd_Args := 0;
	455	Command_Args := Types.New_List_Mal_Type (Types.List_List);
	456	Command_List := Types.Deref_List (Command_Args);
	457
	458	while Ada.Command_Line.Argument_Count > Cmd_Args loop
	459
	460	Cmd_Args := Cmd_Args + 1;
	461	if Ada.Command_Line.Argument (Cmd_Args) = "-d" then
18e21187	462	Debug := True;
ebb6e9d3 CM	463	elsif Ada.Command_Line.Argument (Cmd_Args) = "-e" then
ebb6e9d3 CM	464	Envs.Debug := True;
f049dc3a CM	465	elsif not File_Processed then
	466	File_Param := Cmd_Args;
	467	File_Processed := True;
ebb6e9d3	468	else
f049dc3a CM	469	Command_List.Append
f049dc3a CM	470	(Types.New_Symbol_Mal_Type (Ada.Command_Line.Argument (Cmd_Args)));
ebb6e9d3 CM	471	end if;
	472
	473	end loop;
	474
b5bad5ea	475	Envs.Set (Repl_Env, "ARGV", Command_Args);
ebb6e9d3	476
f049dc3a	477	if File_Processed then
b5bad5ea	478	RE ("(load-file """ & Ada.Command_Line.Argument (File_Param) & """)");
453a89a0 CM	479	else
	480	loop
	481	begin
	482	Ada.Text_IO.Put ("user> ");
	483	Ada.Text_IO.Get_Line (S, Last);
	484	Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env));
	485	exception
	486	when Ada.IO_Exceptions.End_Error => raise;
	487	when E : others =>
	488	Ada.Text_IO.Put_Line
	489	(Ada.Text_IO.Standard_Error,
	490	Ada.Exceptions.Exception_Information (E));
	491	end;
	492	end loop;
f049dc3a CM	493	end if;
f049dc3a CM	494
ebb6e9d3 CM	495	exception
	496	when Ada.IO_Exceptions.End_Error => null;
	497	-- i.e. exit without textual output
	498	end Step7_Quote;