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

(* File: NamedType.m3                                          *)
(* Last modified on Wed Sep  2 10:43:58 PDT 1992 by rustan     *)
(*      modified on Mon Mar  2 11:16:44 PST 1992 by kalsow     *)
(*      modified on Fri Dec 21 01:25:25 1990 by muller         *)

MODULE NamedType;

IMPORT Token, Type, TypeRep, Scanner, ObjectType, Value, String;
IMPORT Error, Scope, Int, RefType, MBuf, M3;
IMPORT TrOffsets;

TYPE
  P = Type.T BRANDED "NamedType.T" OBJECT
        scope      : Scope.T;
	qid        : String.QID;
	type       : Type.T;
        obj        : Value.T;
      OVERRIDES
        check      := Check;
        base       := Baser;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        count      := Counter;
        bounds     := Bounder;
        size       := Sizer;
        minSize    := MinSizer;
        alignment  := Aligner;
	isEmpty    := IsEmpty;
        dependsOn  := DependsOn;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        tracedOffs := TracedOffs;
        paramEncoding := ParamEnc;
        mapper     := GenMap;
        fprint     := FPrinter;
        stripper   := Strip;
        class      := MyClass;
      END;

PROCEDURE Parse (READONLY fail: Token.Set): Type.T =
  TYPE TK = Token.T;
  VAR p: P;  t: Type.T;
  BEGIN
    IF (Scanner.cur.token = TK.tIDENT)
      AND (Scanner.cur.defn # NIL)
      AND (Value.ClassOf (Scanner.cur.defn) = Value.Class.Type) THEN
      (* this identifier is reserved! *)
      t := Value.ToType (Scanner.cur.defn);
      Scanner.GetToken (); (* IDENT *)
    ELSE
      (* this is a non-reserved ID *)
      p := NEW (P);
      TypeRep.Init (p);
      p.scope      := Scope.Top ();
      p.type       := NIL;
      p.obj        := NIL;
      p.qid.module := NIL;
      p.qid.item   := Scanner.MatchID (fail, Token.Set {TK.tDOT});
      IF (Scanner.cur.token = TK.tDOT) THEN
        Scanner.GetToken (); (* . *)
        p.qid.module := p.qid.item;
        p.qid.item   := Scanner.MatchID1 (fail);
      END;
      t := p;
    END;
 
    IF (Scanner.cur.token = TK.tBRANDED) THEN
      t := ObjectType.Parse (t, FALSE, RefType.ParseBrand (fail), fail);
    ELSIF (Scanner.cur.token = TK.tOBJECT) THEN
      t := ObjectType.Parse (t, FALSE, NIL, fail);
    END;
    RETURN t;
  END Parse;

PROCEDURE New (t: Type.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.scope      := NIL;
    p.qid.module := NIL;
    p.qid.item   := NIL;
    p.type       := t;
    p.obj        := NIL;
    RETURN p;
  END New;

PROCEDURE Create (m, n: String.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.scope      := Scope.Top ();
    p.qid.module := m;
    p.qid.item   := n;
    p.type       := NIL;
    p.obj        := NIL;
    RETURN p;
  END Create;

PROCEDURE Split (t: Type.T;  VAR name: String.QID): BOOLEAN =
  BEGIN
    TYPECASE t OF
    | NULL => RETURN FALSE;
    | P(p) => name := p.qid;  RETURN TRUE;
    ELSE      RETURN FALSE
    END;
  END Split;

PROCEDURE SplitV (t: Type.T;  VAR v: Value.T): BOOLEAN =
  BEGIN
    TYPECASE t OF
    | NULL => RETURN FALSE;
    | P(p) => Resolve (p);  v := p.obj;  RETURN TRUE;
    ELSE      RETURN FALSE
    END;
  END SplitV;

PROCEDURE Resolve (p: P) =
  VAR o: Value.T;  t: Type.T;  save: INTEGER;
  BEGIN
    IF (p.type = NIL) THEN
      o := Scope.LookUpQID (p.scope, p.qid);
      p.obj := o;
      IF (o = NIL) THEN
        save := Scanner.offset;
        Scanner.offset := p.origin;
        Error.QID (p.qid, "undefined");
        Scanner.offset := save;
        t := Int.T;
      ELSIF (Value.ClassOf (o) = Value.Class.Type) THEN
        t := Value.ToType (o);
      ELSE
        save := Scanner.offset;
        Scanner.offset := p.origin;
        Error.QID (p.qid, "name isn\'t bound to a type");
        Scanner.offset := save;
        t := Int.T;
      END;
      p.type := t;
    END;
  END Resolve;

PROCEDURE Strip (p: P): Type.T =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.Strip (p.type);
  END Strip;

PROCEDURE MyClass (p: P): TypeRep.Class =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN p.type.class ();
  END MyClass;

PROCEDURE Check (p: P) =
  VAR cs := M3.OuterCheckState;
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    IF (p.obj # NIL) THEN Value.TypeCheck (p.obj, cs) END;
    Type.Check (p.type);
    p.isTraced    := Type.IsTraced (p.type);
    p.hasUntraced := Type.HasUntraced (p.type);
    p.isLocalOnly := Type.IsLocalOnly (p.type);
    p.hash        := p.type.hash;
  END Check;

PROCEDURE Compiler (p: P) =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    Type.Compile (p.type);
  END Compiler;

PROCEDURE Counter (p: P): INTEGER =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.Number (p.type);
  END Counter;

PROCEDURE Bounder (p: P;  VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.GetBounds (p.type, min, max);
  END Bounder;

PROCEDURE Baser (p: P): Type.T =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.Base (p.type);
  END Baser;

PROCEDURE EqualChk (a: P;  b: Type.T;  x: Type.Assumption): BOOLEAN =
  BEGIN
    EVAL a; EVAL b; EVAL x;
    <* ASSERT FALSE *> (* since Type.IsEqual calls Strip() *)
  (*
    IF (a.type = NIL) THEN Resolve (a) END;
    RETURN Type.IsEqual (Type.Strip (a.type), Type.Strip (b), x);
  *)
  END EqualChk;

PROCEDURE Subtyper (a: P;  b: Type.T): BOOLEAN =
  BEGIN
    IF (a.type = NIL) THEN Resolve (a) END;
    RETURN Type.IsSubtype (Type.Strip (a.type), Type.Strip (b));
  END Subtyper;

PROCEDURE Sizer (p: P): INTEGER =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.Size (p.type);
  END Sizer;

PROCEDURE MinSizer (p: P): INTEGER =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.MinSize (p.type);
  END MinSizer;

PROCEDURE Aligner (p: P): INTEGER =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.Alignment (p.type);
  END Aligner;

PROCEDURE IsEmpty (p: P): BOOLEAN =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.IsEmpty (p.type);
  END IsEmpty;

PROCEDURE DependsOn (p: P;  t: Type.T): BOOLEAN =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.DependsOn (p.type, t);
  END DependsOn;

PROCEDURE InitCoster (p: P;  zeroed: BOOLEAN): INTEGER =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.InitCost (p.type, zeroed);
  END InitCoster;

PROCEDURE GenInit (p: P) =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    Type.GenInitialValue (p.type);
  END GenInit;

PROCEDURE TracedOffs (p: P;  offset: CARDINAL): TrOffsets.T =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    RETURN Type.TracedOffsets (p.type, offset)
  END TracedOffs;

PROCEDURE ParamEnc (p: P): TEXT =
  BEGIN
    IF p.type = NIL THEN Resolve (p) END;
    RETURN Type.ParamEncoding (p.type)
  END ParamEnc;

PROCEDURE GenMap (p: P;  VAR prefix: String.Stack) =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    Type.GenMap (p.type, prefix);
  END GenMap;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    IF (p.type = NIL) THEN Resolve (p) END;
    Type.Fingerprint (p.type, map, wr);
  END FPrinter;

BEGIN
END NamedType.