gcc/ada/g-spitbo.ads

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