Natools

         end if;
      end if;

      raise Command_Not_Found
        with "Unknown command """ & To_String (Cmd.Current_Atom) & '"';
   end Execute;



   --------------------------------------
   -- Interpreter Building Subprograms --
   --------------------------------------

   function Build (Commands : Command_Array) return Interpreter is
      Result : Interpreter;
   begin
      for I in Commands'Range loop
         Result.Add_Command
           (Commands (I).Name.Query.Data.all,
            Commands (I).Cmd.Query.Data.all);
      end loop;

      return Result;
   end Build;


   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter
   is
      Result : Interpreter := Build (Commands);
   begin
      Result.Set_Fallback (To_Atom (Fallback));
      return Result;
   end Build;


   function Item (Name : String; Cmd : Command'Class)
     return Command_Description
   is
      function Get_Name return Atom;
      function Get_Command return Command'Class;

      function Get_Name return Atom is
      begin
         return To_Atom (Name);
      end Get_Name;

      function Get_Command return Command'Class is
      begin
         return Cmd;
      end Get_Command;
   begin
      return (Name => Atom_Refs.Create (Get_Name'Access),
              Cmd => Command_Refs.Create (Get_Command'Access));
   end Item;

end Natools.S_Expressions.Interpreters;

-- Formal types represent common objets for all the command, Shared_State   --
-- begin read/write while Shared_Context is read-only.                      --
------------------------------------------------------------------------------

with Natools.S_Expressions.Lockable;

private with Ada.Containers.Indefinite_Ordered_Maps;
private with Natools.References;
private with Natools.S_Expressions.Atom_Refs;
private with Natools.Storage_Pools;

generic
   type Shared_State (<>) is limited private;
   type Shared_Context (<>) is limited private;

package Natools.S_Expressions.Interpreters is
   pragma Preelaborate (Interpreters);

   overriding procedure Execute
     (Self : in Interpreter;
      State : in out Shared_State;
      Context : in Shared_Context;
      Cmd : in out Lockable.Descriptor'Class);
      --  Execute a single command with arguments

   type Command_Description is private;
   type Command_Array is array (Positive range <>) of Command_Description;

   function Build (Commands : Command_Array) return Interpreter;
   function Build (Commands : Command_Array; Fallback : String)
     return Interpreter;
   function Item (Name : String; Cmd : Command'Class)
     return Command_Description;

private

   type Exception_Command is new Command with null record;

   package Command_Maps is new Ada.Containers.Indefinite_Ordered_Maps
     (Atom, Command'Class, Less_Than);

   type Interpreter is new Command with record
      Commands : Command_Maps.Map;
      Max_Length : Count := 0;
      Fallback_Name : Atom_Refs.Reference;
   end record;

   package Command_Refs is new Natools.References
     (Command'Class,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   type Command_Description is record
      Name : Atom_Refs.Immutable_Reference;
      Cmd : Command_Refs.Immutable_Reference;
   end record;

end Natools.S_Expressions.Interpreters;