Natools

   procedure Insert_Image
     (State : in out Format;
      Context : in Meaningless_Type;
      Image : in Atom);







   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);

      Image : in Atom)
   is
      pragma Unreferenced (Context);
   begin
      State.Append_Image (Image);
   end Insert_Image;































   procedure Update_Format
     (State : in out Format;
      Context : in Meaningless_Type;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is

         when Commands.Align_Right =>
            State.Set_Align (Right_Aligned);

         when Commands.Base =>
            State.Set_Symbols (Arguments);

         when Commands.Images =>
            Parse (State.Images, Arguments);

         when Commands.Padding =>
            case Arguments.Current_Event is
               when Events.Add_Atom =>
                  State.Left_Padding := Create (Arguments.Current_Atom);
                  State.Right_Padding := State.Left_Padding;
               when others =>

         Length := Length + 1;
         Output.Append (Symbols (Digit).Query.Data.all);
         exit when Remainder = 0;
      end loop;
   end Reverse_Render;



   -----------------------
   -- Dynamic Atom Maps --
   -----------------------

   procedure Exclude
     (Map : in out Atom_Maps.Map;
      Values : in Interval)
   is
      procedure Delete_And_Next
        (Target : in out Atom_Maps.Map;
         Cursor : in out Atom_Maps.Cursor);

      procedure Delete_And_Next
        (Target : in out Atom_Maps.Map;
         Cursor : in out Atom_Maps.Cursor)
      is
         Next : constant Atom_Maps.Cursor := Atom_Maps.Next (Cursor);
      begin
         Target.Delete (Cursor);
         Cursor := Next;
      end Delete_And_Next;

      Cursor : Atom_Maps.Cursor := Map.Ceiling ((Values.First, Values.First));
   begin
      if not Atom_Maps.Has_Element (Cursor) then
         return;
      end if;

      pragma Assert (not (Atom_Maps.Key (Cursor).Last < Values.First));

      if Atom_Maps.Key (Cursor).First < Values.First then
         declare
            Old_Key : constant Interval := Atom_Maps.Key (Cursor);
            Prefix_Key : constant Interval
              := (Old_Key.First,  T'Pred (Values.First));
            Prefix_Image : constant Atom_Refs.Immutable_Reference
              := Atom_Maps.Element (Cursor);
         begin
            Delete_And_Next (Map, Cursor);
            Map.Insert (Prefix_Key, Prefix_Image);

            if Values.Last < Old_Key.Last then
               Map.Insert ((T'Succ (Values.Last), Old_Key.Last), Prefix_Image);
               return;
            end if;
         end;
      end if;

      while Atom_Maps.Has_Element (Cursor)
        and then not (Values.Last < Atom_Maps.Key (Cursor).Last)
      loop
         Delete_And_Next (Map, Cursor);
      end loop;

      if Atom_Maps.Has_Element (Cursor)
        and then not (Values.Last < Atom_Maps.Key (Cursor).First)
      then
         declare
            Old_Key : constant Interval := Atom_Maps.Key (Cursor);
            Suffix_Key : constant Interval
              := (T'Succ (Values.Last), Old_Key.Last);
            Suffix_Image : constant Atom_Refs.Immutable_Reference
              := Atom_Maps.Element (Cursor);
         begin
            Delete_And_Next (Map, Cursor);
            Map.Insert (Suffix_Key, Suffix_Image);
         end;
      end if;
   end Exclude;


   procedure Include
     (Map : in out Atom_Maps.Map;
      Values : in Interval;
      Image : in Atom_Refs.Immutable_Reference) is
   begin
      Exclude (Map, Values);
      Map.Insert (Values, Image);
   end Include;


   procedure Parse
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class)
   is
      Event : Events.Event := Expression.Current_Event;
      Lock : Lockable.Lock_State;
   begin
      loop
         case Event is
            when Events.Add_Atom =>
               declare
                  Index : constant T := Next_Index (Map);
               begin
                  Include
                    (Map,
                     (Index, Index),
                     Create (Expression.Current_Atom));
               end;

            when Events.Open_List =>
               Expression.Lock (Lock);

               begin
                  Expression.Next;
                  Parse_Single_Image (Map, Expression);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;

               Expression.Unlock (Lock);
               Event := Expression.Current_Event;
               exit when Event in Events.Error | Events.End_Of_Input;

            when Events.Close_List | Events.Error | Events.End_Of_Input =>
               exit;
         end case;

         Expression.Next (Event);
      end loop;
   end Parse;


   procedure Parse_Single_Image
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class)
   is
      Event : Events.Event := Expression.Current_Event;
      Lock : Lockable.Lock_State;
      First, Last : T;
   begin
      case Event is
         when Events.Add_Atom =>
            begin
               First := T'Value (To_String (Expression.Current_Atom));
               Last := First;
            exception
               when Constraint_Error =>
                  return;
            end;

         when Events.Open_List =>
            Expression.Lock (Lock);

            begin
               Expression.Next (Event);
               if Event = Events.Add_Atom then
                  First := T'Value (To_String (Expression.Current_Atom));
               else
                  Expression.Unlock (Lock, False);
                  return;
               end if;

               Expression.Next (Event);
               if Event = Events.Add_Atom then
                  Last := T'Value (To_String (Expression.Current_Atom));
               else
                  Expression.Unlock (Lock, False);
                  return;
               end if;
            exception
               when Constraint_Error =>
                  Expression.Unlock (Lock, False);
                  return;
               when others =>
                  Expression.Unlock (Lock, False);
                  raise;
            end;

            Expression.Unlock (Lock);

         when others =>
            return;
      end case;

      if Last < First then
         return;
      end if;

      Expression.Next (Event);

      if Event = Events.Add_Atom then
         Include (Map, (First, Last), Create (Expression.Current_Atom));
      else
         Exclude (Map, (First, Last));
      end if;
   end Parse_Single_Image;



   ----------------------
   -- Public Interface --
   ----------------------

   function Render (Value : T; Template : Format) return Atom is
      function "*" (Count : Width; Symbol : Atom) return Atom;

      Has_Sign : Boolean := True;
      Length : Width;
      Symbols : constant Atom_Arrays.Immutable_Reference
        := (if Template.Symbols.Is_Empty then Decimal else Template.Symbols);
   begin
      Check_Explicit_Image :
      declare
         Cursor : constant Atom_Maps.Cursor
           := Template.Images.Find ((Value, Value));
      begin
         if Atom_Maps.Has_Element (Cursor) then
            return Atom_Maps.Element (Cursor).Query.Data.all;
         end if;
      end Check_Explicit_Image;

      if Value < 0 then

   begin
      Append_Image (Object, Create (Image));
   end Append_Image;


   procedure Remove_Image (Object : in out Format; Value : in T) is
   begin
      Exclude (Object.Images, (Value, Value));
   end Remove_Image;


   procedure Set_Align (Object : in out Format; Value : in Alignment) is
   begin
      Object.Align := Value;
   end Set_Align;


   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom_Refs.Immutable_Reference) is
   begin
      Include (Object.Images, (Value, Value), Image);
   end Set_Image;


   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom) is

      --  consecutive atoms found in Atom_List.

   function Decimal return Atom_Arrays.Immutable_Reference
     with Post => not Decimal'Result.Is_Empty;
      --  Return a reference to usual decimal representation


   type Interval is record
      First, Last : T;
   end record
     with Dynamic_Predicate => not (Interval.Last < Interval.First);

   function "<" (Left, Right : Interval) return Boolean
     is (Left.Last < Right.First);
      --  Strict non-overlap comparison

   package Atom_Maps is new Ada.Containers.Ordered_Maps
     (Interval, Atom_Refs.Immutable_Reference, "<", Atom_Refs."=");

   function Next_Index (Map : Atom_Maps.Map) return T
     is (if Map.Is_Empty then T'First else Map.Last_Key.Last + 1);
      --  Index of the next element to insert in sequential lists

   procedure Exclude
     (Map : in out Atom_Maps.Map;
      Values : in Interval);
      --  Remove the given interval from the map

   procedure Include
     (Map : in out Atom_Maps.Map;
      Values : in Interval;
      Image : in Atom_Refs.Immutable_Reference);
      --  Add Image to the given interval, overwriting any existing values

   procedure Parse_Single_Image
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class);
      --  Parse Expression to match `value image` or `(first last) image`,
      --  and include it to Map.

   procedure Parse
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class);
      --  Parse Expression as a list of single image expression (see above)

   ---------------------
   -- Format Mutators --
   ---------------------

   procedure Set_Align (Object : in out Format; Value : in Alignment);