ada.2/types-fns.adb

   1 with Err;
   2 pragma Warnings (Off, "unit ""Types.Sequences"" is not referenced");
   3 with Types.Sequences;
   4 pragma Warnings (On, "unit ""Types.Sequences"" is not referenced");
   5
   6 package body Types.Fns is
   7
   8    function Apply (Item : in Instance;
   9                    Args : in T_Array) return T
  10    is
  11       Env : constant Envs.Ptr := Envs.New_Env (Outer => Item.F_Env);
  12    begin
  13       Env.all.Set_Binds (Binds => Item.F_Params.all.Data,
  14                          Exprs => Args);
  15       return Eval_Cb.all (Ast => Item.F_Ast,
  16                           Env => Env);
  17    end Apply;
  18
  19    function Ast (Item : in Instance) return T
  20    is (Item.F_Ast);
  21
  22    function Env (Item : in Instance) return Envs.Ptr
  23    is (Item.F_Env);
  24
  25    procedure Keep_References (Object : in out Instance) is
  26    begin
  27       Keep (Object.F_Ast);
  28       Object.F_Params.all.Keep;
  29       Object.F_Env.all.Keep;
  30       Keep (Object.F_Meta);
  31    end Keep_References;
  32
  33    function Meta (Item : in Instance) return T
  34    is (Item.F_Meta);
  35
  36    function New_Function (Params   : in Sequence_Ptr;
  37                           Ast      : in T;
  38                           Env      : in Envs.Ptr;
  39                           Metadata : in T            := Nil) return T
  40    is
  41       --  Env and Params are not null and require an immediate
  42       --  initialization.
  43       Ref : constant Fn_Ptr
  44         := new Instance'(Garbage_Collected.Instance with
  45                          F_Ast    => Ast,
  46                          F_Env    => Env,
  47                          F_Meta   => Metadata,
  48                          F_Params => Params);
  49    begin
  50       Garbage_Collected.Register (Garbage_Collected.Pointer (Ref));
  51       Err.Check ((for all P of Params.all.Data => P.Kind = Kind_Symbol),
  52                  "formal parameters must be symbols");
  53       return (Kind_Fn, Ref);
  54    end New_Function;
  55
  56    function Params (Item : in Instance) return Sequence_Ptr
  57    is (Item.F_Params);
  58
  59 end Types.Fns;