diff --git a/ada/evaluation.adb b/ada/evaluation.adb index 2c533ecb..2a2e3a1f 100644 --- a/ada/evaluation.adb +++ b/ada/evaluation.adb @@ -45,24 +45,23 @@ package body Evaluation is case Deref (Func).Sym_Type is - when Sym => + when Atom => declare - Sym_P : Types.Sym_Ptr; + Atom_P : Types.Atom_Ptr; begin - Sym_P := Types.Deref_Sym (Func); - case Sym_P.all.Symbol is - when '+' => return Reduce ("+"'Access, Args); - when '-' => return Reduce ("-"'Access, Args); - when '*' => return Reduce ("*"'Access, Args); - when '/' => return Reduce ("/"'Access, Args); - when others => null; - end case; + Atom_P := Types.Deref_Atom (Func); + if Atom_P.Get_Atom = "+" then + return Reduce ("+"'Access, Args); + elsif Atom_P.Get_Atom = "-" then + return Reduce ("-"'Access, Args); + elsif Atom_P.Get_Atom = "*" then + return Reduce ("*"'Access, Args); + elsif Atom_P.Get_Atom = "/" then + return Reduce ("/"'Access, Args); + end if; end; --- when Atom => - - when Error => return Func; when others => null; @@ -109,17 +108,6 @@ package body Evaluation is case Deref (Ast).Sym_Type is - when Sym => - - declare - Sym : Mal_String (1..1) := Deref_Sym (Ast).Symbol & ""; - begin - return Envs.Get (Sym); - exception - when Envs.Not_Found => - return New_Error_Mal_Type ("'" & Sym & "' not found"); - end; - when Atom => declare diff --git a/ada/reader.adb b/ada/reader.adb index 3ad49ad4..1c960f31 100644 --- a/ada/reader.adb +++ b/ada/reader.adb @@ -147,7 +147,7 @@ package body Reader is Res := New_Float_Mal_Type (Floating => Mal_Float'Value (Get_Token_String)); when Sym => - Res := New_Sym_Mal_Type (Sym => Get_Token_Char); + Res := New_Atom_Mal_Type (Str => Get_Token_Char & ""); when Nil => Res := New_Atom_Mal_Type (Str => Get_Token_String); when True_Tok => @@ -208,7 +208,7 @@ package body Reader is use Types; List_SP, MTA : Mal_Handle; List_P : List_Ptr; - Close : Character := Types.Closing (LT); + Close : String (1..1) := (1 => Types.Closing (LT)); begin @@ -220,8 +220,8 @@ package body Reader is loop MTA := Read_Form; exit when Is_Null (MTA) or else - (Deref (MTA).Sym_Type = Sym and then - Sym_Mal_Type (Deref (MTA).all).Symbol = Close); + (Deref (MTA).Sym_Type = Atom and then + Atom_Mal_Type (Deref (MTA).all).Get_Atom = Close); Append (List_P.all, MTA); end loop; return List_SP; @@ -239,7 +239,6 @@ package body Reader is function Read_Form return Types.Mal_Handle is use Types; MTS : Mal_Handle; - Symbol : Character; begin MTS := Get_Token; @@ -248,40 +247,43 @@ package body Reader is return Smart_Pointers.Null_Smart_Pointer; end if; - if Deref (MTS).Sym_Type = Sym then + if Deref (MTS).Sym_Type = Atom then - Symbol := Sym_Mal_Type (Deref (MTS).all).Symbol; - -- Listy things and quoting... - if Symbol = '(' then - return Read_List (List_List); - elsif Symbol = '[' then - return Read_List (Vector_List); - elsif Symbol = '{' then - return Read_List (Hashed_List); - elsif Symbol = '^' then - declare - Meta, Obj : Mal_Handle; - begin - Meta := Read_Form; - Obj := Read_Form; + declare + Symbol : String := Atom_Mal_Type (Deref (MTS).all).Get_Atom; + begin + -- Listy things and quoting... + if Symbol = "(" then + return Read_List (List_List); + elsif Symbol = "[" then + return Read_List (Vector_List); + elsif Symbol = "{" then + return Read_List (Hashed_List); + elsif Symbol = "^" then declare - MT : Mal_Ptr := Deref (Obj); + Meta, Obj : Mal_Handle; begin - Set_Meta (MT.all, Meta); + Meta := Read_Form; + Obj := Read_Form; + declare + MT : Mal_Ptr := Deref (Obj); + begin + Set_Meta (MT.all, Meta); + end; + return Obj; end; - return Obj; - end; - elsif Symbol = ACL.Apostrophe then - return New_Unitary_Mal_Type (Func => Quote, Op => Read_Form); - elsif Symbol = ACL.Grave then - return New_Unitary_Mal_Type (Func => Quasiquote, Op => Read_Form); - elsif Symbol = ACL.Tilde then - return New_Unitary_Mal_Type (Func => Unquote, Op => Read_Form); - elsif Symbol = ACL.Commercial_At then - return New_Unitary_Mal_Type (Func => Deref, Op => Read_Form); - else - return MTS; - end if; + elsif Symbol = ACL.Apostrophe & "" then + return New_Unitary_Mal_Type (Func => Quote, Op => Read_Form); + elsif Symbol = ACL.Grave & "" then + return New_Unitary_Mal_Type (Func => Quasiquote, Op => Read_Form); + elsif Symbol = ACL.Tilde & "" then + return New_Unitary_Mal_Type (Func => Unquote, Op => Read_Form); + elsif Symbol = ACL.Commercial_At & "" then + return New_Unitary_Mal_Type (Func => Deref, Op => Read_Form); + else + return MTS; + end if; + end; elsif Deref(MTS).Sym_Type = Unitary and then Unitary_Mal_Type (Deref (MTS).all).Get_Func = Splice_Unquote then diff --git a/ada/step2_eval.adb b/ada/step2_eval.adb index 8607ea84..768c29bf 100644 --- a/ada/step2_eval.adb +++ b/ada/step2_eval.adb @@ -45,10 +45,10 @@ begin Envs.New_Env; - Envs.Set ("+", Types.New_Sym_Mal_Type ('+')); - Envs.Set ("-", Types.New_Sym_Mal_Type ('-')); - Envs.Set ("*", Types.New_Sym_Mal_Type ('*')); - Envs.Set ("/", Types.New_Sym_Mal_Type ('/')); + Envs.Set ("+", Types.New_Atom_Mal_Type ("+")); + Envs.Set ("-", Types.New_Atom_Mal_Type ("-")); + Envs.Set ("*", Types.New_Atom_Mal_Type ("*")); + Envs.Set ("/", Types.New_Atom_Mal_Type ("/")); loop Ada.Text_IO.Put ("user> "); diff --git a/ada/step3_env.adb b/ada/step3_env.adb index c25aa67a..6ece5d1a 100644 --- a/ada/step3_env.adb +++ b/ada/step3_env.adb @@ -52,10 +52,10 @@ begin Envs.New_Env; - Envs.Set ("+", Types.New_Sym_Mal_Type ('+')); - Envs.Set ("-", Types.New_Sym_Mal_Type ('-')); - Envs.Set ("*", Types.New_Sym_Mal_Type ('*')); - Envs.Set ("/", Types.New_Sym_Mal_Type ('/')); + Envs.Set ("+", Types.New_Atom_Mal_Type ("+")); + Envs.Set ("-", Types.New_Atom_Mal_Type ("-")); + Envs.Set ("*", Types.New_Atom_Mal_Type ("*")); + Envs.Set ("/", Types.New_Atom_Mal_Type ("/")); loop Ada.Text_IO.Put ("user> "); diff --git a/ada/types.adb b/ada/types.adb index 8a6ff058..666d875b 100644 --- a/ada/types.adb +++ b/ada/types.adb @@ -109,33 +109,6 @@ package body Types is end Deref_Float; - function New_Sym_Mal_Type (Sym : Character) return Mal_Handle is - begin - return Smart_Pointers.New_Ptr - (new Sym_Mal_Type'(Mal_Type with Symbol => Sym)); - end New_Sym_Mal_Type; - - overriding function Sym_Type (T : Sym_Mal_Type) return Sym_Types is - begin - return Sym; - end Sym_Type; - - function Symbol (T : Sym_Mal_Type) return Character is - begin - return T.Symbol; - end Symbol; - - overriding function To_Str (T : Sym_Mal_Type) return Mal_String is - begin - return "" & T.Symbol; - end To_Str; - - function Deref_Sym (S : Mal_Handle) return Sym_Ptr is - begin - return Sym_Ptr (Deref (S)); - end Deref_Sym; - - function New_String_Mal_Type (Str : Mal_String) return Mal_Handle is begin return Smart_Pointers.New_Ptr diff --git a/ada/types.ads b/ada/types.ads index 6b69a255..34588228 100644 --- a/ada/types.ads +++ b/ada/types.ads @@ -29,7 +29,7 @@ package Types is subtype Mal_Handle is Smart_Pointers.Smart_Pointer; - type Sym_Types is (Int, Floating, List, Sym, Str, Atom, + type Sym_Types is (Int, Floating, List, Str, Atom, Unitary, Node, Lambda, Error); type Mal_Type is abstract new Smart_Pointers.Base_Class with private; @@ -79,19 +79,6 @@ package Types is function Deref_Float (SP : Mal_Handle) return Float_Ptr; - type Sym_Mal_Type is new Mal_Type with private; - - function New_Sym_Mal_Type (Sym : Character) return Mal_Handle; - - overriding function Sym_Type (T : Sym_Mal_Type) return Sym_Types; - - function Symbol (T : Sym_Mal_Type) return Character; - - type Sym_Ptr is access all Sym_Mal_Type; - - function Deref_Sym (S : Mal_Handle) return Sym_Ptr; - - type String_Mal_Type is new Mal_Type with private; function New_String_Mal_Type (Str : Mal_String) return Mal_Handle; @@ -230,12 +217,6 @@ private overriding function To_Str (T : Float_Mal_Type) return Mal_String; - type Sym_Mal_Type is new Mal_Type with record - Symbol : Character; - end record; - - overriding function To_Str (T : Sym_Mal_Type) return Mal_String; - type String_Mal_Type is new Mal_Type with record The_String : Ada.Strings.Unbounded.Unbounded_String; end record;