mirror of
https://github.com/kanaka/mal.git
synced 2024-09-19 09:38:28 +03:00
87663bb769
Implement macros as a bit in the function record as advised in the process. No need to reinvent Apply anymore. Also add an explicit Unreferenced pragma to silent a new compiler warning.
80 lines
2.4 KiB
Ada
80 lines
2.4 KiB
Ada
with Err;
|
|
with Types.Builtins;
|
|
with Types.Fns;
|
|
|
|
package body Types.Atoms is
|
|
|
|
function Atom (Args : in T_Array) return T is
|
|
begin
|
|
Err.Check (Args'Length = 1, "expected 1 parameter");
|
|
declare
|
|
Ref : constant Atom_Ptr := new Instance;
|
|
begin
|
|
Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
|
|
Ref.all.Data := Args (Args'First);
|
|
return (Kind_Atom, Ref);
|
|
end;
|
|
end Atom;
|
|
|
|
function Deref (Args : in T_Array) return T is
|
|
begin
|
|
Err.Check (Args'Length = 1 and then Args (Args'First).Kind = Kind_Atom,
|
|
"expected an atom");
|
|
return Args (Args'First).Atom.all.Data;
|
|
end Deref;
|
|
|
|
function Deref (Item : in Instance) return T
|
|
is (Item.Data);
|
|
|
|
procedure Keep_References (Object : in out Instance) is
|
|
begin
|
|
Keep (Object.Data);
|
|
Keep (Object.Meta);
|
|
end Keep_References;
|
|
|
|
function Meta (Item : in Instance) return T
|
|
is (Item.F_Meta);
|
|
|
|
function Reset (Args : in T_Array) return T is
|
|
begin
|
|
Err.Check (Args'Length = 2 and then Args (Args'First).Kind = Kind_Atom,
|
|
"expected an atom then a value");
|
|
Args (Args'First).Atom.all.Data := Args (Args'Last);
|
|
return Args (Args'Last);
|
|
end Reset;
|
|
|
|
function Swap (Args : in T_Array) return T is
|
|
begin
|
|
Err.Check (2 <= Args'Length and then Args (Args'First).Kind = Kind_Atom,
|
|
"expected an atom, optional arguments then a function");
|
|
declare
|
|
X : T renames Args (Args'First).Atom.all.Data;
|
|
F : T renames Args (Args'First + 1);
|
|
A : constant T_Array := X & Args (Args'First + 2 .. Args'Last);
|
|
begin
|
|
case F.Kind is
|
|
when Kind_Builtin =>
|
|
X := F.Builtin.all (A);
|
|
when Kind_Builtin_With_Meta =>
|
|
X := F.Builtin_With_Meta.all.Builtin.all (A);
|
|
when Kind_Fn =>
|
|
X := F.Fn.all.Apply (A);
|
|
when others =>
|
|
Err.Raise_With ("parameter 2 must be a function");
|
|
end case;
|
|
return X;
|
|
end;
|
|
end Swap;
|
|
|
|
function With_Meta (Item : in Instance;
|
|
Metadata : in T) return T is
|
|
Ref : constant Atom_Ptr := new Instance;
|
|
begin
|
|
Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
|
|
Ref.all.Data := Item.Data;
|
|
Ref.all.F_Meta := Metadata;
|
|
return (Kind_Atom, Ref);
|
|
end With_Meta;
|
|
|
|
end Types.Atoms;
|