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

(* Modula-2+ version created by John Ellis in ancient times.   *)
(* Simplified and ported to Modula-3 by J.Stolfi on May 1990.  *)
(* Last modified on Wed Feb 12 12:38:05 PST 1992 by muller     *)
(*      modified on Tue Oct 15 22:54:06 PDT 1991 by stolfi     *)

MODULE SxSymbol;

IMPORT Text, TxtRefTbl;

VAR
  Counter: RECORD
      mutex: MUTEX;
      value: CARDINAL;
    END;

TYPE 
  Public = OBJECT 
      parent:  (*CONST*) T;        (* The symbol's parent, or NIL if root *)
      name:    (*CONST*) TEXT;     (* Symbol's name rel. to parent, if parent#NIL *)
      number:  (*CONST*) CARDINAL; (* Symbol's serial number *)
    END;

REVEAL 
  T = Public BRANDED OBJECT
      mutex: MUTEX;                    (* Protects children table *) 
      children: TxtRefTbl.T;   (* Hash table of symbol's children *)
    END;

PROCEDURE Init() =
  CONST DefaultRootNumber = 0;     (* Serial number of root. *)
  BEGIN
    Counter.mutex := NEW(MUTEX);
    Counter.value := DefaultRootNumber;
    DefaultRoot := NewRoot();
  END Init;

PROCEDURE New(name: TEXT; parent: T): T =
  (* 
    Creates a new symbol record with given name and parent,
    assuming there is none such. Does not add the symbol
    to the parent's children list. *)
  BEGIN
    <* ASSERT name # NIL *>
    WITH symbol = NEW (T) DO
      symbol.name := name;
      symbol.parent := parent;
      LOCK Counter.mutex DO
        symbol.number := Counter.value; INC(Counter.value)
      END;
      symbol.mutex := NEW(MUTEX);
      symbol.children := NIL;
      RETURN symbol
    END
  END New;

PROCEDURE NewRoot(): T =
  BEGIN
    RETURN New("ROOT", NIL)
  END NewRoot;

PROCEDURE FromName(name: TEXT; parent: T := NIL): T =
  CONST TableSize = 8;  (* Initial root table size *)
  VAR childAny: REFANY;
  BEGIN
    IF parent = NIL THEN parent := DefaultRoot END;
    LOCK parent.mutex DO  
      IF parent.children = NIL THEN
        parent.children := TxtRefTbl.New(TableSize)
      ELSE
        IF parent.children.in(name, childAny) THEN
          RETURN NARROW(childAny, T);
        END
      END;
      (* Create symbol node and add to parent's table: *)
      WITH symbol = New(name, parent) DO
        IF parent.children.put(name, symbol) THEN <*ASSERT FALSE*> END;
        RETURN symbol
      END
    END
  END FromName;

PROCEDURE FromNameChars(READONLY name: ARRAY OF CHAR; parent: T := NIL): T =
  CONST TableSize = 8;  (* Initial root table size *)
  VAR childAny: REFANY;
  BEGIN
    IF parent = NIL THEN parent := DefaultRoot END;
    LOCK parent.mutex DO  
      IF parent.children = NIL THEN
        parent.children := TxtRefTbl.New(TableSize)
      ELSE
        IF parent.children.inChars(name, childAny) THEN
          RETURN NARROW(childAny, T);
        END
      END;
      (* Create symbol node and add to parent's table: *)
      WITH 
        text = Text.FromChars(name),
        symbol = New(text, parent)
      DO
        IF parent.children.put(text, symbol) THEN <*ASSERT FALSE*> END;
        RETURN symbol
      END
    END
  END FromNameChars;

PROCEDURE FromNames(READONLY name: ARRAY OF TEXT; root: T := NIL): T =
  VAR s := root;
  BEGIN 
    IF s = NIL THEN s := DefaultRoot END;
    FOR i := 0 TO LAST(name) DO s := FromName(name[i], s) END;
    RETURN s
  END FromNames;

BEGIN
  Init()
END SxSymbol.