Commit | Line | Data |
---|---|---|
66bf8260 | 1 | with Ada.Calendar; |
8c49f5a7 | 2 | with Ada.Characters.Latin_1; |
a974463a | 3 | with Ada.Strings.Unbounded; |
0571a45f | 4 | with Ada.Text_IO; |
18e21187 | 5 | with Eval_Callback; |
8c49f5a7 | 6 | with Reader; |
0571a45f CM |
7 | with Smart_Pointers; |
8 | with Types; | |
874db2ac | 9 | with Types.Hash_Map; |
705f3d2c | 10 | with Types.Vector; |
0571a45f CM |
11 | |
12 | package body Core is | |
13 | ||
14 | use Types; | |
15 | ||
16 | -- primitive functions on Smart_Pointer, | |
17 | function "+" is new Arith_Op ("+", "+"); | |
18 | function "-" is new Arith_Op ("-", "-"); | |
19 | function "*" is new Arith_Op ("*", "*"); | |
20 | function "/" is new Arith_Op ("/", "/"); | |
21 | ||
22 | function "<" is new Rel_Op ("<", "<"); | |
23 | function "<=" is new Rel_Op ("<=", "<="); | |
24 | function ">" is new Rel_Op (">", ">"); | |
25 | function ">=" is new Rel_Op (">=", ">="); | |
26 | ||
27 | ||
0571a45f CM |
28 | function Eval_As_Boolean (MH : Types.Mal_Handle) return Boolean is |
29 | use Types; | |
30 | Res : Boolean; | |
31 | begin | |
32 | case Deref (MH).Sym_Type is | |
311cbfc0 | 33 | when Bool => |
0571a45f | 34 | Res := Deref_Bool (MH).Get_Bool; |
311cbfc0 | 35 | when Nil => |
8083b525 | 36 | Res := False; |
0571a45f CM |
37 | -- when List => |
38 | -- declare | |
39 | -- L : List_Mal_Type; | |
40 | -- begin | |
41 | -- L := Deref_List (MH).all; | |
42 | -- Res := not Is_Null (L); | |
43 | -- end; | |
44 | when others => -- Everything else | |
45 | Res := True; | |
46 | end case; | |
47 | return Res; | |
48 | end Eval_As_Boolean; | |
49 | ||
50 | ||
1c28e560 | 51 | function Throw (Rest_Handle : Mal_Handle) |
f0727512 CM |
52 | return Types.Mal_Handle is |
53 | First_Param : Mal_Handle; | |
54 | Rest_List : Types.List_Mal_Type; | |
55 | begin | |
56 | Rest_List := Deref_List (Rest_Handle).all; | |
57 | First_Param := Car (Rest_List); | |
18e21187 | 58 | Types.Mal_Exception_Value := First_Param; |
f0727512 CM |
59 | raise Mal_Exception; |
60 | return First_Param; -- Keep the compiler happy. | |
61 | end Throw; | |
62 | ||
63 | ||
1c28e560 | 64 | function Is_True (Rest_Handle : Mal_Handle) |
f0727512 CM |
65 | return Types.Mal_Handle is |
66 | First_Param, Evaled_List : Mal_Handle; | |
67 | Rest_List : Types.List_Mal_Type; | |
68 | begin | |
69 | Rest_List := Deref_List (Rest_Handle).all; | |
70 | First_Param := Car (Rest_List); | |
71 | return New_Bool_Mal_Type | |
72 | (Deref (First_Param).Sym_Type = Bool and then | |
73 | Deref_Bool (First_Param).Get_Bool); | |
74 | end Is_True; | |
75 | ||
76 | ||
1c28e560 | 77 | function Is_False (Rest_Handle : Mal_Handle) |
f0727512 CM |
78 | return Types.Mal_Handle is |
79 | First_Param, Evaled_List : Mal_Handle; | |
80 | Rest_List : Types.List_Mal_Type; | |
81 | begin | |
82 | Rest_List := Deref_List (Rest_Handle).all; | |
83 | First_Param := Car (Rest_List); | |
84 | return New_Bool_Mal_Type | |
85 | (Deref (First_Param).Sym_Type = Bool and then | |
86 | not Deref_Bool (First_Param).Get_Bool); | |
87 | end Is_False; | |
88 | ||
89 | ||
1c28e560 | 90 | function Is_Nil (Rest_Handle : Mal_Handle) |
f0727512 CM |
91 | return Types.Mal_Handle is |
92 | First_Param, Evaled_List : Mal_Handle; | |
93 | Rest_List : Types.List_Mal_Type; | |
94 | begin | |
95 | Rest_List := Deref_List (Rest_Handle).all; | |
96 | First_Param := Car (Rest_List); | |
97 | return New_Bool_Mal_Type | |
8083b525 | 98 | (Deref (First_Param).Sym_Type = Nil); |
f0727512 CM |
99 | end Is_Nil; |
100 | ||
101 | ||
1c28e560 | 102 | function Meta (Rest_Handle : Mal_Handle) |
5b77d5f7 CM |
103 | return Types.Mal_Handle is |
104 | First_Param : Mal_Handle; | |
105 | Rest_List : Types.List_Mal_Type; | |
106 | begin | |
107 | Rest_List := Deref_List (Rest_Handle).all; | |
108 | First_Param := Car (Rest_List); | |
109 | return Deref (First_Param).Get_Meta; | |
110 | end Meta; | |
111 | ||
112 | ||
1c28e560 | 113 | function With_Meta (Rest_Handle : Mal_Handle) |
5b77d5f7 CM |
114 | return Types.Mal_Handle is |
115 | First_Param, Meta_Param, Res : Mal_Handle; | |
116 | Rest_List : Types.List_Mal_Type; | |
117 | begin | |
118 | Rest_List := Deref_List (Rest_Handle).all; | |
119 | First_Param := Car (Rest_List); | |
120 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
121 | Meta_Param := Car (Rest_List); | |
122 | Res := Copy (First_Param); | |
123 | Deref (Res).Set_Meta (Meta_Param); | |
124 | return Res; | |
125 | end With_Meta; | |
126 | ||
127 | ||
1c28e560 | 128 | function New_Atom (Rest_Handle : Mal_Handle) |
f88e4203 CM |
129 | return Types.Mal_Handle is |
130 | First_Param : Mal_Handle; | |
131 | Rest_List : Types.List_Mal_Type; | |
132 | begin | |
133 | Rest_List := Deref_List (Rest_Handle).all; | |
134 | First_Param := Car (Rest_List); | |
51fa7633 | 135 | return New_Atom_Mal_Type (First_Param); |
f88e4203 CM |
136 | end New_Atom; |
137 | ||
1c28e560 | 138 | function Is_Atom (Rest_Handle : Mal_Handle) |
f88e4203 CM |
139 | return Types.Mal_Handle is |
140 | First_Param, Evaled_List : Mal_Handle; | |
141 | Rest_List : Types.List_Mal_Type; | |
142 | begin | |
143 | Rest_List := Deref_List (Rest_Handle).all; | |
144 | First_Param := Car (Rest_List); | |
145 | return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Atom); | |
146 | end Is_Atom; | |
147 | ||
148 | ||
1c28e560 | 149 | function Deref_Atm (Rest_Handle : Mal_Handle) |
36b6dea5 CM |
150 | return Types.Mal_Handle is |
151 | First_Param : Mal_Handle; | |
152 | Rest_List : Types.List_Mal_Type; | |
153 | begin | |
154 | Rest_List := Deref_List (Rest_Handle).all; | |
155 | First_Param := Car (Rest_List); | |
156 | return Deref_Atom (First_Param).Get_Atom; | |
1c28e560 | 157 | end Deref_Atm; |
36b6dea5 CM |
158 | |
159 | ||
1c28e560 | 160 | function Reset (Rest_Handle : Mal_Handle) |
36b6dea5 CM |
161 | return Types.Mal_Handle is |
162 | First_Param, Atom_Param, New_Val : Mal_Handle; | |
163 | Rest_List : Types.List_Mal_Type; | |
164 | begin | |
165 | Rest_List := Deref_List (Rest_Handle).all; | |
166 | Atom_Param := Car (Rest_List); | |
167 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
168 | New_Val := Car (Rest_List); | |
169 | Deref_Atom (Atom_Param).Set_Atom (New_Val); | |
170 | return New_Val; | |
171 | end Reset; | |
172 | ||
173 | ||
1c28e560 | 174 | function Swap (Rest_Handle : Mal_Handle) |
36b6dea5 CM |
175 | return Types.Mal_Handle is |
176 | First_Param, Atom_Param, Atom_Val, New_Val : Mal_Handle; | |
177 | Rest_List : Types.List_Mal_Type; | |
178 | Rest_List_Class : Types.List_Class_Ptr; | |
0073c0a1 | 179 | Func_Param, Param_List : Mal_Handle; |
36b6dea5 CM |
180 | begin |
181 | Rest_List := Deref_List (Rest_Handle).all; | |
182 | Atom_Param := Car (Rest_List); | |
183 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
0073c0a1 CM |
184 | Func_Param := Car (Rest_List); |
185 | Param_List := Cdr (Rest_List); | |
36b6dea5 | 186 | |
0073c0a1 | 187 | Rest_List_Class := Deref_List_Class (Param_List); |
36b6dea5 CM |
188 | Param_List := Rest_List_Class.Duplicate; |
189 | Atom_Val := Deref_Atom (Atom_Param).Get_Atom; | |
190 | Param_List := Prepend (Atom_Val, Deref_List (Param_List).all); | |
0073c0a1 CM |
191 | case Deref (Func_Param).Sym_Type is |
192 | when Lambda => | |
18e21187 | 193 | New_Val := Deref_Lambda (Func_Param).Apply (Param_List); |
0073c0a1 | 194 | when Func => |
1c28e560 | 195 | New_Val := Deref_Func (Func_Param).Call_Func (Param_List); |
dd7a4f55 | 196 | when others => raise Runtime_Exception with "Swap with bad func"; |
0073c0a1 | 197 | end case; |
36b6dea5 CM |
198 | Deref_Atom (Atom_Param).Set_Atom (New_Val); |
199 | return New_Val; | |
200 | end Swap; | |
201 | ||
202 | ||
1c28e560 | 203 | function Is_List (Rest_Handle : Mal_Handle) |
0571a45f CM |
204 | return Types.Mal_Handle is |
205 | First_Param, Evaled_List : Mal_Handle; | |
206 | Rest_List : Types.List_Mal_Type; | |
207 | begin | |
208 | Rest_List := Deref_List (Rest_Handle).all; | |
209 | First_Param := Car (Rest_List); | |
210 | return New_Bool_Mal_Type | |
211 | (Deref (First_Param).Sym_Type = List and then | |
212 | Deref_List (First_Param).Get_List_Type = List_List); | |
213 | end Is_List; | |
214 | ||
215 | ||
1c28e560 | 216 | function Is_Vector (Rest_Handle : Mal_Handle) |
f0727512 CM |
217 | return Types.Mal_Handle is |
218 | First_Param, Evaled_List : Mal_Handle; | |
219 | Rest_List : Types.List_Mal_Type; | |
220 | begin | |
221 | Rest_List := Deref_List (Rest_Handle).all; | |
222 | First_Param := Car (Rest_List); | |
223 | return New_Bool_Mal_Type | |
224 | (Deref (First_Param).Sym_Type = List and then | |
225 | Deref_List (First_Param).Get_List_Type = Vector_List); | |
226 | end Is_Vector; | |
227 | ||
228 | ||
1c28e560 | 229 | function Is_Map (Rest_Handle : Mal_Handle) |
f0727512 CM |
230 | return Types.Mal_Handle is |
231 | First_Param, Evaled_List : Mal_Handle; | |
232 | Rest_List : Types.List_Mal_Type; | |
233 | begin | |
234 | Rest_List := Deref_List (Rest_Handle).all; | |
235 | First_Param := Car (Rest_List); | |
236 | return New_Bool_Mal_Type | |
237 | (Deref (First_Param).Sym_Type = List and then | |
238 | Deref_List (First_Param).Get_List_Type = Hashed_List); | |
239 | end Is_Map; | |
240 | ||
241 | ||
1c28e560 | 242 | function Is_Sequential (Rest_Handle : Mal_Handle) |
f0727512 CM |
243 | return Types.Mal_Handle is |
244 | First_Param, Evaled_List : Mal_Handle; | |
245 | Rest_List : Types.List_Mal_Type; | |
246 | begin | |
247 | Rest_List := Deref_List (Rest_Handle).all; | |
248 | First_Param := Car (Rest_List); | |
249 | return New_Bool_Mal_Type | |
250 | (Deref (First_Param).Sym_Type = List and then | |
251 | Deref_List (First_Param).Get_List_Type /= Hashed_List); | |
252 | end Is_Sequential; | |
253 | ||
254 | ||
1c28e560 | 255 | function Is_Empty (Rest_Handle : Mal_Handle) |
0571a45f CM |
256 | return Types.Mal_Handle is |
257 | First_Param, Evaled_List : Mal_Handle; | |
705f3d2c | 258 | List : List_Class_Ptr; |
0571a45f CM |
259 | Rest_List : Types.List_Mal_Type; |
260 | begin | |
261 | Rest_List := Deref_List (Rest_Handle).all; | |
262 | First_Param := Car (Rest_List); | |
705f3d2c CM |
263 | List := Deref_List_Class (First_Param); |
264 | return New_Bool_Mal_Type (Is_Null (List.all)); | |
0571a45f CM |
265 | end Is_Empty; |
266 | ||
267 | ||
268 | function Eval_As_List (MH : Types.Mal_Handle) return List_Mal_Type is | |
269 | begin | |
270 | case Deref (MH).Sym_Type is | |
8083b525 CM |
271 | when List => return Deref_List (MH).all; |
272 | when Nil => return Null_List (List_List); | |
0571a45f CM |
273 | when others => null; |
274 | end case; | |
dd7a4f55 | 275 | raise Runtime_Exception with "Expecting a List"; |
0571a45f CM |
276 | return Null_List (List_List); |
277 | end Eval_As_List; | |
278 | ||
279 | ||
1c28e560 | 280 | function Count (Rest_Handle : Mal_Handle) |
0571a45f CM |
281 | return Types.Mal_Handle is |
282 | First_Param, Evaled_List : Mal_Handle; | |
705f3d2c | 283 | L : List_Mal_Type; |
0571a45f | 284 | Rest_List : Types.List_Mal_Type; |
705f3d2c | 285 | N : Natural; |
0571a45f CM |
286 | begin |
287 | Rest_List := Deref_List (Rest_Handle).all; | |
288 | First_Param := Car (Rest_List); | |
705f3d2c CM |
289 | if Deref (First_Param).Sym_Type = List and then |
290 | Deref_List (First_Param).Get_List_Type = Vector_List then | |
291 | N := Deref_List_Class (First_Param).Length; | |
292 | else | |
293 | L := Eval_As_List (First_Param); | |
294 | N := L.Length; | |
295 | end if; | |
296 | return New_Int_Mal_Type (N); | |
0571a45f CM |
297 | end Count; |
298 | ||
299 | ||
1c28e560 | 300 | function Cons (Rest_Handle : Mal_Handle) |
ebb6e9d3 CM |
301 | return Types.Mal_Handle is |
302 | Rest_List : Types.List_Mal_Type; | |
303 | First_Param, List_Handle : Mal_Handle; | |
304 | List : List_Mal_Type; | |
705f3d2c | 305 | List_Class : List_Class_Ptr; |
ebb6e9d3 CM |
306 | begin |
307 | Rest_List := Deref_List (Rest_Handle).all; | |
308 | First_Param := Car (Rest_List); | |
309 | List_Handle := Cdr (Rest_List); | |
310 | List := Deref_List (List_Handle).all; | |
311 | List_Handle := Car (List); | |
705f3d2c CM |
312 | List_Class := Deref_List_Class (List_Handle); |
313 | return Prepend (First_Param, List_Class.all); | |
ebb6e9d3 CM |
314 | end Cons; |
315 | ||
316 | ||
1c28e560 | 317 | function Concat (Rest_Handle : Mal_Handle) |
ebb6e9d3 CM |
318 | return Types.Mal_Handle is |
319 | Rest_List : Types.List_Mal_Type; | |
320 | begin | |
321 | Rest_List := Deref_List (Rest_Handle).all; | |
1c28e560 | 322 | return Types.Concat (Rest_List); |
ebb6e9d3 CM |
323 | end Concat; |
324 | ||
325 | ||
1c28e560 | 326 | function First (Rest_Handle : Mal_Handle) |
d836bcfc | 327 | return Types.Mal_Handle is |
705f3d2c CM |
328 | Rest_List : Types.List_Mal_Type; |
329 | First_List : Types.List_Class_Ptr; | |
d836bcfc CM |
330 | First_Param : Mal_Handle; |
331 | begin | |
332 | Rest_List := Deref_List (Rest_Handle).all; | |
333 | First_Param := Car (Rest_List); | |
8083b525 CM |
334 | if Deref (First_Param).Sym_Type = Nil then |
335 | return New_Nil_Mal_Type; | |
5660d35d | 336 | end if; |
705f3d2c CM |
337 | First_List := Deref_List_Class (First_Param); |
338 | if Is_Null (First_List.all) then | |
8083b525 | 339 | return New_Nil_Mal_Type; |
6d91af72 | 340 | else |
705f3d2c | 341 | return Types.Car (First_List.all); |
6d91af72 | 342 | end if; |
d836bcfc CM |
343 | end First; |
344 | ||
345 | ||
1c28e560 | 346 | function Rest (Rest_Handle : Mal_Handle) |
d836bcfc | 347 | return Types.Mal_Handle is |
705f3d2c CM |
348 | Rest_List : Types.List_Mal_Type; |
349 | First_Param, Container : Mal_Handle; | |
d836bcfc CM |
350 | begin |
351 | Rest_List := Deref_List (Rest_Handle).all; | |
352 | First_Param := Car (Rest_List); | |
8083b525 | 353 | if Deref (First_Param).Sym_Type = Nil then |
5660d35d CM |
354 | return New_List_Mal_Type (List_List); |
355 | end if; | |
705f3d2c CM |
356 | Container := Deref_List_Class (First_Param).Cdr; |
357 | return Deref_List_Class (Container).Duplicate; | |
d836bcfc CM |
358 | end Rest; |
359 | ||
360 | ||
1c28e560 | 361 | function Nth (Rest_Handle : Mal_Handle) |
6d91af72 | 362 | return Types.Mal_Handle is |
705f3d2c CM |
363 | -- Rest_List, First_List : Types.List_Mal_Type; |
364 | Rest_List : Types.List_Mal_Type; | |
365 | First_List : Types.List_Class_Ptr; | |
6d91af72 CM |
366 | First_Param, List_Handle, Num_Handle : Mal_Handle; |
367 | List : List_Mal_Type; | |
368 | Index : Types.Int_Mal_Type; | |
369 | begin | |
370 | Rest_List := Deref_List (Rest_Handle).all; | |
371 | First_Param := Car (Rest_List); | |
705f3d2c | 372 | First_List := Deref_List_Class (First_Param); |
6d91af72 CM |
373 | List_Handle := Cdr (Rest_List); |
374 | List := Deref_List (List_Handle).all; | |
375 | Num_Handle := Car (List); | |
376 | Index := Deref_Int (Num_Handle).all; | |
705f3d2c | 377 | return Types.Nth (First_List.all, Natural (Index.Get_Int_Val)); |
6d91af72 CM |
378 | end Nth; |
379 | ||
380 | ||
1c28e560 | 381 | function Apply (Rest_Handle : Mal_Handle) |
b5bad5ea CM |
382 | return Types.Mal_Handle is |
383 | ||
384 | Results_Handle, First_Param : Mal_Handle; | |
385 | Rest_List : List_Mal_Type; | |
386 | Results_List : List_Ptr; | |
387 | ||
388 | begin | |
389 | ||
390 | -- The rest of the line. | |
391 | Rest_List := Deref_List (Rest_Handle).all; | |
392 | First_Param := Car (Rest_List); | |
393 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
394 | ||
395 | Results_Handle := New_List_Mal_Type (List_List); | |
396 | Results_List := Deref_List (Results_Handle); | |
397 | ||
398 | -- The last item is a list or a vector which gets flattened so that | |
399 | -- (apply f (A B) C (D E)) becomes (f (A B) C D E) | |
400 | while not Is_Null (Rest_List) loop | |
401 | declare | |
402 | Part_Handle : Mal_Handle; | |
403 | begin | |
404 | Part_Handle := Car (Rest_List); | |
405 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
406 | ||
407 | -- Is Part_Handle the last item in the list? | |
408 | if Is_Null (Rest_List) then | |
409 | declare | |
410 | The_List : List_Class_Ptr; | |
411 | List_Item : Mal_Handle; | |
412 | Next_List : Mal_Handle; | |
413 | begin | |
414 | The_List := Deref_List_Class (Part_Handle); | |
415 | while not Is_Null (The_List.all) loop | |
416 | List_Item := Car (The_List.all); | |
417 | Append (Results_List.all, List_Item); | |
418 | Next_List := Cdr (The_List.all); | |
419 | The_List := Deref_List_Class (Next_List); | |
420 | end loop; | |
421 | end; | |
422 | else | |
423 | Append (Results_List.all, Part_Handle); | |
424 | end if; | |
425 | end; | |
426 | end loop; | |
c6b1e6e7 CM |
427 | |
428 | -- The apply part... | |
b5bad5ea | 429 | if Deref (First_Param).Sym_Type = Func then |
1c28e560 | 430 | return Call_Func (Deref_Func (First_Param).all, Results_Handle); |
b5bad5ea CM |
431 | elsif Deref (First_Param).Sym_Type = Lambda then |
432 | declare | |
433 | ||
434 | L : Lambda_Mal_Type; | |
435 | E : Envs.Env_Handle; | |
436 | Param_Names : List_Mal_Type; | |
437 | Res : Mal_Handle; | |
438 | ||
439 | begin | |
440 | ||
441 | L := Deref_Lambda (First_Param).all; | |
442 | E := Envs.New_Env (L.Get_Env); | |
443 | ||
444 | Param_Names := Deref_List (L.Get_Params).all; | |
445 | ||
446 | if Envs.Bind (E, Param_Names, Results_List.all) then | |
447 | ||
448 | return Eval_Callback.Eval.all (L.Get_Expr, E); | |
449 | ||
450 | else | |
451 | ||
dd7a4f55 | 452 | raise Runtime_Exception with "Bind failed in Apply"; |
b5bad5ea CM |
453 | |
454 | end if; | |
455 | ||
456 | end; | |
457 | ||
458 | else -- neither a Lambda or a Func | |
dd7a4f55 | 459 | raise Runtime_Exception with "Deref called on non-Func/Lambda"; |
b5bad5ea CM |
460 | end if; |
461 | ||
b5bad5ea CM |
462 | end Apply; |
463 | ||
464 | ||
1c28e560 | 465 | function Map (Rest_Handle : Mal_Handle) |
c7b51393 CM |
466 | return Types.Mal_Handle is |
467 | ||
874db2ac | 468 | Rest_List, Results_List : List_Mal_Type; |
18e21187 | 469 | Func_Handle, List_Handle, Results_Handle : Mal_Handle; |
c7b51393 CM |
470 | |
471 | begin | |
472 | ||
473 | -- The rest of the line. | |
474 | Rest_List := Deref_List (Rest_Handle).all; | |
475 | ||
476 | Func_Handle := Car (Rest_List); | |
18e21187 | 477 | List_Handle := Nth (Rest_List, 1); |
c7b51393 CM |
478 | |
479 | Results_Handle := New_List_Mal_Type (List_List); | |
480 | Results_List := Deref_List (Results_Handle).all; | |
481 | ||
874db2ac | 482 | while not Is_Null (Deref_List_Class (List_Handle).all) loop |
18e21187 | 483 | |
c7b51393 CM |
484 | declare |
485 | Parts_Handle : Mal_Handle; | |
c7b51393 | 486 | begin |
18e21187 CM |
487 | Parts_Handle := |
488 | Make_New_List | |
489 | ((1 => Func_Handle, | |
490 | 2 => Make_New_List | |
b5bad5ea | 491 | ((1 => Car (Deref_List_Class (List_Handle).all))))); |
311cbfc0 | 492 | |
874db2ac | 493 | List_Handle := Cdr (Deref_List_Class (List_Handle).all); |
c7b51393 | 494 | |
c7b51393 CM |
495 | Append |
496 | (Results_List, | |
1c28e560 | 497 | Apply (Parts_Handle)); |
18e21187 | 498 | |
c7b51393 | 499 | end; |
18e21187 | 500 | |
c7b51393 | 501 | end loop; |
18e21187 | 502 | |
c7b51393 | 503 | return New_List_Mal_Type (Results_List); |
18e21187 | 504 | |
c7b51393 CM |
505 | end Map; |
506 | ||
507 | ||
1c28e560 | 508 | function Symbol (Rest_Handle : Mal_Handle) |
8021afae CM |
509 | return Types.Mal_Handle is |
510 | ||
a249dff4 | 511 | Sym_Handle : Mal_Handle; |
8021afae CM |
512 | Rest_List : List_Mal_Type; |
513 | ||
514 | begin | |
515 | ||
516 | -- The rest of the line. | |
517 | Rest_List := Deref_List (Rest_Handle).all; | |
518 | ||
519 | Sym_Handle := Car (Rest_List); | |
520 | ||
a249dff4 | 521 | return New_Symbol_Mal_Type (Deref_String (Sym_Handle).Get_String); |
8021afae | 522 | |
8021afae CM |
523 | end Symbol; |
524 | ||
525 | ||
1c28e560 | 526 | function Is_Symbol (Rest_Handle : Mal_Handle) |
8021afae CM |
527 | return Types.Mal_Handle is |
528 | ||
529 | Sym_Handle : Mal_Handle; | |
530 | Rest_List : List_Mal_Type; | |
2e3389c4 | 531 | Res : Boolean; |
8021afae CM |
532 | |
533 | begin | |
534 | Rest_List := Deref_List (Rest_Handle).all; | |
535 | Sym_Handle := Car (Rest_List); | |
51fa7633 CM |
536 | if Deref (Sym_Handle).Sym_Type = Sym then |
537 | Res := Deref_Sym (Sym_Handle).Get_Sym (1) /= ':'; | |
2e3389c4 CM |
538 | else |
539 | Res := False; | |
540 | end if; | |
541 | return New_Bool_Mal_Type (Res); | |
8021afae CM |
542 | end Is_Symbol; |
543 | ||
544 | ||
d2bb60d3 CM |
545 | function Is_String (Rest_Handle : Mal_Handle) return Types.Mal_Handle is |
546 | First_Param : Mal_Handle; | |
547 | begin | |
548 | First_Param := Car (Deref_List (Rest_Handle).all); | |
549 | return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Str); | |
550 | end Is_String; | |
551 | ||
552 | ||
1c28e560 | 553 | function Keyword (Rest_Handle : Mal_Handle) |
2e3389c4 CM |
554 | return Types.Mal_Handle is |
555 | ||
a249dff4 | 556 | Sym_Handle : Mal_Handle; |
2e3389c4 CM |
557 | Rest_List : List_Mal_Type; |
558 | ||
559 | begin | |
560 | ||
561 | -- The rest of the line. | |
562 | Rest_List := Deref_List (Rest_Handle).all; | |
563 | ||
564 | Sym_Handle := Car (Rest_List); | |
565 | ||
a249dff4 | 566 | return New_Symbol_Mal_Type (':' & Deref_String (Sym_Handle).Get_String); |
2e3389c4 | 567 | |
2e3389c4 CM |
568 | end Keyword; |
569 | ||
570 | ||
1c28e560 | 571 | function Is_Keyword (Rest_Handle : Mal_Handle) |
2e3389c4 CM |
572 | return Types.Mal_Handle is |
573 | ||
574 | Sym_Handle : Mal_Handle; | |
575 | Rest_List : List_Mal_Type; | |
576 | Res : Boolean; | |
577 | ||
578 | begin | |
579 | Rest_List := Deref_List (Rest_Handle).all; | |
580 | Sym_Handle := Car (Rest_List); | |
51fa7633 CM |
581 | if Deref (Sym_Handle).Sym_Type = Sym then |
582 | Res := Deref_Sym (Sym_Handle).Get_Sym (1) = ':'; | |
2e3389c4 CM |
583 | else |
584 | Res := False; | |
585 | end if; | |
586 | return New_Bool_Mal_Type (Res); | |
587 | end Is_Keyword; | |
588 | ||
589 | ||
968faaad DM |
590 | function Is_Number (Rest_Handle : Mal_Handle) return Types.Mal_Handle is |
591 | First_Param : Mal_Handle; | |
592 | begin | |
593 | First_Param := Car (Deref_List (Rest_Handle).all); | |
594 | return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Int); | |
595 | end Is_Number; | |
596 | ||
597 | ||
598 | function Is_Fn (Rest_Handle : Mal_Handle) return Types.Mal_Handle is | |
599 | First_Param : Mal_Handle; | |
600 | Res : Boolean; | |
601 | begin | |
602 | First_Param := Car (Deref_List (Rest_Handle).all); | |
603 | case Deref (First_Param).Sym_Type is | |
604 | when Func => | |
605 | Res := True; | |
606 | when Lambda => | |
607 | Res := not Deref_Lambda (First_Param).Get_Is_Macro; | |
608 | when others => | |
609 | Res := False; | |
610 | end case; | |
611 | return New_Bool_Mal_Type (Res); | |
612 | end Is_Fn; | |
613 | ||
614 | ||
615 | function Is_Macro (Rest_Handle : Mal_Handle) return Types.Mal_Handle is | |
616 | First_Param : Mal_Handle; | |
617 | begin | |
618 | First_Param := Car (Deref_List (Rest_Handle).all); | |
619 | return New_Bool_Mal_Type (Deref (First_Param).Sym_Type = Lambda and then Deref_Lambda (First_Param).Get_Is_Macro); | |
620 | end Is_Macro; | |
621 | ||
622 | ||
1c28e560 | 623 | function New_List (Rest_Handle : Mal_Handle) |
0571a45f CM |
624 | return Types.Mal_Handle is |
625 | Rest_List : Types.List_Mal_Type; | |
626 | begin | |
627 | Rest_List := Deref_List (Rest_Handle).all; | |
628 | return New_List_Mal_Type (The_List => Rest_List); | |
629 | end New_List; | |
630 | ||
631 | ||
1c28e560 | 632 | function New_Vector (Rest_Handle : Mal_Handle) |
cca0b237 CM |
633 | return Types.Mal_Handle is |
634 | Rest_List : List_Mal_Type; | |
635 | Res : Mal_Handle; | |
705f3d2c | 636 | use Types.Vector; |
cca0b237 | 637 | begin |
705f3d2c | 638 | Res := New_Vector_Mal_Type; |
cca0b237 CM |
639 | Rest_List := Deref_List (Rest_Handle).all; |
640 | while not Is_Null (Rest_List) loop | |
705f3d2c | 641 | Deref_Vector (Res).Append (Car (Rest_List)); |
cca0b237 CM |
642 | Rest_List := Deref_List (Cdr (Rest_List)).all; |
643 | end loop; | |
644 | return Res; | |
645 | end New_Vector; | |
646 | ||
647 | ||
1c28e560 | 648 | function New_Map (Rest_Handle : Mal_Handle) |
5fa2b0cc CM |
649 | return Types.Mal_Handle is |
650 | Rest_List : List_Mal_Type; | |
651 | Res : Mal_Handle; | |
652 | begin | |
874db2ac | 653 | Res := Hash_Map.New_Hash_Map_Mal_Type; |
5fa2b0cc CM |
654 | Rest_List := Deref_List (Rest_Handle).all; |
655 | while not Is_Null (Rest_List) loop | |
874db2ac | 656 | Hash_Map.Deref_Hash (Res).Append (Car (Rest_List)); |
5fa2b0cc CM |
657 | Rest_List := Deref_List (Cdr (Rest_List)).all; |
658 | end loop; | |
659 | return Res; | |
660 | end New_Map; | |
661 | ||
662 | ||
1c28e560 | 663 | function Assoc (Rest_Handle : Mal_Handle) |
5fa2b0cc | 664 | return Types.Mal_Handle is |
874db2ac CM |
665 | Rest_List : Mal_Handle; |
666 | Map : Hash_Map.Hash_Map_Mal_Type; | |
5fa2b0cc | 667 | begin |
874db2ac CM |
668 | Rest_List := Rest_Handle; |
669 | Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; | |
670 | Rest_List := Cdr (Deref_List (Rest_List).all); | |
671 | return Hash_Map.Assoc (Map, Rest_List); | |
672 | end Assoc; | |
5fa2b0cc | 673 | |
5fa2b0cc | 674 | |
1c28e560 | 675 | function Dis_Assoc (Rest_Handle : Mal_Handle) |
874db2ac CM |
676 | return Types.Mal_Handle is |
677 | Rest_List : Mal_Handle; | |
678 | Map : Hash_Map.Hash_Map_Mal_Type; | |
679 | begin | |
680 | Rest_List := Rest_Handle; | |
681 | Map := Hash_Map.Deref_Hash (Car (Deref_List (Rest_List).all)).all; | |
682 | Rest_List := Cdr (Deref_List (Rest_List).all); | |
683 | return Hash_Map.Dis_Assoc (Map, Rest_List); | |
684 | end Dis_Assoc; | |
5fa2b0cc CM |
685 | |
686 | ||
1c28e560 | 687 | function Get_Key (Rest_Handle : Mal_Handle) |
5fa2b0cc | 688 | return Types.Mal_Handle is |
874db2ac CM |
689 | Rest_List : List_Mal_Type; |
690 | Map : Hash_Map.Hash_Map_Mal_Type; | |
691 | Map_Param, Key : Mal_Handle; | |
93031830 | 692 | The_Sym : Sym_Types; |
5fa2b0cc CM |
693 | begin |
694 | ||
695 | Rest_List := Deref_List (Rest_Handle).all; | |
4daad7d8 | 696 | Map_Param := Car (Rest_List); |
93031830 | 697 | The_Sym := Deref (Map_Param).Sym_Type; |
8083b525 | 698 | if The_Sym = Sym or The_Sym = Nil then |
4daad7d8 CM |
699 | -- Either its nil or its some other atom |
700 | -- which makes no sense! | |
8083b525 | 701 | return New_Nil_Mal_Type; |
4daad7d8 CM |
702 | end if; |
703 | ||
704 | -- Assume a map from here on in. | |
874db2ac | 705 | Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; |
5fa2b0cc CM |
706 | Rest_List := Deref_List (Cdr (Rest_List)).all; |
707 | Key := Car (Rest_List); | |
708 | ||
874db2ac CM |
709 | return Map.Get (Key); |
710 | ||
5fa2b0cc CM |
711 | end Get_Key; |
712 | ||
713 | ||
1c28e560 | 714 | function Contains_Key (Rest_Handle : Mal_Handle) |
4daad7d8 | 715 | return Types.Mal_Handle is |
874db2ac CM |
716 | Rest_List : List_Mal_Type; |
717 | Map : Hash_Map.Hash_Map_Mal_Type; | |
718 | Key : Mal_Handle; | |
4daad7d8 | 719 | begin |
4daad7d8 | 720 | Rest_List := Deref_List (Rest_Handle).all; |
874db2ac | 721 | Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; |
4daad7d8 CM |
722 | Rest_List := Deref_List (Cdr (Rest_List)).all; |
723 | Key := Car (Rest_List); | |
874db2ac | 724 | return New_Bool_Mal_Type (Hash_Map.Contains (Map, Key)); |
4daad7d8 CM |
725 | end Contains_Key; |
726 | ||
727 | ||
1c28e560 | 728 | function All_Keys (Rest_Handle : Mal_Handle) |
4daad7d8 | 729 | return Types.Mal_Handle is |
874db2ac CM |
730 | Rest_List : List_Mal_Type; |
731 | Map : Hash_Map.Hash_Map_Mal_Type; | |
4daad7d8 | 732 | begin |
4daad7d8 | 733 | Rest_List := Deref_List (Rest_Handle).all; |
874db2ac CM |
734 | Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; |
735 | return Hash_Map.All_Keys (Map); | |
4daad7d8 CM |
736 | end All_Keys; |
737 | ||
738 | ||
1c28e560 | 739 | function All_Values (Rest_Handle : Mal_Handle) |
4daad7d8 | 740 | return Types.Mal_Handle is |
874db2ac CM |
741 | Rest_List : List_Mal_Type; |
742 | Map : Hash_Map.Hash_Map_Mal_Type; | |
4daad7d8 | 743 | begin |
4daad7d8 | 744 | Rest_List := Deref_List (Rest_Handle).all; |
874db2ac CM |
745 | Map := Hash_Map.Deref_Hash (Car (Rest_List)).all; |
746 | return Hash_Map.All_Values (Map); | |
4daad7d8 CM |
747 | end All_Values; |
748 | ||
749 | ||
0571a45f CM |
750 | -- Take a list with two parameters and produce a single result |
751 | -- using the Op access-to-function parameter. | |
752 | function Reduce2 | |
1c28e560 | 753 | (Op : Binary_Func_Access; LH : Mal_Handle) |
0571a45f CM |
754 | return Mal_Handle is |
755 | Left, Right : Mal_Handle; | |
756 | L, Rest_List : List_Mal_Type; | |
757 | begin | |
758 | L := Deref_List (LH).all; | |
759 | Left := Car (L); | |
760 | Rest_List := Deref_List (Cdr (L)).all; | |
761 | Right := Car (Rest_List); | |
762 | return Op (Left, Right); | |
763 | end Reduce2; | |
764 | ||
765 | ||
1c28e560 | 766 | function Plus (Rest_Handle : Mal_Handle) |
0571a45f CM |
767 | return Types.Mal_Handle is |
768 | begin | |
1c28e560 | 769 | return Reduce2 ("+"'Access, Rest_Handle); |
0571a45f CM |
770 | end Plus; |
771 | ||
772 | ||
1c28e560 | 773 | function Minus (Rest_Handle : Mal_Handle) |
0571a45f CM |
774 | return Types.Mal_Handle is |
775 | begin | |
1c28e560 | 776 | return Reduce2 ("-"'Access, Rest_Handle); |
0571a45f CM |
777 | end Minus; |
778 | ||
779 | ||
1c28e560 | 780 | function Mult (Rest_Handle : Mal_Handle) |
0571a45f CM |
781 | return Types.Mal_Handle is |
782 | begin | |
1c28e560 | 783 | return Reduce2 ("*"'Access, Rest_Handle); |
0571a45f CM |
784 | end Mult; |
785 | ||
786 | ||
1c28e560 | 787 | function Divide (Rest_Handle : Mal_Handle) |
0571a45f CM |
788 | return Types.Mal_Handle is |
789 | begin | |
1c28e560 | 790 | return Reduce2 ("/"'Access, Rest_Handle); |
0571a45f CM |
791 | end Divide; |
792 | ||
793 | ||
1c28e560 | 794 | function LT (Rest_Handle : Mal_Handle) |
0571a45f CM |
795 | return Types.Mal_Handle is |
796 | begin | |
1c28e560 | 797 | return Reduce2 ("<"'Access, Rest_Handle); |
0571a45f CM |
798 | end LT; |
799 | ||
800 | ||
1c28e560 | 801 | function LTE (Rest_Handle : Mal_Handle) |
0571a45f CM |
802 | return Types.Mal_Handle is |
803 | begin | |
1c28e560 | 804 | return Reduce2 ("<="'Access, Rest_Handle); |
0571a45f CM |
805 | end LTE; |
806 | ||
807 | ||
1c28e560 | 808 | function GT (Rest_Handle : Mal_Handle) |
0571a45f CM |
809 | return Types.Mal_Handle is |
810 | begin | |
1c28e560 | 811 | return Reduce2 (">"'Access, Rest_Handle); |
0571a45f CM |
812 | end GT; |
813 | ||
814 | ||
1c28e560 | 815 | function GTE (Rest_Handle : Mal_Handle) |
0571a45f CM |
816 | return Types.Mal_Handle is |
817 | begin | |
1c28e560 | 818 | return Reduce2 (">="'Access, Rest_Handle); |
0571a45f CM |
819 | end GTE; |
820 | ||
821 | ||
1c28e560 | 822 | function EQ (Rest_Handle : Mal_Handle) |
0571a45f CM |
823 | return Types.Mal_Handle is |
824 | begin | |
1c28e560 | 825 | return Reduce2 (Types."="'Access, Rest_Handle); |
0571a45f CM |
826 | end EQ; |
827 | ||
828 | ||
1c28e560 | 829 | function Pr_Str (Rest_Handle : Mal_Handle) |
a974463a | 830 | return Types.Mal_Handle is |
a974463a | 831 | begin |
564a4525 | 832 | return New_String_Mal_Type (Deref_List (Rest_Handle).Pr_Str); |
a974463a CM |
833 | end Pr_Str; |
834 | ||
835 | ||
1c28e560 | 836 | function Prn (Rest_Handle : Mal_Handle) |
a974463a | 837 | return Types.Mal_Handle is |
a974463a CM |
838 | begin |
839 | Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str); | |
8083b525 | 840 | return New_Nil_Mal_Type; |
a974463a CM |
841 | end Prn; |
842 | ||
843 | ||
1c28e560 | 844 | function Println (Rest_Handle : Mal_Handle) |
a974463a | 845 | return Types.Mal_Handle is |
a974463a | 846 | begin |
d1967ba5 | 847 | Ada.Text_IO.Put_Line (Deref_List (Rest_Handle).Pr_Str (False)); |
8083b525 | 848 | return New_Nil_Mal_Type; |
a974463a CM |
849 | end Println; |
850 | ||
851 | ||
1c28e560 | 852 | function Str (Rest_Handle : Mal_Handle) |
a974463a | 853 | return Types.Mal_Handle is |
a974463a | 854 | begin |
564a4525 | 855 | return New_String_Mal_Type (Deref_List (Rest_Handle).Cat_Str (False)); |
a974463a CM |
856 | end Str; |
857 | ||
858 | ||
1c28e560 | 859 | function Read_String (Rest_Handle : Mal_Handle) |
8c49f5a7 CM |
860 | return Types.Mal_Handle is |
861 | Rest_List : Types.List_Mal_Type; | |
862 | First_Param : Mal_Handle; | |
863 | begin | |
864 | Rest_List := Deref_List (Rest_Handle).all; | |
865 | First_Param := Car (Rest_List); | |
a249dff4 | 866 | return Reader.Read_Str (Deref_String (First_Param).Get_String); |
8c49f5a7 CM |
867 | end Read_String; |
868 | ||
869 | ||
1c28e560 | 870 | function Read_Line (Rest_Handle : Mal_Handle) |
02c3208a CM |
871 | return Types.Mal_Handle is |
872 | Rest_List : Types.List_Mal_Type; | |
873 | First_Param : Mal_Handle; | |
02c3208a CM |
874 | begin |
875 | Rest_List := Deref_List (Rest_Handle).all; | |
876 | First_Param := Car (Rest_List); | |
a249dff4 CM |
877 | -- Output the prompt. |
878 | Ada.Text_IO.Put (Deref_String (First_Param).Get_String); | |
879 | -- Get the text. | |
311cbfc0 | 880 | return New_String_Mal_Type (Ada.Text_IO.Get_Line); |
02c3208a CM |
881 | end Read_Line; |
882 | ||
883 | ||
1c28e560 | 884 | function Slurp (Rest_Handle : Mal_Handle) |
8c49f5a7 CM |
885 | return Types.Mal_Handle is |
886 | Rest_List : Types.List_Mal_Type; | |
887 | First_Param : Mal_Handle; | |
888 | begin | |
889 | Rest_List := Deref_List (Rest_Handle).all; | |
890 | First_Param := Car (Rest_List); | |
891 | declare | |
a249dff4 | 892 | Unquoted_Str : String := Deref_String (First_Param).Get_String; |
8c49f5a7 CM |
893 | use Ada.Text_IO; |
894 | Fn : Ada.Text_IO.File_Type; | |
3428be48 | 895 | File_Str : Ada.Strings.Unbounded.Unbounded_String := |
564a4525 | 896 | Ada.Strings.Unbounded.Null_Unbounded_String; |
8c49f5a7 CM |
897 | I : Natural := 0; |
898 | begin | |
899 | Ada.Text_IO.Open (Fn, In_File, Unquoted_Str); | |
900 | while not End_Of_File (Fn) loop | |
311cbfc0 CM |
901 | declare |
902 | Line_Str : constant String := Get_Line (Fn); | |
903 | begin | |
904 | if Line_Str'Length > 0 then | |
905 | Ada.Strings.Unbounded.Append (File_Str, Line_Str); | |
906 | Ada.Strings.Unbounded.Append (File_Str, Ada.Characters.Latin_1.LF); | |
907 | end if; | |
908 | end; | |
8c49f5a7 CM |
909 | end loop; |
910 | Ada.Text_IO.Close (Fn); | |
3428be48 | 911 | return New_String_Mal_Type (Ada.Strings.Unbounded.To_String (File_Str)); |
8c49f5a7 CM |
912 | end; |
913 | end Slurp; | |
914 | ||
915 | ||
1c28e560 | 916 | function Conj (Rest_Handle : Mal_Handle) |
a74b420d CM |
917 | return Types.Mal_Handle is |
918 | Rest_List : List_Mal_Type; | |
919 | First_Param, Res : Mal_Handle; | |
920 | begin | |
921 | Rest_List := Deref_List (Rest_Handle).all; | |
922 | First_Param := Car (Rest_List); | |
923 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
924 | ||
925 | -- Is this a List or a Vector? | |
926 | case Deref_List (First_Param).Get_List_Type is | |
927 | when List_List => | |
928 | Res := Copy (First_Param); | |
929 | while not Is_Null (Rest_List) loop | |
930 | Res := Prepend (To_List => Deref_List (Res).all, Op => Car (Rest_List)); | |
931 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
932 | end loop; | |
933 | return Res; | |
934 | when Vector_List => | |
935 | Res := Copy (First_Param); | |
936 | while not Is_Null (Rest_List) loop | |
937 | Vector.Append (Vector.Deref_Vector (Res).all, Car (Rest_List)); | |
938 | Rest_List := Deref_List (Cdr (Rest_List)).all; | |
939 | end loop; | |
940 | return Res; | |
dd7a4f55 | 941 | when Hashed_List => raise Runtime_Exception with "Conj on Hashed_Map"; |
a74b420d CM |
942 | end case; |
943 | end Conj; | |
944 | ||
945 | ||
316d5bbd CM |
946 | function Seq (Rest_Handle : Mal_Handle) |
947 | return Types.Mal_Handle is | |
948 | First_Param, Res : Mal_Handle; | |
949 | begin | |
950 | First_Param := Car (Deref_List (Rest_Handle).all); | |
951 | case Deref (First_Param).Sym_Type is | |
952 | when Nil => return First_Param; | |
953 | when List => | |
954 | case Deref_List (First_Param).Get_List_Type is | |
955 | when List_List => | |
956 | if Is_Null (Deref_List (First_Param).all) then | |
957 | return New_Nil_Mal_Type; | |
958 | else | |
959 | return First_Param; | |
960 | end if; | |
961 | when Vector_List => | |
962 | if Vector.Is_Null (Vector.Deref_Vector (First_Param).all) then | |
963 | return New_Nil_Mal_Type; | |
964 | else | |
965 | return Vector.Duplicate (Vector.Deref_Vector (First_Param).all); | |
966 | end if; | |
dd7a4f55 | 967 | when others => raise Runtime_Exception; |
316d5bbd CM |
968 | end case; |
969 | when Str => | |
970 | declare | |
971 | Param_Str : String := Deref_String (First_Param).Get_String; | |
564a4525 | 972 | String1 : String (1 .. 1); |
316d5bbd CM |
973 | L_Ptr : List_Ptr; |
974 | begin | |
a249dff4 | 975 | if Param_Str'Length = 0 then |
316d5bbd CM |
976 | return New_Nil_Mal_Type; -- "" |
977 | else | |
978 | Res := New_List_Mal_Type (List_List); | |
979 | L_Ptr := Deref_List (Res); | |
a249dff4 | 980 | for I in Param_Str'First .. Param_Str'Last loop |
564a4525 CM |
981 | String1 (1) := Param_Str (I); |
982 | Append (L_Ptr.all, New_String_Mal_Type (String1)); | |
316d5bbd CM |
983 | end loop; |
984 | return Res; | |
985 | end if; | |
986 | end; | |
dd7a4f55 | 987 | when others => raise Runtime_Exception; |
316d5bbd CM |
988 | end case; |
989 | end Seq; | |
990 | ||
991 | ||
66bf8260 CM |
992 | Start_Time : Ada.Calendar.Time := Ada.Calendar.Clock; |
993 | ||
1c28e560 | 994 | function Time_Ms (Rest_Handle : Mal_Handle) |
66bf8260 CM |
995 | return Types.Mal_Handle is |
996 | D : Duration; | |
997 | use Ada.Calendar; | |
998 | begin | |
999 | D := Clock - Start_Time; -- seconds | |
1000 | D := D * 1000.0; -- milli-seconds | |
1001 | return New_Int_Mal_Type (Integer (D)); -- ms rounded to the nearest one | |
1002 | end Time_Ms; | |
1003 | ||
1004 | ||
b5bad5ea | 1005 | procedure Init (Repl_Env : Envs.Env_Handle) is |
0571a45f CM |
1006 | begin |
1007 | ||
6faafa00 | 1008 | Envs.Set (Repl_Env, "*host-language*", Types.New_String_Mal_Type ("Ada")); |
8496c8bc | 1009 | |
b5bad5ea | 1010 | Envs.Set (Repl_Env, |
f0727512 CM |
1011 | "true?", |
1012 | New_Func_Mal_Type ("true?", Is_True'access)); | |
1013 | ||
b5bad5ea | 1014 | Envs.Set (Repl_Env, |
f0727512 CM |
1015 | "false?", |
1016 | New_Func_Mal_Type ("false?", Is_False'access)); | |
1017 | ||
b5bad5ea | 1018 | Envs.Set (Repl_Env, |
5b77d5f7 CM |
1019 | "meta", |
1020 | New_Func_Mal_Type ("meta", Meta'access)); | |
1021 | ||
b5bad5ea | 1022 | Envs.Set (Repl_Env, |
5b77d5f7 CM |
1023 | "with-meta", |
1024 | New_Func_Mal_Type ("with-meta", With_Meta'access)); | |
1025 | ||
b5bad5ea | 1026 | Envs.Set (Repl_Env, |
cca0b237 CM |
1027 | "nil?", |
1028 | New_Func_Mal_Type ("nil?", Is_Nil'access)); | |
1029 | ||
b5bad5ea | 1030 | Envs.Set (Repl_Env, |
f0727512 CM |
1031 | "throw", |
1032 | New_Func_Mal_Type ("throw", Throw'access)); | |
1033 | ||
b5bad5ea | 1034 | Envs.Set (Repl_Env, |
f88e4203 CM |
1035 | "atom", |
1036 | New_Func_Mal_Type ("atom", New_Atom'access)); | |
1037 | ||
b5bad5ea | 1038 | Envs.Set (Repl_Env, |
f88e4203 CM |
1039 | "atom?", |
1040 | New_Func_Mal_Type ("atom?", Is_Atom'access)); | |
1041 | ||
b5bad5ea | 1042 | Envs.Set (Repl_Env, |
36b6dea5 | 1043 | "deref", |
1c28e560 | 1044 | New_Func_Mal_Type ("deref", Deref_Atm'access)); |
36b6dea5 | 1045 | |
b5bad5ea | 1046 | Envs.Set (Repl_Env, |
36b6dea5 CM |
1047 | "reset!", |
1048 | New_Func_Mal_Type ("reset!", Reset'access)); | |
1049 | ||
b5bad5ea | 1050 | Envs.Set (Repl_Env, |
36b6dea5 CM |
1051 | "swap!", |
1052 | New_Func_Mal_Type ("swap!", Swap'access)); | |
1053 | ||
b5bad5ea | 1054 | Envs.Set (Repl_Env, |
cca0b237 CM |
1055 | "list", |
1056 | New_Func_Mal_Type ("list", New_List'access)); | |
f0727512 | 1057 | |
b5bad5ea | 1058 | Envs.Set (Repl_Env, |
0571a45f CM |
1059 | "list?", |
1060 | New_Func_Mal_Type ("list?", Is_List'access)); | |
1061 | ||
b5bad5ea | 1062 | Envs.Set (Repl_Env, |
cca0b237 CM |
1063 | "vector", |
1064 | New_Func_Mal_Type ("vector", New_Vector'access)); | |
1065 | ||
b5bad5ea | 1066 | Envs.Set (Repl_Env, |
f0727512 CM |
1067 | "vector?", |
1068 | New_Func_Mal_Type ("vector?", Is_Vector'access)); | |
1069 | ||
b5bad5ea | 1070 | Envs.Set (Repl_Env, |
5fa2b0cc CM |
1071 | "hash-map", |
1072 | New_Func_Mal_Type ("hash-map", New_Map'access)); | |
1073 | ||
b5bad5ea | 1074 | Envs.Set (Repl_Env, |
5fa2b0cc CM |
1075 | "assoc", |
1076 | New_Func_Mal_Type ("assoc", Assoc'access)); | |
1077 | ||
b5bad5ea | 1078 | Envs.Set (Repl_Env, |
874db2ac CM |
1079 | "dissoc", |
1080 | New_Func_Mal_Type ("dissoc", Dis_Assoc'access)); | |
1081 | ||
b5bad5ea | 1082 | Envs.Set (Repl_Env, |
5fa2b0cc CM |
1083 | "get", |
1084 | New_Func_Mal_Type ("get", Get_Key'access)); | |
1085 | ||
b5bad5ea | 1086 | Envs.Set (Repl_Env, |
4daad7d8 CM |
1087 | "keys", |
1088 | New_Func_Mal_Type ("keys", All_Keys'access)); | |
1089 | ||
b5bad5ea | 1090 | Envs.Set (Repl_Env, |
4daad7d8 CM |
1091 | "vals", |
1092 | New_Func_Mal_Type ("vals", All_Values'access)); | |
1093 | ||
b5bad5ea | 1094 | Envs.Set (Repl_Env, |
f0727512 CM |
1095 | "map?", |
1096 | New_Func_Mal_Type ("map?", Is_Map'access)); | |
1097 | ||
b5bad5ea | 1098 | Envs.Set (Repl_Env, |
4daad7d8 CM |
1099 | "contains?", |
1100 | New_Func_Mal_Type ("contains?", Contains_Key'access)); | |
1101 | ||
b5bad5ea | 1102 | Envs.Set (Repl_Env, |
f0727512 CM |
1103 | "sequential?", |
1104 | New_Func_Mal_Type ("sequential?", Is_Sequential'access)); | |
1105 | ||
b5bad5ea | 1106 | Envs.Set (Repl_Env, |
0571a45f CM |
1107 | "empty?", |
1108 | New_Func_Mal_Type ("empty?", Is_Empty'access)); | |
1109 | ||
b5bad5ea | 1110 | Envs.Set (Repl_Env, |
0571a45f CM |
1111 | "count", |
1112 | New_Func_Mal_Type ("count", Count'access)); | |
1113 | ||
b5bad5ea | 1114 | Envs.Set (Repl_Env, |
ebb6e9d3 CM |
1115 | "cons", |
1116 | New_Func_Mal_Type ("cons", Cons'access)); | |
1117 | ||
b5bad5ea | 1118 | Envs.Set (Repl_Env, |
ebb6e9d3 CM |
1119 | "concat", |
1120 | New_Func_Mal_Type ("concat", Concat'access)); | |
1121 | ||
b5bad5ea | 1122 | Envs.Set (Repl_Env, |
d836bcfc CM |
1123 | "first", |
1124 | New_Func_Mal_Type ("first", First'access)); | |
1125 | ||
b5bad5ea | 1126 | Envs.Set (Repl_Env, |
d836bcfc CM |
1127 | "rest", |
1128 | New_Func_Mal_Type ("rest", Rest'access)); | |
1129 | ||
b5bad5ea | 1130 | Envs.Set (Repl_Env, |
6d91af72 CM |
1131 | "nth", |
1132 | New_Func_Mal_Type ("nth", Nth'access)); | |
1133 | ||
b5bad5ea | 1134 | Envs.Set (Repl_Env, |
c7b51393 CM |
1135 | "map", |
1136 | New_Func_Mal_Type ("map", Map'access)); | |
1137 | ||
b5bad5ea | 1138 | Envs.Set (Repl_Env, |
f0727512 CM |
1139 | "apply", |
1140 | New_Func_Mal_Type ("apply", Apply'access)); | |
1141 | ||
b5bad5ea | 1142 | Envs.Set (Repl_Env, |
8021afae CM |
1143 | "symbol", |
1144 | New_Func_Mal_Type ("symbol", Symbol'access)); | |
1145 | ||
b5bad5ea | 1146 | Envs.Set (Repl_Env, |
8021afae CM |
1147 | "symbol?", |
1148 | New_Func_Mal_Type ("symbol?", Is_Symbol'access)); | |
1149 | ||
d2bb60d3 CM |
1150 | Envs.Set (Repl_Env, |
1151 | "string?", | |
1152 | New_Func_Mal_Type ("string?", Is_String'access)); | |
1153 | ||
b5bad5ea | 1154 | Envs.Set (Repl_Env, |
2e3389c4 CM |
1155 | "keyword", |
1156 | New_Func_Mal_Type ("keyword", Keyword'access)); | |
1157 | ||
b5bad5ea | 1158 | Envs.Set (Repl_Env, |
2e3389c4 CM |
1159 | "keyword?", |
1160 | New_Func_Mal_Type ("keyword?", Is_Keyword'access)); | |
1161 | ||
968faaad DM |
1162 | Envs.Set (Repl_Env, |
1163 | "number?", | |
1164 | New_Func_Mal_Type ("number?", Is_Number'access)); | |
1165 | ||
1166 | Envs.Set (Repl_Env, | |
1167 | "fn?", | |
1168 | New_Func_Mal_Type ("fn?", Is_Fn'access)); | |
1169 | ||
1170 | Envs.Set (Repl_Env, | |
1171 | "macro?", | |
1172 | New_Func_Mal_Type ("macro?", Is_Macro'access)); | |
1173 | ||
b5bad5ea | 1174 | Envs.Set (Repl_Env, |
a974463a CM |
1175 | "pr-str", |
1176 | New_Func_Mal_Type ("pr-str", Pr_Str'access)); | |
1177 | ||
b5bad5ea | 1178 | Envs.Set (Repl_Env, |
a974463a CM |
1179 | "str", |
1180 | New_Func_Mal_Type ("str", Str'access)); | |
1181 | ||
b5bad5ea | 1182 | Envs.Set (Repl_Env, |
a974463a CM |
1183 | "prn", |
1184 | New_Func_Mal_Type ("prn", Prn'access)); | |
1185 | ||
b5bad5ea | 1186 | Envs.Set (Repl_Env, |
a974463a CM |
1187 | "println", |
1188 | New_Func_Mal_Type ("println", Println'access)); | |
1189 | ||
b5bad5ea | 1190 | Envs.Set (Repl_Env, |
8c49f5a7 CM |
1191 | "read-string", |
1192 | New_Func_Mal_Type ("read-string", Read_String'access)); | |
1193 | ||
b5bad5ea | 1194 | Envs.Set (Repl_Env, |
02c3208a CM |
1195 | "readline", |
1196 | New_Func_Mal_Type ("readline", Read_Line'access)); | |
1197 | ||
b5bad5ea | 1198 | Envs.Set (Repl_Env, |
8c49f5a7 CM |
1199 | "slurp", |
1200 | New_Func_Mal_Type ("slurp", Slurp'access)); | |
1201 | ||
b5bad5ea | 1202 | Envs.Set (Repl_Env, |
a74b420d CM |
1203 | "conj", |
1204 | New_Func_Mal_Type ("conj", Conj'access)); | |
1205 | ||
316d5bbd CM |
1206 | Envs.Set (Repl_Env, |
1207 | "seq", | |
1208 | New_Func_Mal_Type ("seq", Seq'access)); | |
1209 | ||
66bf8260 CM |
1210 | Envs.Set (Repl_Env, |
1211 | "time-ms", | |
1212 | New_Func_Mal_Type ("time-ms", Time_Ms'access)); | |
1213 | ||
b5bad5ea | 1214 | Envs.Set (Repl_Env, |
0571a45f CM |
1215 | "+", |
1216 | New_Func_Mal_Type ("+", Plus'access)); | |
1217 | ||
b5bad5ea | 1218 | Envs.Set (Repl_Env, |
0571a45f CM |
1219 | "-", |
1220 | New_Func_Mal_Type ("-", Minus'access)); | |
1221 | ||
b5bad5ea | 1222 | Envs.Set (Repl_Env, |
0571a45f CM |
1223 | "*", |
1224 | New_Func_Mal_Type ("*", Mult'access)); | |
1225 | ||
b5bad5ea | 1226 | Envs.Set (Repl_Env, |
0571a45f CM |
1227 | "/", |
1228 | New_Func_Mal_Type ("/", Divide'access)); | |
1229 | ||
b5bad5ea | 1230 | Envs.Set (Repl_Env, |
0571a45f CM |
1231 | "<", |
1232 | New_Func_Mal_Type ("<", LT'access)); | |
1233 | ||
b5bad5ea | 1234 | Envs.Set (Repl_Env, |
0571a45f CM |
1235 | "<=", |
1236 | New_Func_Mal_Type ("<=", LTE'access)); | |
1237 | ||
b5bad5ea | 1238 | Envs.Set (Repl_Env, |
0571a45f CM |
1239 | ">", |
1240 | New_Func_Mal_Type (">", GT'access)); | |
1241 | ||
b5bad5ea | 1242 | Envs.Set (Repl_Env, |
0571a45f CM |
1243 | ">=", |
1244 | New_Func_Mal_Type (">=", GTE'access)); | |
1245 | ||
b5bad5ea | 1246 | Envs.Set (Repl_Env, |
0571a45f CM |
1247 | "=", |
1248 | New_Func_Mal_Type ("=", EQ'access)); | |
1249 | ||
1250 | end Init; | |
1251 | ||
1252 | ||
1253 | end Core; |