| 1 | with Err; |
| 2 | with Types.Builtins; |
| 3 | with Types.Fns; |
| 4 | |
| 5 | package body Types.Atoms is |
| 6 | |
| 7 | function Atom (Args : in T_Array) return T is |
| 8 | begin |
| 9 | Err.Check (Args'Length = 1, "expected 1 parameter"); |
| 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; |
| 17 | end Atom; |
| 18 | |
| 19 | function Deref (Args : in T_Array) return T is |
| 20 | begin |
| 21 | Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Atom, |
| 22 | "expected an atom"); |
| 23 | return Args (Args'First).Atom.all.Data; |
| 24 | end Deref; |
| 25 | |
| 26 | function Deref (Item : in Instance) return T |
| 27 | is (Item.Data); |
| 28 | |
| 29 | procedure Keep_References (Object : in out Instance) is |
| 30 | begin |
| 31 | Keep (Object.Data); |
| 32 | Keep (Object.Meta); |
| 33 | end Keep_References; |
| 34 | |
| 35 | function Meta (Item : in Instance) return T |
| 36 | is (Item.F_Meta); |
| 37 | |
| 38 | function Reset (Args : in T_Array) return T is |
| 39 | begin |
| 40 | Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom, |
| 41 | "expected an atom then a value"); |
| 42 | Args (Args'First).Atom.all.Data := Args (Args'Last); |
| 43 | return Args (Args'Last); |
| 44 | end Reset; |
| 45 | |
| 46 | function Swap (Args : in T_Array) return T is |
| 47 | begin |
| 48 | Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom, |
| 49 | "expected an atom, optional arguments then a function"); |
| 50 | declare |
| 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); |
| 54 | begin |
| 55 | case F.Kind is |
| 56 | when Kind_Builtin => |
| 57 | X := F.Builtin.all (A); |
| 58 | when Kind_Builtin_With_Meta => |
| 59 | X := F.Builtin_With_Meta.all.Builtin.all (A); |
| 60 | when Kind_Fn => |
| 61 | X := F.Fn.all.Apply (A); |
| 62 | when others => |
| 63 | Err.Raise_With ("parameter 2 must be a function"); |
| 64 | end case; |
| 65 | return X; |
| 66 | end; |
| 67 | end Swap; |
| 68 | |
| 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 | |
| 79 | end Types.Atoms; |