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

(* File: OpaqueType.m3                                         *)
(* Last modified on Wed Sep  2 09:11:12 PDT 1992 by rustan         *)
(*      modified on Mon Mar  2 11:18:10 PST 1992 by kalsow         *)
(*      modified on Sun Feb 24 05:41:53 1991 by muller         *)

MODULE OpaqueType;

IMPORT Type, TypeRep, Target, Reff, Error, Emit, MBuf, Textt;
IMPORT RefType, ObjectType, String, Mutex;
IMPORT Revelation, Scope;
IMPORT TrOffsets, ParamCode;

TYPE
  P = Type.T OBJECT
	super      : Type.T;
        id         : INTEGER;
        isNetworkT : BOOLEAN := FALSE
      OVERRIDES
        check      := Check;
        base       := TypeRep.SelfBase;
        isEqual    := EqualChk;
        isSubtype  := Subtyper;
        isNetworkType := NetworkTyper;
        count      := TypeRep.NotOrdinal;
        bounds     := TypeRep.NotBounded;
        size       := Sizer;
        minSize    := Sizer;
        alignment  := Aligner;
	isEmpty    := TypeRep.IsNever;
        dependsOn  := DependsOn;
        compile    := Compiler;
        initCost   := InitCoster;
        initValue  := GenInit;
        tracedOffs := TracedOffs;
        paramEncoding := ParamEnc;
        mapper     := TypeRep.GenRefMap;
        fprint     := FPrinter;
        class      := MyClass;
      END;

VAR nextID := 1;
PROCEDURE New (super: Type.T): Type.T =
  VAR p: P;
  BEGIN
    p := NEW (P);
    TypeRep.Init (p);
    p.super := super;
    p.id    := nextID; INC (nextID); (* all opaque types are unique *)
    RETURN p;
  END New;

PROCEDURE NewNETWORK (super: Type.T): Type.T =
  VAR p: P := New( super );
  BEGIN
    p.isNetworkT := TRUE;
    RETURN p
  END NewNETWORK;

PROCEDURE Is (t: Type.T): BOOLEAN =
  BEGIN
    RETURN (TYPECODE (Type.Strip (t)) = TYPECODE (P));
  END Is;

PROCEDURE Super (t: Type.T): Type.T =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN NIL;
    | P(p) => RETURN p.super;
    ELSE      RETURN t;
    END;
  END Super;

PROCEDURE Population (): INTEGER =
  BEGIN
    RETURN nextID - 1;
  END Population;

PROCEDURE UID (t: Type.T): INTEGER =
  BEGIN
    TYPECASE Type.Strip (t) OF
    | NULL => RETURN 0;
    | P(p) => RETURN p.id;
    ELSE      RETURN 0;
    END;
  END UID;

PROCEDURE MyClass (<*UNUSED*> p: P): TypeRep.Class =
  BEGIN
    RETURN TypeRep.Class.Opaque;
  END MyClass;

PROCEDURE Check (p: P) =
  BEGIN
    Type.Check (p.super);
    p.hash := -p.id; (* all opaque types are unique *)
    p.isTraced := Type.IsTraced (p.super);
    p.super := Type.Strip (p.super);
    IF (NOT (*OpaqueType*)Is (p.super))
      AND (NOT RefType.Is (p.super))
      AND (NOT ObjectType.Is (p.super)) THEN
      Error.Msg ("opaque super type must be a reference type");
      p.super := Reff.T;
    END;
    p.isNetworkT := p.isNetworkT OR Type.IsNetworkType( p.super );
    p.isLocalOnly := NOT p.isNetworkT
  END Check;

PROCEDURE Compiler (p: P) =
  BEGIN
    Type.Compile (p.super);
    IF TypeRep.IsCompiled (p) THEN RETURN END;

    (* generate the C type declaration *)
    Emit.OpF ("typedef _ADDRESS @;\n", p);

    (* import my type cell *)
    Emit.OpF ("_IMPORT _TYPE* @_TC;\n", p);

    IF TypeRep.StartLinkInfo (p) THEN RETURN END;
    Emit.OpF ("S@\n", p.super);

  END Compiler;

PROCEDURE EqualChk (<*UNUSED*> a: P;  <*UNUSED*> b: Type.T;
                    <*UNUSED*> x: Type.Assumption): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END EqualChk;

PROCEDURE IsSubtype (a, b: Type.T): BOOLEAN =
  (* called if the normal subtype methods didn't prove a <: b. *)
  VAR p: P;  t: Type.T;
  BEGIN
    TYPECASE Type.Strip (b) OF
    | NULL => RETURN FALSE;
    | P(z) => p := z;
    ELSE      RETURN FALSE;
    END;

    t := Revelation.LookUp (p);
    IF (t # NIL) THEN
      Type.Check (t);
      RETURN Type.IsSubtype (a, t);
    END;

    RETURN FALSE;
  END IsSubtype;

PROCEDURE Subtyper (a: P;  b: Type.T): BOOLEAN =
  VAR l: Revelation.TypeList;
  BEGIN
    (* try a's declared super type *)
    IF Type.IsSubtype (a.super, b) THEN RETURN TRUE END;

    (***********************************************
    (* try for a full revelation *)
    t := Revelation.LookUp (a);
    IF (t # NIL) THEN
      Type.Check (t);
      RETURN Type.IsSubtype (t, b);
    END;
    *************************************************)

    (* finally, try all the visible revelations *)
    l := Revelation.LookUpAll (a);
    WHILE (l # NIL) DO
      Type.Check (l.type);
      IF Type.IsSubtype (l.type, b) THEN RETURN TRUE END;
      l := l.next;
    END;

    RETURN FALSE;
  END Subtyper;

PROCEDURE NetworkTyper (p: P): BOOLEAN =
  BEGIN
    Type.Check( p );
    RETURN p.isNetworkT
  END NetworkTyper;

PROCEDURE Sizer (<*UNUSED*> t: Type.T): INTEGER =
  BEGIN
    RETURN Target.ADDRSIZE;
  END Sizer;

PROCEDURE Aligner (<*UNUSED*> t: Type.T): INTEGER =
  BEGIN
    RETURN Target.ADDRALIGN;
  END Aligner;

PROCEDURE DependsOn (p: P;  t: Type.T): BOOLEAN =
  BEGIN
    RETURN Type.DependsOn (p.super, t);
  END DependsOn;

PROCEDURE InitCoster (p: P; zeroed: BOOLEAN): INTEGER =
  BEGIN
    IF (p.isTraced) AND (NOT zeroed) THEN RETURN 1 ELSE RETURN 0 END;
  END InitCoster;

PROCEDURE GenInit (p: P) =
  BEGIN
    Emit.OpF ("(@)_NIL", p);
  END GenInit;

PROCEDURE TracedOffs (p: P;  offset: CARDINAL): TrOffsets.T =
  BEGIN
    IF p.isTraced THEN
      RETURN TrOffsets.New( offset )
    ELSE
      RETURN NIL
    END
  END TracedOffs;

PROCEDURE ParamEnc (p: P): TEXT =
  BEGIN
    <* ASSERT Type.IsNetworkType (p) *>
    RETURN ParamCode.Network
  END ParamEnc;

PROCEDURE FPrinter (p: P;  map: Type.FPMap;  wr: MBuf.T) =
  VAR s: String.Stack;
  BEGIN
    IF Type.IsEqual (p, Textt.T, NIL) THEN
      MBuf.PutText (wr, "$text");
    ELSIF Type.IsEqual (p, Mutex.T, NIL) THEN
      MBuf.PutText (wr, "$mutex");
    ELSE
      <* ASSERT p.declared # NIL *>
      s.top := 0;
      Scope.NameToPrefix (p.declared, s, FALSE, TRUE);
      MBuf.PutText (wr, "OPAQUE ");
      FOR i := 0 TO s.top-1 DO String.Put (wr, s.stk[i]) END;
      MBuf.PutText (wr, " ");
      Type.Fingerprint (p.super, map, wr);
    END;
  END FPrinter;

BEGIN
END OpaqueType.