Natools

      N : Node_Access;
   begin
      if Cache.Exp.Is_Empty then
         return Cursor'(others => <>);
      else
         N := Cache.Exp.Query.Data.Root;
         pragma Assert (N /= null);
         return Cursor'(Exp => Cache.Exp,
           Position => N,
           Opening => N.Kind = List_Node,
           Stack => <>,
           Locked => False);
      end if;
   end First;



   --------------------------
   -- Descriptor Interface --
   --------------------------

   overriding function Current_Event (Object : in Cursor)
     return Events.Event is
   begin
      if Object.Position = null or Object.Locked then
         return Events.End_Of_Input;
      end if;

      case Object.Position.Kind is
         when Atom_Node =>
            return Events.Add_Atom;
         when List_Node =>
            if Object.Opening then
               return Events.Open_List;
            else
               return Events.Close_List;
            end if;
      end case;
   end Current_Event;


   overriding function Current_Atom (Object : in Cursor) return Atom is
   begin
      if Object.Position = null or else Object.Position.Kind /= Atom_Node
        or else Object.Locked
      then
         raise Program_Error;
      end if;

      return Object.Position.Data.all;
   end Current_Atom;


   overriding function Current_Level (Object : in Cursor) return Natural is


   begin
      if Object.Locked then
         return 0;
      else
         return Absolute_Level (Object)
           - Lockable.Current_Level (Object.Stack);


      end if;







   end Current_Level;


   overriding procedure Query_Atom
     (Object : in Cursor;
      Process : not null access procedure (Data : in Atom)) is
   begin
      if Object.Position = null or else Object.Position.Kind /= Atom_Node
        or else Object.Locked
      then
         raise Program_Error;
      end if;

      Process.all (Object.Position.Data.all);
   end Query_Atom;


   overriding procedure Read_Atom
     (Object : in Cursor;
      Data : out Atom;
      Length : out Count)
   is
      Transferred : Count;
   begin
      if Object.Position = null or else Object.Position.Kind /= Atom_Node
        or else Object.Locked
      then
         raise Program_Error;
      end if;

      Length := Object.Position.Data'Length;
      Transferred := Count'Min (Data'Length, Length);
      Data (Data'First .. Data'First + Transferred - 1)
        := Object.Position.Data (Object.Position.Data'First
             .. Object.Position.Data'First + Transferred - 1);
   end Read_Atom;


   overriding procedure Next
     (Object : in out Cursor;
      Event : out Events.Event) is
   begin
      if Object.Position = null or Object.Locked then
         Event := Events.End_Of_Input;
         return;
      end if;

      if Object.Opening then
         pragma Assert (Object.Position.Kind = List_Node);
         if Object.Position.Child = null then

         Object.Position := Object.Position.Parent;
         Object.Opening := False;
      else
         Object.Position := null;
      end if;

      Event := Object.Current_Event;

      if Event = Events.Close_List
        and then Object.Absolute_Level < Lockable.Current_Level (Object.Stack)
      then
         Event := Events.End_Of_Input;
         Object.Locked := True;
      end if;
   end Next;



   -----------------------------------
   -- Lockable.Descriptor Interface --
   -----------------------------------

   function Absolute_Level (Object : Cursor) return Natural is
      Result : Natural := 0;
      N : Node_Access := Object.Position;
   begin
      if Object.Position /= null
        and then Object.Position.Kind = List_Node
        and then Object.Opening
      then
         Result := Result + 1;
      end if;

      while N /= null loop
         Result := Result + 1;
         N := N.Parent;
      end loop;

      return Natural'Max (Result, 1) - 1;
   end Absolute_Level;


   overriding procedure Lock
     (Object : in out Cursor;
      State : out Lockable.Lock_State) is
   begin
      Lockable.Push_Level (Object.Stack, Object.Absolute_Level, State);
   end Lock;


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

      if Finish then
         declare
            Event : Events.Event := Object.Current_Event;
         begin
            loop
               case Event is
                  when Events.Add_Atom | Events.Open_List =>
                     null;
                  when Events.Close_List =>
                     exit when Object.Absolute_Level < Previous_Level;
                  when Events.Error | Events.End_Of_Input =>
                     exit;
               end case;
               Object.Next (Event);
            end loop;
         end;
      end if;

      Object.Locked
        := Object.Absolute_Level < Lockable.Current_Level (Object.Stack);
   end Unlock;

end Natools.S_Expressions.Generic_Caches;