Natools

Artifact [82529a82fc]
Login

Artifact 82529a82fc6e2091ee8ffa143bf31cd8f97969e8:


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.S_Expressions.Templates.Generic_Integers provides a template     --
-- interpreter for integer rendering.                                       --
-- The following commands are recognized:                                   --
--   (align "left|right|center")                                            --
--   (base "symbol 0" "symbol 1" "symbol 2" ...)                            --
--   (left-padding "symbol")                                                --
--   (image (0 "symbol 0") (2 "symbol 2") ...)                              --
--   (max-width "max width" ["overflow text"])                              --
--   (min-width "min width")                                                --
--   (padding "left-symbol" "right-symbol")                                 --
--   (padding "symbol")                                                     --
--   (prefix (0 "prefix 0") (2 "prefix 2") ...)                             --
--   (right-padding "symbol")                                               --
--   (sign "plus sign" ["minus sign"])                                      --
--   (suffix (0 "suffix 0") (2 "suffix 2") ...)                             --
--   (width "fixed width")                                                  --
--   (width "min width" "max width" ["overflow text"])                      --
-- Top-level atoms are taken as the image for the next number.              --
------------------------------------------------------------------------------

with Ada.Containers.Ordered_Maps;
with Ada.Streams;
with Natools.References;
with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Lockable;
with Natools.Storage_Pools;

generic
   type T is range <>;
   with function "<" (Left, Right : T) return Boolean is <>;
package Natools.S_Expressions.Templates.Generic_Integers is
   pragma Preelaborate;

   --------------------------
   -- High-Level Interface --
   --------------------------

   type Format is tagged private;

   function Render (Value : T; Template : Format) return Atom;
      --  Render Value according to Template

   procedure Parse
     (Template : in out Format;
      Expression : in out Lockable.Descriptor'Class);
      --  Read Expression to fill Template

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in T);
      --  Read a rendering format from Template and use it on Value

   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Default_Format : in Format;
      Template : in out Lockable.Descriptor'Class;
      Value : in T);
      --  Read a rendering format from Template, using defaults
      --  from Default_Format, and use it on Value.


   ---------------------
   -- Auxiliary Types --
   ---------------------

   type Alignment is (Left_Aligned, Centered, Right_Aligned);
   type Width is range 0 .. 10000;

   subtype Base_T is T'Base;
   subtype Natural_T is Base_T range 0 .. Base_T'Last;


   type Atom_Array
     is array (Natural_T range <>) of Atom_Refs.Immutable_Reference;

   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Array;
      --  Build an array consisting of consecutive atoms found in Atom_List


   package Atom_Arrays is new References
     (Atom_Array,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool,
      Storage_Pools.Access_In_Default_Pool'Storage_Pool);

   function Create (Atom_List : in out S_Expressions.Descriptor'Class)
     return Atom_Arrays.Immutable_Reference;
      --  Build an array reference consisting of
      --  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);

   procedure Append_Image
     (Object : in out Format;
      Image : in Atom_Refs.Immutable_Reference);
   procedure Append_Image
     (Object : in out Format;
      Image : in Atom);
   procedure Remove_Image (Object : in out Format; Value : in T);
   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom_Refs.Immutable_Reference);
   procedure Set_Image
     (Object : in out Format;
      Value : in T;
      Image : in Atom);

   procedure Set_Left_Padding
     (Object : in out Format;
      Symbol : in Atom_Refs.Immutable_Reference);
   procedure Set_Left_Padding
     (Object : in out Format;
      Symbol : in Atom);

   procedure Set_Maximum_Width (Object : in out Format; Value : in Width);

   procedure Set_Minimum_Width (Object : in out Format; Value : in Width);

   procedure Set_Negative_Sign
     (Object : in out Format;
      Sign : in Atom_Refs.Immutable_Reference);
   procedure Set_Negative_Sign
     (Object : in out Format;
      Sign : in Atom);

   procedure Set_Overflow_Message
     (Object : in out Format;
      Message : in Atom_Refs.Immutable_Reference);
   procedure Set_Overflow_Message
     (Object : in out Format;
      Message : in Atom);

   procedure Set_Positive_Sign
     (Object : in out Format;
      Sign : in Atom_Refs.Immutable_Reference);
   procedure Set_Positive_Sign
     (Object : in out Format;
      Sign : in Atom);

   procedure Remove_Prefix
     (Object : in out Format;
      Value : in T);
   procedure Set_Prefix
     (Object : in out Format;
      Value : in T;
      Prefix : in Atom_Refs.Immutable_Reference);
   procedure Set_Prefix
     (Object : in out Format;
      Value : in T;
      Prefix : in Atom);
   procedure Remove_Prefix
     (Object : in out Format;
      Values : in Interval);
   procedure Set_Prefix
     (Object : in out Format;
      Values : in Interval;
      Prefix : in Atom_Refs.Immutable_Reference);
   procedure Set_Prefix
     (Object : in out Format;
      Values : in Interval;
      Prefix : in Atom);

   procedure Set_Right_Padding
     (Object : in out Format;
      Symbol : in Atom_Refs.Immutable_Reference);
   procedure Set_Right_Padding
     (Object : in out Format;
      Symbol : in Atom);

   procedure Remove_Suffix
     (Object : in out Format;
      Value : in T);
   procedure Set_Suffix
     (Object : in out Format;
      Value : in T;
      Suffix : in Atom_Refs.Immutable_Reference);
   procedure Set_Suffix
     (Object : in out Format;
      Value : in T;
      Suffix : in Atom);
   procedure Remove_Suffix
     (Object : in out Format;
      Values : in Interval);
   procedure Set_Suffix
     (Object : in out Format;
      Values : in Interval;
      Suffix : in Atom_Refs.Immutable_Reference);
   procedure Set_Suffix
     (Object : in out Format;
      Values : in Interval;
      Suffix : in Atom);

   procedure Set_Symbols
     (Object : in out Format;
      Symbols : in Atom_Arrays.Immutable_Reference);
   procedure Set_Symbols
     (Object : in out Format;
      Expression : in out S_Expressions.Descriptor'Class);


private

   Base_10 : Atom_Arrays.Immutable_Reference;
      --  Cache for the often-used decimal representation

   procedure Reverse_Render
     (Value : in Natural_T;
      Symbols : in Atom_Array;
      Output : in out Atom_Buffers.Atom_Buffer;
      Length : out Width)
     with Pre => Symbols'Length >= 2 and Symbols'First = 0;
      --  Create a little-endian image of Value using the given symbol table

   type Format is tagged record
      Symbols : Atom_Arrays.Immutable_Reference;
      Positive_Sign : Atom_Refs.Immutable_Reference;
      Negative_Sign : Atom_Refs.Immutable_Reference;

      Minimum_Width : Width := 0;
      Align : Alignment := Right_Aligned;
      Left_Padding : Atom_Refs.Immutable_Reference;
      Right_Padding : Atom_Refs.Immutable_Reference;

      Maximum_Width : Width := Width'Last;
      Overflow_Message : Atom_Refs.Immutable_Reference;

      Images : Atom_Maps.Map;
      Prefix : Atom_Maps.Map;
      Suffix : Atom_Maps.Map;
   end record;

end Natools.S_Expressions.Templates.Generic_Integers;