Natools

      end if;
   end Current_Event;


   function Current_Atom (P : in Subparser) return Atom is
   begin
      if P.Terminated then
         raise Program_Error;
      else
         return Current_Atom (P.Backend.all);
      end if;
   end Current_Atom;


   function Current_Level (P : in Subparser) return Natural is
   begin
      if P.Terminated then
         return 0;
      else
         return Current_Level (P.Backend.all)
           - Lockable.Current_Level (P.Levels);
      end if;
   end Current_Level;


   procedure Query_Atom
     (P : in Subparser;
      Process : not null access procedure (Data : in Atom)) is
   begin
      if P.Terminated then
         raise Program_Error;
      else
         Query_Atom (P.Backend.all, Process);
      end if;
   end Query_Atom;


   procedure Read_Atom
     (P      : in Subparser;
      Data   : out Atom;
      Length : out Count) is
   begin
      if P.Terminated then
         raise Program_Error;
      else
         Read_Atom (P.Backend.all, Data, Length);
      end if;
   end Read_Atom;


   procedure Next (P : in out Subparser; Event : out Events.Event) is
   begin
      if P.Terminated then
         raise Constraint_Error;
      end if;

      if not P.Initialized then
         declare
            Lost_State : Lockable.Lock_State;
            pragma Unreferenced (Lost_State);
         begin
            Lock (P, Lost_State);
         end;
         P.Initialized := True;
      end if;

      Next_Event (P.Backend.all, P.Input);

      Event := Current_Event (P.Backend.all);

      if Event = Events.Close_List
        and then Current_Level (P.Backend.all)
                   < Lockable.Current_Level (P.Levels)
      then
         P.Terminated := True;
         Event := Events.End_Of_Input;
      end if;
   end Next;


   overriding procedure Lock
     (Object : in out Subparser;
      State : out Lockable.Lock_State) is
   begin
      Lockable.Push_Level
        (Object.Levels,
         Current_Level (Object.Backend.all),
         State);
   end Lock;


   overriding procedure Unlock
     (Object : in out Subparser;
      State : in out Lockable.Lock_State;
      Finish : in Boolean := True)
   is
      Previous_Level : constant Natural
        := Lockable.Current_Level (Object.Levels);
   begin
      Lockable.Pop_Level (Object.Levels, State);
      State := Lockable.Null_State;

      if Finish then
         loop
            case Object.Backend.Current_Event is
               when Events.Open_List | Events.Add_Atom =>
                  null;
               when Events.Close_List =>
                  exit when Object.Backend.Current_Level < Previous_Level;
               when Events.Error | Events.End_Of_Input =>
                  exit;
            end case;
            Next_Event (Object.Backend.all, Object.Input);
         end loop;
      end if;

      Object.Terminated := Object.Backend.Current_Level
        < Lockable.Current_Level (Object.Levels);
   end Unlock;


   procedure Finish (P : in out Subparser) is
      Event : Events.Event := Current_Event (P);
   begin
      while Event /= Events.Error and Event /= Events.End_Of_Input loop
         Next (P, Event);
      end loop;
   end Finish;

end Natools.S_Expressions.Parsers;

-- Descriptor interface. A subparser is constrained to its initial nesting  --
-- level, and reports end-of-input instead of reaching lower.               --
------------------------------------------------------------------------------

with Ada.Streams;

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Lockable;

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

   type Parser is tagged private;

   function Current_Event (P : in Parser) return Events.Event;

     (P     : in out Parser;
      Input : not null access Ada.Streams.Root_Stream_Type'Class);


   type Subparser
     (Backend : access Parser;
      Input   : access Ada.Streams.Root_Stream_Type'Class)
   is new Lockable.Descriptor with private;

   overriding function Current_Event (P : in Subparser) return Events.Event;
   overriding function Current_Atom (P : in Subparser) return Atom;
   overriding function Current_Level (P : in Subparser) return Natural;

   overriding procedure Query_Atom
     (P : in Subparser;
      Process : not null access procedure (Data : in Atom));

   overriding procedure Read_Atom
     (P      : in Subparser;
      Data   : out Atom;
      Length : out Count);

   overriding procedure Next (P : in out Subparser; Event : out Events.Event);


   overriding procedure Lock
     (Object : in out Subparser;
      State : out Lockable.Lock_State);

   overriding procedure Unlock
     (Object : in out Subparser;
      State : in out Lockable.Lock_State;
      Finish : in Boolean := True);

   procedure Finish (P : in out Subparser);
      --  Read enough data to exhaust intial nesting level

private

   type Internal_State is
     (Waiting,          --  waiting for a marker

      Buffer       : Atom_Buffers.Atom_Buffer;
      Level        : Natural := 0;
   end record;

   type Subparser
     (Backend : access Parser;
      Input   : access Ada.Streams.Root_Stream_Type'Class)
   is new Lockable.Descriptor with record
      Levels      : Lockable.Lock_Stack;
      Initialized : Boolean := False;
      Terminated  : Boolean := False;
   end record;

end Natools.S_Expressions.Parsers;