File: NamedType.m3 Last modified on Tue Jul 19 10:05:49 PDT 1994 by kalsow modified on Fri Dec 21 01:25:25 1990 by muller
MODULE; IMPORT M3, M3ID, Token, Type, TypeRep, Scanner, ObjectType; IMPORT Error, Scope, Brand, Value, ErrType; TYPE P = Type.T BRANDED "NamedType.T" OBJECT scope : Scope.T; qid : M3.QID; type : Type.T; obj : Value.T; OVERRIDES check := Check; check_align:= CheckAlign; isEqual := TypeRep.NeverEqual; isSubtype := TypeRep.NoSubtypes; compile := Compiler; initCost := InitCoster; initValue := GenInit; mapper := GenMap; gen_desc := GenDesc; fprint := FPrinter; END; PROCEDURE NamedType Parse (): 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, Type.Class.Named); p.scope := Scope.Top (); p.type := NIL; p.obj := NIL; p.qid.module := M3ID.NoID; p.qid.item := Scanner.MatchID (); IF (Scanner.cur.token = TK.tDOT) THEN Scanner.GetToken (); (* . *) p.qid.module := p.qid.item; p.qid.item := Scanner.MatchID (); END; t := p; END; IF (Scanner.cur.token = TK.tBRANDED) THEN t := ObjectType.Parse (t, FALSE, Brand.Parse ()); ELSIF (Scanner.cur.token = TK.tOBJECT) THEN t := ObjectType.Parse (t, FALSE, NIL); END; RETURN t; END Parse; PROCEDURENew (t: Type.T): Type.T = VAR p: P; BEGIN p := NEW (P); TypeRep.Init (p, Type.Class.Named); p.scope := NIL; p.qid.module := M3ID.NoID; p.qid.item := M3ID.NoID; p.type := t; p.obj := NIL; RETURN p; END New; PROCEDURECreate (m, n: M3ID.T): Type.T = VAR p: P; BEGIN p := NEW (P); TypeRep.Init (p, Type.Class.Named); p.scope := Scope.Top (); p.qid.module := m; p.qid.item := n; p.type := NIL; p.obj := NIL; RETURN p; END Create; PROCEDUREReduce (t: Type.T): P = BEGIN IF (t = NIL) THEN RETURN NIL END; IF (t.info.class # Type.Class.Named) THEN RETURN NIL END; RETURN t; END Reduce; PROCEDURESplit (t: Type.T; VAR name: M3.QID): BOOLEAN = VAR p := Reduce (t); BEGIN IF (p = NIL) THEN RETURN FALSE END; name := p.qid; RETURN TRUE; END Split; PROCEDURESplitV (t: Type.T; VAR v: Value.T): BOOLEAN = VAR p := Reduce (t); BEGIN IF (p = NIL) THEN RETURN FALSE END; Resolve (p); v := p.obj; RETURN TRUE; END SplitV; PROCEDUREResolve (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 := ErrType.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 := ErrType.T; END; p.type := t; END; END Resolve; PROCEDUREStrip (t: Type.T): Type.T = VAR p: P := t; BEGIN IF (p.type = NIL) THEN Resolve (p) END; RETURN p.type; END Strip; PROCEDURECheck (p: P) = VAR cs := M3.OuterCheckState; nErrs, nWarns, nErrsB: INTEGER; BEGIN IF (p.type = NIL) THEN Resolve (p) END; nErrs := 0; nErrsB := 0; IF (p.obj # NIL) THEN Error.Count (nErrs, nWarns); Value.TypeCheck (p.obj, cs); Error.Count (nErrsB, nWarns); END; IF (nErrs = nErrsB) THEN (* no errors yet... *) p.type := Type.CheckInfo (p.type, p.info); ELSE (* some sort of error (probably illegal recursion...) *) EVAL Type.CheckInfo (ErrType.T, p.info); END; p.info.class := Type.Class.Named; (* this node is still a Named node *) END Check; PROCEDURECheckAlign (p: P; offset: INTEGER): BOOLEAN = BEGIN IF (p.type = NIL) THEN Resolve (p) END; RETURN Type.IsAlignedOk (p.type, offset); END CheckAlign; PROCEDURECompiler (p: P) = BEGIN IF (p.type = NIL) THEN Resolve (p) END; (*** Type.Compile (p.type); ***) IF (p.type # NIL) THEN Scanner.offset := p.type.origin; p.type.compile (); END; END Compiler; PROCEDUREInitCoster (p: P; zeroed: BOOLEAN): INTEGER = BEGIN IF (p.type = NIL) THEN Resolve (p) END; RETURN Type.InitCost (p.type, zeroed); END InitCoster; PROCEDUREGenInit (p: P; zeroed: BOOLEAN) = BEGIN IF (p.type = NIL) THEN Resolve (p) END; Type.InitValue (p.type, zeroed); END GenInit; PROCEDUREGenMap (p: P; offset, size: INTEGER; refs_only: BOOLEAN) = BEGIN IF (p.type = NIL) THEN Resolve (p) END; Type.GenMap (p.type, offset, size, refs_only); END GenMap; PROCEDUREGenDesc (p: P) = BEGIN IF (p.type = NIL) THEN Resolve (p) END; Type.GenDesc (p.type); END GenDesc; PROCEDUREFPrinter (p: P; VAR x: M3.FPInfo) = BEGIN Error.QID (p.qid, "INTERNAL ERROR: fingerprint of named type"); IF (p.type = NIL) THEN Resolve (p) END; IF (p.type # NIL) THEN p.type.fprint (x); END; END FPrinter; BEGIN END NamedType.