From an abstract point of view, strings are simply sequences of characters. However, programmers and users are accustomed to think of some strings, such as words and numerals, as units, without attending to their internal structure. Most programming languages, therefore, provide either a built-in string data type, distinct from any of the other sequence types, or else a string library that predefines operations that are regarded as natural and common on character strings.
Although Standard Pascal in a sense equates strings with certain packed arrays of characters (those in which the lower bound of the index type is 1), it nevertheless distinguishes strings from other arrays in several ways:
Write and WriteLn operations
to string values. Again, for arrays of any other kind, the programmer must
define her own output procedures.
Read and ReadLn procedures do not take
string arguments; strings must be read in character by character.
Ideally, a string type should include every finite sequence of characters. Its operations should include analogues of all of the sequence operations, and in addition a few that depend on the nature of the elements: lexicographic comparisons (both case-sensitive and case-insensitive), conversion to upper case and to lower case; input and output operations. Here are the specifications for these additional operations:
equal
Inputs: left-operand and right-operand, both
strings.
Output: result, a Boolean.
Preconditions: none.
Postconditions: result is true if
left-operand is the same string as right-operand,
that is, if each string has the same character in each position.
Otherwise, result is false.
case-insensitive-equal
Inputs: left-operand and right-operand, both
strings.
Output: result, a Boolean.
Preconditions: none.
Postconditions: result is true if the length
left-operand is the length of right-operand and,
for every natural number k from one to this common length, the
character in position k of left-operand differs from
the character in position k of right-operand, if at
all, only in that they are different cases of the same letter. Otherwise,
result is false.
precedes
Inputs: left-operand and right-operand, both
strings.
Output: result, a Boolean.
Preconditions: none.
Postconditions: result is true if
left-operand lexicographically precedes
right-operand -- that is, if either (1) the length of
left-operand is less than the length of
right-operand, and for every natural number k from 1 to
the length of left-operand, the character in position k
of left-operand is the character in position k of
right-operand, or (2) there is a positive integer j
such that both the length of left-operand and the length of
right-operand is greater than or equal to j, the
character in position j of left-operand comes before
the character in position j of right-operand in the
character set to which both belong, and, for every natural number k
from one to j, the character in position k of
left-operand is the character in position k of
right-operand. Otherwise, result is
false.
case-insensitive-precedes
Inputs: left-operand and right-operand, both
strings.
Output: result, a Boolean.
Preconditions: none.
Postconditions: result is true if either (1) the length
of left-operand is less than the length of
right-operand, and for every natural number k from 1 to
the length of left-operand, the character in position k
of left-operand differs from the character in position
k of right-operand, if at all, only in that they are
different cases of the same latter; or (2) there is a positive integer
j such that both the length of left-operand and the
length of right-operand is greater than or equal to j,
the character in position j of left-operand comes
before the character in position j of right-operand in
the character set to which both belong, and they are not merely different
cases of the same letter, and, for every natural number k from one
to j, the character in position k of
left-operand differs from the character in position k
of right-operand, if at all, only in that they are different
cases of the same letter. Otherwise, result is
false.
upcase
Input: operand, a string.
Output: result, a string.
Preconditions: none.
Postconditions: The length of result is the length of
operand. For every natural number k from one to the
length of operand, if the character at position k in
operand is a lower-case letter, the character at position
k in result is the corresponding upper-case letter;
otherwise, the character at position k in result is the
character at position k in operand.
downcase
Input: operand, a string.
Output: result, a string.
Preconditions: none.
Postconditions: The length of result is the length of
operand. For every natural number k from one to the
length of operand, if the character at position k in
operand is an upper-case letter, the character at position
k in result is the corresponding lower-case letter;
otherwise, the character at position k in result is the
character at position k in operand.
read
Input: source, a data source.
Outputs: legend, a string, and success, a
Boolean.
Preconditions: none.
Postcondition: Either success is true and one line of
text has been extracted from source and legend is
the string of characters making up that line (not including any
terminator), or success is false and an input error of
some kind has occurred.
write
Input: target, a data sink, and scribend, a
string.
Outputs: none.
Preconditions: none.
Postcondition: The string scribend has been appended to
target.
Chr
(0), is used as the terminator. Of course, the policy of making
MaxSize even larger than 255 just exacerbates the problem of
wasted storage. In this implementation, the frequently used length
operation takes longer, since it requires a left-to-right search for the
string terminator every time (the length isn't stored anywhere).
Sequences module, but
with characters as elements. Since a linked list is not a random-access
structure, finding the kth character in a string is not a
constant-time operation in this implementation, though perhaps indexing into
a string is not such an important operation. However, finding the length
of the string also requires a search for the right end of the list, which
can be slow. Also, having just one character in each list component is
again rather wasteful of storage; a string under this implementation
occupies four bytes for the header pointer plus eight bytes per character
(one for the character, four for the pointer to the next component of the
list, and three bytes of padding to ensure correct alignment).
implement section of the module
so that it can be changed easily if there is some good reason to do so.
I've assumed that most string applications will generate strings of no more
than eighty characters and will therefore be able to perform most
operations without allocating extra blocks.A header at the beginning of the string keeps track of its exact length, so that it is possible to determine where to stop within a block without having to store an explicit terminator, and so that length can simply return the stored value instead of having to count blocks.
Since standard Pascal strings provide some advantages that the
implementation cannot duplicate, such as the possibility of defining string
constants, I've also provided procedures for converting standard Pascal
strings to String values and vice versa.
{ This module defines an interface for a variable-length string data type
and implements it for HP 9000 Series 700 workstations under HP-UX 9.x,
using HP Pascal.
Programmer: John Stone, Grinnell College.
Original version: October 30, 1996.
}
$heap_dispose on$
module Strings;
export
type
String = ^StringRecord; { an opaque type }
{ The NullString function constructs and returns a string of zero
characters. }
function NullString: String;
{ The ConstructString function takes a string and returns a new string
just like it except that a new character has been prepended. }
function ConstructString (Prefix: Char; Base: String): String;
{ The FirstOfString function returns the first character of a non-empty
string. }
function FirstOfString (Operand: String): Char;
{ The AllButFirstOfString function takes a non-empty string and returns a
new string just like it except that the first character has been
removed. }
function AllButFirstOfString (Operand: String): String;
{ The EmptyString function determines whether a given string is the
empty string. }
function EmptyString (Operand: String): Boolean;
{ The LengthOfString function returns the length of a given string. }
function LengthOfString (Operand: String): Integer;
{ The AppendToString function takes a string and returns a new
string just like it except that a new character has been appended. }
function AppendToString (Base: String; Postfix: Char): String;
{ The LastOfString function returns the last character of a non-empty
string. }
function LastOfString (Operand: String): Char;
{ The AllButLastOfString function takes a non-empty string and returns a
new string just like it except that the last character has been
removed. }
function AllButLastOfString (Operand: String): String;
{ The ConcatenateString function takes two strings and returns a new
string in which the characters of the first operand are followed by the
characters of the second operand. }
function ConcatenateString (LeftOperand, RightOperand: String): String;
{ The RecoverByPositionFromString function returns the value occupying
a specified position in a string. }
function RecoverByPositionFromString (Position: Integer;
Str: String): Char;
{ The CharInString function determines whether a given character occurs
in a given string. }
function CharInString (Candidate: Char; Str: String): Boolean;
{ The LocateInString procedure determines whether a given character
occurs in a given string and, if so, returns the least position at
which it occurs. }
procedure LocateInString (Sought: Char; Str: String;
var Found: Boolean; var Position: Integer);
{ The Substring function constructs and returns a string that is a copy
of a section of a given string, bounded by the positions indicated by
Start and Finish. }
function Substring (Str: String; Start, Finish: Integer): String;
{ The ReverseString function constructs and returns a string that is just
like a given string except that the order of the characters is
reversed. }
function ReverseString (Operand: String): String;
{ The InsertAtPositionInString function constructs and returns a string
that is just like a given string except that a new character has been
inserted at a specified position. }
function InsertAtPositionInString (Str: String; Position: Integer;
Ch: Char): String;
{ The DeleteAtPositionInString function constructs and returns a string
that is just like a given string except that the character at a
specified position has been removed. }
function DeleteAtPositionInString (Str: String; Position: Integer):
String;
{ The DeleteCharacterFromString function constructs and returns a string
that is just like a given string except that every occurrence of a
specified character has been removed. }
function DeleteCharacterFromString (Str: String; Delend: Char): String;
{ The SubstituteInString function constructs and returns a string
that is just like a given string except that every occurrence of a
specified character has been replaced with a new specified character
(the same one in each case). }
function SubstituteInString (Str: String; Displacer, Displaced: Char):
String;
{ The FillString function constructs and returns a string consisting
of a specified number of copies of a given character. }
function FillString (Length: Integer; Filler: Char): String;
{ The GenerateString function constructs a string of a specified
length by applying a given function to the positive integers in
ascending order until that length is reached. }
function GenerateString (function Generator (N: Integer): Char;
Length: Integer): String;
{ The MapString function constructs a string by applying a given
function to each successive character of a given string. }
function MapString (Str: String; function Mapper (Ch: Char): Char):
String;
{ The ApplyAlongString procedure applies a given procedure to each
successive character of a given string. }
procedure ApplyAlongString (Str: String; procedure Applicand (Ch: Char));
{ The EveryCharOfString function determines whether every character
of a given string satisfies a given predicate. }
function EveryCharOfString (Str: String;
function Test (Ch: Char): Boolean): Boolean;
{ The SomeCharOfString function determines whether at least one
character of a given string satisfies a given predicate. }
function SomeCharOfString (Str: String;
function Test (Ch: Char): Boolean): Boolean;
{ The RecoverByTestFromString procedure determines whether any of the
characters of a given string satisfies a given predicate and, if so,
returns the one whose position is the least. }
procedure RecoverByTestFromString (Str: String;
function Test (Ch: Char): Boolean; var Found: Boolean;
var Sought: Char);
{ The LocateByTestInString procedure determines whether any of the
characters of a given string satisfies a given predicate and, if so,
returns the least position occupied by such an character. }
procedure LocateByTestInString (Str: String;
function Test (Ch: Char): Boolean; var Found: Boolean;
var Position: Integer);
{ The FilterString procedure constructs and returns a string
comprising exactly those characters of a given string that satisfy a
given predicate. }
function FilterString (Str: String;
function Test (Ch: Char): Boolean): String;
{ The EqualStrings function determines whether two given strings contain
exactly the the same characters. }
function EqualStrings (LeftOperand, RightOperand: String): Boolean;
{ The CaseInsensitiveEqualStrings determines whether two given strings
contain exactly the same characters except possibly for having
corresponding characters differing only in case. }
function CaseInsensitiveEqualStrings (LeftOperand, RightOperand: String):
Boolean;
{ The PrecedesString function determines whether one given string
strictly lexicographically precedes another. }
function PrecedesString (LeftOperand, RightOperand: String): Boolean;
{ The CaseInsensitivePrecedesString function determines whether one given
string strictly lexicographically precedes another, provided that
differences between cases of letters are ignored. }
function CaseInsensitivePrecedesString (LeftOperand,
RightOperand: String): Boolean;
{ The UpCaseString function constructs and returns a copy of a given
string, except that all lower-case characters in the given string are
replaced with their upper-case equivalents in the copy. }
function UpCaseString (Operand: String): String;
{ The DownCaseString function constructs and returns a copy of a given
string, except that all upper-case characters in the given string are
replaced with their lower-case equivalents in the copy. }
function DownCaseString (Operand: String): String;
{ The ReadString procedure reads in one line from a text file and
constructs and returns the characters on that line (not including the
line break as a string. The Success parameter is set to True if no
input error is encountered, to False if there is a problem. }
procedure ReadString (var Source: Text; var Legend: String;
var Success: Boolean);
{ The WriteString procedure writes a string to a text file (but does not
terminate the line). }
procedure WriteString (var Target: Text; Scribend: String);
{ The ConvertFromPascalString procedure translates a standard Pascal
string of any length into a string as here implemented. }
procedure ConvertFromPascalString (Source: packed array
[Low .. High: Integer] of Char; var Target: String);
{ The ConvertToPascalString procedure translates a string as here
implemented into a standard Pascal string, padding on the right
with space characters if the standard Pascal string is longer and
truncating it at the right end if the standard Pascal string is too
short. The Truncated parameter indicates whether a truncation was
necessary. }
procedure ConvertToPascalString (Source: String;
var Target: packed array [Low .. High: Integer] of Char;
var Truncated: Boolean);
{ The DeallocateString procedure recycles the storage associated with
a given string. }
procedure DeallocateString (var Operand: String);
implement
import StdErr;
const
FirstExceptionCode = 1;
UndefinedStringException = 1;
IncorrectlyConstructedStringException = 2;
FirstOfStringException = 3;
AllButFirstOfStringException = 4;
LastOfStringException = 5;
AllButLastOfStringException = 6;
RecoverByPositionFromStringException = 7;
SubstringException = 8;
InsertAtPositionInStringException = 9;
DeleteAtPositionInStringException = 10;
FillStringException = 11;
GenerateStringException = 12;
ExceptionException = 13;
LastExceptionCode = 13;
BlockSize = 80;
{ the number of characters in each character block }
Debug = False;
{ True during debugging, False (for greater speed) when the
module is released }
type
Natural = 0 .. MaxInt;
Block = packed array [1 .. BlockSize] of Char;
Link = ^BlockRecord;
BlockRecord = record
Data: Block;
Next: Link
end;
{ A BlockRecord is a component of the linked list of character
blocks. }
StringRecord = record
Head: Link;
Size: Natural
end;
{ The StringRecord is the ``header node'' that keeps track of the
size of the string and contains a pointer to the first block. }
procedure StringExceptionHandler (ExceptionCode: Integer);
begin
if (ExceptionCode < FirstExceptionCode) or
(LastExceptionCode < ExceptionCode) then
ExceptionCode := ExceptionException;
WriteLn (StdErr, 'Exception #', ExceptionCode : 1,
' in module Strings:');
case ExceptionCode of
UndefinedStringException:
WriteLn (StdErr, 'An operation was applied to an uninitialized ',
'string.');
IncorrectlyConstructedStringException:
WriteLn (StdErr, 'An operation attempted to return an incorrectly ',
'constructed string.');
FirstOfStringException:
WriteLn (StdErr, 'The empty string was passed to the ',
'FirstOfString function.');
AllButFirstOfStringException:
WriteLn (StdErr, 'The empty string was passed to the ',
'AllButFirstOfString function.');
LastOfStringException:
WriteLn (StdErr, 'The empty string was passed to the ',
'LastOfString function.');
AllButLastOfStringException:
WriteLn (StdErr, 'The empty string was passed to the ',
'AllButLastOfString function.');
RecoverByPositionFromStringException:
WriteLn (StdErr, 'An invalid index was passed to the ',
'RecoverByPositionFromString function.');
SubstringException:
WriteLn (StdErr, 'An invalid index was passed to the Substring ',
'function.');
InsertAtPositionInStringException:
WriteLn (StdErr, 'An invalid index was passed to the ',
'InsertAtPositionInString function.');
DeleteAtPositionInStringException:
WriteLn (StdErr, 'An invalid index was passed to the ',
'DeleteAtPositionInString function.');
FillStringException:
WriteLn (StdErr, 'A negative Length argument was passed to the ',
'FillString function.');
GenerateStringException:
WriteLn (StdErr, 'A negative Length argument was passed to the ',
'GenerateString function.');
ExceptionException:
WriteLn (StdErr, 'The StringExceptionHandler procedure received ',
'an unknown exception code.')
end
end;
function UpCase (Ch: Char): Char;
const
CaseSeparation = 32;
{ the distance between upper-case letters and their lower-case
counterparts in the ASCII character set }
begin
if ('a' <= Ch) and (Ch <= 'z') then
UpCase := Chr (Ord (Ch) - CaseSeparation)
else
UpCase := Ch
end;
function DownCase (Ch: Char): Char;
const
CaseSeparation = 32;
{ the distance between upper-case letters and their lower-case
counterparts in the ASCII character set }
begin
if ('A' <= Ch) and (Ch <= 'Z') then
DownCase := Chr (Ord (Ch) + CaseSeparation)
else
DownCase := Ch
end;
{ The ValidString function checks whether a given string is correctly
constructed. This function is invoked only when the module is being
debugged (i.e., when Debug is True). }
function ValidString (Str: String): Boolean;
var
Traverser: Link;
{ points to successive character blocks of ths string }
DesiredBlockCount: Natural;
{ the number of character blocks that should be required to hold
a string of the specified size }
Tally: Natural;
{ counts the character blocks }
begin
if Str = nil then
ValidString := False
else if Str^.Size < 0 then
ValidString := False
else begin
Traverser := Str^.Head;
if Str^.Size mod BlockSize = 0 then
DesiredBlockCount := Str^.Size div BlockSize
else
DesiredBlockCount := Str^.Size div BlockSize + 1;
Tally := 0;
while (Traverser <> nil) and (Tally < DesiredBlockCount) do begin
Tally := Tally + 1;
Traverser := Traverser^.Next
end;
ValidString := (Traverser = nil) and (Tally = DesiredBlockCount)
end
end;
function NullString: String;
var
Result: String;
{ the null string, as it is being constructed }
begin
New (Result);
Result^.Head := nil; { No blocks are needed for a
zero-character string. }
Result^.Size := 0;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
NullString := Result
end;
function ConstructString (Prefix: Char; Base: String): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
BasePosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
BaseTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Base <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 1;
ResultTraverser^.Data[ResultPosition] := Prefix;
BaseTraverser := Base^.Head;
BasePosition := 0;
for Position := 1 to Base^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if BasePosition = BlockSize then begin
BaseTraverser := BaseTraverser^.Next;
BasePosition := 0
end;
ResultPosition := ResultPosition + 1;
BasePosition := BasePosition + 1;
ResultTraverser^.Data[ResultPosition] :=
BaseTraverser^.Data[BasePosition]
end;
ResultTraverser^.Next := nil;
Result^.Size := Base^.Size + 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
ConstructString := Result
end;
function FirstOfString (Operand: String): Char;
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
Assert (0 < Operand^.Size, FirstOfStringException,
StringExceptionHandler);
FirstOfString := Operand^.Head^.Data[1]
end;
function AllButFirstOfString (Operand: String): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
OperandPosition: Natural;
{ counts off positions in each character block of the base string }
OperandTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
Assert (0 < Operand^.Size, AllButFirstOfStringException,
StringExceptionHandler);
New (Result);
if Operand^.Size = 1 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
OperandTraverser := Operand^.Head;
OperandPosition := 1;
for Position := 2 to Operand^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if OperandPosition = BlockSize then begin
OperandTraverser := OperandTraverser^.Next;
OperandPosition := 0
end;
ResultPosition := ResultPosition + 1;
OperandPosition := OperandPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
OperandTraverser^.Data[OperandPosition]
end
end;
ResultTraverser^.Next := nil;
Result^.Size := Operand^.Size - 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
AllButFirstOfString := Result
end;
function EmptyString (Operand: String): Boolean;
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
EmptyString := (Operand^.Size = 0)
end;
function LengthOfString (Operand: String): Integer;
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
LengthOfString := Operand^.Size
end;
function AppendToString (Base: String; Postfix: Char): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
BasePosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
BaseTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Base <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
BaseTraverser := Base^.Head;
BasePosition := 0;
for Position := 1 to Base^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if BasePosition = BlockSize then begin
BaseTraverser := BaseTraverser^.Next;
BasePosition := 0
end;
ResultPosition := ResultPosition + 1;
BasePosition := BasePosition + 1;
ResultTraverser^.Data[ResultPosition] :=
BaseTraverser^.Data[BasePosition]
end;
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] := Postfix;
ResultTraverser^.Next := nil;
Result^.Size := Base^.Size + 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
AppendToString := Result
end;
function LastOfString (Operand: String): Char;
var
OperandTraverser: Link;
{ points to successive character blocks in the operand string }
PartialBlockSize: Natural;
{ the number of characters left over after the last complete block }
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
Assert (0 < Operand^.Size, LastOfStringException,
StringExceptionHandler);
OperandTraverser := Operand^.Head;
while OperandTraverser^.Next <> nil do
OperandTraverser := OperandTraverser^.Next;
PartialBlockSize := Operand^.Size mod BlockSize;
if PartialBlockSize = 0 then
LastOfString := OperandTraverser^.Data[BlockSize]
else
LastOfString := OperandTraverser^.Data[PartialBlockSize]
end;
function AllButLastOfString (Operand: String): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
OperandPosition: Natural;
{ counts off positions in each character block of the base string }
OperandTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
Assert (0 < Operand^.Size, AllButLastOfStringException,
StringExceptionHandler);
New (Result);
if Operand^.Size = 1 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
OperandTraverser := Operand^.Head;
OperandPosition := 0;
for Position := 1 to Operand^.Size - 1 do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if OperandPosition = BlockSize then begin
OperandTraverser := OperandTraverser^.Next;
OperandPosition := 0
end;
ResultPosition := ResultPosition + 1;
OperandPosition := OperandPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
OperandTraverser^.Data[OperandPosition]
end;
ResultTraverser^.Next := nil;
end;
Result^.Size := Operand^.Size - 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
AllButLastOfString := Result
end;
function ConcatenateString (LeftOperand, RightOperand: String):
String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
OperandPosition: Natural;
{ counts off positions in each character block of the operand
strings }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
OperandTraverser: Link;
{ a pointer to the character block of the operand string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in each operand string }
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedStringException, StringExceptionHandler);
New (Result);
if (LeftOperand^.Size = 0) and (RightOperand^.Size = 0) then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
OperandTraverser := LeftOperand^.Head;
OperandPosition := 0;
for Position := 1 to LeftOperand^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if OperandPosition = BlockSize then begin
OperandTraverser := OperandTraverser^.Next;
OperandPosition := 0
end;
ResultPosition := ResultPosition + 1;
OperandPosition := OperandPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
OperandTraverser^.Data[OperandPosition]
end;
OperandTraverser := RightOperand^.Head;
OperandPosition := 0;
for Position := 1 to RightOperand^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if OperandPosition = BlockSize then begin
OperandTraverser := OperandTraverser^.Next;
OperandPosition := 0
end;
ResultPosition := ResultPosition + 1;
OperandPosition := OperandPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
OperandTraverser^.Data[OperandPosition]
end;
ResultTraverser^.Next := nil;
end;
Result^.Size := LeftOperand^.Size + RightOperand^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
ConcatenateString := Result
end;
function RecoverByPositionFromString (Position: Integer;
Str: String): Char;
var
Traverser: Link;
{ points to successive character blocks in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Assert ((1 <= Position) and (Position <= Str^.Size),
RecoverByPositionFromStringException, StringExceptionHandler);
Traverser := Str^.Head;
while BlockSize < Position do begin
Traverser := Traverser^.Next;
Position := Position - BlockSize
end;
RecoverByPositionFromString := Traverser^.Data[Position]
end;
function CharInString (Candidate: Char; Str: String): Boolean;
label 99;
{ early exit if a character matching Candidate is found }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for Position := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if Candidate = Traverser^.Data[PositionInBlock] then begin
CharInString := True;
goto 99
end
end;
CharInString := False;
99:
end;
procedure LocateInString (Sought: Char; Str: String;
var Found: Boolean; var Position: Integer);
label 99;
{ early exit if a character matching Sought is found }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
PositionInString: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for PositionInString := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if Sought = Traverser^.Data[PositionInBlock] then begin
Found := True;
Position := PositionInString;
goto 99
end
end;
Found := False;
99:
end;
function Substring (Str: String; Start, Finish: Integer): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the source string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the source string }
Position: Natural;
{ counts off positions in the source string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Assert ((1 <= Start) and (Start <= Str^.Size) and
(1 <= Finish) and (Finish <= Str^.Size), SubstringException,
StringExceptionHandler);
New (Result);
if (Finish < Start) then begin
Result^.Head := nil;
Result^.Size := 0
end
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Str^.Head;
StrPosition := Start - 1;
while (BlockSize < StrPosition) do begin
StrTraverser := StrTraverser^.Next;
StrPosition := StrPosition - BlockSize
end;
for Position := Start to Finish do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
ResultTraverser^.Next := nil;
Result^.Size := Finish - Start + 1
end;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
Substring := Result
end;
function ReverseString (Operand: String): String;
var
Result: String;
{ the new string, as it is being constructed }
PartialBlockSize: Natural;
{ the number of characters left over after the last complete block }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
OperandPosition: Natural;
{ counts off positions in each character block of the source string }
NewBlock: Link;
{ a pointer to a newly allocated character block, to be prepended
to the result string }
OperandTraverser: Link;
{ a pointer to the character block of the source string }
Position: Natural;
{ counts off positions in the source string }
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
New (Result);
if Operand^.Size = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
Result^.Head^.Next := nil;
PartialBlockSize := Operand^.Size mod BlockSize;
if PartialBlockSize = 0 then
ResultPosition := BlockSize + 1
else
ResultPosition := PartialBlockSize + 1;
OperandTraverser := Operand^.Head;
OperandPosition := 0;
for Position := 1 to Operand^.Size do begin
if ResultPosition = 1 then begin
New (NewBlock);
NewBlock^.Next := Result^.Head;
Result^.Head := NewBlock;
ResultPosition := BlockSize + 1
end;
if OperandPosition = BlockSize then begin
OperandTraverser := OperandTraverser^.Next;
OperandPosition := 0
end;
ResultPosition := ResultPosition - 1;
OperandPosition := OperandPosition + 1;
Result^.Head^.Data[ResultPosition] :=
OperandTraverser^.Data[OperandPosition]
end
end;
Result^.Size := Operand^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
ReverseString := Result
end;
function InsertAtPositionInString (Str: String; Position: Integer;
Ch: Char): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
PositionInString: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Assert ((1 <= Position) and (Position <= Str^.Size + 1),
InsertAtPositionInStringException, StringExceptionHandler);
New (Result);
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for PositionInString := 1 to Position - 1 do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] := Ch;
for PositionInString := Position to Str^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
ResultTraverser^.Next := nil;
Result^.Size := Str^.Size + 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
InsertAtPositionInString := Result
end;
function DeleteAtPositionInString (Str: String; Position: Integer):
String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
PositionInString: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Assert ((1 <= Position) and (Position <= Str^.Size),
DeleteAtPositionInStringException, StringExceptionHandler);
New (Result);
if Str^.Size = 1 then
Result^.Head := nil
else begin
New (Result);
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for PositionInString := 1 to Position - 1 do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
StrPosition := StrPosition + 1;
for PositionInString := Position + 1 to Str^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Str^.Size - 1;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
DeleteAtPositionInString := Result
end;
function DeleteCharacterFromString (Str: String; Delend: Char):
String;
var
Result: String;
{ the new string, as it is being constructed }
First: Boolean;
{ True if no characters have yet been added to the result string,
False after the first character has been added }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
PositionInString: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
First := True;
Result^.Size := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for PositionInString := 1 to Str^.Size do begin
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
StrPosition := StrPosition + 1;
if StrTraverser^.Data[StrPosition] <> Delend then begin
if First then begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
First := False
end
else if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition];
Result^.Size := Result^.Size + 1
end
end;
if First then
Result^.Head := nil
else
ResultTraverser^.Next := nil;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
DeleteCharacterFromString := Result
end;
function SubstituteInString (Str: String; Displacer, Displaced: Char):
String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
if Str^.Size = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for Position := 1 to Str^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
if StrTraverser^.Data[StrPosition] = Displaced then
ResultTraverser^.Data[ResultPosition] := Displacer
else
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition]
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Str^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
SubstituteInString := Result
end;
function FillString (Length: Integer; Filler: Char): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
Position: Natural;
{ counts off positions in the result string }
begin { function FillString }
Assert (0 <= Length, FillStringException, StringExceptionHandler);
New (Result);
if Length = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
for Position := 1 to Length do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] := Filler
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Length;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
FillString := Result
end;
function GenerateString (function Generator (N: Integer): Char;
Length: Integer): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
Position: Natural;
{ counts off positions in the result string }
begin
Assert (0 <= Length, GenerateStringException, StringExceptionHandler);
New (Result);
if Length = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
for Position := 1 to Length do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] := Generator (Position)
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Length;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
GenerateString := Result
end;
function MapString (Str: String; function Mapper (Ch: Char): Char):
String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
if Str^.Size = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for Position := 1 to Str^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
Mapper (StrTraverser^.Data[StrPosition])
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Str^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
MapString := Result
end;
procedure ApplyAlongString (Str: String; procedure Applicand (Ch: Char));
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for Position := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
Applicand (Traverser^.Data[PositionInBlock])
end
end;
function EveryCharOfString (Str: String;
function Test (Ch: Char): Boolean): Boolean;
label 99;
{ early exit if a character fails the test }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for Position := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if not Test (Traverser^.Data[PositionInBlock]) then begin
EveryCharOfString := False;
goto 99
end
end;
EveryCharOfString := True;
99:
end;
function SomeCharOfString (Str: String;
function Test (Ch: Char): Boolean): Boolean;
label 99;
{ early exit if a character passes the test }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for Position := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if Test (Traverser^.Data[PositionInBlock]) then begin
SomeCharOfString := True;
goto 99
end
end;
SomeCharOfString := False;
99:
end;
procedure RecoverByTestFromString (Str: String;
function Test (Ch: Char): Boolean; var Found: Boolean;
var Sought: Char);
label 99;
{ early exit when a character passes the test }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for Position := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if Test (Traverser^.Data[PositionInBlock]) then begin
Found := True;
Sought := Traverser^.Data[PositionInBlock];
goto 99
end
end;
Found := False;
99:
end;
procedure LocateByTestInString (Str: String;
function Test (Ch: Char): Boolean; var Found: Boolean;
var Position: Integer);
label 99;
{ early exit when a character passes the test }
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
PositionInString: Natural;
{ counts off characters in the string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
Traverser := Str^.Head;
PositionInBlock := 0;
for PositionInString := 1 to Str^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if Test (Traverser^.Data[PositionInBlock]) then begin
Found := True;
Position := PositionInString;
goto 99
end
end;
Found := False;
99:
end;
function FilterString (Str: String;
function Test (Ch: Char): Boolean): String;
var
Result: String;
{ the new string, as it is being constructed }
First: Boolean;
{ True if no characters have yet been added to the result string,
False after the first character has been added }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
PositionInString: Natural;
{ counts off positions in the base string }
begin
Assert (Str <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
First := True;
Result^.Size := 0;
StrTraverser := Str^.Head;
StrPosition := 0;
for PositionInString := 1 to Str^.Size do begin
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
StrPosition := StrPosition + 1;
if Test (StrTraverser^.Data[StrPosition]) then begin
if First then begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
First := False
end
else if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
ResultPosition := ResultPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
StrTraverser^.Data[StrPosition];
Result^.Size := Result^.Size + 1
end
end;
if First then
Result^.Head := nil
else
ResultTraverser^.Next := nil;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
FilterString := Result
end;
function EqualStrings (LeftOperand, RightOperand: String): Boolean;
label 99;
{ early exit when unequal characters are found in corresponding
positions }
var
LeftTraverser, RightTraverser: Link;
{ pointers to successive character blocks in the left and right
operand strings }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedStringException, StringExceptionHandler);
if LeftOperand^.Size <> RightOperand^.Size then
EqualStrings := False
else begin
LeftTraverser := LeftOperand^.Head;
RightTraverser := RightOperand^.Head;
PositionInBlock := 0;
for Position := 1 to LeftOperand^.Size do begin
if PositionInBlock = BlockSize then begin
LeftTraverser := LeftTraverser^.Next;
RightTraverser := RightTraverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if LeftTraverser^.Data[PositionInBlock] <>
RightTraverser^.Data[PositionInBlock] then begin
EqualStrings := False;
goto 99
end
end;
EqualStrings := True;
99:
end
end;
function CaseInsensitiveEqualStrings (LeftOperand, RightOperand: String):
Boolean;
label 99;
{ early exit when unequal characters are found in corresponding
positions }
var
LeftTraverser, RightTraverser: Link;
{ pointers to successive character blocks in the left and right
operand strings }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedStringException, StringExceptionHandler);
if LeftOperand^.Size <> RightOperand^.Size then
CaseInsensitiveEqualStrings := False
else begin
LeftTraverser := LeftOperand^.Head;
RightTraverser := RightOperand^.Head;
PositionInBlock := 0;
for Position := 1 to LeftOperand^.Size do begin
if PositionInBlock = BlockSize then begin
LeftTraverser := LeftTraverser^.Next;
RightTraverser := RightTraverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if UpCase (LeftTraverser^.Data[PositionInBlock]) <>
UpCase (RightTraverser^.Data[PositionInBlock]) then begin
CaseInsensitiveEqualStrings := False;
goto 99
end
end;
CaseInsensitiveEqualStrings := True;
99:
end
end;
function PrecedesString (LeftOperand, RightOperand: String): Boolean;
label 99;
{ early exit when unequal characters are found in corresponding
positions }
var
LeftTraverser, RightTraverser: Link;
{ pointers to successive character blocks in the left and right
operand strings }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
CommonLength: Natural;
{ the number of characters in the shorter of the two operand
strings }
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedStringException, StringExceptionHandler);
LeftTraverser := LeftOperand^.Head;
RightTraverser := RightOperand^.Head;
PositionInBlock := 0;
if LeftOperand^.Size <= RightOperand^.Size then
CommonLength := LeftOperand^.Size
else
CommonLength := RightOperand^.Size;
for Position := 1 to CommonLength do begin
if PositionInBlock = BlockSize then begin
LeftTraverser := LeftTraverser^.Next;
RightTraverser := RightTraverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
if LeftTraverser^.Data[PositionInBlock] <
RightTraverser^.Data[PositionInBlock] then begin
PrecedesString := True;
goto 99
end
else if RightTraverser^.Data[PositionInBlock] <
LeftTraverser^.Data[PositionInBlock] then begin
PrecedesString := False;
goto 99
end
end;
PrecedesString := (LeftOperand^.Size < RightOperand^.Size);
99:
end;
function CaseInsensitivePrecedesString (LeftOperand,
RightOperand: String): Boolean;
label 99;
{ early exit when unequal characters are found in corresponding
positions }
var
LeftTraverser, RightTraverser: Link;
{ pointers to successive character blocks in the left and right
operand strings }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
CommonLength: Natural;
{ the number of characters in the shorter of the two operand
strings }
LeftChar, RightChar: Char;
{ one character at a time from the left and right operand strings,
respectively, converted to upper case if necessary }
begin
Assert ((LeftOperand <> nil) and (RightOperand <> nil),
UndefinedStringException, StringExceptionHandler);
LeftTraverser := LeftOperand^.Head;
RightTraverser := RightOperand^.Head;
PositionInBlock := 0;
if LeftOperand^.Size <= RightOperand^.Size then
CommonLength := LeftOperand^.Size
else
CommonLength := RightOperand^.Size;
for Position := 1 to CommonLength do begin
if PositionInBlock = BlockSize then begin
LeftTraverser := LeftTraverser^.Next;
RightTraverser := RightTraverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
LeftChar := UpCase (LeftTraverser^.Data[PositionInBlock]);
RightChar := UpCase (RightTraverser^.Data[PositionInBlock]);
if LeftChar < RightChar then begin
CaseInsensitivePrecedesString := True;
goto 99
end
else if RightChar < LeftChar then begin
CaseInsensitivePrecedesString := False;
goto 99
end
end;
CaseInsensitivePrecedesString :=
(LeftOperand^.Size < RightOperand^.Size);
99:
end;
function UpCaseString (Operand: String): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Operand <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
if Operand^.Size = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Operand^.Head;
StrPosition := 0;
for Position := 1 to Operand^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
UpCase (StrTraverser^.Data[StrPosition])
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Operand^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
UpCaseString := Result
end;
function DownCaseString (Operand: String): String;
var
Result: String;
{ the new string, as it is being constructed }
ResultPosition: Natural;
{ counts off positions in each character block added to the result
string }
StrPosition: Natural;
{ counts off positions in each character block of the base string }
ResultTraverser: Link;
{ a pointer to the character block currently being filled }
StrTraverser: Link;
{ a pointer to the character block of the base string from which
characters are currently being copied }
Position: Natural;
{ counts off positions in the base string }
begin
Assert (Operand <> nil, UndefinedStringException, StringExceptionHandler);
New (Result);
if Operand^.Size = 0 then
Result^.Head := nil
else begin
New (Result^.Head);
ResultTraverser := Result^.Head;
ResultPosition := 0;
StrTraverser := Operand^.Head;
StrPosition := 0;
for Position := 1 to Operand^.Size do begin
if ResultPosition = BlockSize then begin
New (ResultTraverser^.Next);
ResultTraverser := ResultTraverser^.Next;
ResultPosition := 0
end;
if StrPosition = BlockSize then begin
StrTraverser := StrTraverser^.Next;
StrPosition := 0
end;
ResultPosition := ResultPosition + 1;
StrPosition := StrPosition + 1;
ResultTraverser^.Data[ResultPosition] :=
DownCase (StrTraverser^.Data[StrPosition])
end;
ResultTraverser^.Next := nil
end;
Result^.Size := Operand^.Size;
if Debug then
Assert (ValidString (Result), IncorrectlyConstructedStringException,
StringExceptionHandler);
DownCaseString := Result
end;
procedure ReadString (var Source: Text; var Legend: String;
var Success: Boolean);
var
LegendPosition: Natural;
{ counts off positions in each character block added to the string
being read }
LegendTraverser: Link;
{ a pointer to the character block currently being filled }
Continue: Boolean;
{ indicates whether the search for the end of a line can and should
continue }
begin
if EOF (Source) then
Success := False
else begin
New (Legend);
Legend^.Size := 0;
if EOLn (Source) then begin
ReadLn (Source);
Success := True;
Legend^.Head := nil
end
else begin
New (Legend^.Head);
LegendTraverser := Legend^.Head;
LegendPosition := 0;
Continue := True;
while Continue do
if EOF (Source) then begin
Success := False;
LegendTraverser^.Next := nil;
DeallocateString (Legend);
Continue := False
end
else if EOLn (Source) then begin
ReadLn (Source);
Success := True;
LegendTraverser^.Next := nil;
Continue := False
end
else begin
if LegendPosition = BlockSize then begin
New (LegendTraverser^.Next);
LegendTraverser := LegendTraverser^.Next;
LegendPosition := 0
end;
LegendPosition := LegendPosition + 1;
Read (Source, LegendTraverser^.Data[LegendPosition]);
Legend^.Size := Legend^.Size + 1
end
end
end;
if Debug and Success then
Assert (ValidString (Legend), IncorrectlyConstructedStringException,
StringExceptionHandler);
end;
procedure WriteString (var Target: Text; Scribend: String);
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Scribend <> nil, UndefinedStringException,
StringExceptionHandler);
Traverser := Scribend^.Head;
PositionInBlock := 0;
for Position := 1 to Scribend^.Size do begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
Write (Target, Traverser^.Data[PositionInBlock])
end
end;
procedure ConvertFromPascalString (Source: packed array
[Low .. High: Integer] of Char; var Target: String);
var
TargetPosition: Natural;
{ counts off positions in each character block added to the result
string }
TargetTraverser: Link;
{ a pointer to the character block currently being filled }
Position: Natural;
{ counts off positions in the result string }
begin
New (Target);
New (Target^.Head);
TargetTraverser := Target^.Head;
TargetPosition := 0;
for Position := Low to High do begin
if TargetPosition = BlockSize then begin
New (TargetTraverser^.Next);
TargetTraverser := TargetTraverser^.Next;
TargetPosition := 0
end;
TargetPosition := TargetPosition + 1;
TargetTraverser^.Data[TargetPosition] := Source[Position]
end;
TargetTraverser^.Next := nil;
Target^.Size := High - Low + 1;
if Debug then
Assert (ValidString (Target), IncorrectlyConstructedStringException,
StringExceptionHandler);
end;
procedure ConvertToPascalString (Source: String;
var Target: packed array [Low .. High: Integer] of Char;
var Truncated: Boolean);
const
Space = ' ';
var
Traverser: Link;
{ points to successive character blocks in the string }
PositionInBlock: Natural;
{ runs through successive positions in one character block }
Position: Natural;
{ counts off characters in the string }
begin
Assert (Source <> nil, UndefinedStringException,
StringExceptionHandler);
Traverser := Source^.Head;
PositionInBlock := 0;
for Position := Low to High do begin
if Position - Low + 1 <= Source^.Size then begin
if PositionInBlock = BlockSize then begin
Traverser := Traverser^.Next;
PositionInBlock := 0
end;
PositionInBlock := PositionInBlock + 1;
Target[Position] := Traverser^.Data[PositionInBlock]
end
else
Target[Position] := Space
end;
Truncated := (High - Low + 1 < Source^.Size)
end;
procedure DeallocateString (var Operand: String);
var
Traverser: Link;
{ points to successive character blocks in the string }
Trailer: Link;
{ points to the character block immediately preceding the one
Traverser points to }
begin
Assert (Operand <> nil, UndefinedStringException,
StringExceptionHandler);
Traverser := Operand^.Head;
while Traverser <> nil do begin
Trailer := Traverser;
Traverser := Traverser^.Next;
Dispose (Trailer)
end;
Dispose (Operand);
Operand := nil
end;
end.
This document is available on the World Wide Web as
http://www.math.grin.edu/~stone/courses/fundamentals/strings.html