]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T . S P I T B O L -- | |
6 | -- -- | |
7 | -- S p e c -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1997-2020, AdaCore -- |
38cbfe40 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
607d0635 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
38cbfe40 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
607d0635 AC |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
38cbfe40 | 26 | -- -- |
fbf5a39b AC |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
38cbfe40 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | -- SPITBOL-like interface facilities | |
33 | ||
34 | -- This package provides a set of interfaces to semantic operations copied | |
35 | -- from SPITBOL, including a complete implementation of SPITBOL pattern | |
36 | -- matching. The code is derived from the original SPITBOL MINIMAL sources, | |
37 | -- created by Robert Dewar. The translation is not exact, but the | |
38 | -- algorithmic approaches are similar. | |
39 | ||
40 | with Ada.Finalization; use Ada.Finalization; | |
41 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; | |
42 | with Interfaces; use Interfaces; | |
43 | ||
44 | package GNAT.Spitbol is | |
009186e0 | 45 | pragma Preelaborate; |
38cbfe40 RK |
46 | |
47 | -- The Spitbol package relies heavily on the Unbounded_String package, | |
48 | -- using the synonym VString for variable length string. The following | |
49 | -- declarations define this type and other useful abbreviations. | |
50 | ||
51 | subtype VString is Ada.Strings.Unbounded.Unbounded_String; | |
52 | ||
53 | function V (Source : String) return VString | |
54 | renames Ada.Strings.Unbounded.To_Unbounded_String; | |
55 | ||
56 | function S (Source : VString) return String | |
57 | renames Ada.Strings.Unbounded.To_String; | |
58 | ||
59 | Nul : VString renames Ada.Strings.Unbounded.Null_Unbounded_String; | |
60 | ||
61 | ------------------------- | |
62 | -- Facilities Provided -- | |
63 | ------------------------- | |
64 | ||
65 | -- The SPITBOL support in GNAT consists of this package together with | |
66 | -- several child packages. In this package, we have first a set of | |
67 | -- useful string functions, copied exactly from the corresponding | |
68 | -- SPITBOL functions, except that we had to rename REVERSE because | |
69 | -- reverse is a reserved word (it is now Reverse_String). | |
70 | ||
71 | -- The second element of the parent package is a generic implementation | |
72 | -- of a table facility. In SPITBOL, the TABLE function allows general | |
73 | -- mappings from any datatype to any other datatype, and of course, as | |
74 | -- always, we can freely mix multiple types in the same table. | |
75 | ||
76 | -- The Ada version of tables is strongly typed, so the indexing type and | |
77 | -- the range type are always of a consistent type. In this implementation | |
78 | -- we only provide VString as an indexing type, since this is by far the | |
79 | -- most common case. The generic instantiation specifies the range type | |
80 | -- to be used. | |
81 | ||
82 | -- Three child packages provide standard instantiations of this table | |
83 | -- package for three common datatypes: | |
84 | ||
85 | -- GNAT.Spitbol.Table_Boolean (file g-sptabo.ads) | |
86 | ||
87 | -- The range type is Boolean. The default value is False. This | |
88 | -- means that this table is essentially a representation of a set. | |
89 | ||
90 | -- GNAT.Spitbol.Table_Integer (file g-sptain.ads) | |
91 | ||
92 | -- The range type is Integer. The default value is Integer'First. | |
93 | -- This provides a general mapping from strings to integers. | |
94 | ||
95 | -- GNAT.Spitbol.Table_VString (file g-sptavs.ads) | |
96 | ||
97 | -- The range type is VString. The default value is the null string. | |
98 | -- This provides a general mapping from strings to strings. | |
99 | ||
100 | -- Finally there is another child package: | |
101 | ||
102 | -- GNAT.Spitbol.Patterns (file g-spipat.ads) | |
103 | ||
104 | -- This child package provides a complete implementation of SPITBOL | |
105 | -- pattern matching. The spec contains a complete tutorial on the | |
106 | -- use of pattern matching. | |
107 | ||
108 | --------------------------------- | |
109 | -- Standard String Subprograms -- | |
110 | --------------------------------- | |
111 | ||
112 | -- This section contains some operations on unbounded strings that are | |
113 | -- closely related to those in the package Unbounded.Strings, but they | |
114 | -- correspond to the SPITBOL semantics for these operations. | |
115 | ||
116 | function Char (Num : Natural) return Character; | |
117 | pragma Inline (Char); | |
118 | -- Equivalent to Character'Val (Num) | |
119 | ||
120 | function Lpad | |
2f388d2d RD |
121 | (Str : VString; |
122 | Len : Natural; | |
123 | Pad : Character := ' ') return VString; | |
38cbfe40 | 124 | function Lpad |
2f388d2d RD |
125 | (Str : String; |
126 | Len : Natural; | |
127 | Pad : Character := ' ') return VString; | |
38cbfe40 RK |
128 | -- If the length of Str is greater than or equal to Len, then Str is |
129 | -- returned unchanged. Otherwise, The value returned is obtained by | |
130 | -- concatenating Length (Str) - Len instances of the Pad character to | |
131 | -- the left hand side. | |
132 | ||
133 | procedure Lpad | |
134 | (Str : in out VString; | |
135 | Len : Natural; | |
136 | Pad : Character := ' '); | |
137 | -- The procedure form is identical to the function form, except that | |
138 | -- the result overwrites the input argument Str. | |
139 | ||
140 | function Reverse_String (Str : VString) return VString; | |
141 | function Reverse_String (Str : String) return VString; | |
142 | -- Returns result of reversing the string Str, i.e. the result returned | |
143 | -- is a mirror image (end-for-end reversal) of the input string. | |
144 | ||
145 | procedure Reverse_String (Str : in out VString); | |
146 | -- The procedure form is identical to the function form, except that the | |
147 | -- result overwrites the input argument Str. | |
148 | ||
149 | function Rpad | |
2f388d2d RD |
150 | (Str : VString; |
151 | Len : Natural; | |
152 | Pad : Character := ' ') return VString; | |
38cbfe40 | 153 | function Rpad |
2f388d2d RD |
154 | (Str : String; |
155 | Len : Natural; | |
156 | Pad : Character := ' ') return VString; | |
38cbfe40 RK |
157 | -- If the length of Str is greater than or equal to Len, then Str is |
158 | -- returned unchanged. Otherwise, The value returned is obtained by | |
159 | -- concatenating Length (Str) - Len instances of the Pad character to | |
160 | -- the right hand side. | |
161 | ||
162 | procedure Rpad | |
163 | (Str : in out VString; | |
164 | Len : Natural; | |
165 | Pad : Character := ' '); | |
166 | -- The procedure form is identical to the function form, except that the | |
167 | -- result overwrites the input argument Str. | |
168 | ||
169 | function Size (Source : VString) return Natural | |
170 | renames Ada.Strings.Unbounded.Length; | |
171 | ||
172 | function Substr | |
173 | (Str : VString; | |
174 | Start : Positive; | |
2f388d2d | 175 | Len : Natural) return VString; |
38cbfe40 RK |
176 | function Substr |
177 | (Str : String; | |
178 | Start : Positive; | |
2f388d2d | 179 | Len : Natural) return VString; |
38cbfe40 RK |
180 | -- Returns the substring starting at the given character position (which |
181 | -- is always counted from the start of the string, regardless of bounds, | |
182 | -- e.g. 2 means starting with the second character of the string), and | |
473e20df | 183 | -- with the length (Len) given. Index_Error is raised if the starting |
38cbfe40 RK |
184 | -- position is out of range, and Length_Error is raised if Len is too long. |
185 | ||
186 | function Trim (Str : VString) return VString; | |
187 | function Trim (Str : String) return VString; | |
188 | -- Returns the string obtained by removing all spaces from the right | |
189 | -- hand side of the string Str. | |
190 | ||
191 | procedure Trim (Str : in out VString); | |
192 | -- The procedure form is identical to the function form, except that the | |
193 | -- result overwrites the input argument Str. | |
194 | ||
195 | ----------------------- | |
196 | -- Utility Functions -- | |
197 | ----------------------- | |
198 | ||
199 | -- In SPITBOL, integer values can be freely treated as strings. The | |
200 | -- following definitions help provide some of this capability in | |
201 | -- some common cases. | |
202 | ||
203 | function "&" (Num : Integer; Str : String) return String; | |
204 | function "&" (Str : String; Num : Integer) return String; | |
205 | function "&" (Num : Integer; Str : VString) return VString; | |
206 | function "&" (Str : VString; Num : Integer) return VString; | |
207 | -- In all these concatenation operations, the integer is converted to | |
208 | -- its corresponding decimal string form, with no leading blank. | |
209 | ||
210 | function S (Num : Integer) return String; | |
211 | function V (Num : Integer) return VString; | |
212 | -- These operators return the given integer converted to its decimal | |
213 | -- string form with no leading blank. | |
214 | ||
215 | function N (Str : VString) return Integer; | |
216 | -- Converts string to number (same as Integer'Value (S (Str))) | |
217 | ||
218 | ------------------- | |
219 | -- Table Support -- | |
220 | ------------------- | |
221 | ||
222 | -- So far, we only provide support for tables whose indexing data values | |
223 | -- are strings (or unbounded strings). The values stored may be of any | |
224 | -- type, as supplied by the generic formal parameter. | |
225 | ||
226 | generic | |
227 | ||
228 | type Value_Type is private; | |
229 | -- Any non-limited type can be used as the value type in the table | |
230 | ||
231 | Null_Value : Value_Type; | |
009186e0 | 232 | -- Value used to represent a value that is not present in the table |
38cbfe40 RK |
233 | |
234 | with function Img (A : Value_Type) return String; | |
235 | -- Used to provide image of value in Dump procedure | |
236 | ||
237 | with function "=" (A, B : Value_Type) return Boolean is <>; | |
238 | -- This allows a user-defined equality function to override the | |
239 | -- predefined equality function. | |
240 | ||
241 | package Table is | |
242 | ||
243 | ------------------------ | |
244 | -- Table Declarations -- | |
245 | ------------------------ | |
246 | ||
247 | type Table (N : Unsigned_32) is private; | |
248 | -- This is the table type itself. A table is a mapping from string | |
249 | -- values to values of Value_Type. The discriminant is an estimate of | |
250 | -- the number of values in the table. If the estimate is much too | |
251 | -- high, some space is wasted, if the estimate is too low, access to | |
252 | -- table elements is slowed down. The type Table has copy semantics, | |
253 | -- not reference semantics. This means that if a table is copied | |
254 | -- using simple assignment, then the two copies refer to entirely | |
255 | -- separate tables. | |
256 | ||
257 | ----------------------------- | |
258 | -- Table Access Operations -- | |
259 | ----------------------------- | |
260 | ||
261 | function Get (T : Table; Name : VString) return Value_Type; | |
262 | function Get (T : Table; Name : Character) return Value_Type; | |
263 | pragma Inline (Get); | |
264 | function Get (T : Table; Name : String) return Value_Type; | |
265 | ||
266 | -- If an entry with the given name exists in the table, then the | |
267 | -- corresponding Value_Type value is returned. Otherwise Null_Value | |
268 | -- is returned. | |
269 | ||
270 | function Present (T : Table; Name : VString) return Boolean; | |
271 | function Present (T : Table; Name : Character) return Boolean; | |
272 | pragma Inline (Present); | |
273 | function Present (T : Table; Name : String) return Boolean; | |
274 | -- Determines if an entry with the given name is present in the table. | |
275 | -- A returned value of True means that it is in the table, otherwise | |
276 | -- False indicates that it is not in the table. | |
277 | ||
278 | procedure Delete (T : in out Table; Name : VString); | |
279 | procedure Delete (T : in out Table; Name : Character); | |
280 | pragma Inline (Delete); | |
281 | procedure Delete (T : in out Table; Name : String); | |
282 | -- Deletes the table element with the given name from the table. If | |
283 | -- no element in the table has this name, then the call has no effect. | |
284 | ||
285 | procedure Set (T : in out Table; Name : VString; Value : Value_Type); | |
286 | procedure Set (T : in out Table; Name : Character; Value : Value_Type); | |
287 | pragma Inline (Set); | |
288 | procedure Set (T : in out Table; Name : String; Value : Value_Type); | |
289 | -- Sets the value of the element with the given name to the given | |
290 | -- value. If Value is equal to Null_Value, the effect is to remove | |
291 | -- the entry from the table. If no element with the given name is | |
292 | -- currently in the table, then a new element with the given value | |
293 | -- is created. | |
294 | ||
295 | ---------------------------- | |
296 | -- Allocation and Copying -- | |
297 | ---------------------------- | |
298 | ||
299 | -- Table is a controlled type, so that all storage associated with | |
300 | -- tables is properly reclaimed when a Table value is abandoned. | |
301 | -- Tables have value semantics rather than reference semantics as | |
302 | -- in Spitbol, i.e. when you assign a copy you end up with two | |
303 | -- distinct copies of the table, as though COPY had been used in | |
304 | -- Spitbol. It seems clearly more appropriate in Ada to require | |
305 | -- the use of explicit pointers for reference semantics. | |
306 | ||
307 | procedure Clear (T : in out Table); | |
308 | -- Clears all the elements of the given table, freeing associated | |
309 | -- storage. On return T is an empty table with no elements. | |
310 | ||
0ae9f22f | 311 | procedure Copy (From : Table; To : in out Table); |
38cbfe40 RK |
312 | -- First all the elements of table To are cleared (as described for |
313 | -- the Clear procedure above), then all the elements of table From | |
314 | -- are copied into To. In the case where the tables From and To have | |
315 | -- the same declared size (i.e. the same discriminant), the call to | |
316 | -- Copy has the same effect as the assignment of From to To. The | |
317 | -- difference is that, unlike the assignment statement, which will | |
318 | -- cause a Constraint_Error if the source and target are of different | |
319 | -- sizes, Copy works fine with different sized tables. | |
320 | ||
321 | ---------------- | |
322 | -- Conversion -- | |
323 | ---------------- | |
324 | ||
325 | type Table_Entry is record | |
326 | Name : VString; | |
327 | Value : Value_Type; | |
328 | end record; | |
329 | ||
330 | type Table_Array is array (Positive range <>) of Table_Entry; | |
331 | ||
332 | function Convert_To_Array (T : Table) return Table_Array; | |
333 | -- Returns a Table_Array value with a low bound of 1, and a length | |
334 | -- corresponding to the number of elements in the table. The elements | |
335 | -- of the array give the elements of the table in unsorted order. | |
336 | ||
337 | --------------- | |
338 | -- Debugging -- | |
339 | --------------- | |
340 | ||
341 | procedure Dump (T : Table; Str : String := "Table"); | |
342 | -- Dump contents of given table to the standard output file. The | |
343 | -- string value Str is used as the name of the table in the dump. | |
344 | ||
345 | procedure Dump (T : Table_Array; Str : String := "Table_Array"); | |
346 | -- Dump contents of given table array to the current output file. The | |
347 | -- string value Str is used as the name of the table array in the dump. | |
348 | ||
349 | private | |
350 | ||
351 | ------------------ | |
352 | -- Private Part -- | |
353 | ------------------ | |
354 | ||
355 | -- A Table is a pointer to a hash table which contains the indicated | |
356 | -- number of hash elements (the number is forced to the next odd value | |
357 | -- if it is even to improve hashing performance). If more than one | |
358 | -- of the entries in a table hashes to the same slot, the Next field | |
359 | -- is used to chain entries from the header. The chains are not kept | |
360 | -- ordered. A chain is terminated by a null pointer in Next. An unused | |
361 | -- chain is marked by an element whose Name is null and whose value | |
362 | -- is Null_Value. | |
363 | ||
364 | type Hash_Element; | |
365 | type Hash_Element_Ptr is access all Hash_Element; | |
366 | ||
367 | type Hash_Element is record | |
368 | Name : String_Access := null; | |
369 | Value : Value_Type := Null_Value; | |
370 | Next : Hash_Element_Ptr := null; | |
371 | end record; | |
372 | ||
373 | type Hash_Table is | |
374 | array (Unsigned_32 range <>) of aliased Hash_Element; | |
375 | ||
376 | type Table (N : Unsigned_32) is new Controlled with record | |
377 | Elmts : Hash_Table (1 .. N); | |
378 | end record; | |
379 | ||
380 | pragma Finalize_Storage_Only (Table); | |
381 | ||
7504523e | 382 | overriding procedure Adjust (Object : in out Table); |
38cbfe40 RK |
383 | -- The Adjust procedure does a deep copy of the table structure |
384 | -- so that the effect of assignment is, like other assignments | |
385 | -- in Ada, value-oriented. | |
386 | ||
7504523e | 387 | overriding procedure Finalize (Object : in out Table); |
38cbfe40 RK |
388 | -- This is the finalization routine that ensures that all storage |
389 | -- associated with a table is properly released when a table object | |
390 | -- is abandoned and finalized. | |
391 | ||
392 | end Table; | |
393 | ||
394 | end GNAT.Spitbol; |