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

(* File: String.m3                                             *)
(* Last modified on Fri May 11 10:49:38 1990 by muller         *)
(*      modified on Tue Feb 13 21:06:45 1990 by kalsow         *)



UNSAFE MODULE String;

IMPORT Wr, UnsafeWr, Text, Fmt, Word;

CONST
  MaxHash      = 1024;
  MaxCharIndex = 300000;
  MaxTexts     = 1024;
  NOTEXT       = -1;

TYPE
  Index = [0..MaxCharIndex];

REVEAL
  T = UNTRACED BRANDED REF RECORD
    start  : Index;
    length : Index;
    class  : INTEGER;
    hash   : INTEGER;
    textID : INTEGER;
    uid    : INTEGER;
    next   : T;
  END;

VAR
  nextChar : Index := 0;
  nTexts   : INTEGER := 0;
  chars    : ARRAY Index OF CHAR;
  hashTable: ARRAY [0..MaxHash - 1] OF T := ARRAY [0..MaxHash-1] OF T {NIL,..};
  counter  : ARRAY [0..4] OF CHAR;
  texts    : ARRAY [0..MaxTexts] OF Text.T;
  digits   := ARRAY [0..9] OF CHAR {'0','1','2','3','4','5','6','7','8','9'};
  numbers  : ARRAY [0..100] OF T := ARRAY [0..100] OF T {NIL, ..};

PROCEDURE Add (x: Text.T;  length: INTEGER := 999999): T =
  VAR j: Index;  t: T;
  BEGIN
    length := MIN (length, Text.Length (x));
    j := nextChar;
    FOR i := 0 TO length - 1 DO
      chars[j] := Text.GetChar (x, i);
      INC (j);
    END;
    t := Append (j);
    IF (t.textID = NOTEXT) THEN
      t.textID := nTexts;
      texts[nTexts] := Text.Sub (x, 0, length);
      INC (nTexts);
    END;
    RETURN t;
  END Add;

PROCEDURE AddInt (i: INTEGER): T =
  VAR t: T;
  BEGIN
    IF 0 <= i AND i < NUMBER (numbers) THEN
      IF numbers [i] = NIL THEN
        t := NEW (T);
        t.class := -1;
        t.hash := i;
        numbers [i] := t;
      END;
      RETURN numbers [i];
    ELSE
      t := NEW (T);
      t.class := -1;
      t.hash := i;
      RETURN t;
    END;
  END AddInt;

PROCEDURE FromStr (READONLY buf: ARRAY OF CHAR;  length: INTEGER := 99999): T =
  VAR j: Index;
  BEGIN
    length := MIN (length, NUMBER (buf));
    j := nextChar;
    FOR i := 0 TO length - 1 DO
      chars[j] := buf[i];
      INC (j);
    END;
    RETURN Append (j);
  END FromStr;

PROCEDURE Concat (a, b: T): T =
  VAR j: INTEGER;
  BEGIN
    IF (a = NIL) OR (a.length = 0) THEN RETURN b END;
    IF (b = NIL) OR (b.length = 0) THEN RETURN a END;
    j := nextChar;
    FOR i := a.start TO a.start + a.length - 1 DO
      chars[j] := chars[i];
      INC (j);
    END;
    FOR i := b.start TO b.start + b.length - 1 DO
      chars[j] := chars[i];
      INC (j);
    END;
    RETURN Append (j);
  END Concat;

PROCEDURE Append (finish: Index): T =
  VAR len, hash, bucket: INTEGER; t: T;
  BEGIN
    len  := finish - nextChar;
    hash := 0;
    FOR i := nextChar TO nextChar + len - 1 DO
      hash := 2 * hash + ORD (chars[i]);
    END;
    bucket := hash MOD MaxHash;
    t := hashTable[bucket];
    WHILE (t # NIL) DO
      IF (t.hash = hash)
        AND (t.length = len)
        AND Equal (nextChar, t.start, len) THEN
        (* we found a hit! *)
        RETURN t;
      END;
      t := t.next;
    END;
    (* we didn't find the string *)
    t := NEW (T);
    t.start  := nextChar;
    t.length := len;
    t.class  := 0;
    t.hash   := hash;
    t.next   := hashTable [bucket];
    t.textID := NOTEXT;
    t.uid    := NOTEXT;
    hashTable [bucket] := t;
    chars[finish] := '\000';
    nextChar := finish + 1;
    RETURN t;
  END Append;

PROCEDURE Equal (a, b: Index;  len: INTEGER): BOOLEAN =
  BEGIN
    WHILE (len > 0) DO
      IF (chars[a] # chars[b]) THEN RETURN FALSE END;
      DEC (len);  INC (a);  INC (b);
    END;
    RETURN TRUE;
  END Equal;

PROCEDURE Unique (root: T): T =
  VAR j: INTEGER;
  BEGIN
    j := LAST (counter);
    WHILE (counter[j] = '9') DO  counter[j] := '0'; DEC (j);  END;
    counter[j] := VAL (ORD (counter[j]) + 1, CHAR);
    j := nextChar;
    FOR i := root.start TO root.start + root.length - 1 DO
      chars[j] := chars[i];
      INC (j);
    END;
    FOR i := 0 TO LAST (counter) DO
      chars[j] := counter[i];
      INC (j);
    END;
    RETURN Append (j);
  END Unique;

PROCEDURE ToText (t: T): Text.T =
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    IF (t.textID = NOTEXT) THEN
      t.textID := nTexts;
      texts[nTexts] := Text.FromStr (SUBARRAY (chars, t.start, t.length));
      INC (nTexts);
    END;
    RETURN texts [t.textID];
  END ToText;

PROCEDURE Put (wr: Wr.T;  t: T) =
  BEGIN
    IF (t # NIL) THEN
      IF t.class = -1 THEN
        VAR i := t.hash;
        BEGIN
          IF (0 <= i) THEN
            IF (i < 10) THEN
              UnsafeWr.FastPutChar (wr, digits[i]);
            ELSIF (i < 100) THEN
              UnsafeWr.FastPutChar (wr, digits[i DIV 10]);
              UnsafeWr.FastPutChar (wr, digits[i MOD 10]);
            ELSE
              UnsafeWr.FastPutInt (wr, i);
            END;
          ELSE
            UnsafeWr.FastPutInt (wr, i);
          END;
        END;
      ELSE
        FOR i := t.start TO t.start + t.length - 1 DO
          EmitChar (wr, chars[i]);
        END;
      END;
    END;
  END Put;

PROCEDURE PutStack (wr: Wr.T; s: Stack) =
  BEGIN
    FOR i := 0 TO s.top - 1 DO Put (wr, s.stk[i]); END;
  END PutStack;

PROCEDURE PutChars (wr: Wr.T; t: T) =
  VAR n: INTEGER;
  BEGIN
    IF (t # NIL) THEN
      n := 0;
      FOR i := t.start TO t.start + t.length - 1 DO
	IF (i > t.start) THEN  UnsafeWr.FastPutChar (wr, ',')  END;
        IF (n >= 20) THEN  UnsafeWr.FastPutChar (wr, '\n'); n := 0  END;
	UnsafeWr.FastPutChar (wr, '\'');
	EmitChar (wr, chars[i]);
	UnsafeWr.FastPutChar (wr, '\'');
	INC (n);
      END;
    END;
  END PutChars;

PROCEDURE EmitChar (wr: Wr.T;  c: CHAR) =
  VAR i: INTEGER;
  BEGIN
    IF (c < ' ') OR (c = '\"') OR (c = '\'') OR ('~' < c) OR (c = '\\') THEN
      i := Word.And (ORD (c), 255);
      UnsafeWr.FastPutChar (wr, '\\');
      UnsafeWr.FastPutChar (wr, digits[i DIV 64]);  i := Word.And (i, 63);
      UnsafeWr.FastPutChar (wr, digits[i DIV 8]);   i := Word.And (i, 7);
      UnsafeWr.FastPutChar (wr, digits[i]);
    ELSE (* simple graphic character *)
      UnsafeWr.FastPutChar (wr, c);
    END;
  END EmitChar;

PROCEDURE SetClass (t: T;  class: CARDINAL) =
  BEGIN
    t.class := class;
  END SetClass;

PROCEDURE GetClass (t: T): INTEGER =
  BEGIN
    RETURN t.class;
  END GetClass;

PROCEDURE Length (t: T): INTEGER =
  BEGIN
    IF (t = NIL)
      THEN RETURN 0;
      ELSE RETURN t.length;
    END;
  END Length;

PROCEDURE GetUID (t: T): INTEGER =
  BEGIN
    RETURN t.uid;
  END GetUID;

PROCEDURE SetUID (t: T;  uid: INTEGER) =
  BEGIN
    t.uid := uid;
  END SetUID;

PROCEDURE Initialize () =
  BEGIN
    counter[0] := '_';
    FOR i := 1 TO LAST (counter) DO counter[i] := '0' END;
  END Initialize;

BEGIN
END String.