Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume2/pstrings/part01/strings.h

Text File | 1991-08-07 | 7.3 KB | 397 lines

{
*
* String handling package in Pascal (ISO Level 1).
*
*   This package of procedures and functions implements unbounded
* Strings of Characters.
*
* N.B. All string variables MUST be initialised via initS(s).
*      Assignment MUST be via assignS(dest, src).
*      If desired, storage may be reclaimed via finalS(s).
*  i.e.
*         var s,t: String;
*             . . .
*       initS(s); initS(t);
*          . . .
*       assignS(t, concatS(mkS('Join this string '), mkS('to this')));
*       assignS(s, t);
*          . . .
*       finalS(s); finalS(t);
*
* Additionally, string by-value parameters must be initialised by calling
* initvalparamS(s).
* * e.g.
*
*    procedure p(s:String);
*     begin writelnS(output, concatS(s, concatS(s,s)))
*     end;
*
* MUST be written as:
*
*    procedure p(s:String);
*     begin initvalparamS(s);
*           writelnS(output, concatS(s, concatS(s,s)))
*     end;
* (This is because the package performs incremental garbage collection
*  on unassigned strings, but extant by-value references cannot be
*  detected.)
*
*
*
* Implementation Issues:
*
* The representation is a header record containing a
* length field, a reference count, and a packed array [1..slength]
* of Char, followed by zero or more `tail' chunks - also
* containing a packed array [1..slength] of Char.
* The empty string is represented by nil.  Beware of
* s1 := s2   this copies pointers (!) not the strings themselves.
* `:=' between strings should not be used; it cannot be banned
* because types inherit assignment in Pascal.
* The procedure     assignS(dest, source)
* should be used to copy strings, it uses the reference count to
* avoid copying.  Only if updateS is used will the string
* actually be copied (if the ref count is > 1).
*
*   All the routines end with a capital S.
*
* Ian Cottam, University of Manchester,  NOV.85. revised MAR.86 and DEC.86.
*                                        revised MAR.88 - better names,
*                     plus use of initvalparamS.
}

{ -- string chunk length - any length > 0 will work }
const slength = 16;

type

  String = ^ stringrec;


  Nat0 = 0 .. maxint;

  Nat1 = 1 .. maxint;


  stringtail = ^ tailrec;

  stringrec = record
    LEN:  Nat1; { -- Note: no 0 as nil represents '' }
    REFS: Nat0; { -- How many refs are there to this string }
                { -- N.B. only = 0 when string generated by a function }
    HEAD: packed array [1..slength] of Char;
    TAIL: stringtail
      end;

  tailrec   = record
        MORE: packed array [1..slength] of Char;
        REST: stringtail
          end;


 { -- Result of compare - internal function to ADT }
 StrCmpResult = (lt, eq, gt);

 { -- type for sequencing thru strings - internal to ADT at the moment}
 CharOfString = record
                   POS: 1..slength;
                  case KIND: Boolean of
             true:  (HD: String);
             false: (TL: stringtail)
                end;


{************ function and procedure headings **************}

{ --   ...   in Alphabetical order   ...           }



procedure assignS(var lhs: String; rhs: String);
{
* lhs := rhs
}
external;



{ ***** AUXILIARY FUNCTION ***** }
function compare(left, right:String):StrCmpResult;
{
* String comparison - used in the impl. of eqS, neS, ltS, etc.
}
external;


function concatS(s1, s2: String):String;
{
* Returns s1 + s2
* Concatenates s1 and s2.
}
external;



function CtoS(c: Char):String;
{
* Converts a character into a string of length 1
}
external;



procedure disposeS(var s: String);
{
* reclaims the storage associated with the string s
}
external;



function emptyS: String;
{
* Returns the empty or null string ''
}
external;



function eqS(left,right: String):Boolean;
{
* left = right
}
external;


procedure finalS(var s: String);
{
* same as disposeS but possibly better name
* reclaims the storage associated with the string s
}
external;



{ ***** AUXILIARY FUNCTION ***** }
procedure first(var c:CharOfString; var s: String);
{
* c initialised to point to the first char of s
*
* precondition
*     s <> ''
}
external;



function geS(left,right: String):Boolean;
{
* left >= right
}
external;



function getsubS(s: String; frompos, topos: Nat0):String;
{
* Returns s[frompos..topos]
* Extracts a substring of s.
*  returns ''  if frompos..topos not in range.
}
external;



function gtS(left,right: String):Boolean;
{
* left > right
}
external;



function indexS(s: String; i: Nat1):Char;
{
* Returns s[i]
*
* precondition:
*     i <= lengthS(s)
}
external;



procedure initS(var s: String);
{
* Initialises s to be the empty or null string ''
* Same as newS, but possibly less confusing name.
}
external;



procedure initvalparamS(var s: String);
{
* Initialises s, which should be a value parameter, to be
* safely useable within the current procedure.
}
external;



function leS(left,right: String):Boolean;
{
* left <= right
}
external;



function lengthS(s: String):Nat0;
{
* Returns the dynamic length of a string
}
external;



function ltS(left,right: String):Boolean;
{
* left < right
}
external;



function matchS(s, pat: String):Nat0;
{
* Returns position of pat in s or 0 if not present.
* Empty strings are not considered present!
}
external;



{ ***** AUXILIARY FUNCTION ***** }
function mk(var static: packed array [lo..hi:Integer] of Char;
            limit: Integer):String;
{
* Converts a static Pascal string into a (dynamic) String.
* From lo to limit rather than hi.
* This internal procedure may be made generally available
* should there be a demand.
}
external;


function mkS(static: packed array [lo..hi:Integer] of Char):String;
{
* Converts a static Pascal string into a (dynamic) String.
}
external;



procedure mkStaticS(s: String; var p: packed array[lo..hi:Integer] of Char);
{
* Converts a dynamic string into a static string.
* p is null padded if necessary.
* Info will be lost if lengthS(s) > hi-lo+1.
}
external;



function neS(left,right: String):Boolean;
{
* left <> right
}
external;



procedure newS(var s: String);
{
* Initialises s to be the empty or null string ''
}
external;



{ ***** AUXILIARY FUNCTION ***** }
procedure next(var c: CharOfString; var ch: Char);
{
* c is advanced to point to next char in its string and current char
* returned in ch
*
* precondition
*     c initialised by call to first and not at end of string
}
external;



procedure readS(var f: Text; var s: String);
{
* Reads a string from text file f; eoln terminating.  The input is
* left pointing to the beginning of the next line, if any.
*
* precondition:
*    f open for reading & not eof(f)
}
external;




procedure readtS(var f: Text; var s: String; function stop(c:Char):Boolean);
{
* Reads a string from text file f; eoln or stop(c) returning true
* (whichever occurs first) terminating.  In either case,
* input is left positioned at the terminator.
*
* precondition:
*    f open for reading & not eof(f)
}
external;



function repS(s: String; n: Nat0):String;
{
* Returns s * n
* Replicates s, n times.
}
external;



procedure updateS(var s: String; i: Nat1; c:Char);
{
* Updates the string s at position  i  with the char c.
* if i > lengthS(s), s is first space filled upto i-1.
}
external;



procedure writeS(var f: Text; s: String);
{
* Write the dynamic string s to file f
*
* precondition:
*    f open for writing
}
external;



procedure writelnS(var f: Text; s: String);
{
* Write the dynamic string s to file f followed by an eoln marker
*
* precondition:
*    f open for writing
}
external;