ada/step2_eval.adb

   1 with Ada.Containers.Hashed_Maps;
   2 with Ada.Strings.Unbounded.Hash;
   3 with Ada.Text_IO;
   4 with Ada.IO_Exceptions;
   5 with Ada.Exceptions;
   6 with Printer;
   7 with Reader;
   8 with Smart_Pointers;
   9 with Types;
  10
  11 procedure Step2_Eval is
  12
  13    use Types;
  14
  15    -- primitive functions on Smart_Pointer,
  16    function "+" is new Arith_Op ("+", "+");
  17    function "-" is new Arith_Op ("-", "-");
  18    function "*" is new Arith_Op ("*", "*");
  19    function "/" is new Arith_Op ("/", "/");
  20
  21    -- Take a list with two parameters and produce a single result
  22    -- using the Op access-to-function parameter.
  23    function Reduce2
  24      (Op : Binary_Func_Access; LH : Mal_Handle)
  25    return Mal_Handle is
  26       Left, Right : Mal_Handle;
  27       L, Rest_List : List_Mal_Type;
  28    begin
  29       L := Deref_List (LH).all;
  30       Left := Car (L);
  31       Rest_List := Deref_List (Cdr (L)).all;
  32       Right := Car (Rest_List);
  33       return Op (Left, Right);
  34    end Reduce2;
  35
  36
  37    function Plus (Rest_Handle : Mal_Handle)
  38    return Types.Mal_Handle is
  39    begin
  40        return Reduce2 (Step2_Eval."+"'Unrestricted_Access, Rest_Handle);
  41    end Plus;
  42
  43
  44    function Minus (Rest_Handle : Mal_Handle)
  45    return Types.Mal_Handle is
  46    begin
  47        return Reduce2 (Step2_Eval."-"'Unrestricted_Access, Rest_Handle);
  48    end Minus;
  49
  50
  51    function Mult (Rest_Handle : Mal_Handle)
  52    return Types.Mal_Handle is
  53    begin
  54        return Reduce2 (Step2_Eval."*"'Unrestricted_Access, Rest_Handle);
  55    end Mult;
  56
  57
  58    function Divide (Rest_Handle : Mal_Handle)
  59    return Types.Mal_Handle is
  60    begin
  61        return Reduce2 (Step2_Eval."/"'Unrestricted_Access, Rest_Handle);
  62    end Divide;
  63
  64
  65    package String_Mal_Hash is new Ada.Containers.Hashed_Maps
  66      (Key_Type        => Ada.Strings.Unbounded.Unbounded_String,
  67       Element_Type    => Smart_Pointers.Smart_Pointer,
  68       Hash            => Ada.Strings.Unbounded.Hash,
  69       Equivalent_Keys => Ada.Strings.Unbounded."=",
  70       "="             => Smart_Pointers."=");
  71
  72    Not_Found : exception;
  73
  74    function Get (M : String_Mal_Hash.Map; K : String) return Mal_Handle is
  75       use String_Mal_Hash;
  76       C : Cursor;
  77    begin
  78       C := Find (M, Ada.Strings.Unbounded.To_Unbounded_String (K));
  79       if C = No_Element then
  80          raise Not_Found;
  81       else
  82          return Element (C);
  83       end if;
  84    end Get;
  85
  86
  87    Repl_Env : String_Mal_Hash.Map;
  88
  89
  90    function Eval (Param : Types.Mal_Handle; Env : String_Mal_Hash.Map)
  91    return Types.Mal_Handle;
  92
  93
  94    Debug : Boolean := False;
  95
  96
  97    function Read (Param : String) return Types.Mal_Handle is
  98    begin
  99       return Reader.Read_Str (Param);
 100    end Read;
 101
 102
 103    function Eval_Ast
 104      (Ast : Mal_Handle; Env : String_Mal_Hash.Map)
 105      return Mal_Handle is
 106
 107       function Call_Eval (A : Mal_Handle) return Mal_Handle is
 108       begin
 109          return Eval (A, Env);
 110       end Call_Eval;
 111
 112    begin
 113
 114       case Deref (Ast).Sym_Type is
 115
 116          when Sym =>
 117
 118             declare
 119                Sym : Mal_String := Deref_Sym (Ast).Get_Sym;
 120             begin
 121                -- if keyword, return it. Otherwise look it up in the environment.
 122                if Sym(1) = ':' then
 123                   return Ast;
 124                else
 125                   return Get (Env, Sym);
 126                end if;
 127             exception
 128                when Not_Found =>
 129                   raise Not_Found with ("'" &  Sym & "' not found");
 130             end;
 131
 132          when List =>
 133
 134             return Map (Call_Eval'Unrestricted_Access, Deref_List_Class (Ast).all);
 135
 136          when others => return Ast;
 137
 138       end case;
 139
 140    end Eval_Ast;
 141
 142
 143    function Eval (Param : Mal_Handle; Env : String_Mal_Hash.Map)
 144                  return Mal_Handle is
 145       First_Elem : Mal_Handle;
 146    begin
 147
 148       if Debug then
 149          Ada.Text_IO.Put_Line ("Evaling " & Deref (Param).To_String);
 150       end if;
 151
 152       if Deref (Param).Sym_Type = List and then
 153          Deref_List (Param).Get_List_Type = List_List then
 154
 155          declare
 156             Evaled_H, First_Param : Mal_Handle;
 157             Evaled_List : List_Mal_Type;
 158             Param_List : List_Mal_Type;
 159          begin
 160             Param_List := Deref_List (Param).all;
 161
 162             -- Deal with empty list..
 163             if Param_List.Length = 0 then
 164                return Param;
 165             end if;
 166
 167             Evaled_H := Eval_Ast (Param, Env);
 168             Evaled_List := Deref_List (Evaled_H).all;
 169             First_Param := Car (Evaled_List);
 170             return Call_Func (Deref_Func (First_Param).all, Cdr (Evaled_List));
 171          end;
 172
 173       else -- Not a List_List
 174
 175          return Eval_Ast (Param, Env);
 176
 177       end if;
 178
 179    end Eval;
 180
 181
 182    function Print (Param : Types.Mal_Handle) return String is
 183    begin
 184       return Printer.Pr_Str (Param);
 185    end Print;
 186
 187
 188    function Rep (Param : String; Env : String_Mal_Hash.Map) return String is
 189      AST, Evaluated_AST : Types.Mal_Handle;
 190    begin
 191
 192      AST := Read (Param);
 193
 194      if Types.Is_Null (AST) then
 195         return "";
 196      else
 197         Evaluated_AST := Eval (AST, Env);
 198         return Print (Evaluated_AST);
 199      end if;
 200
 201    end Rep;
 202
 203
 204    S : String (1..Reader.Max_Line_Len);
 205    Last : Natural;
 206
 207 begin
 208
 209    String_Mal_Hash.Include
 210      (Container => Repl_Env,
 211       Key       => Ada.Strings.Unbounded.To_Unbounded_String ("+"),
 212       New_Item  => New_Func_Mal_Type ("+", Plus'Unrestricted_access));
 213
 214    String_Mal_Hash.Include
 215      (Container => Repl_Env,
 216       Key       => Ada.Strings.Unbounded.To_Unbounded_String ("-"),
 217       New_Item  => New_Func_Mal_Type ("-", Minus'Unrestricted_access));
 218
 219    String_Mal_Hash.Include
 220      (Container => Repl_Env,
 221       Key       => Ada.Strings.Unbounded.To_Unbounded_String ("*"),
 222       New_Item  => New_Func_Mal_Type ("*", Mult'Unrestricted_access));
 223
 224    String_Mal_Hash.Include
 225      (Container => Repl_Env,
 226       Key       => Ada.Strings.Unbounded.To_Unbounded_String ("/"),
 227       New_Item  => New_Func_Mal_Type ("/", Divide'Unrestricted_access));
 228
 229    loop
 230       begin
 231          Ada.Text_IO.Put ("user> ");
 232          Ada.Text_IO.Get_Line (S, Last);
 233          Ada.Text_IO.Put_Line (Rep (S (1..Last), Repl_Env));
 234       exception
 235          when Ada.IO_Exceptions.End_Error => raise;
 236          when E : others =>
 237             Ada.Text_IO.Put_Line
 238               (Ada.Text_IO.Standard_Error,
 239                Ada.Exceptions.Exception_Information (E));
 240       end;
 241    end loop;
 242
 243 exception
 244    when Ada.IO_Exceptions.End_Error => null;
 245    -- i.e. exit without textual output
 246 end Step2_Eval;