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