Index: src/natools-smaz-tools.adb ================================================================== --- src/natools-smaz-tools.adb +++ src/natools-smaz-tools.adb @@ -19,10 +19,13 @@ package Sx renames Natools.S_Expressions; function Dummy_Hash (Value : String) return Natural; -- Placeholder for Hash member, always raises Program_Error + function Image (B : Boolean) return String; + -- Return correctly-cased image of B + ------------------------------ -- Local Helper Subprograms -- ------------------------------ @@ -32,14 +35,230 @@ raise Program_Error with "Dummy_Hash called"; return 0; end Dummy_Hash; + function Image (B : Boolean) return String is + begin + if B then + return "True"; + else + return "False"; + end if; + end Image; + + ---------------------- -- Public Interface -- ---------------------- + + procedure Print_Dictionary_In_Ada + (Dict : in Dictionary; + Hash_Image : in String := "TODO"; + Max_Width : in Positive := 70; + First_Prefix : in String := " := ("; + Prefix : in String := " "; + Half_Indent : in String := " ") + is + procedure Append_Entity + (Buffer : in out String; + Last : in out Natural; + Entity : in String); + function Double_Quote (S : String; Count : Natural) return String; + function Offsets_Suffix (I : Ada.Streams.Stream_Element) return String; + function Strip_Image (S : String) return String; + function Values_Separator (I : Positive) return String; + + procedure Append_Entity + (Buffer : in out String; + Last : in out Natural; + Entity : in String) is + begin + if Last + 1 + Entity'Length <= Buffer'Last then + Buffer (Last + 1) := ' '; + Buffer (Last + 2 .. Last + 1 + Entity'Length) := Entity; + Last := Last + 1 + Entity'Length; + else + Put_Line (Buffer (Buffer'First .. Last)); + Last := Buffer'First + Prefix'Length - 1; + Buffer (Last + 1 .. Last + Half_Indent'Length) := Half_Indent; + Last := Last + Half_Indent'Length; + Buffer (Last + 1 .. Last + Entity'Length) := Entity; + Last := Last + Entity'Length; + end if; + end Append_Entity; + + function Double_Quote (S : String; Count : Natural) return String is + begin + if Count = 0 then + return S; + else + return Quoted : String (1 .. S'Length + Count) do + declare + O : Positive := Quoted'First; + begin + for I in S'Range loop + Quoted (O) := S (I); + O := O + 1; + + if S (I) = '"' then + Quoted (O) := S (I); + O := O + 1; + end if; + end loop; + end; + end return; + end if; + end Double_Quote; + + function Offsets_Suffix (I : Ada.Streams.Stream_Element) return String is + begin + if I < Dict.Offsets'Last then + return ","; + else + return "),"; + end if; + end Offsets_Suffix; + + function Strip_Image (S : String) return String is + begin + if S'Length > 0 and then S (S'First) = ' ' then + return S (S'First + 1 .. S'Last); + else + return S; + end if; + end Strip_Image; + + function Values_Separator (I : Positive) return String is + begin + if I > Dict.Values'First then + return "& "; + else + return ""; + end if; + end Values_Separator; + + Line_Buffer : String (1 .. Max_Width + Prefix'Length); + Buffer_Last : Natural; + begin + Put_Line (First_Prefix & "Dict_Last =>" + & Ada.Streams.Stream_Element'Image (Dict.Dict_Last) & ','); + Put_Line (Prefix & "String_Size =>" + & Natural'Image (Dict.String_Size) & ','); + Put_Line (Prefix & "Variable_Length_Verbatim => " + & Image (Dict.Variable_Length_Verbatim) & ','); + Put_Line (Prefix & "Max_Word_Length =>" + & Natural'Image (Dict.Max_Word_Length) & ','); + + Line_Buffer (1 .. Prefix'Length) := Prefix; + Line_Buffer (Prefix'Length + 1 .. Prefix'Length + 11) := "Offsets => "; + Buffer_Last := Prefix'Length + 11; + + for I in Dict.Offsets'Range loop + Append_Entity (Line_Buffer, Buffer_Last, Strip_Image + (Positive'Image (Dict.Offsets (I)) & Offsets_Suffix (I))); + + if I = Dict.Offsets'First then + Line_Buffer (Prefix'Length + 12) := '('; + end if; + end loop; + + Put_Line (Line_Buffer (Line_Buffer'First .. Buffer_Last)); + Line_Buffer (Prefix'Length + 1 .. Prefix'Length + 9) := "Values =>"; + Buffer_Last := Prefix'Length + 9; + + declare + I : Positive := Dict.Values'First; + First, Last : Positive; + Quote_Count : Natural; + begin + Values_Loop : + while I <= Dict.Values'Last loop + Add_Unprintable : + while Dict.Values (I) not in ' ' .. '~' loop + Append_Entity + (Line_Buffer, Buffer_Last, + Values_Separator (I) & Character'Image (Dict.Values (I))); + I := I + 1; + exit Values_Loop when I > Dict.Values'Last; + end loop Add_Unprintable; + + First := I; + Quote_Count := 0; + + Find_Printable_Substring : + loop + if Dict.Values (I) = '"' then + Quote_Count := Quote_Count + 1; + end if; + + I := I + 1; + exit Find_Printable_Substring when I > Dict.Values'Last + or else Dict.Values (I) not in ' ' .. '~'; + end loop Find_Printable_Substring; + + Last := I - 1; + + Split_Lines : + loop + declare + Partial_Quote_Count : Natural := 0; + Partial_Width : Natural := 0; + Partial_Last : Natural := First - 1; + Sep : constant String := Values_Separator (First); + Available_Length : constant Natural + := (if Line_Buffer'Last > Buffer_Last + Sep'Length + 4 + then Line_Buffer'Last - Buffer_Last - Sep'Length - 4 + else Line_Buffer'Length - Prefix'Length + - Half_Indent'Length - Sep'Length - 3); + begin + if 1 + Last - First + Quote_Count < Available_Length then + Append_Entity + (Line_Buffer, Buffer_Last, + Sep & '"' & Double_Quote + (Dict.Values (First .. Last), Quote_Count) & '"'); + exit Split_Lines; + else + Count_Quotes : + loop + if Dict.Values (Partial_Last + 1) = '"' then + exit Count_Quotes + when Partial_Width + 2 > Available_Length; + Partial_Width := Partial_Width + 1; + Partial_Quote_Count := Partial_Quote_Count + 1; + else + exit Count_Quotes + when Partial_Width + 1 > Available_Length; + end if; + + Partial_Width := Partial_Width + 1; + Partial_Last := Partial_Last + 1; + end loop Count_Quotes; + + Append_Entity + (Line_Buffer, Buffer_Last, Sep & '"' + & Double_Quote + (Dict.Values (First .. Partial_Last), + Partial_Quote_Count) + & '"'); + First := Partial_Last + 1; + Quote_Count := Quote_Count - Partial_Quote_Count; + end if; + end; + end loop Split_Lines; + end loop Values_Loop; + + Put_Line (Line_Buffer (Line_Buffer'First .. Buffer_Last) & ','); + end; + + Line_Buffer (Prefix'Length + 1 .. Prefix'Length + 7) := "Hash =>"; + Buffer_Last := Prefix'Length + 7; + Append_Entity (Line_Buffer, Buffer_Last, Hash_Image & ");"); + Put_Line (Line_Buffer (Line_Buffer'First .. Buffer_Last)); + end Print_Dictionary_In_Ada; + procedure Read_List (List : out String_Lists.List; Descriptor : in out S_Expressions.Descriptor'Class) is Index: src/natools-smaz-tools.ads ================================================================== --- src/natools-smaz-tools.ads +++ src/natools-smaz-tools.ads @@ -43,6 +43,22 @@ Ada.Containers.Count_Type (Ada.Streams.Stream_Element'Last); -- Build a Dictionary object from a string list -- Note that Hash is set to a placeholder which uncinditionnally -- raises Program_Error when called. + generic + with procedure Put_Line (Line : String); + procedure Print_Dictionary_In_Ada + (Dict : in Dictionary; + Hash_Image : in String := "TODO"; + Max_Width : in Positive := 70; + First_Prefix : in String := " := ("; + Prefix : in String := " "; + Half_Indent : in String := " "); + -- Output Ada code corresponding to the value of the dictionary. + -- Note that Prefix is the actual base indentation, while Half_Indent + -- is added beyond Prefix before values continued on another line. + -- Frist_Prefix is used instead of Prefix on the first line. + -- All the defaults value are what was used to generate the constant + -- in Natools.Smaz.Original. + end Natools.Smaz.Tools;