M2compiler-V3/stdlib/strings.mod

IMPLEMENTATION MODULE Strings;
(* NUL-terminated string operations, matching the V3 CHAR-array model
   (every CHAR array reserves a terminator slot at index = count) and
   gm2's conventions. Length scans for the terminator rather than using
   the descriptor count, so fixed-size buffers holding shorter strings
   behave correctly. *)

PROCEDURE Length (VAR s : ARRAY OF CHAR) : INTEGER;
VAR i : INTEGER;
BEGIN
  i := 0;
  WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
  RETURN i
END Length;

PROCEDURE Assign (VAR src, dst : ARRAY OF CHAR);
VAR i, n, cap : INTEGER;
BEGIN
  n := Length(src);
  cap := HIGH(dst);
  IF n > cap THEN n := cap END;
  i := 0;
  WHILE i < n DO
    dst[i] := src[i];
    i := i + 1
  END;
  dst[n] := CHR(0)
END Assign;

PROCEDURE Copy (VAR src, dst : ARRAY OF CHAR);
BEGIN
  Assign(src, dst)
END Copy;

PROCEDURE Concat (VAR s1, s2 : ARRAY OF CHAR; VAR dst : ARRAY OF CHAR);
VAR i, n1, n2, cap : INTEGER;
BEGIN
  n1 := Length(s1);
  n2 := Length(s2);
  cap := HIGH(dst);
  IF n1 > cap THEN n1 := cap END;
  IF n1 + n2 > cap THEN n2 := cap - n1 END;
  IF n2 < 0 THEN n2 := 0 END;
  i := 0;
  WHILE i < n1 DO
    dst[i] := s1[i];
    i := i + 1
  END;
  i := 0;
  WHILE i < n2 DO
    dst[n1 + i] := s2[i];
    i := i + 1
  END;
  dst[n1 + n2] := CHR(0)
END Concat;

PROCEDURE Delete (VAR s : ARRAY OF CHAR; start, count : INTEGER);
VAR n, i : INTEGER;
BEGIN
  n := Length(s);
  IF start < 0 THEN start := 0 END;
  IF start > n THEN start := n END;
  IF count < 0 THEN count := 0 END;
  IF start + count > n THEN count := n - start END;
  i := start;
  WHILE i + count < n DO
    s[i] := s[i + count];
    i := i + 1
  END;
  s[n - count] := CHR(0)
END Delete;

PROCEDURE Append (VAR src, dst : ARRAY OF CHAR);
VAR n, m, cap, i : INTEGER;
BEGIN
  n := Length(dst);
  m := Length(src);
  cap := HIGH(dst);
  IF n + m > cap THEN m := cap - n END;
  IF m < 0 THEN m := 0 END;
  i := 0;
  WHILE i < m DO
    dst[n + i] := src[i];
    i := i + 1
  END;
  dst[n + m] := CHR(0)
END Append;

PROCEDURE Equal (VAR s1, s2 : ARRAY OF CHAR) : BOOLEAN;
VAR i, n1, n2 : INTEGER;
BEGIN
  n1 := Length(s1); n2 := Length(s2);
  IF n1 # n2 THEN RETURN FALSE END;
  i := 0;
  WHILE i < n1 DO
    IF s1[i] # s2[i] THEN RETURN FALSE END;
    i := i + 1
  END;
  RETURN TRUE
END Equal;

PROCEDURE Pos (VAR pattern, s : ARRAY OF CHAR) : INTEGER;
VAR i, j, np, ns : INTEGER;
    found : BOOLEAN;
BEGIN
  np := Length(pattern);
  ns := Length(s);
  IF (np = 0) OR (np > ns) THEN RETURN 0 END;
  i := 0;
  WHILE i + np <= ns DO
    j := 0; found := TRUE;
    WHILE (j < np) AND found DO
      IF s[i + j] # pattern[j] THEN
        found := FALSE
      ELSE
        j := j + 1
      END
    END;
    IF found THEN RETURN i + 1 END;
    i := i + 1
  END;
  RETURN 0
END Pos;

PROCEDURE Slice (VAR s : ARRAY OF CHAR; start, stop : INTEGER;
                 VAR dst : ARRAY OF CHAR);
VAR n, i, k, cap : INTEGER;
BEGIN
  n := Length(s);
  IF start < 0 THEN start := n + start END;
  IF stop < 0 THEN stop := n + stop END;
  IF start < 0 THEN start := 0 END;
  IF start > n THEN start := n END;
  IF stop < 0 THEN stop := 0 END;
  IF stop > n THEN stop := n END;
  IF stop < start THEN stop := start END;
  cap := HIGH(dst);
  i := start; k := 0;
  WHILE (i < stop) AND (k < cap) DO
    dst[k] := s[i];
    INC(i); INC(k)
  END;
  dst[k] := CHR(0)
END Slice;

PROCEDURE Insert (VAR src, dst : ARRAY OF CHAR; pos : INTEGER);
VAR n, m, cap, nl, i : INTEGER;
BEGIN
  n := Length(dst);
  m := Length(src);
  cap := HIGH(dst);
  IF pos < 0 THEN pos := 0 END;
  IF pos > n THEN pos := n END;
  IF m < 0 THEN m := 0 END;
  IF n + m > cap THEN m := cap - n END;   (* only what fits *)
  IF m < 0 THEN m := 0 END;
  (* shift the tail right by m, from the end backwards *)
  i := n;
  WHILE i > pos DO
    DEC(i);
    IF i + m <= cap THEN dst[i + m] := dst[i] END
  END;
  i := 0;
  WHILE i < m DO
    dst[pos + i] := src[i];
    INC(i)
  END;
  nl := n + m;
  IF nl > cap THEN nl := cap END;
  dst[nl] := CHR(0)
END Insert;

PROCEDURE Replace (VAR src, dst : ARRAY OF CHAR; pos : INTEGER);
VAR n, m, cap, nl, i : INTEGER;
BEGIN
  n := Length(dst);
  m := Length(src);
  cap := HIGH(dst);
  IF pos < 0 THEN pos := 0 END;
  IF pos > n THEN pos := n END;
  i := 0;
  WHILE (i < m) AND (pos + i < cap) DO
    dst[pos + i] := src[i];
    INC(i)
  END;
  nl := pos + m;
  IF nl > cap THEN nl := cap END;
  IF nl > n THEN dst[nl] := CHR(0) END
END Replace;

PROCEDURE Capitalize (VAR s : ARRAY OF CHAR);
VAR i, n : INTEGER;
    ch : CHAR;
BEGIN
  n := Length(s);
  i := 0;
  WHILE i < n DO
    ch := s[i];
    IF i = 0 THEN
      IF (ch >= "a") AND (ch <= "z") THEN
        ch := CHR(ORD(ch) - 32)
      END
    ELSE
      IF (ch >= "A") AND (ch <= "Z") THEN
        ch := CHR(ORD(ch) + 32)
      END
    END;
    s[i] := ch;
    INC(i)
  END
END Capitalize;

PROCEDURE Compare (VAR s1, s2 : ARRAY OF CHAR) : INTEGER;
VAR i, n1, n2, n : INTEGER;
BEGIN
  n1 := Length(s1);
  n2 := Length(s2);
  n := n1;
  IF n2 < n THEN n := n2 END;
  i := 0;
  WHILE i < n DO
    IF s1[i] < s2[i] THEN RETURN -1
    ELSIF s1[i] > s2[i] THEN RETURN 1
    END;
    i := i + 1
  END;
  IF n1 < n2 THEN RETURN -1
  ELSIF n1 > n2 THEN RETURN 1
  END;
  RETURN 0
END Compare;

END Strings.