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-2019, 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 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 394end GNAT.Spitbol; 395