File: OpaqueType.m3 Last modified on Tue May 23 15:25:09 PDT 1995 by kalsow modified on Sun Feb 24 05:41:53 1991 by muller
MODULE; IMPORT M3, M3ID, CG, Type, TypeRep, Target, Reff, Error, Mutex; IMPORT Revelation, Scope, M3Buf, Textt, Value, Host; TYPE P = Type.T OBJECT declared : Value.T; super : Type.T; id : M3ID.T; isTraced : BOOLEAN; OVERRIDES check := Check; check_align:= TypeRep.ScalarAlign; isEqual := EqualChk; isSubtype := Subtyper; compile := Compiler; initCost := InitCoster; initValue := TypeRep.InitToZeros; mapper := TypeRep.GenRefMap; gen_desc := TypeRep.GenRefDesc; fprint := FPrinter; END; PROCEDURE OpaqueType New (super: Type.T; decl: Value.T): Type.T = VAR p: P; BEGIN p := NEW (P); TypeRep.Init (p, Type.Class.Opaque); p.super := super; p.declared := decl; p.id := M3ID.NoID; RETURN p; END New; PROCEDUREReduce (t: Type.T): P = BEGIN IF (t = NIL) THEN RETURN NIL END; IF (t.info.class = Type.Class.Named) THEN t := Type.Strip (t) END; IF (t.info.class # Type.Class.Opaque) THEN RETURN NIL END; RETURN t; END Reduce; PROCEDUREIs (t: Type.T): BOOLEAN = BEGIN RETURN (Reduce (t) # NIL); END Is; PROCEDURESuper (t: Type.T): Type.T = VAR p := Reduce (t); BEGIN IF (p # NIL) THEN RETURN p.super; ELSE RETURN t; END; END Super; PROCEDUREUID (t: Type.T): INTEGER = VAR p := Reduce (t); BEGIN IF (p = NIL) THEN RETURN M3ID.NoID END; IF (p.id = M3ID.NoID) THEN p.id := M3ID.Add (Value.GlobalName (p.declared, dots := TRUE, with_module := TRUE)); END; RETURN p.id; END UID; PROCEDURECheck (p: P) = VAR info: Type.Info; BEGIN p.super := Type.CheckInfo (p.super, info); p.isTraced := info.isTraced; IF (info.class # Type.Class.Opaque) AND (info.class # Type.Class.Ref) AND (info.class # Type.Class.Object) THEN IF (info.class # Type.Class.Error) THEN Error.Msg ("opaque super type must be a reference type"); END; p.super := Reff.T; END; p.info.size := Target.Address.size; p.info.min_size := Target.Address.size; p.info.alignment := Target.Address.align; p.info.mem_type := CG.Type.Addr; p.info.stk_type := CG.Type.Addr; p.info.class := Type.Class.Opaque; p.info.isTraced := info.isTraced; p.info.isEmpty := FALSE; p.info.isSolid := TRUE; p.info.hash := -p.id; (* all opaque types are unique *) END Check; PROCEDURECompiler (p: P) = VAR self := Type.GlobalUID (p); super := Type.GlobalUID (p.super); BEGIN CG.Declare_opaque (self, super); Host.env.note_opaque (self, super); END Compiler; PROCEDUREEqualChk (<*UNUSED*> a: P; <*UNUSED*> b: Type.T; <*UNUSED*> x: Type.Assumption): BOOLEAN = BEGIN RETURN FALSE; END EqualChk; PROCEDUREIsSubtype (a, b: Type.T): BOOLEAN = (* called if the normal subtype methods didn't prove a <: b. *) VAR p := Reduce (b); t: Type.T; BEGIN IF (p = NIL) THEN RETURN FALSE END; t := Revelation.LookUp (p); IF (t = NIL) THEN RETURN FALSE END; t := Type.Check (t); RETURN Type.IsSubtype (a, t); END IsSubtype; PROCEDURESubtyper (a: P; b: Type.T): BOOLEAN = VAR t: Type.T; x: Revelation.TypeSet; 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 t := Type.Check (t); RETURN Type.IsSubtype (t, b); END; *************************************************) (* finally, try all the visible revelations *) Revelation.LookUpAll (a, x); FOR i := 0 TO x.cnt-1 DO t := Type.Check (x.types[i]); IF Type.IsSubtype (t, b) THEN RETURN TRUE END; END; WHILE (x.others # NIL) DO t := Type.Check (x.others.type); IF Type.IsSubtype (t, b) THEN RETURN TRUE END; x.others := x.others.next; END; RETURN FALSE; END Subtyper; PROCEDUREInitCoster (p: P; zeroed: BOOLEAN): INTEGER = BEGIN IF (p.isTraced) AND (NOT zeroed) THEN RETURN 1 ELSE RETURN 0 END; END InitCoster; PROCEDUREFPrinter (p: P; VAR x: M3.FPInfo) = VAR s: Scope.IDStack; BEGIN IF Type.IsEqual (p, Textt.T, NIL) THEN x.tag := "$text"; x.n_nodes := 0; ELSIF Type.IsEqual (p, Mutex.T, NIL) THEN x.tag := "$mutex"; x.n_nodes := 0; ELSE M3Buf.PutText (x.buf, "OPAQUE "); s.top := 0; Scope.NameToPrefix (p.declared, s, FALSE, TRUE); Scope.PutStack (x.buf, s); x.n_nodes := 1; x.nodes[0] := p.super; END; END FPrinter; BEGIN END OpaqueType.