diff options
Diffstat (limited to 'gcc/ada/g-spitbo.ads')
| -rw-r--r-- | gcc/ada/g-spitbo.ads | 403 |
1 files changed, 403 insertions, 0 deletions
diff --git a/gcc/ada/g-spitbo.ads b/gcc/ada/g-spitbo.ads new file mode 100644 index 00000000000..ebf2620e156 --- /dev/null +++ b/gcc/ada/g-spitbo.ads @@ -0,0 +1,403 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT LIBRARY COMPONENTS -- +-- -- +-- G N A T . S P I T B O L -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.18 $ -- +-- -- +-- Copyright (C) 1997-1999 Ada Core Technologies, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- SPITBOL-like interface facilities + +-- This package provides a set of interfaces to semantic operations copied +-- from SPITBOL, including a complete implementation of SPITBOL pattern +-- matching. The code is derived from the original SPITBOL MINIMAL sources, +-- created by Robert Dewar. The translation is not exact, but the +-- algorithmic approaches are similar. + +with Ada.Finalization; use Ada.Finalization; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Interfaces; use Interfaces; + +package GNAT.Spitbol is +pragma Preelaborate (Spitbol); + + -- The Spitbol package relies heavily on the Unbounded_String package, + -- using the synonym VString for variable length string. The following + -- declarations define this type and other useful abbreviations. + + subtype VString is Ada.Strings.Unbounded.Unbounded_String; + + function V (Source : String) return VString + renames Ada.Strings.Unbounded.To_Unbounded_String; + + function S (Source : VString) return String + renames Ada.Strings.Unbounded.To_String; + + Nul : VString renames Ada.Strings.Unbounded.Null_Unbounded_String; + + ------------------------- + -- Facilities Provided -- + ------------------------- + + -- The SPITBOL support in GNAT consists of this package together with + -- several child packages. In this package, we have first a set of + -- useful string functions, copied exactly from the corresponding + -- SPITBOL functions, except that we had to rename REVERSE because + -- reverse is a reserved word (it is now Reverse_String). + + -- The second element of the parent package is a generic implementation + -- of a table facility. In SPITBOL, the TABLE function allows general + -- mappings from any datatype to any other datatype, and of course, as + -- always, we can freely mix multiple types in the same table. + + -- The Ada version of tables is strongly typed, so the indexing type and + -- the range type are always of a consistent type. In this implementation + -- we only provide VString as an indexing type, since this is by far the + -- most common case. The generic instantiation specifies the range type + -- to be used. + + -- Three child packages provide standard instantiations of this table + -- package for three common datatypes: + + -- GNAT.Spitbol.Table_Boolean (file g-sptabo.ads) + + -- The range type is Boolean. The default value is False. This + -- means that this table is essentially a representation of a set. + + -- GNAT.Spitbol.Table_Integer (file g-sptain.ads) + + -- The range type is Integer. The default value is Integer'First. + -- This provides a general mapping from strings to integers. + + -- GNAT.Spitbol.Table_VString (file g-sptavs.ads) + + -- The range type is VString. The default value is the null string. + -- This provides a general mapping from strings to strings. + + -- Finally there is another child package: + + -- GNAT.Spitbol.Patterns (file g-spipat.ads) + + -- This child package provides a complete implementation of SPITBOL + -- pattern matching. The spec contains a complete tutorial on the + -- use of pattern matching. + + --------------------------------- + -- Standard String Subprograms -- + --------------------------------- + + -- This section contains some operations on unbounded strings that are + -- closely related to those in the package Unbounded.Strings, but they + -- correspond to the SPITBOL semantics for these operations. + + function Char (Num : Natural) return Character; + pragma Inline (Char); + -- Equivalent to Character'Val (Num) + + function Lpad + (Str : VString; + Len : Natural; + Pad : Character := ' ') + return VString; + function Lpad + (Str : String; + Len : Natural; + Pad : Character := ' ') + return VString; + -- If the length of Str is greater than or equal to Len, then Str is + -- returned unchanged. Otherwise, The value returned is obtained by + -- concatenating Length (Str) - Len instances of the Pad character to + -- the left hand side. + + procedure Lpad + (Str : in out VString; + Len : Natural; + Pad : Character := ' '); + -- The procedure form is identical to the function form, except that + -- the result overwrites the input argument Str. + + function Reverse_String (Str : VString) return VString; + function Reverse_String (Str : String) return VString; + -- Returns result of reversing the string Str, i.e. the result returned + -- is a mirror image (end-for-end reversal) of the input string. + + procedure Reverse_String (Str : in out VString); + -- The procedure form is identical to the function form, except that the + -- result overwrites the input argument Str. + + function Rpad + (Str : VString; + Len : Natural; + Pad : Character := ' ') + return VString; + function Rpad + (Str : String; + Len : Natural; + Pad : Character := ' ') + return VString; + -- If the length of Str is greater than or equal to Len, then Str is + -- returned unchanged. Otherwise, The value returned is obtained by + -- concatenating Length (Str) - Len instances of the Pad character to + -- the right hand side. + + procedure Rpad + (Str : in out VString; + Len : Natural; + Pad : Character := ' '); + -- The procedure form is identical to the function form, except that the + -- result overwrites the input argument Str. + + function Size (Source : VString) return Natural + renames Ada.Strings.Unbounded.Length; + + function Substr + (Str : VString; + Start : Positive; + Len : Natural) + return VString; + function Substr + (Str : String; + Start : Positive; + Len : Natural) + return VString; + -- Returns the substring starting at the given character position (which + -- is always counted from the start of the string, regardless of bounds, + -- e.g. 2 means starting with the second character of the string), and + -- with the length (Len) given. Indexing_Error is raised if the starting + -- position is out of range, and Length_Error is raised if Len is too long. + + function Trim (Str : VString) return VString; + function Trim (Str : String) return VString; + -- Returns the string obtained by removing all spaces from the right + -- hand side of the string Str. + + procedure Trim (Str : in out VString); + -- The procedure form is identical to the function form, except that the + -- result overwrites the input argument Str. + + ----------------------- + -- Utility Functions -- + ----------------------- + + -- In SPITBOL, integer values can be freely treated as strings. The + -- following definitions help provide some of this capability in + -- some common cases. + + function "&" (Num : Integer; Str : String) return String; + function "&" (Str : String; Num : Integer) return String; + function "&" (Num : Integer; Str : VString) return VString; + function "&" (Str : VString; Num : Integer) return VString; + -- In all these concatenation operations, the integer is converted to + -- its corresponding decimal string form, with no leading blank. + + function S (Num : Integer) return String; + function V (Num : Integer) return VString; + -- These operators return the given integer converted to its decimal + -- string form with no leading blank. + + function N (Str : VString) return Integer; + -- Converts string to number (same as Integer'Value (S (Str))) + + ------------------- + -- Table Support -- + ------------------- + + -- So far, we only provide support for tables whose indexing data values + -- are strings (or unbounded strings). The values stored may be of any + -- type, as supplied by the generic formal parameter. + + generic + + type Value_Type is private; + -- Any non-limited type can be used as the value type in the table + + Null_Value : Value_Type; + -- Value used to represent a value that is not present in the table. + + with function Img (A : Value_Type) return String; + -- Used to provide image of value in Dump procedure + + with function "=" (A, B : Value_Type) return Boolean is <>; + -- This allows a user-defined equality function to override the + -- predefined equality function. + + package Table is + + ------------------------ + -- Table Declarations -- + ------------------------ + + type Table (N : Unsigned_32) is private; + -- This is the table type itself. A table is a mapping from string + -- values to values of Value_Type. The discriminant is an estimate of + -- the number of values in the table. If the estimate is much too + -- high, some space is wasted, if the estimate is too low, access to + -- table elements is slowed down. The type Table has copy semantics, + -- not reference semantics. This means that if a table is copied + -- using simple assignment, then the two copies refer to entirely + -- separate tables. + + ----------------------------- + -- Table Access Operations -- + ----------------------------- + + function Get (T : Table; Name : VString) return Value_Type; + function Get (T : Table; Name : Character) return Value_Type; + pragma Inline (Get); + function Get (T : Table; Name : String) return Value_Type; + + -- If an entry with the given name exists in the table, then the + -- corresponding Value_Type value is returned. Otherwise Null_Value + -- is returned. + + function Present (T : Table; Name : VString) return Boolean; + function Present (T : Table; Name : Character) return Boolean; + pragma Inline (Present); + function Present (T : Table; Name : String) return Boolean; + -- Determines if an entry with the given name is present in the table. + -- A returned value of True means that it is in the table, otherwise + -- False indicates that it is not in the table. + + procedure Delete (T : in out Table; Name : VString); + procedure Delete (T : in out Table; Name : Character); + pragma Inline (Delete); + procedure Delete (T : in out Table; Name : String); + -- Deletes the table element with the given name from the table. If + -- no element in the table has this name, then the call has no effect. + + procedure Set (T : in out Table; Name : VString; Value : Value_Type); + procedure Set (T : in out Table; Name : Character; Value : Value_Type); + pragma Inline (Set); + procedure Set (T : in out Table; Name : String; Value : Value_Type); + -- Sets the value of the element with the given name to the given + -- value. If Value is equal to Null_Value, the effect is to remove + -- the entry from the table. If no element with the given name is + -- currently in the table, then a new element with the given value + -- is created. + + ---------------------------- + -- Allocation and Copying -- + ---------------------------- + + -- Table is a controlled type, so that all storage associated with + -- tables is properly reclaimed when a Table value is abandoned. + -- Tables have value semantics rather than reference semantics as + -- in Spitbol, i.e. when you assign a copy you end up with two + -- distinct copies of the table, as though COPY had been used in + -- Spitbol. It seems clearly more appropriate in Ada to require + -- the use of explicit pointers for reference semantics. + + procedure Clear (T : in out Table); + -- Clears all the elements of the given table, freeing associated + -- storage. On return T is an empty table with no elements. + + procedure Copy (From : in Table; To : in out Table); + -- First all the elements of table To are cleared (as described for + -- the Clear procedure above), then all the elements of table From + -- are copied into To. In the case where the tables From and To have + -- the same declared size (i.e. the same discriminant), the call to + -- Copy has the same effect as the assignment of From to To. The + -- difference is that, unlike the assignment statement, which will + -- cause a Constraint_Error if the source and target are of different + -- sizes, Copy works fine with different sized tables. + + ---------------- + -- Conversion -- + ---------------- + + type Table_Entry is record + Name : VString; + Value : Value_Type; + end record; + + type Table_Array is array (Positive range <>) of Table_Entry; + + function Convert_To_Array (T : Table) return Table_Array; + -- Returns a Table_Array value with a low bound of 1, and a length + -- corresponding to the number of elements in the table. The elements + -- of the array give the elements of the table in unsorted order. + + --------------- + -- Debugging -- + --------------- + + procedure Dump (T : Table; Str : String := "Table"); + -- Dump contents of given table to the standard output file. The + -- string value Str is used as the name of the table in the dump. + + procedure Dump (T : Table_Array; Str : String := "Table_Array"); + -- Dump contents of given table array to the current output file. The + -- string value Str is used as the name of the table array in the dump. + + private + + ------------------ + -- Private Part -- + ------------------ + + -- A Table is a pointer to a hash table which contains the indicated + -- number of hash elements (the number is forced to the next odd value + -- if it is even to improve hashing performance). If more than one + -- of the entries in a table hashes to the same slot, the Next field + -- is used to chain entries from the header. The chains are not kept + -- ordered. A chain is terminated by a null pointer in Next. An unused + -- chain is marked by an element whose Name is null and whose value + -- is Null_Value. + + type Hash_Element; + type Hash_Element_Ptr is access all Hash_Element; + + type Hash_Element is record + Name : String_Access := null; + Value : Value_Type := Null_Value; + Next : Hash_Element_Ptr := null; + end record; + + type Hash_Table is + array (Unsigned_32 range <>) of aliased Hash_Element; + + type Table (N : Unsigned_32) is new Controlled with record + Elmts : Hash_Table (1 .. N); + end record; + + pragma Finalize_Storage_Only (Table); + + procedure Adjust (Object : in out Table); + -- The Adjust procedure does a deep copy of the table structure + -- so that the effect of assignment is, like other assignments + -- in Ada, value-oriented. + + procedure Finalize (Object : in out Table); + -- This is the finalization routine that ensures that all storage + -- associated with a table is properly released when a table object + -- is abandoned and finalized. + + end Table; + +end GNAT.Spitbol; |