ADDED generated/natools-s_expressions-printers-pretty-config-atom_enc.adb Index: generated/natools-s_expressions-printers-pretty-config-atom_enc.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-atom_enc.adb +++ generated/natools-s_expressions-printers-pretty-config-atom_enc.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc is + + P : constant array (0 .. 3) of Natural := + (1, 4, 5, 10); + + T1 : constant array (0 .. 3) of Unsigned_8 := + (10, 8, 8, 20); + + T2 : constant array (0 .. 3) of Unsigned_8 := + (15, 16, 8, 6); + + G : constant array (0 .. 20) of Unsigned_8 := + (0, 0, 7, 0, 0, 3, 4, 2, 0, 0, 5, 0, 0, 1, 8, 0, 0, 0, 0, 4, 6); + + 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 21; + F2 := (F2 + Natural (T2 (K)) * J) mod 21; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 10; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc; ADDED generated/natools-s_expressions-printers-pretty-config-atom_enc.ads Index: generated/natools-s_expressions-printers-pretty-config-atom_enc.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-atom_enc.ads +++ generated/natools-s_expressions-printers-pretty-config-atom_enc.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc; ADDED generated/natools-s_expressions-printers-pretty-config-commands-ce.adb Index: generated/natools-s_expressions-printers-pretty-config-commands-ce.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-ce.adb +++ generated/natools-s_expressions-printers-pretty-config-commands-ce.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Commands.CE is + + P : constant array (0 .. 2) of Natural := + (1, 4, 6); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (20, 19, 0); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (9, 10, 8); + + G : constant array (0 .. 20) of Unsigned_8 := + (0, 0, 9, 6, 0, 5, 1, 0, 0, 0, 0, 0, 0, 0, 5, 0, 4, 9, 2, 0, 1); + + 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 21; + F2 := (F2 + Natural (T2 (K)) * J) mod 21; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 10; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Commands.CE; ADDED generated/natools-s_expressions-printers-pretty-config-commands-ce.ads Index: generated/natools-s_expressions-printers-pretty-config-commands-ce.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-ce.ads +++ generated/natools-s_expressions-printers-pretty-config-commands-ce.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Commands.CE is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Commands.CE; ADDED generated/natools-s_expressions-printers-pretty-config-commands-sc.adb Index: generated/natools-s_expressions-printers-pretty-config-commands-sc.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-sc.adb +++ generated/natools-s_expressions-printers-pretty-config-commands-sc.adb @@ -0,0 +1,33 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Commands.SC is + + P : constant array (0 .. 1) of Natural := + (3, 7); + + T1 : constant array (0 .. 1) of Unsigned_8 := + (5, 6); + + T2 : constant array (0 .. 1) of Unsigned_8 := + (4, 16); + + G : constant array (0 .. 24) of Unsigned_8 := + (1, 6, 0, 5, 0, 0, 0, 0, 0, 0, 10, 6, 7, 0, 2, 0, 0, 0, 0, 0, 6, 3, 3, + 0, 6); + + 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 25; + F2 := (F2 + Natural (T2 (K)) * J) mod 25; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 12; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Commands.SC; ADDED generated/natools-s_expressions-printers-pretty-config-commands-sc.ads Index: generated/natools-s_expressions-printers-pretty-config-commands-sc.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-sc.ads +++ generated/natools-s_expressions-printers-pretty-config-commands-sc.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Commands.SC is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Commands.SC; ADDED generated/natools-s_expressions-printers-pretty-config-commands-t.adb Index: generated/natools-s_expressions-printers-pretty-config-commands-t.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-t.adb +++ generated/natools-s_expressions-printers-pretty-config-commands-t.adb @@ -0,0 +1,107 @@ +-- Generated at 2014-06-02 19:12:04 +0000 by Natools.Static_Hash_Maps +-- from ../src/natools-s_expressions-printers-pretty-config-commands.sx + +with Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Commands.SC; +with Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc; +with Natools.S_Expressions.Printers.Pretty.Config.Commands.CE; +with Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing; +with Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt; +with Natools.S_Expressions.Printers.Pretty.Config.Token_Opt; +function Natools.S_Expressions.Printers.Pretty.Config.Commands.T + return Boolean is +begin + for I in Map_1_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd.Hash + (Map_1_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_2_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd.Hash + (Map_2_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_3_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd.Hash + (Map_3_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_4_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Commands.SC.Hash + (Map_4_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_5_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc.Hash + (Map_5_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_6_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Commands.CE.Hash + (Map_6_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_7_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing.Hash + (Map_7_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_8_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc.Hash + (Map_8_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_9_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc.Hash + (Map_9_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_10_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt.Hash + (Map_10_Keys (I).all) /= I + then + return False; + end if; + end loop; + + for I in Map_11_Keys'Range loop + if Natools.S_Expressions.Printers.Pretty.Config.Token_Opt.Hash + (Map_11_Keys (I).all) /= I + then + return False; + end if; + end loop; + + return True; +end Natools.S_Expressions.Printers.Pretty.Config.Commands.T; ADDED generated/natools-s_expressions-printers-pretty-config-commands-t.ads Index: generated/natools-s_expressions-printers-pretty-config-commands-t.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands-t.ads +++ generated/natools-s_expressions-printers-pretty-config-commands-t.ads @@ -0,0 +1,6 @@ +-- Generated at 2014-06-02 19:12:04 +0000 by Natools.Static_Hash_Maps +-- from ../src/natools-s_expressions-printers-pretty-config-commands.sx + +function Natools.S_Expressions.Printers.Pretty.Config.Commands.T + return Boolean; +pragma Preelaborate (Natools.S_Expressions.Printers.Pretty.Config.Commands.T); ADDED generated/natools-s_expressions-printers-pretty-config-commands.adb Index: generated/natools-s_expressions-printers-pretty-config-commands.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands.adb +++ generated/natools-s_expressions-printers-pretty-config-commands.adb @@ -0,0 +1,149 @@ +-- Generated at 2014-06-02 19:12:04 +0000 by Natools.Static_Hash_Maps +-- from ../src/natools-s_expressions-printers-pretty-config-commands.sx + +with Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd; +with Natools.S_Expressions.Printers.Pretty.Config.Commands.SC; +with Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc; +with Natools.S_Expressions.Printers.Pretty.Config.Commands.CE; +with Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing; +with Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc; +with Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt; +with Natools.S_Expressions.Printers.Pretty.Config.Token_Opt; + +package body Natools.S_Expressions.Printers.Pretty.Config.Commands is + + function Main (Key : String) return Main_Command is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd.Hash (Key); + begin + if Map_1_Keys (N).all = Key then + return Map_1_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end Main; + + + function Newline (Key : String) return Newline_Command is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd.Hash (Key); + begin + if Map_2_Keys (N).all = Key then + return Map_2_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end Newline; + + + function Quoted_String (Key : String) return Quoted_String_Command is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd.Hash (Key); + begin + if Map_3_Keys (N).all = Key then + return Map_3_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end Quoted_String; + + + function Separator (Key : String) return Separator_Command is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Commands.SC.Hash (Key); + begin + if Map_4_Keys (N).all = Key then + return Map_4_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end Separator; + + + function To_Atom_Encoding (Key : String) return Atom_Encoding is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc.Hash (Key); + begin + if Map_5_Keys (N).all = Key then + return Map_5_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Atom_Encoding; + + + function To_Character_Encoding (Key : String) return Character_Encoding is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Commands.CE.Hash (Key); + begin + if Map_6_Keys (N).all = Key then + return Map_6_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Character_Encoding; + + + function To_Hex_Casing (Key : String) return Encodings.Hex_Casing is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing.Hash (Key); + begin + if Map_7_Keys (N).all = Key then + return Map_7_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Hex_Casing; + + + function To_Newline_Encoding (Key : String) return Newline_Encoding is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc.Hash (Key); + begin + if Map_8_Keys (N).all = Key then + return Map_8_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Newline_Encoding; + + + function To_Quoted_Escape (Key : String) return Quoted_Escape_Type is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc.Hash (Key); + begin + if Map_9_Keys (N).all = Key then + return Map_9_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Quoted_Escape; + + + function To_Quoted_Option (Key : String) return Quoted_Option is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt.Hash (Key); + begin + if Map_10_Keys (N).all = Key then + return Map_10_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Quoted_Option; + + + function To_Token_Option (Key : String) return Token_Option is + N : constant Natural + := Natools.S_Expressions.Printers.Pretty.Config.Token_Opt.Hash (Key); + begin + if Map_11_Keys (N).all = Key then + return Map_11_Elements (N); + else + raise Constraint_Error with "Key """ & Key & """ not in map"; + end if; + end To_Token_Option; + +end Natools.S_Expressions.Printers.Pretty.Config.Commands; ADDED generated/natools-s_expressions-printers-pretty-config-commands.ads Index: generated/natools-s_expressions-printers-pretty-config-commands.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-commands.ads +++ generated/natools-s_expressions-printers-pretty-config-commands.ads @@ -0,0 +1,588 @@ +-- Generated at 2014-06-02 19:12:04 +0000 by Natools.Static_Hash_Maps +-- from ../src/natools-s_expressions-printers-pretty-config-commands.sx + +private package Natools.S_Expressions.Printers.Pretty.Config.Commands is + pragma Preelaborate; + + type Main_Command is + (Set_Char_Encoding, + Set_Fallback, + Set_Hex_Casing, + Set_Indentation, + Set_Newline, + Set_Newline_Encoding, + Set_Quoted, + Set_Quoted_String, + Set_Space_At, + Set_Tab_Stop, + Set_Token, + Set_Width); + + type Newline_Command is + (Set_Newline_Command_Encoding, + Set_Newline_Separator); + + type Quoted_String_Command is + (Set_Quoted_Option, + Set_Quoted_Escape); + + type Separator_Command is + (All_Separators, + No_Separators, + Invert_Separators, + Open_Open, + Open_Atom, + Open_Close, + Atom_Open, + Atom_Atom, + Atom_Close, + Close_Open, + Close_Atom, + Close_Close); + + function Main (Key : String) return Main_Command; + function Newline (Key : String) return Newline_Command; + function Quoted_String (Key : String) return Quoted_String_Command; + function Separator (Key : String) return Separator_Command; + function To_Atom_Encoding (Key : String) return Atom_Encoding; + function To_Character_Encoding (Key : String) return Character_Encoding; + function To_Hex_Casing (Key : String) return Encodings.Hex_Casing; + function To_Newline_Encoding (Key : String) return Newline_Encoding; + function To_Quoted_Escape (Key : String) return Quoted_Escape_Type; + function To_Quoted_Option (Key : String) return Quoted_Option; + function To_Token_Option (Key : String) return Token_Option; + +private + + Map_1_Key_0 : aliased constant String := "ascii"; + Map_1_Key_1 : aliased constant String := "ASCII"; + Map_1_Key_2 : aliased constant String := "latin-1"; + Map_1_Key_3 : aliased constant String := "latin"; + Map_1_Key_4 : aliased constant String := "iso-8859-1"; + Map_1_Key_5 : aliased constant String := "ISO-8859-1"; + Map_1_Key_6 : aliased constant String := "utf-8"; + Map_1_Key_7 : aliased constant String := "UTF-8"; + Map_1_Key_8 : aliased constant String := "utf8"; + Map_1_Key_9 : aliased constant String := "UTF8"; + Map_1_Key_10 : aliased constant String := "base64"; + Map_1_Key_11 : aliased constant String := "base-64"; + Map_1_Key_12 : aliased constant String := "lower-hex"; + Map_1_Key_13 : aliased constant String := "lower-hexa"; + Map_1_Key_14 : aliased constant String := "hex"; + Map_1_Key_15 : aliased constant String := "hexa"; + Map_1_Key_16 : aliased constant String := "hexadecimal"; + Map_1_Key_17 : aliased constant String := "upper-hex"; + Map_1_Key_18 : aliased constant String := "upper-hexa"; + Map_1_Key_19 : aliased constant String := "verbatim"; + Map_1_Key_20 : aliased constant String := "lower"; + Map_1_Key_21 : aliased constant String := "lower-case"; + Map_1_Key_22 : aliased constant String := "upper"; + Map_1_Key_23 : aliased constant String := "upper-case"; + Map_1_Key_24 : aliased constant String := "indent"; + Map_1_Key_25 : aliased constant String := "indentation"; + Map_1_Key_26 : aliased constant String := "no-indent"; + Map_1_Key_27 : aliased constant String := "no-indentation"; + Map_1_Key_28 : aliased constant String := "newline"; + Map_1_Key_29 : aliased constant String := "cr"; + Map_1_Key_30 : aliased constant String := "CR"; + Map_1_Key_31 : aliased constant String := "lf"; + Map_1_Key_32 : aliased constant String := "LF"; + Map_1_Key_33 : aliased constant String := "CRLF"; + Map_1_Key_34 : aliased constant String := "CR-LF"; + Map_1_Key_35 : aliased constant String := "crlf"; + Map_1_Key_36 : aliased constant String := "cr-lf"; + Map_1_Key_37 : aliased constant String := "lf-cr"; + Map_1_Key_38 : aliased constant String := "lfcr"; + Map_1_Key_39 : aliased constant String := "LF-CR"; + Map_1_Key_40 : aliased constant String := "LFCR"; + Map_1_Key_41 : aliased constant String := "no-quoted"; + Map_1_Key_42 : aliased constant String := "no-quoted-string"; + Map_1_Key_43 : aliased constant String := "quoted-when-shorter"; + Map_1_Key_44 : aliased constant String := "quoted-string-when-shorter"; + Map_1_Key_45 : aliased constant String := "single-line-quoted"; + Map_1_Key_46 : aliased constant String := "single-line-quoted-string"; + Map_1_Key_47 : aliased constant String := "escape"; + Map_1_Key_48 : aliased constant String := "quoted"; + Map_1_Key_49 : aliased constant String := "space"; + Map_1_Key_50 : aliased constant String := "tab-stop"; + Map_1_Key_51 : aliased constant String := "extended-token"; + Map_1_Key_52 : aliased constant String := "no-token"; + Map_1_Key_53 : aliased constant String := "standard-token"; + Map_1_Key_54 : aliased constant String := "token"; + Map_1_Key_55 : aliased constant String := "width"; + Map_1_Key_56 : aliased constant String := "no-width"; + Map_1_Keys : constant array (0 .. 56) 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_Key_20'Access, + Map_1_Key_21'Access, + Map_1_Key_22'Access, + Map_1_Key_23'Access, + Map_1_Key_24'Access, + Map_1_Key_25'Access, + Map_1_Key_26'Access, + Map_1_Key_27'Access, + Map_1_Key_28'Access, + Map_1_Key_29'Access, + Map_1_Key_30'Access, + Map_1_Key_31'Access, + Map_1_Key_32'Access, + Map_1_Key_33'Access, + Map_1_Key_34'Access, + Map_1_Key_35'Access, + Map_1_Key_36'Access, + Map_1_Key_37'Access, + Map_1_Key_38'Access, + Map_1_Key_39'Access, + Map_1_Key_40'Access, + Map_1_Key_41'Access, + Map_1_Key_42'Access, + Map_1_Key_43'Access, + Map_1_Key_44'Access, + Map_1_Key_45'Access, + Map_1_Key_46'Access, + Map_1_Key_47'Access, + Map_1_Key_48'Access, + Map_1_Key_49'Access, + Map_1_Key_50'Access, + Map_1_Key_51'Access, + Map_1_Key_52'Access, + Map_1_Key_53'Access, + Map_1_Key_54'Access, + Map_1_Key_55'Access, + Map_1_Key_56'Access); + Map_1_Elements : constant array (0 .. 56) of Main_Command + := (Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Char_Encoding, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Fallback, + Set_Hex_Casing, + Set_Hex_Casing, + Set_Hex_Casing, + Set_Hex_Casing, + Set_Indentation, + Set_Indentation, + Set_Indentation, + Set_Indentation, + Set_Newline, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Newline_Encoding, + Set_Quoted, + Set_Quoted, + Set_Quoted, + Set_Quoted, + Set_Quoted, + Set_Quoted, + Set_Quoted_String, + Set_Quoted_String, + Set_Space_At, + Set_Tab_Stop, + Set_Token, + Set_Token, + Set_Token, + Set_Token, + Set_Width, + Set_Width); + + Map_2_Key_0 : aliased constant String := "cr"; + Map_2_Key_1 : aliased constant String := "CR"; + Map_2_Key_2 : aliased constant String := "lf"; + Map_2_Key_3 : aliased constant String := "LF"; + Map_2_Key_4 : aliased constant String := "CRLF"; + Map_2_Key_5 : aliased constant String := "CR-LF"; + Map_2_Key_6 : aliased constant String := "crlf"; + Map_2_Key_7 : aliased constant String := "cr-lf"; + Map_2_Key_8 : aliased constant String := "lf-cr"; + Map_2_Key_9 : aliased constant String := "lfcr"; + Map_2_Key_10 : aliased constant String := "LF-CR"; + Map_2_Key_11 : aliased constant String := "LFCR"; + Map_2_Key_12 : aliased constant String := "all"; + Map_2_Key_13 : aliased constant String := "none"; + Map_2_Key_14 : aliased constant String := "not"; + Map_2_Key_15 : aliased constant String := "open-open"; + Map_2_Key_16 : aliased constant String := "open-atom"; + Map_2_Key_17 : aliased constant String := "open-close"; + Map_2_Key_18 : aliased constant String := "atom-open"; + Map_2_Key_19 : aliased constant String := "atom-atom"; + Map_2_Key_20 : aliased constant String := "atom-close"; + Map_2_Key_21 : aliased constant String := "close-open"; + Map_2_Key_22 : aliased constant String := "close-atom"; + Map_2_Key_23 : aliased constant String := "close-close"; + Map_2_Keys : constant array (0 .. 23) of access constant String + := (Map_2_Key_0'Access, + Map_2_Key_1'Access, + Map_2_Key_2'Access, + Map_2_Key_3'Access, + Map_2_Key_4'Access, + Map_2_Key_5'Access, + Map_2_Key_6'Access, + Map_2_Key_7'Access, + Map_2_Key_8'Access, + Map_2_Key_9'Access, + Map_2_Key_10'Access, + Map_2_Key_11'Access, + Map_2_Key_12'Access, + Map_2_Key_13'Access, + Map_2_Key_14'Access, + Map_2_Key_15'Access, + Map_2_Key_16'Access, + Map_2_Key_17'Access, + Map_2_Key_18'Access, + Map_2_Key_19'Access, + Map_2_Key_20'Access, + Map_2_Key_21'Access, + Map_2_Key_22'Access, + Map_2_Key_23'Access); + Map_2_Elements : constant array (0 .. 23) of Newline_Command + := (Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Command_Encoding, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator, + Set_Newline_Separator); + + Map_3_Key_0 : aliased constant String := "never"; + Map_3_Key_1 : aliased constant String := "single-line"; + Map_3_Key_2 : aliased constant String := "when-shorter"; + Map_3_Key_3 : aliased constant String := "octal"; + Map_3_Key_4 : aliased constant String := "hex"; + Map_3_Key_5 : aliased constant String := "hexa"; + Map_3_Key_6 : aliased constant String := "hexadecimal"; + Map_3_Key_7 : aliased constant String := "lower-hex"; + Map_3_Key_8 : aliased constant String := "lower-hexa"; + Map_3_Key_9 : aliased constant String := "upper-hex"; + Map_3_Key_10 : aliased constant String := "upper-hexa"; + Map_3_Keys : constant array (0 .. 10) of access constant String + := (Map_3_Key_0'Access, + Map_3_Key_1'Access, + Map_3_Key_2'Access, + Map_3_Key_3'Access, + Map_3_Key_4'Access, + Map_3_Key_5'Access, + Map_3_Key_6'Access, + Map_3_Key_7'Access, + Map_3_Key_8'Access, + Map_3_Key_9'Access, + Map_3_Key_10'Access); + Map_3_Elements : constant array (0 .. 10) of Quoted_String_Command + := (Set_Quoted_Option, + Set_Quoted_Option, + Set_Quoted_Option, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape, + Set_Quoted_Escape); + + Map_4_Key_0 : aliased constant String := "all"; + Map_4_Key_1 : aliased constant String := "none"; + Map_4_Key_2 : aliased constant String := "not"; + Map_4_Key_3 : aliased constant String := "open-open"; + Map_4_Key_4 : aliased constant String := "open-atom"; + Map_4_Key_5 : aliased constant String := "open-close"; + Map_4_Key_6 : aliased constant String := "atom-open"; + Map_4_Key_7 : aliased constant String := "atom-atom"; + Map_4_Key_8 : aliased constant String := "atom-close"; + Map_4_Key_9 : aliased constant String := "close-open"; + Map_4_Key_10 : aliased constant String := "close-atom"; + Map_4_Key_11 : aliased constant String := "close-close"; + Map_4_Keys : constant array (0 .. 11) of access constant String + := (Map_4_Key_0'Access, + Map_4_Key_1'Access, + Map_4_Key_2'Access, + Map_4_Key_3'Access, + Map_4_Key_4'Access, + Map_4_Key_5'Access, + Map_4_Key_6'Access, + Map_4_Key_7'Access, + Map_4_Key_8'Access, + Map_4_Key_9'Access, + Map_4_Key_10'Access, + Map_4_Key_11'Access); + Map_4_Elements : constant array (0 .. 11) of Separator_Command + := (All_Separators, + No_Separators, + Invert_Separators, + Open_Open, + Open_Atom, + Open_Close, + Atom_Open, + Atom_Atom, + Atom_Close, + Close_Open, + Close_Atom, + Close_Close); + + Map_5_Key_0 : aliased constant String := "base64"; + Map_5_Key_1 : aliased constant String := "base-64"; + Map_5_Key_2 : aliased constant String := "lower-hex"; + Map_5_Key_3 : aliased constant String := "lower-hexa"; + Map_5_Key_4 : aliased constant String := "hex"; + Map_5_Key_5 : aliased constant String := "hexa"; + Map_5_Key_6 : aliased constant String := "hexadecimal"; + Map_5_Key_7 : aliased constant String := "upper-hex"; + Map_5_Key_8 : aliased constant String := "upper-hexa"; + Map_5_Key_9 : aliased constant String := "verbatim"; + Map_5_Keys : constant array (0 .. 9) of access constant String + := (Map_5_Key_0'Access, + Map_5_Key_1'Access, + Map_5_Key_2'Access, + Map_5_Key_3'Access, + Map_5_Key_4'Access, + Map_5_Key_5'Access, + Map_5_Key_6'Access, + Map_5_Key_7'Access, + Map_5_Key_8'Access, + Map_5_Key_9'Access); + Map_5_Elements : constant array (0 .. 9) of Atom_Encoding + := (Base64, + Base64, + Hexadecimal, + Hexadecimal, + Hexadecimal, + Hexadecimal, + Hexadecimal, + Hexadecimal, + Hexadecimal, + Verbatim); + + Map_6_Key_0 : aliased constant String := "ascii"; + Map_6_Key_1 : aliased constant String := "ASCII"; + Map_6_Key_2 : aliased constant String := "latin-1"; + Map_6_Key_3 : aliased constant String := "latin"; + Map_6_Key_4 : aliased constant String := "iso-8859-1"; + Map_6_Key_5 : aliased constant String := "ISO-8859-1"; + Map_6_Key_6 : aliased constant String := "utf-8"; + Map_6_Key_7 : aliased constant String := "UTF-8"; + Map_6_Key_8 : aliased constant String := "utf8"; + Map_6_Key_9 : aliased constant String := "UTF8"; + Map_6_Keys : constant array (0 .. 9) of access constant String + := (Map_6_Key_0'Access, + Map_6_Key_1'Access, + Map_6_Key_2'Access, + Map_6_Key_3'Access, + Map_6_Key_4'Access, + Map_6_Key_5'Access, + Map_6_Key_6'Access, + Map_6_Key_7'Access, + Map_6_Key_8'Access, + Map_6_Key_9'Access); + Map_6_Elements : constant array (0 .. 9) of Character_Encoding + := (ASCII, + ASCII, + Latin, + Latin, + Latin, + Latin, + UTF_8, + UTF_8, + UTF_8, + UTF_8); + + Map_7_Key_0 : aliased constant String := "lower"; + Map_7_Key_1 : aliased constant String := "lower-case"; + Map_7_Key_2 : aliased constant String := "upper"; + Map_7_Key_3 : aliased constant String := "upper-case"; + Map_7_Keys : constant array (0 .. 3) of access constant String + := (Map_7_Key_0'Access, + Map_7_Key_1'Access, + Map_7_Key_2'Access, + Map_7_Key_3'Access); + Map_7_Elements : constant array (0 .. 3) of Encodings.Hex_Casing + := (Encodings.Lower, + Encodings.Lower, + Encodings.Upper, + Encodings.Upper); + + Map_8_Key_0 : aliased constant String := "CR"; + Map_8_Key_1 : aliased constant String := "cr"; + Map_8_Key_2 : aliased constant String := "LF"; + Map_8_Key_3 : aliased constant String := "lf"; + Map_8_Key_4 : aliased constant String := "CRLF"; + Map_8_Key_5 : aliased constant String := "CR-LF"; + Map_8_Key_6 : aliased constant String := "crlf"; + Map_8_Key_7 : aliased constant String := "cr-lf"; + Map_8_Key_8 : aliased constant String := "LFCR"; + Map_8_Key_9 : aliased constant String := "LF-CR"; + Map_8_Key_10 : aliased constant String := "lfcr"; + Map_8_Key_11 : aliased constant String := "lf-cr"; + Map_8_Keys : constant array (0 .. 11) of access constant String + := (Map_8_Key_0'Access, + Map_8_Key_1'Access, + Map_8_Key_2'Access, + Map_8_Key_3'Access, + Map_8_Key_4'Access, + Map_8_Key_5'Access, + Map_8_Key_6'Access, + Map_8_Key_7'Access, + Map_8_Key_8'Access, + Map_8_Key_9'Access, + Map_8_Key_10'Access, + Map_8_Key_11'Access); + Map_8_Elements : constant array (0 .. 11) of Newline_Encoding + := (CR, + CR, + LF, + LF, + CR_LF, + CR_LF, + CR_LF, + CR_LF, + LF_CR, + LF_CR, + LF_CR, + LF_CR); + + Map_9_Key_0 : aliased constant String := "octal"; + Map_9_Key_1 : aliased constant String := "hex"; + Map_9_Key_2 : aliased constant String := "hexa"; + Map_9_Key_3 : aliased constant String := "hexadecimal"; + Map_9_Key_4 : aliased constant String := "lower-hex"; + Map_9_Key_5 : aliased constant String := "lower-hexa"; + Map_9_Key_6 : aliased constant String := "upper-hex"; + Map_9_Key_7 : aliased constant String := "upper-hexa"; + Map_9_Keys : constant array (0 .. 7) of access constant String + := (Map_9_Key_0'Access, + Map_9_Key_1'Access, + Map_9_Key_2'Access, + Map_9_Key_3'Access, + Map_9_Key_4'Access, + Map_9_Key_5'Access, + Map_9_Key_6'Access, + Map_9_Key_7'Access); + Map_9_Elements : constant array (0 .. 7) of Quoted_Escape_Type + := (Octal_Escape, + Hex_Escape, + Hex_Escape, + Hex_Escape, + Hex_Escape, + Hex_Escape, + Hex_Escape, + Hex_Escape); + + Map_10_Key_0 : aliased constant String := "when-shorter"; + Map_10_Key_1 : aliased constant String := "quoted-when-shorter"; + Map_10_Key_2 : aliased constant String := "quoted-string-when-shorter"; + Map_10_Key_3 : aliased constant String := "single-line"; + Map_10_Key_4 : aliased constant String := "single-line-quoted"; + Map_10_Key_5 : aliased constant String := "single-line-quoted-string"; + Map_10_Key_6 : aliased constant String := "never"; + Map_10_Key_7 : aliased constant String := "no-quoted"; + Map_10_Key_8 : aliased constant String := "no-quoted-string"; + Map_10_Keys : constant array (0 .. 8) of access constant String + := (Map_10_Key_0'Access, + Map_10_Key_1'Access, + Map_10_Key_2'Access, + Map_10_Key_3'Access, + Map_10_Key_4'Access, + Map_10_Key_5'Access, + Map_10_Key_6'Access, + Map_10_Key_7'Access, + Map_10_Key_8'Access); + Map_10_Elements : constant array (0 .. 8) of Quoted_Option + := (When_Shorter, + When_Shorter, + When_Shorter, + Single_Line, + Single_Line, + Single_Line, + No_Quoted, + No_Quoted, + No_Quoted); + + Map_11_Key_0 : aliased constant String := "extended-token"; + Map_11_Key_1 : aliased constant String := "extended"; + Map_11_Key_2 : aliased constant String := "standard-token"; + Map_11_Key_3 : aliased constant String := "token"; + Map_11_Key_4 : aliased constant String := "standard"; + Map_11_Key_5 : aliased constant String := "no-token"; + Map_11_Key_6 : aliased constant String := "no"; + Map_11_Key_7 : aliased constant String := "none"; + Map_11_Key_8 : aliased constant String := "never"; + Map_11_Keys : constant array (0 .. 8) of access constant String + := (Map_11_Key_0'Access, + Map_11_Key_1'Access, + Map_11_Key_2'Access, + Map_11_Key_3'Access, + Map_11_Key_4'Access, + Map_11_Key_5'Access, + Map_11_Key_6'Access, + Map_11_Key_7'Access, + Map_11_Key_8'Access); + Map_11_Elements : constant array (0 .. 8) of Token_Option + := (Extended_Token, + Extended_Token, + Standard_Token, + Standard_Token, + Standard_Token, + No_Token, + No_Token, + No_Token, + No_Token); + +end Natools.S_Expressions.Printers.Pretty.Config.Commands; ADDED generated/natools-s_expressions-printers-pretty-config-hex_casing.adb Index: generated/natools-s_expressions-printers-pretty-config-hex_casing.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-hex_casing.adb +++ generated/natools-s_expressions-printers-pretty-config-hex_casing.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing is + + P : constant array (0 .. 1) of Natural := + (1, 6); + + T1 : constant array (0 .. 1) of Unsigned_8 := + (8, 7); + + T2 : constant array (0 .. 1) of Unsigned_8 := + (9, 5); + + G : constant array (0 .. 9) of Unsigned_8 := + (0, 0, 0, 0, 0, 0, 2, 0, 3, 1); + + 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 10; + F2 := (F2 + Natural (T2 (K)) * J) mod 10; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 4; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing; ADDED generated/natools-s_expressions-printers-pretty-config-hex_casing.ads Index: generated/natools-s_expressions-printers-pretty-config-hex_casing.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-hex_casing.ads +++ generated/natools-s_expressions-printers-pretty-config-hex_casing.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing; ADDED generated/natools-s_expressions-printers-pretty-config-main_cmd.adb Index: generated/natools-s_expressions-printers-pretty-config-main_cmd.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-main_cmd.adb +++ generated/natools-s_expressions-printers-pretty-config-main_cmd.adb @@ -0,0 +1,37 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd is + + P : constant array (0 .. 4) of Natural := + (1, 4, 6, 10, 19); + + T1 : constant array (0 .. 4) of Unsigned_8 := + (90, 49, 2, 41, 29); + + T2 : constant array (0 .. 4) of Unsigned_8 := + (4, 57, 54, 101, 3); + + G : constant array (0 .. 114) of Unsigned_8 := + (42, 53, 32, 0, 0, 0, 0, 0, 49, 0, 0, 5, 0, 0, 24, 15, 0, 52, 0, 0, 0, + 0, 0, 0, 13, 0, 24, 0, 0, 0, 33, 0, 0, 40, 0, 0, 16, 0, 0, 0, 21, 43, + 0, 39, 41, 0, 0, 51, 0, 52, 30, 0, 52, 0, 0, 29, 0, 35, 0, 0, 0, 0, 0, + 0, 28, 13, 0, 0, 0, 7, 0, 14, 0, 27, 3, 0, 0, 55, 44, 0, 31, 24, 25, + 41, 0, 24, 5, 31, 56, 0, 0, 21, 27, 49, 49, 13, 0, 0, 39, 45, 0, 0, + 40, 0, 0, 41, 13, 2, 50, 12, 41, 23, 1, 0, 0); + + 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 115; + F2 := (F2 + Natural (T2 (K)) * J) mod 115; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 57; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-main_cmd.ads Index: generated/natools-s_expressions-printers-pretty-config-main_cmd.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-main_cmd.ads +++ generated/natools-s_expressions-printers-pretty-config-main_cmd.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-newline_cmd.adb Index: generated/natools-s_expressions-printers-pretty-config-newline_cmd.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-newline_cmd.adb +++ generated/natools-s_expressions-printers-pretty-config-newline_cmd.adb @@ -0,0 +1,34 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd is + + P : constant array (0 .. 2) of Natural := + (2, 3, 7); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (11, 29, 8); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (43, 5, 24); + + G : constant array (0 .. 48) of Unsigned_8 := + (0, 6, 0, 6, 0, 23, 0, 0, 0, 0, 0, 0, 0, 21, 0, 0, 0, 4, 14, 1, 0, 0, + 15, 15, 12, 0, 9, 5, 14, 0, 21, 7, 0, 0, 0, 3, 0, 0, 1, 12, 0, 0, 16, + 0, 2, 0, 19, 1, 12); + + 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 49; + F2 := (F2 + Natural (T2 (K)) * J) mod 49; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 24; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-newline_cmd.ads Index: generated/natools-s_expressions-printers-pretty-config-newline_cmd.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-newline_cmd.ads +++ generated/natools-s_expressions-printers-pretty-config-newline_cmd.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-newline_enc.adb Index: generated/natools-s_expressions-printers-pretty-config-newline_enc.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-newline_enc.adb +++ generated/natools-s_expressions-printers-pretty-config-newline_enc.adb @@ -0,0 +1,33 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc is + + P : constant array (0 .. 1) of Natural := + (1, 3); + + T1 : constant array (0 .. 1) of Unsigned_8 := + (24, 21); + + T2 : constant array (0 .. 1) of Unsigned_8 := + (5, 8); + + G : constant array (0 .. 24) of Unsigned_8 := + (0, 0, 0, 4, 0, 0, 0, 3, 0, 9, 0, 0, 11, 0, 0, 0, 8, 3, 4, 9, 1, 7, 0, + 0, 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 25; + F2 := (F2 + Natural (T2 (K)) * J) mod 25; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 12; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc; ADDED generated/natools-s_expressions-printers-pretty-config-newline_enc.ads Index: generated/natools-s_expressions-printers-pretty-config-newline_enc.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-newline_enc.ads +++ generated/natools-s_expressions-printers-pretty-config-newline_enc.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_cmd.adb Index: generated/natools-s_expressions-printers-pretty-config-quoted_cmd.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_cmd.adb +++ generated/natools-s_expressions-printers-pretty-config-quoted_cmd.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd is + + P : constant array (0 .. 2) of Natural := + (1, 4, 10); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (11, 3, 3); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (14, 19, 16); + + G : constant array (0 .. 22) of Unsigned_8 := + (2, 0, 0, 10, 0, 0, 0, 1, 0, 0, 5, 9, 0, 0, 1, 10, 0, 3, 0, 7, 0, 6, 0); + + 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 23; + F2 := (F2 + Natural (T2 (K)) * J) mod 23; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 11; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_cmd.ads Index: generated/natools-s_expressions-printers-pretty-config-quoted_cmd.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_cmd.ads +++ generated/natools-s_expressions-printers-pretty-config-quoted_cmd.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_esc.adb Index: generated/natools-s_expressions-printers-pretty-config-quoted_esc.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_esc.adb +++ generated/natools-s_expressions-printers-pretty-config-quoted_esc.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc is + + P : constant array (0 .. 2) of Natural := + (1, 4, 10); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (5, 4, 2); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (8, 2, 3); + + G : constant array (0 .. 16) of Unsigned_8 := + (0, 0, 0, 4, 0, 0, 0, 2, 0, 0, 7, 0, 4, 0, 3, 0, 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 17; + F2 := (F2 + Natural (T2 (K)) * J) mod 17; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 8; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_esc.ads Index: generated/natools-s_expressions-printers-pretty-config-quoted_esc.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_esc.ads +++ generated/natools-s_expressions-printers-pretty-config-quoted_esc.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_opt.adb Index: generated/natools-s_expressions-printers-pretty-config-quoted_opt.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_opt.adb +++ generated/natools-s_expressions-printers-pretty-config-quoted_opt.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt is + + P : constant array (0 .. 2) of Natural := + (2, 12, 19); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (3, 14, 14); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (15, 16, 7); + + G : constant array (0 .. 18) of Unsigned_8 := + (0, 0, 0, 0, 0, 0, 8, 2, 0, 0, 6, 0, 1, 2, 0, 4, 0, 3, 6); + + 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 19; + F2 := (F2 + Natural (T2 (K)) * J) mod 19; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 9; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt; ADDED generated/natools-s_expressions-printers-pretty-config-quoted_opt.ads Index: generated/natools-s_expressions-printers-pretty-config-quoted_opt.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-quoted_opt.ads +++ generated/natools-s_expressions-printers-pretty-config-quoted_opt.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt; ADDED generated/natools-s_expressions-printers-pretty-config-token_opt.adb Index: generated/natools-s_expressions-printers-pretty-config-token_opt.adb ================================================================== --- generated/natools-s_expressions-printers-pretty-config-token_opt.adb +++ generated/natools-s_expressions-printers-pretty-config-token_opt.adb @@ -0,0 +1,32 @@ +with Interfaces; use Interfaces; + +package body Natools.S_Expressions.Printers.Pretty.Config.Token_Opt is + + P : constant array (0 .. 2) of Natural := + (1, 3, 9); + + T1 : constant array (0 .. 2) of Unsigned_8 := + (4, 10, 2); + + T2 : constant array (0 .. 2) of Unsigned_8 := + (10, 17, 11); + + G : constant array (0 .. 18) of Unsigned_8 := + (0, 0, 0, 0, 0, 6, 7, 2, 0, 2, 0, 0, 0, 0, 0, 3, 5, 6, 3); + + 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 19; + F2 := (F2 + Natural (T2 (K)) * J) mod 19; + end loop; + return (Natural (G (F1)) + Natural (G (F2))) mod 9; + end Hash; + +end Natools.S_Expressions.Printers.Pretty.Config.Token_Opt; ADDED generated/natools-s_expressions-printers-pretty-config-token_opt.ads Index: generated/natools-s_expressions-printers-pretty-config-token_opt.ads ================================================================== --- generated/natools-s_expressions-printers-pretty-config-token_opt.ads +++ generated/natools-s_expressions-printers-pretty-config-token_opt.ads @@ -0,0 +1,4 @@ +package Natools.S_Expressions.Printers.Pretty.Config.Token_Opt is + pragma Preelaborate; + function Hash (S : String) return Natural; +end Natools.S_Expressions.Printers.Pretty.Config.Token_Opt; ADDED src/natools-s_expressions-printers-pretty-config-commands.sx Index: src/natools-s_expressions-printers-pretty-config-commands.sx ================================================================== --- src/natools-s_expressions-printers-pretty-config-commands.sx +++ src/natools-s_expressions-printers-pretty-config-commands.sx @@ -0,0 +1,136 @@ +(Natools.S_Expressions.Printers.Pretty.Config.Commands + private + preelaborate + (test-function T) + (extra-decl "\ + type Main_Command is + (Set_Char_Encoding, + Set_Fallback, + Set_Hex_Casing, + Set_Indentation, + Set_Newline, + Set_Newline_Encoding, + Set_Quoted, + Set_Quoted_String, + Set_Space_At, + Set_Tab_Stop, + Set_Token, + Set_Width); + + type Newline_Command is + (Set_Newline_Command_Encoding, + Set_Newline_Separator); + + type Quoted_String_Command is + (Set_Quoted_Option, + Set_Quoted_Escape); + + type Separator_Command is + (All_Separators, + No_Separators, + Invert_Separators, + Open_Open, + Open_Atom, + Open_Close, + Atom_Open, + Atom_Atom, + Atom_Close, + Close_Open, + Close_Atom, + Close_Close);") + + (Main_Command + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Main_Cmd) + (function Main) + (nodes + (Set_Char_Encoding ascii ASCII latin-1 latin iso-8859-1 ISO-8859-1 utf-8 UTF-8 utf8 UTF8) + (Set_Fallback base64 base-64 lower-hex lower-hexa hex hexa hexadecimal upper-hex upper-hexa verbatim) + (Set_Hex_Casing lower lower-case upper upper-case) + (Set_Indentation indent indentation no-indent no-indentation) + (Set_Newline newline) + (Set_Newline_Encoding cr CR lf LF CRLF CR-LF crlf cr-lf lf-cr lfcr LF-CR LFCR) + (Set_Quoted no-quoted no-quoted-string quoted-when-shorter quoted-string-when-shorter single-line-quoted single-line-quoted-string) + (Set_Quoted_String escape quoted) + (Set_Space_At space) + (Set_Tab_Stop tab-stop) + (Set_Token extended-token no-token standard-token token) + (Set_Width width no-width))) + (Newline_Command + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Newline_Cmd) + (function Newline) + (nodes + (Set_Newline_Command_Encoding + cr CR lf LF CRLF CR-LF crlf cr-lf lf-cr lfcr LF-CR LFCR) + (Set_Newline_Separator + all none not open-open open-atom open-close atom-open atom-atom atom-close close-open close-atom close-close))) + (Quoted_String_Command + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Cmd) + (function Quoted_String) + (nodes + (Set_Quoted_Option never single-line when-shorter) + (Set_Quoted_Escape octal hex hexa hexadecimal lower-hex lower-hexa upper-hex upper-hexa))) + (Separator_Command + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Commands.SC) + (function Separator) + (nodes + (All_Separators all) + (No_Separators none) + (Invert_Separators not) + (Open_Open open-open) + (Open_Atom open-atom) + (Open_Close open-close) + (Atom_Open atom-open) + (Atom_Atom atom-atom) + (Atom_Close atom-close) + (Close_Open close-open) + (Close_Atom close-atom) + (Close_Close close-close))) + + (Atom_Encoding + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Atom_Enc) + (function To_Atom_Encoding) + (nodes + (Base64 base64 base-64) + (Hexadecimal lower-hex lower-hexa hex hexa hexadecimal upper-hex upper-hexa) + (Verbatim verbatim))) + (Character_Encoding + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Commands.CE) + (function To_Character_Encoding) + (nodes + (ASCII ascii ASCII) + (Latin latin-1 latin iso-8859-1 ISO-8859-1) + (UTF_8 utf-8 UTF-8 utf8 UTF8))) + (Encodings.Hex_Casing + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Hex_Casing) + (function To_Hex_Casing) + (nodes + (Encodings.Lower lower lower-case) + (Encodings.Upper upper upper-case))) + (Newline_Encoding + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Newline_Enc) + (function To_Newline_Encoding) + (nodes + (CR CR cr) + (LF LF lf) + (CR_LF CRLF CR-LF crlf cr-lf) + (LF_CR LFCR LF-CR lfcr lf-cr))) + (Quoted_Escape_Type + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Esc) + (function To_Quoted_Escape) + (nodes + (Octal_Escape octal) + (Hex_Escape hex hexa hexadecimal lower-hex lower-hexa upper-hex upper-hexa))) + (Quoted_Option + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Quoted_Opt) + (function To_Quoted_Option) + (nodes + (When_Shorter when-shorter quoted-when-shorter quoted-string-when-shorter) + (Single_Line single-line single-line-quoted single-line-quoted-string) + (No_Quoted never no-quoted no-quoted-string))) + (Token_Option + (hash-package Natools.S_Expressions.Printers.Pretty.Config.Token_Opt) + (function To_Token_Option) + (nodes + (Extended_Token extended-token extended) + (Standard_Token standard-token token standard) + (No_Token no-token no none never)))) Index: src/natools-s_expressions-printers-pretty-config.adb ================================================================== --- src/natools-s_expressions-printers-pretty-config.adb +++ src/natools-s_expressions-printers-pretty-config.adb @@ -12,14 +12,17 @@ -- 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.Interpreter_Loop; +with Natools.S_Expressions.Printers.Pretty.Config.Commands; + package body Natools.S_Expressions.Printers.Pretty.Config is procedure Read_Screen_Offset - (Expression : in out Lockable.Descriptor'Class; + (Expression : in Lockable.Descriptor'Class; Value : in out Screen_Offset; Has_Value : out Boolean); -- Decode a screen offset from a S-expression procedure Update_Casing @@ -30,17 +33,365 @@ function To_Atom (Before, After : in Entity) return Atom; function To_String (Value : in Entity) return String; + procedure Main_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom); + + procedure Main_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + + procedure Newline_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom); + + procedure Newline_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + + procedure Newline_Interpreter + (Expression : in out Lockable.Descriptor'Class; + Param : in out Parameters); + + procedure Quoted_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom); + + procedure Quoted_Interpreter + (Expression : in out Lockable.Descriptor'Class; + Param : in out Parameters); + + procedure Separator_Execute + (State : in out Entity_Separator; + Value : in Boolean; + Name : in Atom); + + procedure Separator_Execute + (State : in out Entity_Separator; + Value : in Boolean; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + + procedure Separator_Interpreter + (Expression : in out Lockable.Descriptor'Class; + State : in out Entity_Separator; + Context : in Boolean); + + + ------------------ + -- Interpreters -- + ------------------ + + procedure Main_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + begin + case Commands.Main (Command) is + when Commands.Set_Char_Encoding => + Param.Char_Encoding := Commands.To_Character_Encoding (Command); + + when Commands.Set_Fallback => + Param.Fallback := Commands.To_Atom_Encoding (Command); + Update_Casing (Param.Hex_Casing, Name); + + when Commands.Set_Hex_Casing => + Param.Hex_Casing := Commands.To_Hex_Casing (Command); + + when Commands.Set_Indentation => + Param.Indentation := 0; + + when Commands.Set_Newline_Encoding => + Param.Newline := Commands.To_Newline_Encoding (Command); + + when Commands.Set_Quoted => + Param.Quoted := Commands.To_Quoted_Option (Command); + + when Commands.Set_Token => + Param.Token := Commands.To_Token_Option (Command); + + when Commands.Set_Width => + Param.Width := 0; + + when Commands.Set_Newline + | Commands.Set_Quoted_String + | Commands.Set_Space_At + | Commands.Set_Tab_Stop + => + -- Those commands are meaningless without argument + null; + end case; + end Main_Execute; + + + procedure Main_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + begin + case Commands.Main (Command) is + when Commands.Set_Indentation => + declare + Has_Value : Boolean; + Event : Events.Event; + begin + Read_Screen_Offset (Arguments, Param.Indentation, Has_Value); + + if Has_Value and then Param.Indentation /= 0 then + Arguments.Next (Event); + + if Event = Events.Add_Atom then + declare + Unit : constant String + := To_String (Arguments.Current_Atom); + Last : Natural := Unit'Last; + begin + if Last > 0 and then Unit (Last) = 's' then + Last := Last - 1; + end if; + + if Unit (Unit'First .. Last) = "tab" then + Param.Indent := Tabs; + elsif Unit (Unit'First .. Last) = "space" then + Param.Indent := Spaces; + elsif Unit (Unit'First .. Last) = "tabbed-space" then + Param.Indent := Tabs_And_Spaces; + end if; + end; + end if; + end if; + end; + + when Commands.Set_Newline => + Newline_Interpreter (Arguments, Param); + + when Commands.Set_Quoted_String => + Quoted_Interpreter (Arguments, Param); + + when Commands.Set_Space_At => + Separator_Interpreter (Arguments, Param.Space_At, True); + + when Commands.Set_Tab_Stop => + declare + Value : Screen_Offset := 0; + Has_Value : Boolean; + begin + Read_Screen_Offset (Arguments, Value, Has_Value); + + if Has_Value and then Value /= 0 then + Param.Tab_Stop := Value; + end if; + end; + + when Commands.Set_Token => + begin + if Arguments.Current_Event = Events.Add_Atom then + Param.Token := Commands.To_Token_Option + (To_String (Arguments.Current_Atom)); + end if; + exception + when Constraint_Error => null; + end; + + when Commands.Set_Width => + declare + Has_Value : Boolean; + begin + Read_Screen_Offset (Arguments, Param.Width, Has_Value); + end; + + when Commands.Set_Char_Encoding + | Commands.Set_Fallback + | Commands.Set_Hex_Casing + | Commands.Set_Newline_Encoding + | Commands.Set_Quoted + => + -- These commands don't do anything with arguments + null; + end case; + end Main_Execute; + + + procedure Newline_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + begin + case Commands.Newline (Command) is + when Commands.Set_Newline_Command_Encoding => + Param.Newline := Commands.To_Newline_Encoding (Command); + when Commands.Set_Newline_Separator => + Separator_Execute (Param.Newline_At, True, Name); + end case; + end Newline_Execute; + + + procedure Newline_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + begin + case Commands.Newline (Command) is + when Commands.Set_Newline_Command_Encoding => + Param.Newline := Commands.To_Newline_Encoding (Command); + when Commands.Set_Newline_Separator => + Separator_Execute (Param.Newline_At, True, Name, Arguments); + end case; + end Newline_Execute; + + + procedure Quoted_Execute + (Param : in out Parameters; + Context : in Meaningless_Type; + Name : in Atom) + is + pragma Unreferenced (Context); + Command : constant String := To_String (Name); + begin + case Commands.Quoted_String (Command) is + when Commands.Set_Quoted_Option => + Param.Quoted := Commands.To_Quoted_Option (Command); + when Commands.Set_Quoted_Escape => + Param.Quoted_Escape := Commands.To_Quoted_Escape (Command); + Update_Casing (Param.Hex_Casing, Name); + end case; + end Quoted_Execute; + + + procedure Separator_Execute + (State : in out Entity_Separator; + Value : in Boolean; + Name : in Atom) is + begin + case Commands.Separator (To_String (Name)) is + when Commands.All_Separators => + State := (others => (others => Value)); + when Commands.No_Separators => + State := (others => (others => not Value)); + + when Commands.Invert_Separators => + null; -- Error, actually + + when Commands.Open_Open => + State (Opening, Opening) := Value; + when Commands.Open_Atom => + State (Opening, Atom_Data) := Value; + when Commands.Open_Close => + State (Opening, Closing) := Value; + + when Commands.Atom_Open => + State (Atom_Data, Opening) := Value; + when Commands.Atom_Atom => + State (Atom_Data, Atom_Data) := Value; + when Commands.Atom_Close => + State (Atom_Data, Closing) := Value; + + when Commands.Close_Open => + State (Closing, Opening) := Value; + when Commands.Close_Atom => + State (Closing, Atom_Data) := Value; + when Commands.Close_Close => + State (Closing, Closing) := Value; + end case; + end Separator_Execute; + + + procedure Separator_Execute + (State : in out Entity_Separator; + Value : in Boolean; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) is + begin + case Commands.Separator (To_String (Name)) is + when Commands.Invert_Separators => + Separator_Interpreter (Arguments, State, not Value); + + when Commands.All_Separators + | Commands.No_Separators + | Commands.Open_Open + | Commands.Open_Atom + | Commands.Open_Close + | Commands.Atom_Open + | Commands.Atom_Atom + | Commands.Atom_Close + | Commands.Close_Open + | Commands.Close_Atom + | Commands.Close_Close + => + Separator_Execute (State, Value, Name); + end case; + end Separator_Execute; + + + + procedure Main_Interpreter is new Interpreter_Loop + (Parameters, Meaningless_Type, Main_Execute, Main_Execute); + + procedure Newline_Interpreter is new Interpreter_Loop + (Parameters, Meaningless_Type, Newline_Execute, Newline_Execute); + + procedure Quoted_Interpreter is new Interpreter_Loop + (Parameters, Meaningless_Type, + Dispatch_Without_Argument => Quoted_Execute); + + procedure Interpreter is new Interpreter_Loop + (Entity_Separator, Boolean, Separator_Execute, Separator_Execute); + + + + procedure Newline_Interpreter + (Expression : in out Lockable.Descriptor'Class; + Param : in out Parameters) is + begin + Newline_Interpreter (Expression, Param, Meaningless_Value); + end Newline_Interpreter; + + procedure Quoted_Interpreter + (Expression : in out Lockable.Descriptor'Class; + Param : in out Parameters) is + begin + Quoted_Interpreter (Expression, Param, Meaningless_Value); + end Quoted_Interpreter; + + procedure Separator_Interpreter + (Expression : in out Lockable.Descriptor'Class; + State : in out Entity_Separator; + Context : in Boolean) + renames Interpreter; + + ------------------------------ -- Local Helper Subprograms -- ------------------------------ procedure Read_Screen_Offset - (Expression : in out Lockable.Descriptor'Class; + (Expression : in Lockable.Descriptor'Class; Value : in out Screen_Offset; Has_Value : out Boolean) is Result : Screen_Offset := 0; begin @@ -294,525 +645,11 @@ end Print; procedure Update (Param : in out Parameters; - Expression : in out Lockable.Descriptor'Class) - is - Interpreter : constant Interpreters.Interpreter := Config_Interpreter; - begin - Update (Interpreter, Param, Expression); - end Update; - - - procedure Update - (Interpreter : in Interpreters.Interpreter; - Param : in out Parameters; Expression : in out Lockable.Descriptor'Class) is begin - Interpreter.Execute (Expression, Param, True); + Main_Interpreter (Expression, Param, Meaningless_Value); end Update; - - - ------------------------------ - -- Interpreter Constructors -- - ------------------------------ - - function Config_Interpreter return Interpreters.Interpreter is - Quoted_SI, Newline_SI, Space_SI, Result : Interpreters.Interpreter; - begin - -- Setup subinterpreters - Add_Separator_Commands (Newline_SI, True, True); - Add_Newline_Encoding_Commands (Newline_SI); - Add_Quoted_Commands (Quoted_SI); - Add_Quoted_Escape_Commands (Quoted_SI); - Add_Separator_Commands (Space_SI, True, False); - - -- Build final interpreter - Result.Add_Command (To_Atom ("escape"), - Set_Quoted_String'(Subinterpreter => Quoted_SI)); - Result.Add_Command (To_Atom ("indent"), Set_Indentation'(null record)); - Result.Add_Command (To_Atom ("indentation"), - Set_Indentation'(null record)); - Result.Add_Command (To_Atom ("no-indent"), - Set_Indentation'(null record)); - Result.Add_Command (To_Atom ("no-indentation"), - Set_Indentation'(null record)); - Result.Add_Command (To_Atom ("newline"), - Set_Newline'(Subinterpreter => Newline_SI)); - Result.Add_Command (To_Atom ("quoted"), - Set_Quoted_String'(Subinterpreter => Quoted_SI)); - Result.Add_Command (To_Atom ("space"), - Set_Space_At'(Subinterpreter => Space_SI)); - Result.Add_Command (To_Atom ("tab-stop"), Set_Tab_Stop'(null record)); - Result.Add_Command (To_Atom ("width"), Set_Width'(null record)); - Result.Add_Command (To_Atom ("no-width"), Set_Width'(null record)); - - Result.Add_Command (To_Atom ("extended-token"), - Set_Token'(Value => Extended_Token)); - Result.Add_Command (To_Atom ("no-token"), - Set_Token'(Value => No_Token)); - Result.Add_Command (To_Atom ("standard-token"), - Set_Token'(Value => Standard_Token)); - Result.Add_Command (To_Atom ("token"), - Set_Token'(Value => Standard_Token)); - - Result.Add_Command (To_Atom ("no-quoted"), - Set_Quoted'(Value => No_Quoted)); - Result.Add_Command (To_Atom ("no-quoted-string"), - Set_Quoted'(Value => No_Quoted)); - Result.Add_Command (To_Atom ("quoted-when-shorter"), - Set_Quoted'(Value => When_Shorter)); - Result.Add_Command (To_Atom ("quoted-string-when-shorter"), - Set_Quoted'(Value => When_Shorter)); - Result.Add_Command (To_Atom ("single-line-quoted"), - Set_Quoted'(Value => Single_Line)); - Result.Add_Command (To_Atom ("single-line-quoted-string"), - Set_Quoted'(Value => Single_Line)); - - Result.Add_Command (To_Atom ("base64"), - Set_Fallback'(Value => Base64)); - Result.Add_Command (To_Atom ("base-64"), - Set_Fallback'(Value => Base64)); - Result.Add_Command (To_Atom ("lower-hex"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("lower-hexa"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("hex"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("hexa"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("hexadecimal"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("upper-hex"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("upper-hexa"), - Set_Fallback'(Value => Hexadecimal)); - Result.Add_Command (To_Atom ("verbatim"), - Set_Fallback'(Value => Verbatim)); - - Add_Char_Encoding_Commands (Result); - Add_Hex_Casing_Commands (Result); - Add_Newline_Encoding_Commands (Result); - return Result; - end Config_Interpreter; - - - procedure Add_Char_Encoding_Commands - (Interpreter : in out Interpreters.Interpreter) is - begin - Interpreter.Add_Command (To_Atom ("utf-8"), - Set_Char_Encoding'(Value => UTF_8)); - Interpreter.Add_Command (To_Atom ("UTF-8"), - Set_Char_Encoding'(Value => UTF_8)); - Interpreter.Add_Command (To_Atom ("utf8"), - Set_Char_Encoding'(Value => UTF_8)); - Interpreter.Add_Command (To_Atom ("UTF8"), - Set_Char_Encoding'(Value => UTF_8)); - Interpreter.Add_Command (To_Atom ("ascii"), - Set_Char_Encoding'(Value => ASCII)); - Interpreter.Add_Command (To_Atom ("ASCII"), - Set_Char_Encoding'(Value => ASCII)); - Interpreter.Add_Command (To_Atom ("latin-1"), - Set_Char_Encoding'(Value => Latin)); - Interpreter.Add_Command (To_Atom ("latin"), - Set_Char_Encoding'(Value => Latin)); - Interpreter.Add_Command (To_Atom ("iso-8859-1"), - Set_Char_Encoding'(Value => Latin)); - Interpreter.Add_Command (To_Atom ("ISO-8859-1"), - Set_Char_Encoding'(Value => Latin)); - end Add_Char_Encoding_Commands; - - - procedure Add_Hex_Casing_Commands - (Interpreter : in out Interpreters.Interpreter) is - begin - Interpreter.Add_Command (To_Atom ("upper"), - Set_Hex_Casing'(Value => Encodings.Upper)); - Interpreter.Add_Command (To_Atom ("upper-case"), - Set_Hex_Casing'(Value => Encodings.Upper)); - Interpreter.Add_Command (To_Atom ("lower"), - Set_Hex_Casing'(Value => Encodings.Lower)); - Interpreter.Add_Command (To_Atom ("lower-case"), - Set_Hex_Casing'(Value => Encodings.Lower)); - end Add_Hex_Casing_Commands; - - - procedure Add_Quoted_Commands - (Interpreter : in out Interpreters.Interpreter) is - begin - Interpreter.Add_Command (To_Atom ("never"), - Set_Quoted'(Value => No_Quoted)); - Interpreter.Add_Command (To_Atom ("single-line"), - Set_Quoted'(Value => Single_Line)); - Interpreter.Add_Command (To_Atom ("when-shorter"), - Set_Quoted'(Value => When_Shorter)); - end Add_Quoted_Commands; - - - procedure Add_Quoted_Escape_Commands - (Interpreter : in out Interpreters.Interpreter) is - begin - Interpreter.Add_Command (To_Atom ("octal"), - Set_Quoted_Escape'(Value => Octal_Escape)); - Interpreter.Add_Command (To_Atom ("hex"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("hexa"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("hexadecimal"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("lower-hex"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("lower-hexa"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("upper-hex"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Interpreter.Add_Command (To_Atom ("upper-hexa"), - Set_Quoted_Escape'(Value => Hex_Escape)); - Add_Hex_Casing_Commands (Interpreter); - end Add_Quoted_Escape_Commands; - - - procedure Add_Newline_Encoding_Commands - (Interpreter : in out Interpreters.Interpreter) is - begin - Interpreter.Add_Command (To_Atom ("cr"), - Set_Newline_Encoding'(Value => CR)); - Interpreter.Add_Command (To_Atom ("CR"), - Set_Newline_Encoding'(Value => CR)); - Interpreter.Add_Command (To_Atom ("lf"), - Set_Newline_Encoding'(Value => LF)); - Interpreter.Add_Command (To_Atom ("LF"), - Set_Newline_Encoding'(Value => LF)); - Interpreter.Add_Command (To_Atom ("CRLF"), - Set_Newline_Encoding'(Value => CR_LF)); - Interpreter.Add_Command (To_Atom ("CR-LF"), - Set_Newline_Encoding'(Value => CR_LF)); - Interpreter.Add_Command (To_Atom ("crlf"), - Set_Newline_Encoding'(Value => CR_LF)); - Interpreter.Add_Command (To_Atom ("cr-lf"), - Set_Newline_Encoding'(Value => CR_LF)); - Interpreter.Add_Command (To_Atom ("lf-cr"), - Set_Newline_Encoding'(Value => LF_CR)); - Interpreter.Add_Command (To_Atom ("lfcr"), - Set_Newline_Encoding'(Value => LF_CR)); - Interpreter.Add_Command (To_Atom ("LF-CR"), - Set_Newline_Encoding'(Value => LF_CR)); - Interpreter.Add_Command (To_Atom ("LFCR"), - Set_Newline_Encoding'(Value => LF_CR)); - end Add_Newline_Encoding_Commands; - - - procedure Add_Separator_Commands - (Interpreter : in out Interpreters.Interpreter; - Value : in Boolean; - Newline : in Boolean) is - begin - for Before in Entity loop - for After in Entity loop - Interpreter.Add_Command - (To_Atom (Before, After), - Set_Separator'(Before, After, Value, Newline)); - end loop; - end loop; - - Interpreter.Add_Command - (To_Atom ("all"), - Set_All_Separators'(Value, Newline)); - Interpreter.Add_Command - (To_Atom ("none"), - Set_All_Separators'(not Value, Newline)); - Interpreter.Add_Command - (To_Atom ("not"), - Set_All_Separators'(not Value, Newline)); - end Add_Separator_Commands; - - - - ------------------------- - -- Invididual Commands -- - ------------------------- - - procedure Execute - (Self : in Set_Width; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Self, Context, Name); - begin - State.Width := 0; - end Execute; - - - procedure Execute - (Self : in Set_Width; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) - is - pragma Unreferenced (Self, Context); - Has_Value : Boolean; - begin - Cmd.Next; - Read_Screen_Offset (Cmd, State.Width, Has_Value); - end Execute; - - - procedure Execute - (Self : in Set_Tab_Stop; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) - is - pragma Unreferenced (Self, Context); - Value : Screen_Offset := 0; - Has_Value : Boolean; - begin - Cmd.Next; - Read_Screen_Offset (Cmd, Value, Has_Value); - if Has_Value and then Value /= 0 then - State.Tab_Stop := Value; - end if; - end Execute; - - - procedure Execute - (Self : in Set_Indentation; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Self, Context, Name); - begin - State.Indentation := 0; - end Execute; - - - procedure Execute - (Self : in Set_Indentation; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) - is - pragma Unreferenced (Self, Context); - Has_Value : Boolean; - Event : Events.Event; - begin - Cmd.Next (Event); - Read_Screen_Offset (Cmd, State.Indentation, Has_Value); - - if Has_Value and State.Indentation /= 0 then - Cmd.Next (Event); - if Event = Events.Add_Atom then - declare - Keyword : constant String := To_String (Cmd.Current_Atom); - begin - if Keyword = "tab" or Keyword = "tabs" then - State.Indent := Tabs; - elsif Keyword = "space" or Keyword = "spaces" then - State.Indent := Spaces; - elsif Keyword = "tabbed-space" or Keyword = "tabbed-spaces" then - State.Indent := Tabs_And_Spaces; - end if; - end; - end if; - end if; - end Execute; - - - procedure Execute - (Self : in Set_Newline; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) is - begin - pragma Assert (not Self.Subinterpreter.Is_Empty); - Cmd.Next; - Self.Subinterpreter.Execute (Cmd, State, Context); - end Execute; - - - procedure Execute - (Self : in Set_Space_At; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) is - begin - pragma Assert (not Self.Subinterpreter.Is_Empty); - Cmd.Next; - Self.Subinterpreter.Execute (Cmd, State, Context); - end Execute; - - - procedure Execute - (Self : in Set_Char_Encoding; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - State.Char_Encoding := Self.Value; - end Execute; - - - procedure Execute - (Self : in Set_Newline_Encoding; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - State.Newline := Self.Value; - end Execute; - - - procedure Execute - (Self : in Set_Separator; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - if Self.Newline then - State.Newline_At (Self.Before, Self.After) := Self.Value; - else - State.Space_At (Self.Before, Self.After) := Self.Value; - end if; - end Execute; - - - procedure Execute - (Self : in Set_All_Separators; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - if Self.Newline then - State.Newline_At := (others => (others => Self.Value)); - else - State.Space_At := (others => (others => Self.Value)); - end if; - end Execute; - - - procedure Execute - (Self : in Set_All_Separators; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) - is - Subinterpreter : Interpreters.Interpreter; - begin - Add_Separator_Commands (Subinterpreter, Self.Value, Self.Newline); - Subinterpreter.Execute (Cmd, State, Context); - end Execute; - - - procedure Execute - (Self : in Set_Hex_Casing; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - State.Hex_Casing := Self.Value; - end Execute; - - - procedure Execute - (Self : in Set_Fallback; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context); - begin - State.Fallback := Self.Value; - Update_Casing (State.Hex_Casing, Name); - end Execute; - - - procedure Execute - (Self : in Set_Token; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - State.Token := Self.Value; - end Execute; - - - procedure Execute - (Self : in Set_Token; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) - is - pragma Unreferenced (Self, Context); - Event : Events.Event; - begin - Cmd.Next (Event); - if Event /= Events.Add_Atom then - return; - end if; - - declare - Token : constant String := To_String (Cmd.Current_Atom); - begin - if Token = "standard" then - State.Token := Standard_Token; - elsif Token = "extended" then - State.Token := Extended_Token; - elsif Token = "never" or Token = "none" or Token = "no" then - State.Token := No_Token; - end if; - end; - end Execute; - - - procedure Execute - (Self : in Set_Quoted_Escape; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context); - begin - State.Quoted_Escape := Self.Value; - Update_Casing (State.Hex_Casing, Name); - end Execute; - - - procedure Execute - (Self : in Set_Quoted; - State : in out Parameters; - Context : in Boolean; - Name : in Atom) - is - pragma Unreferenced (Context, Name); - begin - State.Quoted := Self.Value; - end Execute; - - - procedure Execute - (Self : in Set_Quoted_String; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class) is - begin - pragma Assert (not Self.Subinterpreter.Is_Empty); - Cmd.Next; - Self.Subinterpreter.Execute (Cmd, State, Context); - end Execute; - end Natools.S_Expressions.Printers.Pretty.Config; Index: src/natools-s_expressions-printers-pretty-config.ads ================================================================== --- src/natools-s_expressions-printers-pretty-config.ads +++ src/natools-s_expressions-printers-pretty-config.ads @@ -15,217 +15,24 @@ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Natools.S_Expressions.Printers.Pretty.Config provides serialization and -- -- deserialization of pretty printer parameters to and from S-expressions. -- --- -- --- The interpreter uses a dummy Boolean context that is always ignored. -- ------------------------------------------------------------------------------ -with Natools.S_Expressions.Interpreters; with Natools.S_Expressions.Lockable; package Natools.S_Expressions.Printers.Pretty.Config is pragma Preelaborate (Config); - package Interpreters is - new Natools.S_Expressions.Interpreters (Parameters, Boolean); - - - -------------------------- - -- High-Level Interface -- - -------------------------- - - function Config_Interpreter return Interpreters.Interpreter; - -- Build a parameter interpreter procedure Update (Param : in out Parameters; Expression : in out Lockable.Descriptor'Class); -- Update parameters using a temporary interpreter - procedure Update - (Interpreter : in Interpreters.Interpreter; - Param : in out Parameters; - Expression : in out Lockable.Descriptor'Class); - -- Update parameters using Interpreter (wrapper around its Execute) - procedure Print (Output : in out Printers.Printer'Class; Param : in Parameters); -- Output parameters to S-expression printer - - --------------------- - -- Building Blocks -- - --------------------- - - procedure Add_Char_Encoding_Commands - (Interpreter : in out Interpreters.Interpreter); - procedure Add_Hex_Casing_Commands - (Interpreter : in out Interpreters.Interpreter); - procedure Add_Quoted_Commands - (Interpreter : in out Interpreters.Interpreter); - procedure Add_Quoted_Escape_Commands - (Interpreter : in out Interpreters.Interpreter); - procedure Add_Newline_Encoding_Commands - (Interpreter : in out Interpreters.Interpreter); - procedure Add_Separator_Commands - (Interpreter : in out Interpreters.Interpreter; - Value : in Boolean; - Newline : in Boolean); - -- Inject commands into subinterpreter - - type Set_Width is new Interpreters.Command with null record; - procedure Execute - (Self : in Set_Width; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - procedure Execute - (Self : in Set_Width; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Space_At is new Interpreters.Command with record - Subinterpreter : Interpreters.Interpreter; - end record; - procedure Execute - (Self : in Set_Space_At; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Tab_Stop is new Interpreters.Command with null record; - procedure Execute - (Self : in Set_Tab_Stop; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Indentation is new Interpreters.Command with null record; - procedure Execute - (Self : in Set_Indentation; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - procedure Execute - (Self : in Set_Indentation; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Quoted is new Interpreters.Command with record - Value : Quoted_Option; - end record; - procedure Execute - (Self : in Set_Quoted; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Token is new Interpreters.Command with record - Value : Token_Option; - end record; - procedure Execute - (Self : in Set_Token; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - procedure Execute - (Self : in Set_Token; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Hex_Casing is new Interpreters.Command with record - Value : Encodings.Hex_Casing; - end record; - procedure Execute - (Self : in Set_Hex_Casing; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Quoted_Escape is new Interpreters.Command with record - Value : Quoted_Escape_Type; - end record; - procedure Execute - (Self : in Set_Quoted_Escape; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Char_Encoding is new Interpreters.Command with record - Value : Character_Encoding; - end record; - procedure Execute - (Self : in Set_Char_Encoding; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Fallback is new Interpreters.Command with record - Value : Atom_Encoding; - end record; - procedure Execute - (Self : in Set_Fallback; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Newline is new Interpreters.Command with record - Subinterpreter : Interpreters.Interpreter; - end record; - procedure Execute - (Self : in Set_Newline; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Newline_Encoding is new Interpreters.Command with record - Value : Newline_Encoding; - end record; - procedure Execute - (Self : in Set_Newline_Encoding; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_Separator is new Interpreters.Command with record - Before : Entity; - After : Entity; - Value : Boolean; - Newline : Boolean; - end record; - procedure Execute - (Self : in Set_Separator; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - - type Set_All_Separators is new Interpreters.Command with record - Value : Boolean; - Newline : Boolean; - end record; - procedure Execute - (Self : in Set_All_Separators; - State : in out Parameters; - Context : in Boolean; - Name : in Atom); - procedure Execute - (Self : in Set_All_Separators; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - - type Set_Quoted_String is new Interpreters.Command with record - Subinterpreter : Interpreters.Interpreter; - end record; - procedure Execute - (Self : in Set_Quoted_String; - State : in out Parameters; - Context : in Boolean; - Cmd : in out Lockable.Descriptor'Class); - end Natools.S_Expressions.Printers.Pretty.Config;