language-Modula2-0.1: examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STRINGS/STRCSBMI.MOD
(*
9.3 StringCSBMI Implementation
*)
IMPLEMENTATION MODULE StrCSBMI;
(*==========================================================
Version : 1.00 29 Apr 1989 C. Lins
Compiler : TopSpeed Modula-2
Code Size: R- bytes
Component: Monolithic Structure String (Opaque version)
Character Sequential Bounded Managed Iterator
REVISION HISTORY
v1.00 29 Apr 1989 C. Lins:
Initial implementation.
==========================================================*)
FROM JPIStorage IMPORT
(*--Proc*) Allocate, Deallocate;
FROM ErrorHandling IMPORT
(*--Type*) HandlerProc,
(*--Proc*) NullHandler, ExitOnError, Raise;
FROM CharItems IMPORT
(*--Cons*) NullItem,
(*--Type*) Item, AccessProc, ChangeProc,
LoopAccessProc, LoopChangeProc;
FROM Relations IMPORT
(*--Type*) Relation;
FROM StrEnum IMPORT
(*--Type*) Exceptions, Operations, ComponentID;
(*-----------------------*)
(* 9.3.1 Internal Bounded String Representation
╟Illustration Here╚
Figure 9.1
Like the internal representation for a bounded stack, the representation for the bounded
string is a record dynamically allocated on the heap. This record will be made just large
enough to hold the declared maximum size of the string. Though the items array type
declaration covers the maximum allowed size range of a bounded string, only size entries
are actually allocated. This technique allows great savings in the amount of space
actually used for each bounded string.
length is initialized to zero when a string is created, and this value represents an empty
string. Furthermore, length may never exceed the value of size. Encountering this
condition is an indication of string overflow.
Representation Invariants:
* MIN(SizeRange) <= size <= MAX(SizeRange)
* MIN(SizeRange) <= length <= size
*)
TYPE Substring = ARRAY StringSize OF Item;
TYPE BoundedString = RECORD
size : StringSize; (*-- Maximum String Size *)
length : CARDINAL; (*-- Current String Length *)
items : Substring; (*-- ARRAY[1..TheSize] of Items *)
END (*-- BoundedString *);
TYPE String = POINTER TO BoundedString;
(* 9.3.2 Exceptions
To support the exception handling mechanism two variables are needed. The first,
stringError, is used to record the exception code from each operation; while handlers is an
array of exception handling procedures indexed by the exception code.
The routines StringError, GetHandler, and SetHandler have been previously described in
the definition module, and their operation should be readily apparent. RaiseErrIn is a
local routine used to set the stringError variable and invoke the Raise routine of the
ErrorHandling module.
*)
VAR stringError : Exceptions;
VAR handler : ARRAY Exceptions OF HandlerProc;
(*-----------------------*)
PROCEDURE StringError () : Exceptions (*-- out *);
BEGIN
RETURN stringError;
END StringError;
(*----------------------------*)
PROCEDURE GetHandler ( theError : Exceptions (*-- in *))
: HandlerProc (*-- out *);
BEGIN
RETURN handler[theError];
END GetHandler;
(*----------------------------*)
PROCEDURE SetHandler ( theError : Exceptions (*-- in *);
theHandler : HandlerProc (*-- in *));
BEGIN
handler[theError] := theHandler;
END SetHandler;
(*----------------------------*)
PROCEDURE RaiseErrIn ( theRoutine : Operations (*-- in *);
theError : Exceptions (*-- in *));
BEGIN
stringError := theError;
Raise(ComponentID + ModuleID, theRoutine, theError, handler[theError]);
END RaiseErrIn;
(*----------------------------*)
(* 9.3.3 Local Routines
There are two routines local to the string module used by other, exported routines. They
are declared here following convention of having routines declared prior to their use. This
is not required by Modula-2 (as it was for Pascal) but some single-pass compilers have
imposed restrictions in this regard and this technique facilitates porting to such compilers.
LengthSubstr determines that length of a substring which for our purposes is a standard
Modula-2 string. The substring parameter being tested is declared call-by-reference to
avoid the overhead involved in copying the open array implicit in call-by-value
parameters. Note that we must first explicitly check for the special case of an empty
string, "", which is represented as a string containing only the string terminator character.
The second routine, FromToOK, checks whether the following precondition holds:
fromIndex <= toIndex <= stringLength
which is required for routines such as Delete and SliceOf. The routine takes advantage of
the fact that if the toIndex is less than or equal to the stringLength and the fromIndex is
less than or equal to the toIndex, then the fromIndex must also be less than or equal to the
stringLength.
*)
PROCEDURE LengthSubstr (VAR theSubstring : ARRAY OF Item (*-- in *))
: CARDINAL (*-- out *);
BEGIN
IF (HIGH(theSubstring) = 0) & (theSubstring[0] = NullItem) THEN
RETURN 0;
END (*--if*);
RETURN HIGH(theSubstring) + 1;
END LengthSubstr;
(*----------------------------*)
PROCEDURE FromToOK ( fromIndex : Position (*-- in *);
toIndex : Position (*-- in *);
stringLength : CARDINAL (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
RETURN (toIndex <= stringLength) & (fromIndex <= toIndex);
END FromToOK;
(*----------------------------*)
(* 9.3.4 Constructors
Create begins by clearing the stringError field under the assumption of a successful
result.
The header for the string must then be allocated in a local variable since the function
result cannot be manipulated but only returned. The key to this allocation step is the
calculation of the number of bytes necessary based on the size of an individual item and
the number of items requested. We must not forget the space for storing theSize and the
string length. The constant expression staticSize accomplishes this regardless of the
number and size of these ╥static╙ fields and is unaffected by changes due to future
maintenance. If the bounded string could not be allocated, the overflow exception must
be raised, and the NullString returned.
At this point, all possibility of failure has been avoided and the bounded string header can
be initialized to its empty state (length set to zero), and the size limit stored for this
bounded string. Lastly, the new string can be returned to the caller.
*)
PROCEDURE Create ( theSize : StringSize (*-- in *))
: String (*-- out *);
CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
CONST itemSize = SIZE(Item);
VAR newString : String;
BEGIN
stringError := noerr;
Allocate(newString, staticSize + itemSize * theSize);
IF (newString # NIL) THEN
WITH newString^ DO
size := theSize;
length := 0;
END (*--with*);
RETURN newString;
END (*--if*);
RaiseErrIn(create, overflow);
RETURN NullString;
END Create;
(*----------------------------*)
(*
Destroy simply deallocates the bounded string header which automatically sets theString
to the NullString.
*)
PROCEDURE Destroy (VAR theString : String (*-- inout *));
CONST staticSize = SIZE(BoundedString) - SIZE(Substring);
CONST itemSize = SIZE(Item);
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
Deallocate(theString, staticSize + itemSize * theString^.size);
ELSE
RaiseErrIn(destroy, undefined);
END (*--if*);
END Destroy;
(*----------------------------*)
(*
Clear simply sets the string length to zero, effectively removing all of its items.
*)
PROCEDURE Clear (VAR theString : String (*-- inout *));
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
theString^.length := 0;
ELSE
RaiseErrIn(clear, undefined);
END (*--if*);
END Clear;
(*----------------------------*)
(*
Assignment for bounded objects is simpler to implement than their unbounded
counterparts as the opportunity for overflow is restricted to when the target object is
(re-)created. The source string must be defined, otherwise the undefined exception is
raised.
If the target string exists, the source and target strings represent different string objects
(assignment of a string to itself is a useless operation) and the target string capable of
holding all of the source string's items the assignment can be safely accomplished.
Otherwise, the overflow exception is raised and the operation aborted. When the target
object is undefined it must be created using the size attribute of the source. If overflow
does not occur, the actual assignment can commence, otherwise its suffices to exit (Create
has already raised the exception).
The assignment operator cannot be used to copy the whole items array as only a slice of
the array's index range was actually allocated and who knows what other dynamically
allocated objects follow it in memory. Since our strings are formed from the basic data
type CHAR, the assignment operator can be used to copy individual items from one
string to another as there is no chance for structural sharing to occur. This is done
through a simple loop over each of the items of the source. Then the target string's
length can be updated to match that of the source string.
*)
PROCEDURE Assign ( theString : String (*-- in *);
VAR toString : String (*-- inout *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
IF (theString # toString) THEN
IF (toString # NIL) THEN
IF (theString^.length > toString^.size) THEN
RaiseErrIn(assign, overflow);
END (*--if*);
ELSE
toString := Create(theString^.size);
END (*--if*);
IF (stringError # noerr) THEN
RETURN;
END (*--if*);
WITH theString^ DO
FOR index := MIN(StringSize) TO length DO
toString^.items[index] := items[index];
END (*--for*);
toString^.length := length;
END (*--with*);
END (*--if*);
ELSE
RaiseErrIn(assign, undefined);
END (*--if*);
END Assign;
(*----------------------------*)
(*
Prepend and Append simply make use of the Insert routine to add items to the front or
the back of the target string, respectively.
*)
PROCEDURE Prepend ( theString : String (*-- in *);
VAR toString : String (*-- inout *));
BEGIN
Insert(theString, toString, 1);
END Prepend;
(*----------------------------*)
PROCEDURE Append ( theString : String (*-- in *);
VAR toString : String (*-- inout *));
BEGIN
Insert(theString, toString, LengthOf(toString) + 1);
END Append;
(*----------------------------*)
(*
Insert adds the items of one string to an existing string at the given index position.
Essentially, we must make room for new string items by shifting items from the
insertion index to the right by the number of items being inserted. Then we proceed to
insert the new string items into the vacated positions. Finally, the modified string's
length is updated to reflect the newly inserted items.
*)
PROCEDURE Insert ( theString : String (*-- in *);
VAR toString : String (*-- inout *);
theIndex : Position (*-- in *));
VAR newLength : CARDINAL;
index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) & (toString # NIL) THEN
WITH toString^ DO
newLength := theString^.length + length;
IF (theIndex > length + 1) THEN
RaiseErrIn(insert, positionerr);
ELSIF (newLength > size) THEN
RaiseErrIn(insert, overflow);
ELSE
FOR index := length TO theIndex BY -1 DO
items[index + theString^.length] := items[index];
END (*--for*);
FOR index := MIN(StringSize) TO theString^.length DO
items[theIndex + index - 1] := theString^.items[index];
END (*--for*);
length := newLength;
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(insert, undefined);
END (*--if*);
END Insert;
(*----------------------------*)
(*
Delete removes items from an existing string between the given index positions,
inclusive. Invalid index positions raise positionerr and abort the operation. The
algorithm essentially shifts items above the toIndex down in the string into positions
beginning with the fromIndex. It calculates the amount of this shift, called the offset,
loops through string items above toIndex, shifting each item into its new location. After
moving the items the string's length is updated.
*)
PROCEDURE Delete (VAR theString : String (*-- inout *);
fromIndex : Position (*-- in *);
toIndex : Position (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
offset : CARDINAL; (*-- distance to move items down *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
IF FromToOK(fromIndex, toIndex, length) THEN
offset := toIndex - fromIndex + 1;
FOR index := toIndex + 1 TO length DO
items[index - offset] := items[index];
END (*--for*);
DEC(length, offset);
ELSE
RaiseErrIn(delete, positionerr);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(delete, undefined);
END (*--if*);
END Delete;
(*----------------------------*)
(*
Replace deletes all items of the source string from the given index to the end of the string
and then inserts the replacement string at the end of the source. If theString was expanded
by the replacement process, the string length is adjusted accordingly.
*)
PROCEDURE Replace (VAR theString : String (*-- inout *);
theIndex : Position (*-- in *);
withString : String (*-- in *));
VAR endPosition : CARDINAL; (*-- new length of theString *)
index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) & (withString # NIL) THEN
endPosition := theIndex + withString^.length - 1;
WITH theString^ DO
IF (theIndex <= length) & (endPosition <= size) THEN
FOR index := MIN(StringSize) TO withString^.length DO
items[theIndex + index - 1] := withString^.items[index];
END (*--for*);
IF (endPosition > length) THEN
length := endPosition;
END (*--if*);
ELSE
RaiseErrIn(replace, positionerr);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(replace, undefined);
END (*--if*);
END Replace;
(*----------------------------*)
(*
SetItem attempts to assign the given item to the string at the given index position. The
index must be within the string's current length otherwise the positionerr exception is
raised avoiding assignment outside the string's current bounds.
*)
PROCEDURE SetItem (VAR theString : String (*-- inout *);
theIndex : Position (*-- in *);
theItem : Item (*-- in *));
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
IF (theIndex <= length) THEN
items[theIndex] := theItem;
ELSE
RaiseErrIn(setitem, positionerr);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(setitem, undefined);
END (*--if*);
END SetItem;
(*----------------------------*)
(*
Construct forms a bounded string from a standard Modula-2 string. If theString has not
yet been created then theSubstring must not be empty since it is meaningless to create a
string with a maximum size of zero items. If theString does exist and theSubstring is
empty it is sufficient to clear theString. Otherwise we simply loop through theSubstring
copying items from there to the target string and when done update the string's length.
*)
PROCEDURE Construct (VAR theString : String (*-- inout *);
theSubstring: ARRAY OF Item (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
lenSubstr : CARDINAL; (*-- # of chars in substring *)
newString : String;
BEGIN
stringError := noerr;
lenSubstr := LengthSubstr(theSubstring);
IF (theString # NIL) THEN
IF (lenSubstr = 0) THEN
Clear(theString);
RETURN;
END (*--if*);
ELSIF (lenSubstr = 0) THEN
RaiseErrIn(construct, positionerr);
RETURN;
ELSE
newString := Create(lenSubstr);
IF (stringError = noerr) THEN
theString := newString;
ELSE
RETURN;
END (*--if*);
END (*--if*);
WITH theString^ DO
(*-- The minimum lenSubstr is one (1). *)
index := MIN(Position);
WHILE (index <= lenSubstr) & (theSubstring[index - 1] # NullItem) DO
items[index] := theSubstring[index - 1];
INC(index);
END (*--while*);
length := index - 1;
END (*--with*);
END Construct;
(*----------------------------*)
(* 9.3.5 Selectors
IsDefined returns true if the given string is not NIL, otherwise returning false.
*)
PROCEDURE IsDefined ( theString : String (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
RETURN (theString # NIL);
END IsDefined;
(*----------------------------*)
(*
IsEmpty simply tests for a string length of zero, returning the appropriate logical value.
As mentioned in the interface, an undefined string is considered empty.
*)
PROCEDURE IsEmpty ( theString : String (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
RETURN theString^.length = 0;
END (*--if*);
RaiseErrIn(isempty, undefined);
RETURN TRUE;
END IsEmpty;
(*----------------------------*)
(*
SizeOf returns the size value for the given string. An undefined string raises the
exception of the same name and returns a size of zero.
*)
PROCEDURE SizeOf ( theString : String (*-- in *))
: CARDINAL (*-- out *);
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
RETURN theString^.size;
END (*--if*);
RaiseErrIn(sizeof, undefined);
RETURN 0;
END SizeOf;
(*----------------------------*)
(*
LengthOf returns the string's current length, which is the number of items in the string.
An undefined string raises the exception of the same name and returns a length of zero.
*)
PROCEDURE LengthOf ( theString : String (*-- in *))
: CARDINAL (*-- out *);
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
RETURN theString^.length;
END (*--if*);
RaiseErrIn(lengthof, undefined);
RETURN 0;
END LengthOf;
(*----------------------------*)
(*
Compare returns the ordering relation between two strings such that ╥left Relation right╙
is True. If either or both strings are undefined then the incomparable relation is returned.
Initially we set up minLength with the smaller of the two string lengths, as reaching the
end of a string is one condition that terminates the comparison. We also preset relOrder
to the correct result based on length. This is based on the fact that all other things being
equal, the smaller of the strings is less than the other.
One this initialization is done, the algorithm loops through the strings from the
beginning examining each character item for the relation between them. The loop
continues as long as the strings are equal or until the end of the smaller string is reached.
The instant that the left item at the current index is less than its counterpart in the right
string the loop is terminated and the relation less is returned. Likewise when the left
item is greater than the right item the relation greater is returned. For equal items the
index is incremented, advancing the algorithm towards the terminating condition.
*)
PROCEDURE Compare ( left : String (*-- in *);
right : String (*-- in *))
: Relation (*-- out *);
VAR index : CARDINAL; (*-- Index into items arrays *)
minLength : CARDINAL; (*-- Smaller of the two string lengths *)
relOrder : Relation; (*-- Most recent comparison result *)
BEGIN
stringError := noerr;
relOrder := incomparable;
IF (left # NIL) & (right # NIL) THEN
WITH left^ DO
IF (length = right^.length) THEN
relOrder := equal;
minLength := length;
ELSIF (length < right^.length) THEN
relOrder := less;
minLength := length;
ELSE
relOrder := greater;
minLength := right^.length;
END (*--if*);
END (*--with*);
index := MIN(StringSize);
LOOP
IF (index > minLength) THEN
EXIT (*--loop*);
END (*--if*);
IF (left^.items[index] < right^.items[index]) THEN
relOrder := less;
EXIT (*--loop*);
ELSIF (left^.items[index] > right^.items[index]) THEN
relOrder := greater;
EXIT (*--loop*);
END (*--if*);
INC(index);
END (*--loop*);
ELSE
RaiseErrIn(compare, undefined);
END (*--if*);
RETURN relOrder;
END Compare;
(*----------------------------*)
(*
IsEqual scans both strings looking for the first mismatch (inequality) which indicates the
strings are unequal, otherwise if the FOR loop completes the strings must be equal. This
assumes that (1) the strings have been defined and (2) have the same length. The first of
these assumptions, if unfounded, raises the undefined exception; while the second is a
simple determinant of inequality.
*)
PROCEDURE IsEqual ( left : String (*-- in *);
right : String (*-- in *))
: BOOLEAN (*-- out *);
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (left # NIL) & (right # NIL) THEN
WITH left^ DO
IF (length = right^.length) THEN
FOR index := MIN(StringSize) TO length DO
IF (items[index] # right^.items[index]) THEN
RETURN FALSE;
END (*--if*);
END (*--for*);
RETURN TRUE;
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(isequal, undefined);
END (*--if*);
RETURN FALSE;
END IsEqual;
(*----------------------------*)
(*
ItemOf attempts to return the item of the string at the given index position. If theIndex
exceeds the length of the string the positionerr exception is raised. This exception and
also an undefined string cause the NullItem (0C) to be returned.
*)
PROCEDURE ItemOf ( theString : String (*-- in *);
theIndex : Position (*-- in *))
: Item (*-- out *);
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
IF (theIndex <= length) THEN
RETURN items[theIndex];
END (*--if*);
END (*--with*);
RaiseErrIn(itemof, positionerr);
ELSE
RaiseErrIn(itemof, undefined);
END (*--if*);
RETURN NullItem;
END ItemOf;
(*----------------------------*)
(*
SliceOf extracts a portion of the given string returning the sequence of characters as a
standard Modula-2 string. The portion of the string to be extracted is specified by the
range of index positions within the string, fromIndex and toIndex. We must take care
that the target slice is indexed from zero and so must shift items from their positions
within the source string into the appropriate positions in the target slice. The
preconditions (1) fromIndex ▓ toIndex ▓ source string length, and (2) number of items
between the from and to indices, inclusive, ▓ target slice size, must both be met. If not,
then the positionerr and overflow exceptions are raised, respectively. If necessary, the
string terminator is added to the end of the slice.
*)
PROCEDURE SliceOf ( theString : String (*-- in *);
fromIndex : Position (*-- in *);
toIndex : Position (*-- in *);
VAR theSlice : ARRAY OF Item (*-- out *));
VAR index : CARDINAL; (*-- loop index over items *)
sliceSize : CARDINAL; (*-- # items between from and to indexes *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
IF FromToOK(fromIndex, toIndex, length) THEN
sliceSize := toIndex - fromIndex;
IF (sliceSize <= HIGH(theSlice)) THEN
FOR index := fromIndex TO toIndex DO
theSlice[index - fromIndex] := items[index];
END (*--for*);
IF (sliceSize < HIGH(theSlice)) THEN
theSlice[sliceSize + 1] := NullItem;
END (*--if*);
ELSE
RaiseErrIn(sliceof, overflow);
END (*--if*);
ELSE
RaiseErrIn(sliceof, positionerr);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(sliceof, undefined);
END (*--if*);
END SliceOf;
(*----------------------------*)
(*
SubstringOf is similar to SliceOf, above, except that the whole string is returned. When
the Target substring is too small for all the items in the Source string, overflow is raised
and the target is filled with as many items that will fit.
*)
PROCEDURE SubstringOf( theString : String (*-- in *);
VAR toSubstring: ARRAY OF Item (*-- out *));
VAR index : CARDINAL; (*-- loop index over items *)
copyLength : CARDINAL; (*-- # items to copy into substring *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
IF (length > HIGH(toSubstring) + 1) THEN
RaiseErrIn(substringof, overflow);
copyLength := HIGH(toSubstring) + 1;
ELSE
copyLength := length;
END (*--if*);
FOR index := MIN(StringSize) TO copyLength DO
toSubstring[index - 1] := items[index];
END (*--for*);
IF (copyLength < HIGH(toSubstring)) THEN
toSubstring[copyLength + 1] := NullItem;
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(substringof, undefined);
END (*--if*);
END SubstringOf;
(*----------------------------*)
(* 9.3.6 Iterators
The bounded string iterators LoopOver and LoopChange use the same algorithm, which is
almost identical to that used with the bounded stack. The stringError state is reset to
noerr and a test made for the undefined string, raising the undefined exception if such is
the case. Then simply loop through each item of the string passing it along to the given
procedure for processing until either the end of the string is reached or the visiting process
returns False indicating that the iteration be terminated.
The bounded string iterators Traverse and TravChange use the same algorithm, which is
almost identical to that used with the bounded stack. The stringError state is reset to
noerr and a test made for the undefined string, raising the undefined exception if such is
the case. Then simply loop through each item of the string passing it along to the given
procedure for processing.
*)
PROCEDURE LoopOver ( theString : String (*-- in *);
theProcess: LoopAccessProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
FOR index := MIN(StringSize) TO length DO
IF ~theProcess(items[index]) THEN
RETURN;
END (*--if*);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(loopover, undefined);
END (*--if*);
END LoopOver;
(*----------------------------*)
PROCEDURE LoopChange ( theString : String (*-- in *);
theProcess: LoopChangeProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
FOR index := MIN(StringSize) TO length DO
IF ~theProcess(items[index]) THEN
RETURN;
END (*--if*);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(loopchange, undefined);
END (*--if*);
END LoopChange;
(*----------------------------*)
PROCEDURE Traverse ( theString : String (*-- in *);
theProcess: AccessProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
FOR index := MIN(StringSize) TO length DO
theProcess(items[index]);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(traverse, undefined);
END (*--if*);
END Traverse;
(*----------------------------*)
PROCEDURE TravChange ( theString : String (*-- in *);
theProcess: ChangeProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stringError := noerr;
IF (theString # NIL) THEN
WITH theString^ DO
FOR index := MIN(StringSize) TO length DO
theProcess(items[index]);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(travchange, undefined);
END (*--if*);
END TravChange;
(*----------------------------*)
(* 9.3.7 Module Initialization
In the module initialization the local exception handlers array variables are set to default
handlers (ExitOnError) except for the noerr handler which is given the null handler.
stringError is given the value noerr avoiding an undefined state.
*)
BEGIN
FOR stringError := MIN(Exceptions) TO MAX(Exceptions) DO
SetHandler(stringError, ExitOnError);
END (*--for*);
SetHandler(noerr, NullHandler);
stringError := noerr;
END StrCSBMI.
(*
References
[1] G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
Benjamin/Cummings, Menlo Park, CA, 1987, pp. 104-141.
[2] D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
Addison-Wesley, Reading, MA 1973.
[3] R. Sedgewick, Algorithms, Addison-Wesley, Reading, MA 1983.
[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
York, NY 1986, pp. 461-469.
*)