kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-20 18:18:51 +03:00
Code Issues Projects Releases Wiki Activity

Ada: Remove Sym_Mal_Type; just a special case of Atom

Browse Source
This commit is contained in:
Chris M Moore 2015-04-06 13:10:39 +01:00
parent 09c532baaa
commit 9cbc9695b9
6 changed files with 58 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
ada/evaluation.adb
View File

@ -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

72
ada/reader.adb
View File

@ -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

8
ada/step2_eval.adb
View File

@ -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> ");

8
ada/step3_env.adb
View File

@ -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> ");

27
ada/types.adb
View File

@ -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

21
ada/types.ads
View File

@ -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;