Commit | Line | Data |
---|---|---|
00c3a3c3 | 1 | with Err; |
5a07bb53 NB |
2 | with Types.Builtins; |
3 | with Types.Fns; | |
daffc668 | 4 | |
5a07bb53 | 5 | package body Types.Atoms is |
daffc668 | 6 | |
8185fe14 | 7 | function Atom (Args : in T_Array) return T is |
00c3a3c3 NB |
8 | begin |
9 | Err.Check (Args'Length = 1, "expected 1 parameter"); | |
8185fe14 NB |
10 | declare |
11 | Ref : constant Atom_Ptr := new Instance; | |
12 | begin | |
13 | Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); | |
14 | Ref.all.Data := Args (Args'First); | |
15 | return (Kind_Atom, Ref); | |
16 | end; | |
00c3a3c3 NB |
17 | end Atom; |
18 | ||
8185fe14 | 19 | function Deref (Args : in T_Array) return T is |
00c3a3c3 | 20 | begin |
8185fe14 NB |
21 | Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Atom, |
22 | "expected an atom"); | |
5a07bb53 | 23 | return Args (Args'First).Atom.all.Data; |
00c3a3c3 | 24 | end Deref; |
11932a6c | 25 | |
8185fe14 | 26 | function Deref (Item : in Instance) return T |
5a07bb53 | 27 | is (Item.Data); |
daffc668 | 28 | |
5a07bb53 | 29 | procedure Keep_References (Object : in out Instance) is |
daffc668 | 30 | begin |
8185fe14 | 31 | Keep (Object.Data); |
87663bb7 | 32 | Keep (Object.Meta); |
5a07bb53 | 33 | end Keep_References; |
daffc668 | 34 | |
87663bb7 NB |
35 | function Meta (Item : in Instance) return T |
36 | is (Item.F_Meta); | |
37 | ||
8185fe14 | 38 | function Reset (Args : in T_Array) return T is |
daffc668 | 39 | begin |
8185fe14 NB |
40 | Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom, |
41 | "expected an atom then a value"); | |
5a07bb53 | 42 | Args (Args'First).Atom.all.Data := Args (Args'Last); |
11932a6c | 43 | return Args (Args'Last); |
daffc668 NB |
44 | end Reset; |
45 | ||
8185fe14 | 46 | function Swap (Args : in T_Array) return T is |
11932a6c | 47 | begin |
8185fe14 NB |
48 | Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom, |
49 | "expected an atom, optional arguments then a function"); | |
11932a6c | 50 | declare |
8185fe14 NB |
51 | X : T renames Args (Args'First).Atom.all.Data; |
52 | F : T renames Args (Args'First + 1); | |
53 | A : constant T_Array := X & Args (Args'First + 2 .. Args'Last); | |
11932a6c NB |
54 | begin |
55 | case F.Kind is | |
56 | when Kind_Builtin => | |
57 | X := F.Builtin.all (A); | |
58 | when Kind_Builtin_With_Meta => | |
5a07bb53 | 59 | X := F.Builtin_With_Meta.all.Builtin.all (A); |
00c3a3c3 | 60 | when Kind_Fn => |
5a07bb53 | 61 | X := F.Fn.all.Apply (A); |
11932a6c | 62 | when others => |
00c3a3c3 | 63 | Err.Raise_With ("parameter 2 must be a function"); |
11932a6c NB |
64 | end case; |
65 | return X; | |
66 | end; | |
67 | end Swap; | |
68 | ||
87663bb7 NB |
69 | function With_Meta (Item : in Instance; |
70 | Metadata : in T) return T is | |
71 | Ref : constant Atom_Ptr := new Instance; | |
72 | begin | |
73 | Garbage_Collected.Register (Garbage_Collected.Pointer (Ref)); | |
74 | Ref.all.Data := Item.Data; | |
75 | Ref.all.F_Meta := Metadata; | |
76 | return (Kind_Atom, Ref); | |
77 | end With_Meta; | |
78 | ||
daffc668 | 79 | end Types.Atoms; |