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

(* File: Tipe.m3                                               *)
(* Last Modified On Fri Apr 20 06:52:43 1990 By muller         *)
(*      Modified On Sat Feb 10 20:59:29 1990 By kalsow         *)


MODULE Tipe;

IMPORT Value, ValueRep, Scope, Error, String, Expr, Emit, OpaqueType;
IMPORT Void, Refany, Address, Temp, Wr, Token, Type, Text;
IMPORT RefType, NamedType, Decl;
FROM Scanner IMPORT GetToken, Fail, Match, MatchID, cur;

TYPE
  T = Value.T BRANDED OBJECT 
        value : Type.T;
      METHODS
        bind        := Bind;
        typeCheck   := Check;
	class       := MyClass;
        fingerprint := FPrinter;
        load        := ValueRep.NoLoader;
        write       := ValueRep.NoWriter;
        select      := ValueRep.NoDuplicates;
        declare0    := Declarer;
        declare1    := Compile;
        needsDecl   := IsExported;
	toExpr      := ValueRep.NoExpr;
	toType      := ToType;
      END;

PROCEDURE Parse (READONLY fail: Token.Set; att: Decl.Attributes) =
  VAR t: T;  fail2: Token.Set;  id: String.T;
  BEGIN
    IF att.isExternal THEN Error.Msg ("a type cannot be external"); END;
    IF att.isInline   THEN Error.Msg ("a type cannot be inline"); END;

    Match (Token.T.tTYPE, fail, Token.Set {Token.T.tSEMI});
    fail2 := fail + Token.Set {Token.T.tSEMI};

    WHILE (cur.token = Token.T.tIDENT) DO
      id := MatchID (fail2, Token.TypeStart + Token.Set {Token.T.tEQUAL,
                                              Token.T.tDOT, Token.T.tSUBTYPE});
      t := Create (id);
      t.unused := att.isUnused;
      t.obsolete := att.isObsolete;
      CASE cur.token OF
      | Token.T.tEQUAL =>
          GetToken (); (* = *)
	  t.value := Type.Parse (fail2);
      | Token.T.tSUBTYPE =>
          GetToken (); (* <: *)
          t.value := OpaqueType.New (Type.Parse (fail2));
      ELSE
          Fail ("missing \'=\' or \'<:\'", fail);
      END;
      Scope.Insert (t);
      Type.NoteDeclaration (t.value, t);
      Match (Token.T.tSEMI, fail, Token.Set {});
    END;

  END Parse;

PROCEDURE Create (name: String.T): T =
  VAR t: T;
  BEGIN
    t := NEW (T);
    ValueRep.Init (t, name);
    t.type     := Void.T;
    t.readonly := TRUE;
    t.value    := NIL;
    RETURN t;
  END Create;

PROCEDURE Define (name: Text.T;  type: Type.T) =
  VAR t: T;
  BEGIN
    t := Create (String.Add (name));
    t.value := type;
    Scope.Insert (t);
    Type.NoteDeclaration (type, t);
  END Define;

PROCEDURE Bind (t: T) =
  BEGIN
    t.value := Type.Bind (t.value);
  END Bind;

PROCEDURE Check (t: T) =
  BEGIN
    Type.Check (t.value);
  END Check;

PROCEDURE Compile (t: T) =
  BEGIN
    Type.Compile (t.value);
  END Compile;

PROCEDURE MyClass (<*UNUSED*> t: T): Value.Class =
  BEGIN
    RETURN Value.Class.Type;
  END MyClass;

PROCEDURE Declarer (t: T): BOOLEAN =
  VAR  v: Value.T;
  BEGIN
    IF IsExported (t) THEN
      Value.GenStorageClass (t);
      IF (t.exported) THEN
        v := Type.ExternalDecl (t.value);
        IF v = NIL THEN
          Emit.OpN ("TYPE TC@ = ", t);
          Emit.OpI ("&t@_TC;\n", Type.Name (t.value));
        ELSE
          Emit.OpN ("TYPE TC@ = (TYPE) 0;\n", t);
        END;
      ELSE
        Emit.OpN ("TYPE TC@;\n", t);
      END;
      RETURN TRUE;
    END;
    RETURN FALSE;
  END Declarer;

PROCEDURE InitializeExport (v: Value.T;  <*UNUSED*> module: String.T) =
  VAR t: T;
  BEGIN
    IF (v.imported) THEN
      (* this type is defined in another module *)
      RETURN;
    END;
    t := v;
    IF IsExported (t) AND Type.ExternalDecl (t.value) # NIL THEN
      Emit.OpN ("TC@ = ", t);
      Emit.OpI ("TC@;\n", Type.Name (t.value));
    END;
  END InitializeExport;

PROCEDURE IsExported (t: T): BOOLEAN =
  BEGIN
    RETURN Type.IsSubtype (t.value, Refany.T)
        OR Type.IsSubtype (t.value, Address.T);
  END IsExported;

PROCEDURE FPrinter (t: T; map: Type.Map; wr: Wr.T) =
  BEGIN
    Wr.PutText (wr, "TYPE ");
    Type.Fingerprint (t.value, map, wr);
  END FPrinter;

PROCEDURE ToType (t: T): Type.T =
  BEGIN
    RETURN t.value;
  END ToType;

BEGIN
END Tipe.