ADDED natools-accumulators-string_accumulator_linked_lists.adb Index: natools-accumulators-string_accumulator_linked_lists.adb ================================================================== --- natools-accumulators-string_accumulator_linked_lists.adb +++ natools-accumulators-string_accumulator_linked_lists.adb @@ -0,0 +1,216 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +package body Natools.Accumulators.String_Accumulator_Linked_Lists is + + procedure Initialize_If_Needed + (Object : in out String_Accumulator_Linked_List) is + begin + if Object.Stack.Is_Empty then + Object.Stack.Append (Object.Build (1)); + Object.Position := Object.Stack.Last; + end if; + end Initialize_If_Needed; + + + + procedure Append (To : in out String_Accumulator_Linked_List; + Text : String) + is + procedure Process (Element : in out String_Accumulator'Class); + + procedure Process (Element : in out String_Accumulator'Class) is + begin + Element.Append (Text); + end Process; + begin + Initialize_If_Needed (To); + To.Stack.Update_Element (To.Position, Process'Access); + end Append; + + + + procedure Hard_Reset (Acc : in out String_Accumulator_Linked_List) is + begin + Acc.Stack.Clear; + Acc.Position := Lists.No_Element; + end Hard_Reset; + + + + function Length (Acc : String_Accumulator_Linked_List) return Natural is + procedure Process (Element : String_Accumulator'Class); + + Result : Natural; + + procedure Process (Element : String_Accumulator'Class) is + begin + Result := Element.Length; + end Process; + begin + if Acc.Stack.Is_Empty then + return 0; + else + Lists.Query_Element (Acc.Position, Process'Access); + return Result; + end if; + end Length; + + + + procedure Push (Acc : in out String_Accumulator_Linked_List) is + procedure Process (Element : in out String_Accumulator'Class); + + use type Lists.Cursor; + + procedure Process (Element : in out String_Accumulator'Class) is + begin + Soft_Reset (Element); + end Process; + begin + Initialize_If_Needed (Acc); + Lists.Next (Acc.Position); + if Acc.Position = Lists.No_Element then + declare + Level_Created : constant Positive + := Natural (Acc.Stack.Length) + 1; + begin + Acc.Stack.Append (Acc.Build (Level_Created)); + Acc.Position := Acc.Stack.Last; + end; + else + Acc.Stack.Update_Element (Acc.Position, Process'Access); + end if; + end Push; + + + + procedure Pop (Acc : in out String_Accumulator_Linked_List) is + use type Lists.Cursor; + begin + if Acc.Stack.Is_Empty then + raise Program_Error; + end if; + Lists.Previous (Acc.Position); + if Acc.Position = Lists.No_Element then + Acc.Position := Lists.First (Acc.Stack); + raise Program_Error; + end if; + end Pop; + + + + procedure Soft_Reset (Acc : in out String_Accumulator_Linked_List) is + procedure Process (Element : in out String_Accumulator'Class); + + procedure Process (Element : in out String_Accumulator'Class) is + begin + Element.Soft_Reset; + end Process; + begin + Initialize_If_Needed (Acc); + Acc.Position := Lists.First (Acc.Stack); + Acc.Stack.Update_Element (Acc.Position, Process'Access); + end Soft_Reset; + + + + function Tail (Acc : String_Accumulator_Linked_List; Size : Natural) + return String + is + procedure Process (Element : String_Accumulator'Class); + + Result : String (1 .. Size); + Actual_Size : Natural; + + procedure Process (Element : String_Accumulator'Class) + is + Output : constant String := Tail (Element, Size); + begin + Actual_Size := Output'Length; + Result (1 .. Actual_Size) := Output; + end Process; + begin + if Acc.Stack.Is_Empty then + return ""; + else + Lists.Query_Element (Acc.Position, Process'Access); + return Result (1 .. Actual_Size); + end if; + end Tail; + + + + function To_String (Acc : String_Accumulator_Linked_List) return String is + begin + if Acc.Stack.Is_Empty then + return ""; + end if; + + declare + procedure Process (Element : String_Accumulator'Class); + + Result : String (1 .. Acc.Length); + + procedure Process (Element : String_Accumulator'Class) is + begin + Result := Element.To_String; + end Process; + begin + Lists.Query_Element (Acc.Position, Process'Access); + return Result; + end; + end To_String; + + + + procedure To_String (Acc : String_Accumulator_Linked_List; + Output : out String) is + begin + if Acc.Stack.Is_Empty then + return; + end if; + + declare + procedure Process (Element : String_Accumulator'Class); + + procedure Process (Element : String_Accumulator'Class) is + begin + Element.To_String (Output); + end Process; + begin + Lists.Query_Element (Acc.Position, Process'Access); + end; + end To_String; + + + + procedure Unappend (From : in out String_Accumulator_Linked_List; + Text : String) + is + procedure Process (Element : in out String_Accumulator'Class); + + procedure Process (Element : in out String_Accumulator'Class) is + begin + Element.Unappend (Text); + end Process; + begin + if not From.Stack.Is_Empty then + From.Stack.Update_Element (From.Position, Process'Access); + end if; + end Unappend; + +end Natools.Accumulators.String_Accumulator_Linked_Lists; ADDED natools-accumulators-string_accumulator_linked_lists.ads Index: natools-accumulators-string_accumulator_linked_lists.ads ================================================================== --- natools-accumulators-string_accumulator_linked_lists.ads +++ natools-accumulators-string_accumulator_linked_lists.ads @@ -0,0 +1,88 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2011, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Accumulators.String_Accumulator_Linked_Lists is a simple -- +-- implementation of String_Accumulator_Stack using an external function to -- +-- generate the String_Accumulator elements when the stack is grown. -- +------------------------------------------------------------------------------ + +private with Ada.Containers.Indefinite_Doubly_Linked_Lists; + +package Natools.Accumulators.String_Accumulator_Linked_Lists is + pragma Preelaborate (String_Accumulator_Linked_Lists); + + type String_Accumulator_Linked_List + (Build : not null access function (Depth : Positive) + return String_Accumulator'Class) + is new String_Accumulator_Stack with private; + + procedure Append (To : in out String_Accumulator_Linked_List; + Text : String); + -- Append the given String to the internal buffer + + procedure Hard_Reset (Acc : in out String_Accumulator_Linked_List); + -- Empty the internal buffer and free all possible memory + + function Length (Acc : String_Accumulator_Linked_List) return Natural; + -- Return the length of the internal buffer + + procedure Push (Acc : in out String_Accumulator_Linked_List); + -- Push the current internal buffer and start with an empty one + + procedure Pop (Acc : in out String_Accumulator_Linked_List); + -- Drop the current internal buffer and use the previsouly pushed one + -- instead + -- Raise Program_Error when trying to pop the last internal buffer + + procedure Soft_Reset (Acc : in out String_Accumulator_Linked_List); + -- Empty the internal buffer for reuse + + function Tail (Acc : String_Accumulator_Linked_List; Size : Natural) + return String; + -- Return the last characters from the internal buffer + + function To_String (Acc : String_Accumulator_Linked_List) return String; + -- Output the whole internal buffer as a String + + procedure To_String (Acc : String_Accumulator_Linked_List; + Output : out String); + -- Write the whole internal buffer into the String, which must be + -- large enough. + + procedure Unappend (From : in out String_Accumulator_Linked_List; + Text : String); + -- Remove the given suffix from the internal buffer + -- Do nothing if the given text is not a prefix the internal buffer + +private + + package Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists + (Element_Type => String_Accumulator'Class); + + type String_Accumulator_Linked_List + (Build : not null access function (Depth : Positive) + return String_Accumulator'Class) + is new String_Accumulator_Stack with + record + Stack : Lists.List; + Position : Lists.Cursor; + end record; + + procedure Initialize_If_Needed + (Object : in out String_Accumulator_Linked_List); + +end Natools.Accumulators.String_Accumulator_Linked_Lists;