File: Value.m3 Last modified on Wed Mar 1 08:51:59 PST 1995 by kalsow modified on Wed Mar 27 03:00:56 1991 by muller
MODULEValue EXPORTSValue ,ValueRep ; IMPORT M3, M3ID, Type, Expr, Error, M3Buf, Scope, M3FP, CG; IMPORT Scanner, Host, ErrType, TypeFP, Procedure; CONST NOT_CHECKED = -1; CONST CHECKED = 0; PROCEDURETypeCheck (t: T; VAR cs: CheckState) = VAR save: INTEGER; BEGIN IF (t = NIL) THEN RETURN END; IF (t.checked) THEN RETURN END; IF (t.checkDepth = NOT_CHECKED) THEN (* this node is not currently being checked *) save := Scanner.offset; Scanner.offset := t.origin; t.checkDepth := Type.recursionDepth; t.typeCheck (cs); t.checkDepth := CHECKED; t.checked := TRUE; Scanner.offset := save; ELSIF (t.checkDepth # Type.recursionDepth) THEN (* this is a legal recursion, just return *) ELSE IllegalRecursion (t); END; END TypeCheck; PROCEDURETypeOf (t: T): Type.T = VAR x: Type.T; BEGIN IF (t = NIL) THEN RETURN ErrType.T END; IF (t.inTypeOf) THEN IllegalRecursion (t); RETURN ErrType.T END; t.inTypeOf := TRUE; x := t.typeOf (); t.inTypeOf := FALSE; RETURN x; END TypeOf; PROCEDURESetGlobals (t: T) = BEGIN IF (t = NIL ) THEN RETURN END; <*ASSERT t.checked *> t.set_globals (); END SetGlobals; PROCEDURELoad (t: T) = BEGIN IF (t = NIL) THEN RETURN END; <* ASSERT t.checked *> t.used := TRUE; t.load (); END Load; PROCEDUREToExpr (t: T): Expr.T = VAR e: Expr.T; BEGIN IF (t = NIL) THEN RETURN NIL END; IF (t.inToExpr) THEN IllegalRecursion (t); RETURN NIL END; t.inToExpr := TRUE; e := t.toExpr (); t.inToExpr := FALSE; RETURN e; END ToExpr; PROCEDUREToType (t: T): Type.T = VAR x: Type.T; BEGIN IF (t = NIL) THEN RETURN NIL END; IF (t.inToType) THEN IllegalRecursion (t); RETURN NIL END; t.inToType := TRUE; x := t.toType (); t.inToType := FALSE; RETURN x; END ToType; PROCEDUREBase (t: T): T = BEGIN IF (t = NIL) THEN RETURN NIL END; RETURN t.base (); END Base; PROCEDUREIllegalRecursion (t: T) = BEGIN IF (NOT t.error) THEN Error.ID (t.name, "illegal recursive declaration"); t.error := TRUE; END; END IllegalRecursion; PROCEDUREClassOf (t: T): Class = BEGIN IF (t = NIL) THEN RETURN Class.Error END; RETURN t.class; END ClassOf; VAR mbuf: M3Buf.T := NIL; PROCEDUREToFP (t: T): M3FP.T = VAR n: CARDINAL; x: M3.FPInfo; fp: M3FP.T; BEGIN IF (t = NIL) THEN RETURN M3FP.Zero END; t := Base (t); IF (mbuf = NIL) THEN mbuf := M3Buf.New () END; (* build the tag *) x.tag := NIL; x.buf := mbuf; mbuf := NIL; x.n_nodes := 0; x.others := NIL; n := AddFPTag (t, x); IF (x.tag # NIL) THEN fp := TypeFP.FromText (x.tag); ELSE fp := TypeFP.FromBuf (x.buf); END; mbuf := x.buf; x.buf := NIL; x.tag := NIL; (* add any type information *) IF (n > 0) THEN <*ASSERT n = 1*> EVAL AddFPEdges (t, x, 0); fp := TypeFP.FromPair (fp, TypeFP.FromType (x.nodes[0])); END; RETURN fp; END ToFP; PROCEDUREAddFPTag (t: T; VAR x: M3.FPInfo): CARDINAL = VAR n: CARDINAL; BEGIN IF (t = NIL) THEN RETURN 0 END; t := t.base (); M3Buf.PutChar (x.buf, '<'); n := t.add_fp_tag (x); M3Buf.PutChar (x.buf, '>'); RETURN n; END AddFPTag; PROCEDUREAddFPEdges (t: T; VAR x: M3.FPInfo; n: CARDINAL): CARDINAL = VAR u: T; type: Type.T; BEGIN IF (t = NIL) THEN RETURN n END; u := t.base (); type := u.fp_type (); IF (type # NIL) THEN IF (x.others = NIL) THEN x.nodes [n] := type; ELSE x.others [n] := type; END; INC (n); END; RETURN n; END AddFPEdges; PROCEDUREFPStart (t: T; VAR x: M3.FPInfo; tag: TEXT; offset: INTEGER; global: BOOLEAN) = VAR s: Scope.IDStack; BEGIN M3Buf.PutText (x.buf, tag); IF (global) THEN s.top := 0; Scope.NameToPrefix (t, s, dots := TRUE); Scope.PutStack (x.buf, s); ELSE M3ID.Put (x.buf, t.name); END; IF (offset # 0) THEN M3Buf.PutChar (x.buf, '@'); M3Buf.PutInt (x.buf, offset); END; IF (t.external) THEN M3Buf.PutChar (x.buf, '$'); M3ID.Put (x.buf, t.extName); END; END FPStart; TYPE VSFlags = RECORD need_vs : BOOLEAN; imported : BOOLEAN; implemented : BOOLEAN; END; PROCEDUREDeclare (t: T) = VAR f: VSFlags; fp: M3FP.T; BEGIN IF (t = NIL) THEN RETURN END; IF (t.declared) THEN RETURN END; IF (NOT t.used) AND (t.imported) THEN RETURN END; t.declared := TRUE; GetVSFlags (t, f); IF t.declare () AND (Host.versionStamps) AND (f.need_vs) THEN fp := ToFP (t); Host.env.note_version_stamp (Scope.ModuleName (t), t.name, fp, f.imported, f.implemented); END; END Declare; PROCEDUREGetVSFlags (t: T; VAR f: VSFlags) = BEGIN f.need_vs := t.imported OR t.exported; IF (t.external) THEN f.imported := NOT t.exported; ELSE f.imported := t.imported; END; f.implemented := NOT f.imported; IF (NOT t.external) AND (t.class = Class.Procedure) THEN f.implemented := Procedure.HasBody (Base (t)); END; END GetVSFlags; PROCEDUREConstInit (t: T) = VAR save: INTEGER; BEGIN IF (t = NIL) THEN RETURN END; IF (t.inited) THEN RETURN END; <* ASSERT t.checked *> t.inited := TRUE; save := Scanner.offset; Scanner.offset := t.origin; t.const_init (); Scanner.offset := save; END ConstInit; PROCEDURENeedsInit (t: T): BOOLEAN = BEGIN IF (t = NIL) THEN RETURN FALSE END; RETURN t.need_init (); END NeedsInit; PROCEDURELangInit (t: T) = VAR save: INTEGER; BEGIN IF (t = NIL) THEN RETURN END; IF (t.compiled) THEN RETURN END; <* ASSERT t.checked *> t.compiled := TRUE; save := Scanner.offset; Scanner.offset := t.origin; t.lang_init (); CG.Free_temps (); Scanner.offset := save; END LangInit; PROCEDUREUserInit (t: T) = VAR save: INTEGER; BEGIN IF (t = NIL) THEN RETURN; END; save := Scanner.offset; Scanner.offset := t.origin; t.user_init (); CG.Free_temps (); Scanner.offset := save; END UserInit; VAR all: T; (* all values in the current module *) PROCEDUREInit (t: T; name: M3ID.T; c: Class) = BEGIN t.origin := Scanner.offset; t.name := name; t.extName := M3ID.NoID; t.scope := NIL; t.checkDepth := NOT_CHECKED; t.class := c; t.checked := FALSE; t.readonly := FALSE; t.traced := FALSE; t.external := FALSE; t.unused := FALSE; t.obsolete := FALSE; t.up_level := FALSE; IF (c # Class.Module) THEN t.vnext := all; all := t; END; t.error := FALSE; t.used := FALSE; t.declared := FALSE; t.inited := FALSE; t.compiled := FALSE; t.imported := NOT Scanner.in_main; t.exported := FALSE; t.exportable := FALSE; t.inTypeOf := FALSE; t.inToExpr := FALSE; t.inToType := FALSE; END Init; PROCEDURENoExpr (<*UNUSED*> t: T): Expr.T = BEGIN <* ASSERT FALSE *> END NoExpr; PROCEDURENoType (<*UNUSED*> t: T): Type.T = BEGIN <* ASSERT FALSE *> END NoType; PROCEDURENoLoader (<*UNUSED*> t: T) = BEGIN <* ASSERT FALSE *> END NoLoader; PROCEDURENever (<*UNUSED*> t: T): BOOLEAN = BEGIN RETURN FALSE; END Never; PROCEDURENoInit (<*UNUSED*> t: T) = BEGIN END NoInit; PROCEDUREAlways (<*UNUSED*> t: T): BOOLEAN = BEGIN RETURN TRUE; END Always; PROCEDURETypeVoid (<*UNUSED*> t: T): Type.T = BEGIN RETURN NIL; END TypeVoid; PROCEDURESelf (t: T): T = BEGIN RETURN t; END Self; PROCEDUREReset () = BEGIN all := NIL; END Reset; PROCEDURESetModule (new: T): T = VAR old := all; BEGIN all := new; RETURN old; END SetModule; PROCEDUREReuse (t: T) = BEGIN WHILE (t # NIL) DO t.used := FALSE; t.error := FALSE; t.declared := FALSE; t.inited := FALSE; t.compiled := FALSE; t.imported := (NOT Host.emitBuiltins); t.exported := FALSE; t.exportable := FALSE; t.inTypeOf := FALSE; t.inToExpr := FALSE; t.inToType := FALSE; t := t.vnext; END; END Reuse; PROCEDUREIsExternal (t: T): BOOLEAN = BEGIN RETURN (t.external); END IsExternal; PROCEDUREIsImported (t: T): BOOLEAN = BEGIN RETURN (t # NIL) AND (t.imported); END IsImported; PROCEDUREIsWritable (t: T; traced: BOOLEAN): BOOLEAN = BEGIN IF traced THEN t.traced := TRUE END; RETURN NOT t.readonly; END IsWritable; PROCEDURECName (t: T): M3ID.T = BEGIN IF (t = NIL) THEN RETURN M3ID.NoID END; RETURN t.base().name; END CName; PROCEDUREGlobalName (t: T; dots, with_module: BOOLEAN): TEXT = VAR ss: Scope.IDStack; BEGIN IF (t = NIL) THEN RETURN NIL END; ss.top := 0; Scope.NameToPrefix (t, ss, NOT dots, dots, with_module); RETURN Scope.StackToText (ss); END GlobalName; BEGIN END Value.