language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/lib/generic/stringope.mod
IMPLEMENTATION MODULE StringOperations;
(* J. Andrea, Jun.17/93 - use internal Length rather than non-standard
built in function LEN, and correct global variables *)
(* J. Andrea, Jul.2/92 - NextBlank and NextNonBlank use same scan routine *)
(* J. Andrea, Sep.5/91 - add compare *)
(* J. Andrea, Aug.12/91 *)
(* This code may be freely used and distributed, it may not be sold. *)
FROM MoreMath IMPORT MinCard;
CONST
nul = 0C;
space = ' ';
tab = 11C;
TYPE
CharScanProc = PROCEDURE( CHAR ) :BOOLEAN;
(* ------------------------------------------------------- *)
PROCEDURE Blank( c :CHAR ) :BOOLEAN;
(* is this character a blank or tab *)
BEGIN
RETURN ( c = space ) OR ( c = tab );
END Blank;
(* ------------------------------------------------------- *)
PROCEDURE NonBlank( c :CHAR ) :BOOLEAN;
(* is this character a blank or tab *)
BEGIN
RETURN NOT Blank( c );
END NonBlank;
(* -------------------------------------------- *)
PROCEDURE Equal( a, b :ARRAY OF CHAR ) :BOOLEAN;
VAR
i, n :CARDINAL;
BEGIN
n := Length( a );
IF n # Length( b ) THEN
RETURN FALSE;
ELSE
i := 0;
WHILE ( i < n ) & ( a[i] = b[i] ) DO
i := i + 1;
END;
RETURN i = n;
END;
END Equal;
(* ---------------------------------------------------------------- *)
PROCEDURE Compare( a, operation, b :ARRAY OF CHAR ) :BOOLEAN;
(*
This nice algorithm comes from:
Western Research Laboratory, Digital Equipment Corp.
100 Hamilton Ave., Palo Alto, CA 94301
and is subject to their copyrights: this may be used, copied
and modified but may not be sold.
Some minor changes and a bug fix by J. Andrea, Sep.5/91
*)
TYPE
Operations = ( eq, ne, gt, ge, lt, le, nop );
VAR
compare_op :Operations;
last_a, last_b :CHAR;
len_a, len_b :CARDINAL;
ok :BOOLEAN;
i, n :CARDINAL;
BEGIN (* Compare *)
n := Length( operation );
IF n < 1 THEN
compare_op := nop;
ELSIF n = 1 THEN
IF operation[0] = '=' THEN
compare_op := eq;
ELSIF operation[0] = '#' THEN
compare_op := ne;
ELSIF operation[0] = '>' THEN
compare_op := gt;
ELSIF operation[0] = '<' THEN
compare_op := lt;
ELSE
compare_op := nop;
END;
ELSIF n = 2 THEN
IF operation[0] = '>' THEN
IF operation[1] = '=' THEN
compare_op := ge;
ELSE
compare_op := nop;
END;
ELSIF operation[0] = '<' THEN
IF operation[1] = '=' THEN
compare_op := le;
ELSIF operation[1] = '>' THEN
compare_op := ne;
ELSE
compare_op := nop;
END;
ELSIF operation[0] = '=' THEN
IF operation[1] = '<' THEN
compare_op := le;
ELSIF operation[1] = '>' THEN
compare_op := ge;
ELSE
compare_op := nop;
END;
ELSE
compare_op := nop;
END;
ELSE
compare_op := nop;
END;
IF compare_op = nop THEN
RETURN FALSE;
ELSE
len_a := Length( a ); len_b := Length( b );
last_a := nul; last_b := nul;
IF len_a = len_b THEN
n := len_a;
IF n # 0 THEN
last_a := a[n-1];
last_b := b[n-1];
END;
ELSIF len_a < len_b THEN
n := len_a;
last_b := b[n-1];
ELSE
n := len_b;
last_a := a[n-1];
END;
i := 0; ok := TRUE;
WHILE ok & ( i < n ) DO
IF a[i] # b[i] THEN
ok := FALSE;
last_a := a[i]; last_b := b[i];
ELSE
i := i + 1;
END;
END;
CASE compare_op OF
eq: RETURN last_a = last_b;
|ne: RETURN last_a # last_b;
|gt: RETURN last_a > last_b;
|lt: RETURN last_a < last_b;
|ge: RETURN last_a >= last_b;
|le: RETURN last_a <= last_b;
END;
END;
END Compare;
(* -------------------------------------------- *)
PROCEDURE Index( source, pattern :ARRAY OF CHAR ) :CARDINAL;
(*
This algorithm is a simple string search.
Help from D. MacDonald for a fix to string lengths.
*)
VAR
len_s, len_p, s, p :CARDINAL;
BEGIN (* Index *)
len_s := Length( source );
IF len_s = 0 THEN
RETURN 0;
ELSE
len_p := Length( pattern );
IF ( len_p = 0 ) OR ( len_p > len_s ) THEN
RETURN 0;
ELSE
(* keep trying to make comparisons till the pattern
will no longer fit at the end of the source *)
s := 0;
WHILE len_s - s + 1 >= len_p DO
(* are the strings equal from this position to the end *)
p := 0;
WHILE ( p < len_p ) & ( source[s+p] = pattern[p] ) DO
p := p + 1;
END;
IF p = len_p THEN (* they are equal *)
RETURN s + 1;
END;
s := s + 1;
END;
RETURN 0; (* if outside the loop, then not found *)
END;
END;
END Index;
(* -------------------------------------------- *)
PROCEDURE Assign( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
VAR
i, n, max :CARDINAL;
BEGIN
n := Length( a );
IF n = 0 THEN
b[0] := nul;
ELSE
(* determine how many characters can be copied *)
max := HIGH( b ) + 1; (* maximum characters in 'c' *)
n := MinCard( n, max ); (* minimum required to copy *)
FOR i := 0 TO n - 1 DO (* copy those characters *)
b[i] := a[i];
END;
IF n < max THEN b[n] := nul; END;
END;
END Assign;
(* ---------------------------------------------------------------- *)
PROCEDURE Append( a :ARRAY OF CHAR; VAR b :ARRAY OF CHAR );
VAR
i, n, max, out, remain :CARDINAL;
BEGIN
n := Length( a );
IF n > 0 THEN
max := HIGH( b ) + 1; (* maximum number of characters in 'b' *)
out := Length( b );
(* calculate the minimum number of characters which must be moved *)
remain := max - out;
n := MinCard( n, remain );
FOR i := 0 TO n-1 DO (* copy those characters *)
b[out] := a[i];
out := out + 1;
END;
IF out < max THEN b[out] := nul; END;
END;
END Append;
(* ---------------------------------------------------------------- *)
PROCEDURE Concat( a, b :ARRAY OF CHAR; VAR c :ARRAY OF CHAR );
BEGIN
Assign( a, c );
Append( b, c );
END Concat;
(* ---------------------------------------------------------------- *)
PROCEDURE SubString( a :ARRAY OF CHAR; start, len :CARDINAL;
VAR b :ARRAY OF CHAR );
VAR
i, n, max :CARDINAL;
BEGIN
IF len = 0 THEN (* don't copy anything *)
b[0] := nul;
ELSE
IF start = 0 THEN start := 1; END;
n := Length( a );
IF start > n THEN (* start off the end, don't copy anything *)
b[0] := nul;
ELSE
max := HIGH( b ) + 1; (* maximum number of characters in 'b' *)
(* determine how many characters can be copied *)
(* don't run off the end of the output string *)
len := MinCard( len, max );
(* and don't run off the end of the input string *)
IF start + len - 1 > n THEN
len := n - start + 1;
END;
(* change 'start' back to zero offset *)
start := start - 1;
FOR i := 0 TO len - 1 DO
b[i] := a[start+i];
END;
IF len < max THEN b[len] := nul; END;
END;
END;
END SubString;
(* ---------------------------------------------------------------- *)
PROCEDURE Insert( a :ARRAY OF CHAR; start :CARDINAL;
VAR b :ARRAY OF CHAR );
VAR
i, j, n, m, len_b, max, top, remain :CARDINAL;
BEGIN
n := Length( a );
IF n > 0 THEN
len_b := Length( b );
IF start = 0 THEN start := 1; END;
IF start <= len_b THEN
(* this operation must be done in two steps *)
(* 1. shift the end section of 'b' back beyond where 'a' will go *)
(* 2. move the characters of 'a' into 'b' *)
max := HIGH( b ) + 1; (* maximum number of characters in 'b' *)
(* begin part 1 *)
top := start + n - 1; (* last character of the insert section *)
(* don't shift anything if the insert will fill the remainder *)
IF top < max THEN
(* how many characters should be shifted *)
m := len_b - start + 1;
(* how many places remain after the insert *)
remain := max - top;
(* move only as many characters as will fit at the end *)
m := MinCard( remain, m );
(* the motion must go from the back to the front *)
(* or else characters may get written over before they are moved *)
(* this really reads j := start + m - 1; *)
(* but the strings are zero offset, so the extra -1 is *)
(* propagated out of the loop to the initial value *)
j := start + m - 2;
FOR i := 1 TO m DO
b[n+j] := b[j];
j := j - 1;
END;
END;
(* begin part 2 *)
(* determine how many characters of 'a' can be copied in *)
m := MinCard( n, max - start + 1 );
(* convert 'start' back to zero offset *)
start := start - 1;
FOR i := 0 TO m-1 DO (* copy those characters *)
b[start+i] := a[i];
END;
top := len_b + n;
IF top < max THEN b[top] := nul; END;
END;
END;
END Insert;
(* ---------------------------------------------------------------- *)
PROCEDURE Replace( a :ARRAY OF CHAR; start :CARDINAL; VAR b :ARRAY OF CHAR );
VAR
i, n, len_a, len_b :CARDINAL;
BEGIN
len_b := Length( b );
IF len_b > 0 THEN
len_a := Length( a );
IF len_a > 0 THEN
IF start = 0 THEN start := 1; END;
IF start <= len_b THEN
(* find the number of characters which can be replaced *)
n := MinCard( len_a, len_b - start + 1 );
IF n > 0 THEN
n := n - 1; start := start - 1;
FOR i := 0 TO n DO
b[start+i] := a[i];
END;
END;
END;
END;
END;
END Replace;
(* ---------------------------------------------------------------- *)
PROCEDURE Delete( VAR a :ARRAY OF CHAR; start, len :CARDINAL );
VAR
i, n, top, remain :CARDINAL;
BEGIN
IF len > 0 THEN
n := Length( a );
IF start = 0 THEN start := 1; END;
IF start <= n THEN
top := start + len - 1; (* last character of the delete section *)
IF top >= n THEN
(* all the remaining characters are to be deleted *)
(* so just end the string here *)
a[start-1] := nul;
ELSE
(* determine how many characters must be shifted down from *)
(* above the delete section *)
n := n - top;
(* change 'start' back to zero offset *)
start := start - 1;
FOR i := 0 TO n - 1 DO
a[start+i] := a[top+i];
END;
a[start+n] := nul;
END;
END;
END;
END Delete;
(* ---------------------------------------------------------------- *)
PROCEDURE Upper( VAR string :ARRAY OF CHAR );
VAR
i, n :CARDINAL;
c :CHAR;
BEGIN
n := Length( string );
FOR i := 0 TO n-1 DO
c := string[i];
IF ( c >= 'a' ) & ( c <= 'z' ) THEN
string[i] := CAP( c );
END;
END;
END Upper;
(* ---------------------------------------------------------------- *)
PROCEDURE Lower( VAR string :ARRAY OF CHAR );
VAR
i, n :CARDINAL;
c :CHAR;
BEGIN
n := Length( string );
FOR i := 0 TO n-1 DO
c := string[i];
IF ( c >= 'A' ) & ( c <= 'Z' ) THEN
string[i] := CHR( ORD( c ) + 32 );
END;
END;
END Lower;
(* -------------------------------------------- *)
PROCEDURE NextScan( source :ARRAY OF CHAR; start :CARDINAL;
ScanFor :CharScanProc ) :CARDINAL;
VAR
i, n :CARDINAL;
BEGIN
n := Length( source );
IF n = 0 THEN
RETURN 0;
ELSE
IF start = 0 THEN start := 1; END;
IF start > n THEN
RETURN 0;
ELSE
i := start - 1;
WHILE ( i < n ) & ScanFor( source[i] ) DO
i := i + 1;
END;
IF i = n THEN
RETURN 0;
ELSE
RETURN i + 1;
END;
END;
END;
END NextScan;
(* -------------------------------------------- *)
PROCEDURE NextBlank( source :ARRAY OF CHAR;
start :CARDINAL ) :CARDINAL;
BEGIN
RETURN NextScan( source, start, NonBlank );
END NextBlank;
(* -------------------------------------------- *)
PROCEDURE NextNonBlank( source :ARRAY OF CHAR;
start :CARDINAL ) :CARDINAL;
BEGIN
RETURN NextScan( source, start, Blank );
END NextNonBlank;
(* ---------------------------------------------------------------- *)
PROCEDURE Empty( VAR string :ARRAY OF CHAR );
VAR
i, n :CARDINAL;
BEGIN
n := HIGH( string );
FOR i := 0 TO n DO
string[i] := nul;
END;
END Empty;
(* ---------------------------------------------------------------- *)
PROCEDURE Trim( VAR string :ARRAY OF CHAR );
VAR
n, on_input :CARDINAL;
BEGIN
on_input := Length( string );
IF on_input # 0 THEN
on_input := on_input - 1;
n := on_input;
(* start at the end and run backwards *)
WHILE ( n > 0 ) & Blank( string[n] ) DO
n := n - 1;
END;
(* has the length of the string actually changed *)
IF n # on_input THEN
(* end the string properly *)
IF n = 0 THEN
IF Blank( string[0] ) THEN string[0] := nul; END;
ELSE
string[n+1] := nul;
END;
END;
END;
END Trim;
(* ---------------------------------------------------------------- *)
PROCEDURE Length( string :ARRAY OF CHAR ) :CARDINAL;
VAR
i, n :CARDINAL;
BEGIN
n := HIGH( string );
i := 0;
WHILE ( i <= n ) & ( string[i] # nul ) DO
i := i + 1;
END;
RETURN i;
END Length;
BEGIN
END StringOperations.