text/src/Text.m3


Copyright (C) 1994, Digital Equipment Corp.
 Last Modified On Fri Aug 11 13:05:42 PDT 1995 By detlefs    
      Modified On Fri Mar 25 12:03:21 PST 1994 By kalsow     
      Modified On Tue Feb 15 10:19:04 PST 1994 By perl       
      Modified On Tue Feb 16 10:20:34 PST 1993 By mjordan    
      Modified On Tue Nov  3 16:19:49 PST 1992 By meehan     
      Modified On Thu Oct  8 08:53:53 PDT 1992 By mcjones    
      Modified On Wed Oct  7 11:51:?? PDT 1991 By muller     

MODULE Text EXPORTS Text, TextF;

TYPE CharMap = ARRAY CHAR OF T;
VAR fromCharCache := CharMap {NIL, ..}; (* 1-char texts *)

PROCEDURE New (n: CARDINAL): T RAISES {} =
  BEGIN
    WITH t = NEW (T, n + 1) DO
      t[n] := '\000';
      RETURN t;
    END;
  END New;

PROCEDURE Cat (t, u: T): T =
  BEGIN
    WITH nt = NUMBER (t^),  nu = NUMBER (u^) DO
      IF nt <= 1 THEN RETURN u END;
      IF nu <= 1 THEN RETURN t END;
      WITH res = NEW (T, nt + nu - 1) DO
        SUBARRAY(res^, 0, nt) := t^;
        SUBARRAY(res^, nt-1, nu) := u^;
        RETURN res;
      END;
    END;
  END Cat;

PROCEDURE Equal (t, u: T): BOOLEAN =
  BEGIN
    IF NUMBER (t^) <= 1 THEN
      RETURN NUMBER (u^) <= 1;
    ELSIF NUMBER (u^) <= 1 THEN
      RETURN (FALSE);
    ELSE
      RETURN (t^ = u^);
    END;
  END Equal;

PROCEDURE GetChar (t: T; i: CARDINAL): CHAR =
  BEGIN
    IF i = LAST (t^) THEN (* force a subscript fault *) INC (i) END;
    RETURN t[i];
  END GetChar;

PROCEDURE Length (t: T): CARDINAL =
  BEGIN
    RETURN MAX (0, NUMBER (t^) - 1);
  END Length;

PROCEDURE Empty (t: T): BOOLEAN =
  BEGIN
    RETURN (NUMBER (t^) <= 1);
  END Empty;

PROCEDURE Sub (t: T; start, length: CARDINAL): T =
  BEGIN
    WITH n   = NUMBER (t^) - 1,
         len = MIN (n - start, length) DO
      IF (len <= 0) THEN RETURN "" END;
      IF (len = n) THEN RETURN t END;
      IF len = 1 THEN RETURN FromChar (t [start]) END;
      WITH res = NEW (T, len + 1) DO
        SUBARRAY(res^, 0, len) := SUBARRAY(t^, start, len);
        res [len] := '\000';
        RETURN res;
      END;
    END;
  END Sub;

PROCEDURE SetChars (VAR a: ARRAY OF CHAR; t: T) =
  BEGIN
    WITH n = MIN (NUMBER (a), NUMBER (t^)-1) DO
      SUBARRAY(a, 0, n) := SUBARRAY(t^, 0, n)
    END;
  END SetChars;

PROCEDURE FromChar (c: CHAR): T =
  BEGIN
    IF fromCharCache [c] = NIL THEN
      WITH new = NEW (T, 2) DO
        new [0] := c;
        new [1] := '\000';
        fromCharCache [c] := new;
        RETURN new
      END
    END;
    RETURN fromCharCache [c]
  END FromChar;

PROCEDURE FromChars (READONLY a: ARRAY OF CHAR): T =
  BEGIN
    WITH n = NUMBER (a) DO
      IF (n = 0) THEN RETURN "" END;
      IF n = 1 THEN RETURN FromChar (a [0]) END;
      WITH res = NEW (T, n + 1) DO
        SUBARRAY(res^, 0, n) := SUBARRAY(a, 0, n);
        res [n] := '\000';
        RETURN res;
      END;
    END;
  END FromChars;

PROCEDURE FindChar (t: T;  c: CHAR;  start := 0): INTEGER =
  BEGIN
    IF (start < 0) THEN RETURN -1 END;
    WITH len = NUMBER (t^) - 1 DO
      LOOP
        IF (start >= len) THEN RETURN -1 END;
        IF (t[start] = c) THEN RETURN start END;
        INC (start);
      END;
    END;
  END FindChar;

PROCEDURE FindCharR (t: T;  c: CHAR;  start := LAST (INTEGER)): INTEGER =
  VAR
    n := NUMBER (t^) - 2;
    i := MIN (n, start);
  BEGIN
    LOOP
      IF (i < 0) THEN RETURN -1 END;
      IF (t[i] = c) THEN RETURN i END;
      DEC (i);
    END;
  END FindCharR;

PROCEDURE Compare (t, u: T): [-1..1] =
  BEGIN
    WITH tEmpty = NUMBER (t^) <= 1,
         uEmpty = NUMBER (u^) <= 1 DO
      IF (tEmpty) THEN
        IF (uEmpty) THEN RETURN 0 ELSE RETURN -1 END;
      ELSIF (uEmpty) THEN
        RETURN 1;
      ELSE
        WITH tn = NUMBER (t^) - 1, tu = NUMBER (u^) - 1 DO
          FOR i := 0 TO MIN (tn, tu) DO
            IF    ORD (t[i]) < ORD (u[i]) THEN RETURN -1;
            ELSIF ORD (t[i]) > ORD (u[i]) THEN RETURN +1;
            END;
          END;
          IF    (tn = tu) THEN RETURN 0;
          ELSIF (tn < tu) THEN RETURN -1;
          ELSE                 RETURN +1;
          END;
        END;
      END;
    END;
  END Compare;

BEGIN
END Text.