Natools

Check-in [e2088218f7]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:natools-accumulators-string_accumulator_linked_lists: simple implementation of String_Accumulator_Stack
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e2088218f7b379405e8d71879f7cd5f3168758e4
User & Date: nat on 2011-11-29 14:13:16
Other Links: manifest | tags
Context
2011-11-29
14:39
natools-chunked_strings: new package for efficient storage and append on large strings check-in: 99dd3c799b user: nat tags: trunk
14:13
natools-accumulators-string_accumulator_linked_lists: simple implementation of String_Accumulator_Stack check-in: e2088218f7 user: nat tags: trunk
13:31
natools-accumulators: new set of interfaces for data accumulation check-in: 43826b6a6a user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added natools-accumulators-string_accumulator_linked_lists.adb version [d55ef85caa]. 


























































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
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 version [9a3f72fc75].




























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47