Package Name: gnat.spitbol

Return to: Package List


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT LIBRARY COMPONENTS                          --
--                                                                          --
--                         G N A T . S P I T B O L                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 1.14 $                             --
--                                                                          --
--                  Copyright (C) 1997, Robert B.K. Dewar                   --
--                                                                          --
-- 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 was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --

------------------------------------------------------------------------------
--  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.

--  The translation is not exact, but the algorithmic approach is 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-stunst.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 S is greater than or equal to Len, then S is returned
   --  unchanged. Otherwise, The value returned is obtained by concatenating

   --  Length (S) - 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 S.
   function Reverse_String (Str : VString) return VString;
   function Reverse_String (Str : String)  return VString;
   --  Returns result of reversing the string, 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 S.
   function Rpad
     (Str  : VString;
      Len  : Natural;
      Pad  : Character := ' ')
      return VString;
   function Rpad
     (Str  : String;
      Len  : Natural;
      Pad  : Character := ' ')
      return VString;
   --  If the length of S is greater than or equal to Len, then S is returned
   --  unchanged. Otherwise, The value returned is obtained by concatenating

   --  Length (S) - 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 S.
   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.
   procedure Trim (Str : in out VString);
   --  The procedure form is identical to the function form, except that the

   --  result overwrites the input argument S.
   -----------------------
   -- 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;
      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;