ada/step6_file.adb

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