1 with Ada
.Containers
.Hashed_Maps
;
2 with Ada
.Strings
.Unbounded
.Hash
;
10 procedure Step2_Eval
is
14 -- primitive functions on Smart_Pointer,
15 function "+" is new Arith_Op
("+", "+");
16 function "-" is new Arith_Op
("-", "-");
17 function "*" is new Arith_Op
("*", "*");
18 function "/" is new Arith_Op
("/", "/");
20 -- Take a list with two parameters and produce a single result
21 -- using the Op access-to-function parameter.
23 (Op
: Binary_Func_Access
; LH
: Mal_Handle
)
25 Left
, Right
: Mal_Handle
;
26 L
, Rest_List
: List_Mal_Type
;
28 L
:= Deref_List
(LH
).all;
30 Rest_List
:= Deref_List
(Cdr
(L
)).all;
31 Right
:= Car
(Rest_List
);
32 return Op
(Left
, Right
);
36 function Plus
(Rest_Handle
: Mal_Handle
)
37 return Types
.Mal_Handle
is
39 return Reduce2
(Step2_Eval
."+"'Unrestricted_Access, Rest_Handle);
43 function Minus (Rest_Handle : Mal_Handle)
44 return Types.Mal_Handle is
46 return Reduce2 (Step2_Eval."-"'Unrestricted_Access
, Rest_Handle
);
50 function Mult
(Rest_Handle
: Mal_Handle
)
51 return Types
.Mal_Handle
is
53 return Reduce2
(Step2_Eval
."*"'Unrestricted_Access, Rest_Handle);
57 function Divide (Rest_Handle : Mal_Handle)
58 return Types.Mal_Handle is
60 return Reduce2 (Step2_Eval."/"'Unrestricted_Access
, Rest_Handle
);
64 package String_Mal_Hash
is new Ada
.Containers
.Hashed_Maps
65 (Key_Type
=> Ada
.Strings
.Unbounded
.Unbounded_String
,
66 Element_Type
=> Smart_Pointers
.Smart_Pointer
,
67 Hash
=> Ada
.Strings
.Unbounded
.Hash
,
68 Equivalent_Keys
=> Ada
.Strings
.Unbounded
."=",
69 "=" => Smart_Pointers
."=");
71 Not_Found
: exception;
73 function Get
(M
: String_Mal_Hash
.Map
; K
: String) return Mal_Handle
is
77 C
:= Find
(M
, Ada
.Strings
.Unbounded
.To_Unbounded_String
(K
));
78 if C
= No_Element
then
86 Repl_Env
: String_Mal_Hash
.Map
;
89 function Eval
(Param
: Types
.Mal_Handle
; Env
: String_Mal_Hash
.Map
)
90 return Types
.Mal_Handle
;
93 Debug
: Boolean := False;
96 function Read
(Param
: String) return Types
.Mal_Handle
is
98 return Reader
.Read_Str
(Param
);
103 (Ast
: Mal_Handle
; Env
: String_Mal_Hash
.Map
)
106 function Call_Eval
(A
: Mal_Handle
) return Mal_Handle
is
108 return Eval
(A
, Env
);
113 case Deref
(Ast
).Sym_Type
is
118 Sym
: Mal_String
:= Deref_Sym
(Ast
).Get_Sym
;
120 -- if keyword, return it. Otherwise look it up in the environment.
124 return Get
(Env
, Sym
);
128 raise Not_Found
with ("'" & Sym
& "' not found");
133 return Map
(Call_Eval
'Unrestricted_Access, Deref_List_Class
(Ast
).all);
135 when others => return Ast
;
142 function Eval
(Param
: Mal_Handle
; Env
: String_Mal_Hash
.Map
)
144 First_Elem
: Mal_Handle
;
148 Ada
.Text_IO
.Put_Line
("Evaling " & Deref
(Param
).To_String
);
151 if Deref
(Param
).Sym_Type
= List
and then
152 Deref_List
(Param
).Get_List_Type
= List_List
then
155 Evaled_H
, First_Param
: Mal_Handle
;
156 Evaled_List
: List_Mal_Type
;
157 Param_List
: List_Mal_Type
;
159 Param_List
:= Deref_List
(Param
).all;
161 -- Deal with empty list..
162 if Param_List
.Length
= 0 then
166 Evaled_H
:= Eval_Ast
(Param
, Env
);
167 Evaled_List
:= Deref_List
(Evaled_H
).all;
168 First_Param
:= Car
(Evaled_List
);
169 return Call_Func
(Deref_Func
(First_Param
).all, Cdr
(Evaled_List
));
172 else -- Not a List_List
174 return Eval_Ast
(Param
, Env
);
181 function Print
(Param
: Types
.Mal_Handle
) return String is
183 return Printer
.Pr_Str
(Param
);
187 function Rep
(Param
: String; Env
: String_Mal_Hash
.Map
) return String is
188 AST
, Evaluated_AST
: Types
.Mal_Handle
;
193 if Types
.Is_Null
(AST
) then
196 Evaluated_AST
:= Eval
(AST
, Env
);
197 return Print
(Evaluated_AST
);
204 String_Mal_Hash
.Include
205 (Container
=> Repl_Env
,
206 Key
=> Ada
.Strings
.Unbounded
.To_Unbounded_String
("+"),
207 New_Item
=> New_Func_Mal_Type
("+", Plus
'Unrestricted_access));
209 String_Mal_Hash
.Include
210 (Container
=> Repl_Env
,
211 Key
=> Ada
.Strings
.Unbounded
.To_Unbounded_String
("-"),
212 New_Item
=> New_Func_Mal_Type
("-", Minus
'Unrestricted_access));
214 String_Mal_Hash
.Include
215 (Container
=> Repl_Env
,
216 Key
=> Ada
.Strings
.Unbounded
.To_Unbounded_String
("*"),
217 New_Item
=> New_Func_Mal_Type
("*", Mult
'Unrestricted_access));
219 String_Mal_Hash
.Include
220 (Container
=> Repl_Env
,
221 Key
=> Ada
.Strings
.Unbounded
.To_Unbounded_String
("/"),
222 New_Item
=> New_Func_Mal_Type
("/", Divide
'Unrestricted_access));
226 Ada
.Text_IO
.Put
("user> ");
227 exit when Ada
.Text_IO
.End_Of_File
;
228 Ada
.Text_IO
.Put_Line
(Rep
(Ada
.Text_IO
.Get_Line
, Repl_Env
));
232 (Ada
.Text_IO
.Standard_Error
,
233 Ada
.Exceptions
.Exception_Information
(E
));