blob: 7d375be9acd192055c02fc12c7ac7ce78629b0fc [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- G N A T . S P I T B O L --
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2023, AdaCore --
-- --
-- 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- 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;
-- 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. Index_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 : 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);
overriding 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.
overriding 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;