Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/g-spitbo.ads @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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 -- --
9 -- Copyright (C) 1997-2017, AdaCore --
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- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
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 --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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
45 pragma Preelaborate;
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
121 (Str : VString;
122 Len : Natural;
123 Pad : Character := ' ') return VString;
124 function Lpad
125 (Str : String;
126 Len : Natural;
127 Pad : Character := ' ') return VString;
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
150 (Str : VString;
151 Len : Natural;
152 Pad : Character := ' ') return VString;
153 function Rpad
154 (Str : String;
155 Len : Natural;
156 Pad : Character := ' ') return VString;
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;
175 Len : Natural) return VString;
176 function Substr
177 (Str : String;
178 Start : Positive;
179 Len : Natural) return VString;
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
183 -- with the length (Len) given. Index_Error is raised if the starting
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;
232 -- Value used to represent a value that is not present in the table
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
311 procedure Copy (From : Table; To : in out Table);
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
382 overriding procedure Adjust (Object : in out Table);
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
387 overriding procedure Finalize (Object : in out Table);
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;