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-2012, 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
40with Ada.Finalization;      use Ada.Finalization;
41with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
42with Interfaces;            use Interfaces;
43
44package 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      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      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
394end GNAT.Spitbol;
395