ADDED generated/natools-static_maps-s_expressions-templates-integers-ac.adb Index: generated/natools-static_maps-s_expressions-templates-integers-ac.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-ac.adb +++ generated/natools-static_maps-s_expressions-templates-integers-ac.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.Static_Maps.S_Expressions.Templates.Integers.AC is + + P : constant array (0 .. 0) of Natural := + (0 .. 0 => 1); + + T1 : constant array (0 .. 0) of Unsigned_8 := + (0 .. 0 => 3); + + T2 : constant array (0 .. 0) of Unsigned_8 := + (0 .. 0 => 5); + + G : constant array (0 .. 6) of Unsigned_8 := + (0, 0, 0, 0, 0, 1, 2); + + function Hash (S : String) return Natural is + F : constant Natural := S'First - 1; + L : constant Natural := S'Length; + F1, F2 : Natural := 0; + J : Natural; + begin + for K in P'Range loop + exit when L < P (K); + J := Character'Pos (S (P (K) + F)); + F1 := (F1 + Natural (T1 (K)) * J) mod 7; + F2 := (F2 + Natural (T2 (K)) * J) mod 7; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 3; + end Hash; + +end Natools.Static_Maps.S_Expressions.Templates.Integers.AC; ADDED generated/natools-static_maps-s_expressions-templates-integers-ac.ads Index: generated/natools-static_maps-s_expressions-templates-integers-ac.ads ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-ac.ads +++ generated/natools-static_maps-s_expressions-templates-integers-ac.ads @@ -0,0 +1,4 @@ +package Natools.Static_Maps.S_Expressions.Templates.Integers.AC is + pragma Pure; + function Hash (S : String) return Natural; +end Natools.Static_Maps.S_Expressions.Templates.Integers.AC; ADDED generated/natools-static_maps-s_expressions-templates-integers-mc.adb Index: generated/natools-static_maps-s_expressions-templates-integers-mc.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-mc.adb +++ generated/natools-static_maps-s_expressions-templates-integers-mc.adb @@ -0,0 +1,33 @@ +with Interfaces; use Interfaces; + +package body Natools.Static_Maps.S_Expressions.Templates.Integers.MC is + + P : constant array (0 .. 3) of Natural := + (1, 2, 5, 9); + + T1 : constant array (0 .. 3) of Unsigned_8 := + (31, 27, 5, 36); + + T2 : constant array (0 .. 3) of Unsigned_8 := + (3, 33, 25, 27); + + G : constant array (0 .. 40) of Unsigned_8 := + (0, 0, 17, 16, 0, 17, 0, 0, 0, 0, 0, 12, 1, 12, 0, 7, 2, 9, 11, 4, 6, + 0, 17, 0, 0, 0, 0, 16, 5, 0, 1, 0, 0, 15, 0, 0, 0, 0, 13, 0, 7); + + function Hash (S : String) return Natural is + F : constant Natural := S'First - 1; + L : constant Natural := S'Length; + F1, F2 : Natural := 0; + J : Natural; + begin + for K in P'Range loop + exit when L < P (K); + J := Character'Pos (S (P (K) + F)); + F1 := (F1 + Natural (T1 (K)) * J) mod 41; + F2 := (F2 + Natural (T2 (K)) * J) mod 41; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 20; + end Hash; + +end Natools.Static_Maps.S_Expressions.Templates.Integers.MC; ADDED generated/natools-static_maps-s_expressions-templates-integers-mc.ads Index: generated/natools-static_maps-s_expressions-templates-integers-mc.ads ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-mc.ads +++ generated/natools-static_maps-s_expressions-templates-integers-mc.ads @@ -0,0 +1,4 @@ +package Natools.Static_Maps.S_Expressions.Templates.Integers.MC is + pragma Pure; + function Hash (S : String) return Natural; +end Natools.Static_Maps.S_Expressions.Templates.Integers.MC; ADDED generated/natools-static_maps-s_expressions-templates-integers-t.adb Index: generated/natools-static_maps-s_expressions-templates-integers-t.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-t.adb +++ generated/natools-static_maps-s_expressions-templates-integers-t.adb @@ -0,0 +1,26 @@ +-- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- from src/natools-s_expressions-templates-generic_integers-maps.sx + +with Natools.Static_Maps.S_Expressions.Templates.Integers.MC; +with Natools.Static_Maps.S_Expressions.Templates.Integers.AC; +function Natools.Static_Maps.S_Expressions.Templates.Integers.T + return Boolean is +begin + for I in Map_1_Keys'Range loop + if Natools.Static_Maps.S_Expressions.Templates.Integers.MC.Hash + (Map_1_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_2_Keys'Range loop + if Natools.Static_Maps.S_Expressions.Templates.Integers.AC.Hash + (Map_2_Keys (I).all) /= I + then + return False; + end if; + end loop; + + return True; +end Natools.Static_Maps.S_Expressions.Templates.Integers.T; ADDED generated/natools-static_maps-s_expressions-templates-integers-t.ads Index: generated/natools-static_maps-s_expressions-templates-integers-t.ads ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers-t.ads +++ generated/natools-static_maps-s_expressions-templates-integers-t.ads @@ -0,0 +1,6 @@ +-- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- from src/natools-s_expressions-templates-generic_integers-maps.sx + +function Natools.Static_Maps.S_Expressions.Templates.Integers.T + return Boolean; +pragma Pure (Natools.Static_Maps.S_Expressions.Templates.Integers.T); ADDED generated/natools-static_maps-s_expressions-templates-integers.adb Index: generated/natools-static_maps-s_expressions-templates-integers.adb ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers.adb +++ generated/natools-static_maps-s_expressions-templates-integers.adb @@ -0,0 +1,32 @@ +-- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- from src/natools-s_expressions-templates-generic_integers-maps.sx + +with Natools.Static_Maps.S_Expressions.Templates.Integers.MC; +with Natools.Static_Maps.S_Expressions.Templates.Integers.AC; + +package body Natools.Static_Maps.S_Expressions.Templates.Integers is + + function Main (Key : String) return Main_Command is + N : constant Natural + := Natools.Static_Maps.S_Expressions.Templates.Integers.MC.Hash (Key); + begin + if Map_1_Keys (N).all = Key then + return Map_1_Elements (N); + else + return Error; + end if; + end Main; + + + function To_Align_Command (Key : String) return Align_Command is + N : constant Natural + := Natools.Static_Maps.S_Expressions.Templates.Integers.AC.Hash (Key); + begin + if Map_2_Keys (N).all = Key then + return Map_2_Elements (N); + else + return Unknown_Align; + end if; + end To_Align_Command; + +end Natools.Static_Maps.S_Expressions.Templates.Integers; ADDED generated/natools-static_maps-s_expressions-templates-integers.ads Index: generated/natools-static_maps-s_expressions-templates-integers.ads ================================================================== --- generated/natools-static_maps-s_expressions-templates-integers.ads +++ generated/natools-static_maps-s_expressions-templates-integers.ads @@ -0,0 +1,104 @@ +-- Generated at 2014-09-14 21:29:47 +0000 by Natools.Static_Hash_Maps +-- from src/natools-s_expressions-templates-generic_integers-maps.sx + +package Natools.Static_Maps.S_Expressions.Templates.Integers is + pragma Pure; + + type Main_Command is + (Error, + Align, + Align_Center, + Align_Left, + Align_Right, + Base, + Padding, + Padding_Left, + Padding_Right, + Sign, + Width, + Width_Max, + Width_Min); + + type Align_Command is (Unknown_Align, Set_Left, Set_Center, Set_Right); + + function Main (Key : String) return Main_Command; + function To_Align_Command (Key : String) return Align_Command; + +private + + Map_1_Key_0 : aliased constant String := "align"; + Map_1_Key_1 : aliased constant String := "align-center"; + Map_1_Key_2 : aliased constant String := "centered"; + Map_1_Key_3 : aliased constant String := "align-left"; + Map_1_Key_4 : aliased constant String := "left-align"; + Map_1_Key_5 : aliased constant String := "align-right"; + Map_1_Key_6 : aliased constant String := "right-align"; + Map_1_Key_7 : aliased constant String := "base"; + Map_1_Key_8 : aliased constant String := "padding"; + Map_1_Key_9 : aliased constant String := "padding-left"; + Map_1_Key_10 : aliased constant String := "left-padding"; + Map_1_Key_11 : aliased constant String := "padding-right"; + Map_1_Key_12 : aliased constant String := "right-padding"; + Map_1_Key_13 : aliased constant String := "sign"; + Map_1_Key_14 : aliased constant String := "signs"; + Map_1_Key_15 : aliased constant String := "width"; + Map_1_Key_16 : aliased constant String := "width-max"; + Map_1_Key_17 : aliased constant String := "max-width"; + Map_1_Key_18 : aliased constant String := "width-min"; + Map_1_Key_19 : aliased constant String := "min-width"; + Map_1_Keys : constant array (0 .. 19) of access constant String + := (Map_1_Key_0'Access, + Map_1_Key_1'Access, + Map_1_Key_2'Access, + Map_1_Key_3'Access, + Map_1_Key_4'Access, + Map_1_Key_5'Access, + Map_1_Key_6'Access, + Map_1_Key_7'Access, + Map_1_Key_8'Access, + Map_1_Key_9'Access, + Map_1_Key_10'Access, + Map_1_Key_11'Access, + Map_1_Key_12'Access, + Map_1_Key_13'Access, + Map_1_Key_14'Access, + Map_1_Key_15'Access, + Map_1_Key_16'Access, + Map_1_Key_17'Access, + Map_1_Key_18'Access, + Map_1_Key_19'Access); + Map_1_Elements : constant array (0 .. 19) of Main_Command + := (Align, + Align_Center, + Align_Center, + Align_Left, + Align_Left, + Align_Right, + Align_Right, + Base, + Padding, + Padding_Left, + Padding_Left, + Padding_Right, + Padding_Right, + Sign, + Sign, + Width, + Width_Max, + Width_Max, + Width_Min, + Width_Min); + + Map_2_Key_0 : aliased constant String := "left"; + Map_2_Key_1 : aliased constant String := "center"; + Map_2_Key_2 : aliased constant String := "right"; + Map_2_Keys : constant array (0 .. 2) of access constant String + := (Map_2_Key_0'Access, + Map_2_Key_1'Access, + Map_2_Key_2'Access); + Map_2_Elements : constant array (0 .. 2) of Align_Command + := (Set_Left, + Set_Center, + Set_Right); + +end Natools.Static_Maps.S_Expressions.Templates.Integers; ADDED src/natools-s_expressions-templates-generic_integers-maps.sx Index: src/natools-s_expressions-templates-generic_integers-maps.sx ================================================================== --- src/natools-s_expressions-templates-generic_integers-maps.sx +++ src/natools-s_expressions-templates-generic_integers-maps.sx @@ -0,0 +1,46 @@ +(Natools.Static_Maps.S_Expressions.Templates.Integers + pure + (test-function T) + (extra-decl "\ + type Main_Command is + (Error, + Align, + Align_Center, + Align_Left, + Align_Right, + Base, + Padding, + Padding_Left, + Padding_Right, + Sign, + Width, + Width_Max, + Width_Min); + + type Align_Command is (Unknown_Align, Set_Left, Set_Center, Set_Right);") + + (Main_Command + (hash-package Natools.Static_Maps.S_Expressions.Templates.Integers.MC) + (function Main) + (not-found Error) + (nodes + (Align align) + (Align_Center align-center centered) + (Align_Left align-left left-align) + (Align_Right align-right right-align) + (Base base) + (Padding padding) + (Padding_Left padding-left left-padding) + (Padding_Right padding-right right-padding) + (Sign sign signs) + (Width width) + (Width_Max width-max max-width) + (Width_Min width-min min-width))) + (Align_Command + (hash-package Natools.Static_Maps.S_Expressions.Templates.Integers.AC) + (function To_Align_Command) + (not-found Unknown_Align) + (nodes + (Set_Left left) + (Set_Center center) + (Set_Right right)))) ADDED src/natools-s_expressions-templates-generic_integers.adb Index: src/natools-s_expressions-templates-generic_integers.adb ================================================================== --- src/natools-s_expressions-templates-generic_integers.adb +++ src/natools-s_expressions-templates-generic_integers.adb @@ -0,0 +1,389 @@ +------------------------------------------------------------------------------ +-- 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. -- +------------------------------------------------------------------------------ + +with Natools.S_Expressions.Atom_Ref_Constructors; +with Natools.S_Expressions.Interpreter_Loop; +with Natools.Static_Maps.S_Expressions.Templates.Integers; + +package body Natools.S_Expressions.Templates.Generic_Integers is + + package Commands + renames Natools.Static_Maps.S_Expressions.Templates.Integers; + + function Create (Data : Atom) return Atom_Refs.Immutable_Reference + renames Atom_Ref_Constructors.Create; + + + procedure Update_Format + (State : in out Format; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + + + ------------------------------ + -- Local Helper Subprograms -- + ------------------------------ + + procedure Update_Format + (State : in out Format; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + Event : Events.Event; + begin + case Commands.Main (Command) is + when Commands.Error => + null; + + when Commands.Align => + case Arguments.Current_Event is + when Events.Add_Atom => + case Commands.To_Align_Command + (To_String (Arguments.Current_Atom)) + is + when Commands.Unknown_Align => + null; + when Commands.Set_Left => + State.Align := Left_Aligned; + when Commands.Set_Center => + State.Align := Centered; + when Commands.Set_Right => + State.Align := Right_Aligned; + end case; + when others => + null; + end case; + + when Commands.Align_Center => + State.Align := Centered; + + when Commands.Align_Left => + State.Align := Left_Aligned; + + when Commands.Align_Right => + State.Align := Right_Aligned; + + when Commands.Base => + declare + New_Base : constant Atom_Arrays.Immutable_Reference + := Create (Arguments); + begin + if not New_Base.Is_Empty + and then New_Base.Query.Data.all'Length >= 2 + then + State.Symbols := New_Base; + end if; + end; + + 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 => + return; + end case; + + Arguments.Next (Event); + case Event is + when Events.Add_Atom => + State.Right_Padding := Create (Arguments.Current_Atom); + when others => + null; + end case; + + when Commands.Padding_Left => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Left_Padding := Create (Arguments.Current_Atom); + when others => + null; + end case; + + when Commands.Padding_Right => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Right_Padding := Create (Arguments.Current_Atom); + when others => + null; + end case; + + when Commands.Sign => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Positive_Sign := Create (Arguments.Current_Atom); + when others => + return; + end case; + + Arguments.Next (Event); + case Event is + when Events.Add_Atom => + State.Negative_Sign := Create (Arguments.Current_Atom); + when others => + null; + end case; + + when Commands.Width => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Maximum_Width + := Width'Value (To_String (Arguments.Current_Atom)); + State.Minimum_Width := State.Maximum_Width; + when others => + return; + end case; + + Arguments.Next (Event); + case Event is + when Events.Add_Atom => + State.Maximum_Width + := Width'Value (To_String (Arguments.Current_Atom)); + when others => + return; + end case; + + Arguments.Next (Event); + case Event is + when Events.Add_Atom => + State.Overflow_Message := Create (Arguments.Current_Atom); + when others => + return; + end case; + + when Commands.Width_Max => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Maximum_Width + := Width'Value (To_String (Arguments.Current_Atom)); + when others => + return; + end case; + + Arguments.Next (Event); + case Event is + when Events.Add_Atom => + State.Overflow_Message := Create (Arguments.Current_Atom); + when others => + return; + end case; + + when Commands.Width_Min => + case Arguments.Current_Event is + when Events.Add_Atom => + State.Minimum_Width + := Width'Value (To_String (Arguments.Current_Atom)); + when others => + null; + end case; + end case; + end Update_Format; + + + procedure Interpreter is new Interpreter_Loop + (Format, Meaningless_Type, Update_Format); + + + + ------------------------- + -- Dynamic Atom Arrays -- + ------------------------- + + function Create (Atom_List : in out S_Expressions.Descriptor'Class) + return Atom_Array + is + function Current_Atom return Atom is (Atom_List.Current_Atom); + New_Ref : Atom_Refs.Immutable_Reference; + begin + case Atom_List.Current_Event is + when Events.Add_Atom => + New_Ref := Atom_Refs.Create (Current_Atom'Access); + Atom_List.Next; + return (0 => New_Ref) & Create (Atom_List); + + when others => + return Atom_Array'(1 .. 0 => <>); + end case; + end Create; + + + function Create (Atom_List : in out S_Expressions.Descriptor'Class) + return Atom_Arrays.Immutable_Reference + is + function Create_Array return Atom_Array is (Create (Atom_List)); + begin + return Atom_Arrays.Create (Create_Array'Access); + end Create; + + + function Decimal return Atom_Arrays.Immutable_Reference is + function Create return Atom_Array + is ((0 => Create ((1 => Character'Pos ('0'))), + 1 => Create ((1 => Character'Pos ('1'))), + 2 => Create ((1 => Character'Pos ('2'))), + 3 => Create ((1 => Character'Pos ('3'))), + 4 => Create ((1 => Character'Pos ('4'))), + 5 => Create ((1 => Character'Pos ('5'))), + 6 => Create ((1 => Character'Pos ('6'))), + 7 => Create ((1 => Character'Pos ('7'))), + 8 => Create ((1 => Character'Pos ('8'))), + 9 => Create ((1 => Character'Pos ('9'))))); + begin + if Base_10.Is_Empty then + Base_10 := Atom_Arrays.Create (Create'Access); + end if; + + return Base_10; + end Decimal; + + + procedure Reverse_Render + (Value : in Natural_T; + Symbols : in Atom_Array; + Output : in out Atom_Buffers.Atom_Buffer; + Length : out Width) + is + Digit : Natural_T; + Remainder : Natural_T := Value; + begin + Length := 0; + loop + Digit := Remainder mod Symbols'Length; + Remainder := Remainder / Symbols'Length; + Length := Length + 1; + Output.Append (Symbols (Digit).Query.Data.all); + exit when Remainder = 0; + end loop; + end Reverse_Render; + + + + ---------------------- + -- Public Interface -- + ---------------------- + + function Render (Value : T; Template : Format) return Atom is + function "*" (Count : Width; Symbol : Atom) return Atom; + + function Safe_Atom + (Ref : Atom_Refs.Immutable_Reference; + Fallback : String) + return Atom; +-- The expression below seems to trigger an infinite loop in +-- GNAT-AUX 4.9.0 20140422, but the if-statement form doesn't. +-- is (if Ref.Is_Empty then To_Atom (Fallback) else Ref.Query.Data.all); + + function Safe_Atom + (Ref : Atom_Refs.Immutable_Reference; + Fallback : String) + return Atom is + begin + if Ref.Is_Empty then + return To_Atom (Fallback); + else + return Ref.Query.Data.all; + end if; + end Safe_Atom; + + function "*" (Count : Width; Symbol : Atom) return Atom is + Result : Atom (1 .. Offset (Count) * Symbol'Length); + begin + for I in 0 .. Offset (Count) - 1 loop + Result (I * Symbol'Length + 1 .. (I + 1) * Symbol'Length) + := Symbol; + end loop; + + return Result; + end "*"; + + Output : Atom_Buffers.Atom_Buffer; + Has_Sign : Boolean := True; + Length : Width; + Symbols : constant Atom_Arrays.Immutable_Reference + := (if Template.Symbols.Is_Empty then Decimal else Template.Symbols); + begin + if Value < 0 then + Reverse_Render (-Value, Symbols.Query.Data.all, Output, Length); + Output.Append (Safe_Atom (Template.Negative_Sign, "-")); + else + Reverse_Render (Value, Symbols.Query.Data.all, Output, Length); + + if not Template.Positive_Sign.Is_Empty then + Output.Append (Template.Positive_Sign.Query.Data.all); + else + Has_Sign := False; + end if; + end if; + + Output.Invert; + + if Has_Sign then + Length := Length + 1; + end if; + + if Length > Template.Maximum_Width then + return Safe_Atom (Template.Overflow_Message, ""); + end if; + + if Length < Template.Minimum_Width then + declare + Needed : constant Width := Template.Minimum_Width - Length; + Left_Count, Right_Count : Width := 0; + begin + case Template.Align is + when Left_Aligned => + Right_Count := Needed; + when Centered => + Left_Count := Needed / 2; + Right_Count := Needed - Left_Count; + when Right_Aligned => + Left_Count := Needed; + end case; + + return Left_Count * Safe_Atom (Template.Left_Padding, " ") + & Output.Data + & Right_Count * Safe_Atom (Template.Right_Padding, " "); + end; + end if; + + return Output.Data; + end Render; + + + procedure Parse + (Template : in out Format; + Expression : in out Lockable.Descriptor'Class) is + begin + Interpreter (Expression, Template, Meaningless_Value); + end Parse; + + + procedure Render + (Output : in out Ada.Streams.Root_Stream_Type'Class; + Template : in out Lockable.Descriptor'Class; + Value : in T) + is + Parsed_Template : Format; + begin + Parse (Parsed_Template, Template); + Output.Write (Render (Value, Parsed_Template)); + end Render; + +end Natools.S_Expressions.Templates.Generic_Integers; ADDED src/natools-s_expressions-templates-generic_integers.ads Index: src/natools-s_expressions-templates-generic_integers.ads ================================================================== --- src/natools-s_expressions-templates-generic_integers.ads +++ src/natools-s_expressions-templates-generic_integers.ads @@ -0,0 +1,120 @@ +------------------------------------------------------------------------------ +-- 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") -- +-- (max-width "max width" ["overflow text"]) -- +-- (min-width "min width") -- +-- (padding "left-symbol" "right-symbol") -- +-- (padding "symbol") -- +-- (right-padding "symbol") -- +-- (sign "plus sign" ["minus sign"]) -- +-- (width "fixed width") -- +-- (width "min width" "max width" ["overflow text"]) -- +------------------------------------------------------------------------------ + +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 <>; +package Natools.S_Expressions.Templates.Generic_Integers is + pragma Preelaborate; + + type Format is 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 + +private + + 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 + + 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 + + + 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 + + Base_10 : Atom_Arrays.Immutable_Reference; + -- Cache for the often-used decimal representation + + + type Format is 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; + end record; + + +end Natools.S_Expressions.Templates.Generic_Integers; ADDED src/natools-s_expressions-templates-integers.ads Index: src/natools-s_expressions-templates-integers.ads ================================================================== --- src/natools-s_expressions-templates-integers.ads +++ src/natools-s_expressions-templates-integers.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- 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.Integers is a common instance of -- +-- Generic_Integers templates, instanciated for standard integers. -- +------------------------------------------------------------------------------ + +with Natools.S_Expressions.Templates.Generic_Integers; + +package Natools.S_Expressions.Templates.Integers + is new Natools.S_Expressions.Templates.Generic_Integers (Integer); +pragma Preelaborate (Natools.S_Expressions.Templates.Integers); ADDED src/natools-s_expressions-templates.ads Index: src/natools-s_expressions-templates.ads ================================================================== --- src/natools-s_expressions-templates.ads +++ src/natools-s_expressions-templates.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- 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 provides a common parent for all -- +-- packages belonging to S-expression templating system. -- +------------------------------------------------------------------------------ + +package Natools.S_Expressions.Templates is + pragma Pure; + +end Natools.S_Expressions.Templates; ADDED src/natools-static_maps-s_expressions-templates.ads Index: src/natools-static_maps-s_expressions-templates.ads ================================================================== --- src/natools-static_maps-s_expressions-templates.ads +++ src/natools-static_maps-s_expressions-templates.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- 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.Static_Maps.S_Expressions.Templates is a common parent to -- +-- generated static hash maps related to S-expression template system. -- +------------------------------------------------------------------------------ + +package Natools.Static_Maps.S_Expressions.Templates is + pragma Pure; + +end Natools.Static_Maps.S_Expressions.Templates; ADDED src/natools-static_maps-s_expressions.ads Index: src/natools-static_maps-s_expressions.ads ================================================================== --- src/natools-static_maps-s_expressions.ads +++ src/natools-static_maps-s_expressions.ads @@ -0,0 +1,25 @@ +------------------------------------------------------------------------------ +-- 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.Static_Maps.S_Expressions is a common parent to generated static -- +-- hash maps related to S-expressions. -- +------------------------------------------------------------------------------ + +package Natools.Static_Maps.S_Expressions is + pragma Pure; + +end Natools.Static_Maps.S_Expressions; ADDED src/natools-static_maps.ads Index: src/natools-static_maps.ads ================================================================== --- src/natools-static_maps.ads +++ src/natools-static_maps.ads @@ -0,0 +1,26 @@ +------------------------------------------------------------------------------ +-- 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.Static_Maps is a common parent to generated static hash maps, -- +-- to put them out of their user hierarchy so that they can be categorized -- +-- pure and don't need to be recompiled when a parent change. -- +------------------------------------------------------------------------------ + +package Natools.Static_Maps is + pragma Pure; + +end Natools.Static_Maps;