ack/lang/m2/libm2/Strings.mod
1987-05-13 14:36:45 +00:00

162 lines
3.8 KiB
Modula-2

IMPLEMENTATION MODULE Strings;
PROCEDURE Assign(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
(* Assign string source to dest
*)
VAR i: CARDINAL;
max: CARDINAL;
BEGIN
max := HIGH(source);
IF HIGH(dest) < max THEN max := HIGH(dest); END;
i := 0;
WHILE (i <= max) AND (source[i] # 0C) DO
dest[i] := source[i];
INC(i);
END;
IF i < HIGH(dest) THEN dest[i] := 0C; END;
END Assign;
PROCEDURE Insert(substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR; inx: CARDINAL);
(* Insert the string substr into str, starting at str[inx].
If inx is equal to or greater than Length(str) then substr is appended
to the end of str.
*)
VAR sublen, length, i: CARDINAL;
BEGIN
sublen := Length(substr);
IF sublen = 0 THEN RETURN; END;
length := Length(str);
IF inx > length THEN inx := length; END;
i := length;
IF i + sublen - 1 > HIGH(str) THEN i := HIGH(str); END;
WHILE i > inx DO
str[i+sublen-1] := str[i-1];
DEC(i);
END;
FOR i := 0 TO sublen - 1 DO
IF i + inx <= HIGH(str) THEN
str[i + inx] := substr[i];
ELSE
RETURN;
END;
END;
IF length + sublen <= HIGH(str) THEN
str[length + sublen] := 0C;
END;
END Insert;
PROCEDURE Delete(VAR str: ARRAY OF CHAR; inx, len: CARDINAL);
(* Delete len characters from str, starting at str[inx].
If inx >= Length(str) then nothing happens.
If there are not len characters to delete, characters to the end of the
string are deleted.
*)
VAR length: CARDINAL;
i : CARDINAL;
BEGIN
IF len = 0 THEN RETURN; END;
length := Length(str);
IF inx >= length THEN RETURN; END;
WHILE inx + len < length DO
str[inx] := str[inx + len];
INC(inx);
END;
str[inx] := 0C;
END Delete;
PROCEDURE Pos(substr, str: ARRAY OF CHAR): CARDINAL;
(* Return the index into str of the first occurrence of substr.
Pos returns a value greater than HIGH(str) of no occurrence is found.
*)
VAR i, j, max, subl: CARDINAL;
BEGIN
max := Length(str);
subl := Length(substr);
IF subl > max THEN RETURN HIGH(str) + 1; END;
IF subl = 0 THEN RETURN 0; END;
max := max - subl;
FOR i := 0 TO max DO
j := 0;
WHILE (j <= subl-1) AND (str[i+j] = substr[j]) DO
INC(j);
END;
IF j = subl THEN RETURN i; END;
END;
RETURN HIGH(str) + 1;
END Pos;
PROCEDURE Copy(str: ARRAY OF CHAR;
inx, len: CARDINAL;
VAR result: ARRAY OF CHAR);
(* Copy at most len characters from str into result, starting at str[inx].
*)
VAR i: CARDINAL;
BEGIN
IF Length(str) <= inx THEN RETURN END;
i := 0;
LOOP
IF i > HIGH(result) THEN RETURN; END;
IF len = 0 THEN EXIT; END;
IF inx > HIGH(str) THEN EXIT; END;
result[i] := str[inx];
INC(i); INC(inx); DEC(len);
END;
IF i <= HIGH(result) THEN result[i] := 0C; END;
END Copy;
PROCEDURE Concat(s1, s2: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
(* Concatenate two strings.
*)
VAR i, j: CARDINAL;
BEGIN
i := 0;
WHILE (i <= HIGH(s1)) AND (s1[i] # 0C) DO
IF i > HIGH(result) THEN RETURN END;
result[i] := s1[i];
INC(i);
END;
j := 0;
WHILE (j <= HIGH(s2)) AND (s2[j] # 0C) DO
IF i > HIGH(result) THEN RETURN END;
result[i] := s2[j];
INC(i);
INC(j);
END;
IF i <= HIGH(result) THEN result[i] := 0C; END;
END Concat;
PROCEDURE Length(str: ARRAY OF CHAR): CARDINAL;
(* Return number of characters in str.
*)
VAR i: CARDINAL;
BEGIN
i := 0;
WHILE (i <= HIGH(str)) DO
IF str[i] = 0C THEN RETURN i; END;
INC(i);
END;
RETURN i;
END Length;
PROCEDURE CompareStr(s1, s2: ARRAY OF CHAR): INTEGER;
(* Compare two strings, return -1 if s1 < s2, 0 if s1 = s2, and 1 if s1 > s2.
*)
VAR i: CARDINAL;
max: CARDINAL;
BEGIN
max := HIGH(s1);
IF HIGH(s2) < max THEN max := HIGH(s2); END;
i := 0;
WHILE (i <= max) DO
IF s1[i] < s2[i] THEN RETURN -1; END;
IF s1[i] > s2[i] THEN RETURN 1; END;
IF s1[i] = 0C THEN RETURN 0; END;
INC(i);
END;
IF (i <= HIGH(s1)) AND (s1[i] # 0C) THEN RETURN 1; END;
IF (i <= HIGH(s2)) AND (s2[i] # 0C) THEN RETURN -1; END;
RETURN 0;
END CompareStr;
END Strings.