(* Copyright (C) 1989, 1990, Digital Equipment Corporation     *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last 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     *)
(*      Modified On Fri Feb 28 09:12:11 PST 1992 By kalsow     *)

UNSAFE MODULE Text EXPORTS Text, TextF;

IMPORT Cstring, Word;

VAR fromCharCache := ARRAY CHAR OF T {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
        EVAL Cstring.memcpy (ADR (res[0]), ADR (t[0]), nt - 1);
        EVAL Cstring.memcpy (ADR (res[nt - 1]), ADR (u[0]), nu);
        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
        EVAL Cstring.memcpy (ADR (res [0]), ADR (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
      IF (n > 0) THEN EVAL Cstring.memcpy (ADR (a[0]), ADR (t[0]), n) END;
    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
        EVAL Cstring.memcpy (ADR (res [0]), ADR (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)-5): INTEGER =
(*** Note: the default value for start should be LAST (INTEGER);
     however, there is a bug in some C compilers and the - 5 fixes that. *)
  VAR i: INTEGER;
  BEGIN
    i := MIN (NUMBER (t^) - 2, start);
    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;

PROCEDURE Hash (t: T): INTEGER =
  VAR res := 0;
  BEGIN
    FOR i := 0 TO MIN (NUMBER (t^) - 1, Word.Size DIV 2) DO
      res := Word.Plus (Word.LeftShift (res, 2), ORD (t [i]));
    END;
    RETURN res;
  END Hash;

BEGIN END Text.