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