Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/dstr2.ada

Text File | 1988-05-03 | 13.8 KB | 399 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : DYNAMIC_STRINGS
-- Version      : 1.0
-- Author       : Mike Linnig et al (see source)
--              : Texas Instruments Ada Technology Branch
--              : PO Box 801, MS 8007
--              : McKinney, TX  75069
-- DDN Address  : linnig%ti-eg at csnet-relay
-- Copyright    : (c)
-- Date created :  27 June 85
-- Release date :  27 June 85
-- Last update  :  27 June 85
-- Machine/System Compiled/Run on : DG MV 10000 with ROLM ADE
--                    DEC VAX 11/780 with DEC Ada
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  STRINGS, DYNAMIC STRINGS
----------------:
--
-- Abstract     : Dynamic_Strings is a generic package which
-- provides a set of routines to manipulate dynamic strings.
-- See the documentation in the source code for references
-- to magazine articles et al
--
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 19850627    1.0    Mike Linnig        Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------


GENERIC
  Max_Length : Positive := 256;

    -- should the package fail gracefully or raise an exception on errors
  Raise_Exception_On_Error : Boolean := False;

PACKAGE Dynamic_Strings IS

------------------------------------------------------------------------------
--  This is a package of several string manipulation functions based on     --
-- a built-in dynamic string type DYN_STRING.  It is an adaptation and      --
-- extension of the package proposed by Sylvan Rubin of Ford Aerospace and  --
-- Communications Corporation in the Nov/Dec 1984 issue of the Journal of   --
-- Pascal, Ada and Modula-2.  Some new functions have been added, the       --
-- SUBSTRING function has been modified to permit it to return the right    --
-- part of a string if the third parameter is permitted to default, and     --
-- much of the body code has been rewritten.                                --
------------------------------------------------------------------------------
-- R.G. Cleaveland 07 December 1984:                                        --
--  Implementation initially with the Telesoft Ada version                  --
-- This required definition of the DYN_STRING type without use of a         --
-- discriminant; an arbitrary maximum string length was chosen.  This       --
-- should be changed when an improved compiler is available.                --
------------------------------------------------------------------------------
-- Richard Powers 03 January 1985:                                          --
-- changed to be used with a real compiler.                                 --
-- Some of the routines removed by my whim.                                 --
------------------------------------------------------------------------------
-- Michael J. Linnig          04 Jan 1985                                   --
--  modified to reflect version published in Dec '84                        --
--  edition of Journal of Pascal, Ada and Modula-2                          --
--   (not all functions from original article reproduced here)              --
--  AND MADE IT GENERIC (to prevent need for dynamic allocation of strings) --
------------------------------------------------------------------------------


  TYPE Dyn_String IS PRIVATE;

  Null_Dstring    : CONSTANT Dyn_String;
  No_Match        : CONSTANT Integer := 0;     -- made constant in spite of
  No_Fit          : CONSTANT Integer := -1;    -- JPAM2 article - mjl

  String_Too_Short : EXCEPTION;
  Dynamic_String_Parameter_Error : EXCEPTION;
     -- raised if parameters make no sense

-----------------------------------------------------------------------------

  FUNCTION D_String (Char : Character) RETURN Dyn_String;
  -- Creates a one-byte dynamic string of contents CHAR.

  FUNCTION D_String (Str : String) RETURN Dyn_String;
  -- Creates a dynamic string of contents STR.

  FUNCTION Char (Dstr : Dyn_String) RETURN Character;
  FUNCTION Str  (Dstr : Dyn_String) RETURN String;

  FUNCTION Length (Dstr : Dyn_String) RETURN Natural;
  FUNCTION "<"    (Ds1, Ds2 : Dyn_String) RETURN Boolean;
  FUNCTION "&"    (Ds1, Ds2 : Dyn_String) RETURN Dyn_String;

  FUNCTION Substring (Dstr   : Dyn_String;
                      Start  : Natural;
                      Length : Natural := 0) RETURN Dyn_String;



  FUNCTION Index (Source_String,
                  Pattern_String : Dyn_String;
                  Start_Pos : Integer) RETURN Integer;

-- If the source string contains the pattern string starting at or AFTER
-- START_POSITION,  the position of such string is returned.



  FUNCTION Rindex (Source_String,
                   Pattern_String : Dyn_String;

                   Start_Pos                     : Integer) RETURN Integer;

-- If the source string contains the pattern string starting at or BEFORE
-- START_POSITION,  the position of such string is returned.

-----------------------------------------------------------------------
PRIVATE

  SUBTYPE String_range IS Natural RANGE 0 .. Max_Length;
  TYPE Internal_Dyn_String (Size : String_range := 0) IS
    RECORD
      Data : String (1 .. Size);
    END RECORD;

  TYPE Dyn_String IS
    RECORD
      Dstring : Internal_Dyn_String;
    END RECORD;

    Null_Dstring    : CONSTANT Dyn_String := (dstring=> (size=>0,
                                                         data=>""));



END Dynamic_Strings;

----------------------------------------------------------------------------

PACKAGE BODY Dynamic_Strings IS

  raise_exceptions : CONSTANT Boolean := Raise_Exception_on_Error;


  FUNCTION "&" (Ds1, Ds2 : Dyn_String) RETURN Dyn_String IS
  BEGIN
    RETURN (Dstring =>
              ((Ds1.Dstring.Size + Ds2.Dstring.Size),
               (Ds1.Dstring.Data & Ds2.Dstring.Data)));
  END "&";



  FUNCTION Length (Dstr : Dyn_String) RETURN Natural IS
  BEGIN
    RETURN Dstr.Dstring.Size;
  END Length;


  FUNCTION D_String (Char : Character) RETURN Dyn_String IS
  BEGIN
    RETURN (Dstring => (1, (1 => Char)));
  END D_String;

  FUNCTION D_String (Str : String) RETURN Dyn_String IS
    First, Last : Natural;
  BEGIN
    First := Str'First;                          -- should always be one -- mjl
    Last := Str'Last;
    RETURN (Dstring => (Last - First + 1, (Str (First .. Last))));
  END D_String;

  FUNCTION Char (Dstr : Dyn_String) RETURN Character IS
  BEGIN
    IF Dstr.Dstring.Size = 0 THEN
      If raise_exceptions then
        RAISE String_Too_Short;
      else
        RETURN Ascii.Nul;  -- fail gracefully
      end if;
    ELSE
      RETURN Dstr.Dstring.Data (1);
    END IF;
  END Char;

  FUNCTION Str (Dstr : Dyn_String) RETURN String IS
  BEGIN
    RETURN Dstr.Dstring.Data (1 .. Dstr.Dstring.Size);
  END Str;


  FUNCTION "<" (Ds1, Ds2 : Dyn_String) RETURN Boolean IS
-- this was not changed back to jpam2 implementation - mjl
  BEGIN
    IF Str (Ds1) < Str (Ds2) THEN
      RETURN (True);
    ELSE
      RETURN (False);
    END IF;
  END "<";

  FUNCTION Substring (Dstr   : Dyn_String;
                      Start  : Natural;
                      Length : Natural := 0) RETURN Dyn_String IS

  BEGIN
    IF (Start < 1)  THEN
      IF raise_Exceptions then
        RAISE Dynamic_String_Parameter_Error;
      Else
        RETURN SUBSTRING(dstr, 1, Length); -- assume start at 1st character
      End if;

    ELSIF   (Start > Dstr.Dstring.Size) THEN
      IF raise_Exceptions then
        RAISE Dynamic_String_Parameter_Error;
      Else
        RETURN Null_Dstring; -- since starting point beyond characters in str.
      End if;

    ELSIF Dstr.Dstring.Size < (Start + Length - 1) THEN
      IF raise_Exceptions then
        RAISE String_Too_Short;
      Else
        -- return portion of string possible [from START to end of DSTR]
        RETURN (Dstring =>
                 (Dstr.Dstring.Size-Start+1,
                  dstr.Dstring.data(Start..Dstr.Dstring.size)));
      End if;

    ELSE
      RETURN (Dstring =>
                (Length, (Dstr.Dstring.Data (Start .. Start + Length - 1))));
    END IF;
  END Substring;


---------------------------------------------------------------------------
  FUNCTION Index (Source_String, Pattern_String : Dyn_String;
                  Start_Pos                     : Integer) RETURN Integer IS

    Pos_Index, I, J : Integer;

    Source_Length   : Natural;                   -- added since undeclared in
                                                 -- jpam2 article
    Pattern_Length  : Natural;                   -- ditto

  BEGIN
    Source_Length := Source_String.Dstring.Size;
    Pattern_Length := Pattern_String.Dstring.Size;

    IF Start_Pos + Pattern_Length - 1 > Source_Length THEN
      RETURN No_Fit;
    END IF;

    IF Start_Pos = 1 THEN
      RETURN No_Fit;
    END IF;

    I := 1;
    J := Start_Pos;
    Pos_Index := Start_Pos;

    LOOP
-- if a char in a pattern string matches with
-- a char in a source string...
      IF Pattern_String.Dstring.Data (I) = Source_String.Dstring.Data (J) THEN

-- if the index of pattern string equal sthe
-- pattern length then there is  a pattern match
-- within source string
        IF I = Pattern_Length THEN
          RETURN Pos_Index;
        ELSE
          -- look at the next pair of chars..
          I := I + 1;
          J := J + 1;
        END IF;

        -- if a character in a pattern string doesn't match
        -- with a character in a sources string..
      ELSE
-- there are not enough characters remaining
-- in the source string to match the pattern, then
-- No match is possible....
        IF Source_Length - Pos_Index < Pattern_Length THEN
          RETURN No_Match;
        ELSE
          -- otherwise, set the pattern string index to 1...
          I := 1;
          -- adjust the postion index of the source string
          -- and keep on comparing...
          Pos_Index := Pos_Index + 1;
          J := Pos_Index;
        END IF;
      END IF;
    END LOOP;
  END Index;


  FUNCTION Rindex (Source_String, Pattern_String : Dyn_String;
                   Start_Pos                     : Integer) RETURN Integer IS

    Pos_Index, I, J : Integer;

    Source_Length   : Natural;                   -- added since undeclared in
                                                 -- jpam2 article
    Pattern_Length  : Natural;                   -- ditto


    No_Match        : CONSTANT Integer := 0;
    No_Fit          : CONSTANT Integer := -1;

  BEGIN
    Source_Length := Source_String.Dstring.Size;
    Pattern_Length := Pattern_String.Dstring.Size;

    IF Start_Pos < Pattern_Length THEN
      RETURN No_Fit;
    END IF;

    IF Start_Pos > Source_Length THEN
      RETURN No_Fit;
    END IF;

    I := Pattern_Length;
    J := Start_Pos;
    Pos_Index := Start_Pos;

    LOOP
-- if a char in a pattern string matches with
-- a char in a source string...
      IF Pattern_String.Dstring.Data (I) = Source_String.Dstring.Data (J) THEN

-- if the index of pattern string equal one
-- then there is  a pattern match
-- within source string
        IF I = 1 THEN
          RETURN Pos_Index;
        ELSE
          -- look at the next pair of chars..
          I := I - 1;
          J := J - 1;
        END IF;

        -- if a character in a pattern string doesn't match
        -- with a character in a sources string..
      ELSE
-- if the source string has no more room for the pattern
        IF Pos_Index = Pattern_Length THEN
          RETURN No_Match;
        ELSE
          -- otherwise, set the pattern string index to
          -- the length of the pattern...
          I := Pattern_Length;
          -- adjust the postion index of the source string
          -- and keep on comparing...
          Pos_Index := Pos_Index - 1;
          J := Pos_Index;
        END IF;
      END IF;
    END LOOP;


  END Rindex;
END Dynamic_Strings;