File: Scope.m3 Last modified on Tue Feb 28 17:01:39 PST 1995 by kalsow modified on Sat Feb 16 02:55:11 1991 by muller
MODULE; IMPORT M3, M3ID, M3Buf, CG, Value, Module, Error, Procedure; IMPORT Scanner, ValueRep, Variable, Tracer, Convert; CONST MinHashed = 30; REVEAL M3.Scope = M3.Node BRANDED "Scope.T" OBJECT next : T; parent : T; sname : M3ID.T; children : INTEGER := 0; head : Value.T := NIL; tail : Value.T := NIL; open : BOOLEAN := FALSE; (* => lookups can see parent *) module : BOOLEAN := FALSE; (* => is an outer module scope *) nested : BOOLEAN := FALSE; (* => is a nested block *) proc_frame : BOOLEAN := FALSE; home : Module.T := NIL; n_elts : INTEGER := 0; hash_size : INTEGER := 0; hash : REF ARRAY OF Value.T := NIL; END; VAR (* explicit reset *) top : T; allScopes : T; VAR (* string "constants" *) emptyStr : M3ID.T; Dot : M3ID.T; DUnderscore : M3ID.T; VAR (* never reset *) stack_buf : M3Buf.T := NIL; int_cache := ARRAY [0..15] OF M3ID.T {M3ID.NoID, ..}; PROCEDURE Scope PopNew () = BEGIN top := top.parent; END PopNew; PROCEDUREPushNew (open: BOOLEAN; name: M3ID.T; module := FALSE; nested := FALSE): T = VAR t := NEW (T); BEGIN t.origin := Scanner.offset; t.next := allScopes; allScopes := t; t.parent := top; t.sname := name; t.open := open; t.module := module; t.nested := nested; t.proc_frame := (open) AND (NOT module) AND (NOT nested); t.home := Module.Current (); top := t; EVAL ScopeName(t); (* Force every anonymous block to have a number, even if not used in a prefix of a procedure name. without this, m3gdb can't figure out what block a nested procedure is inside of. *) RETURN t; END PushNew; PROCEDURENew1 (obj: Value.T): T = VAR t := PushNew (open:=TRUE, name:=M3ID.NoID, module:=FALSE, nested:=TRUE); BEGIN Insert (obj); RETURN t; END New1; PROCEDUREPush (t: T): T = VAR old := top; BEGIN <* ASSERT t # NIL *> top := t; RETURN old; END Push; PROCEDUREPop (old: T) = BEGIN <* ASSERT old # NIL *> top := old; END Pop; PROCEDURETop (): T = (* return the top "open" scope *) VAR t: T; BEGIN t := top; WHILE (t # NIL) AND (NOT t.open) DO t := t.parent END; RETURN t; END Top; PROCEDUREOuterMost (t: T) : BOOLEAN = BEGIN RETURN (t # NIL) AND (t.module); END OuterMost; PROCEDURELookUpQID (t: T; READONLY q: M3.QID): Value.T = BEGIN IF (q.module = M3ID.NoID) THEN RETURN LookUp (t, q.item, FALSE); ELSE TYPECASE Value.Base (LookUp (t, q.module, FALSE)) OF | NULL => RETURN NIL; | Module.T (m) => RETURN LookUp (Module.ExportScope (m), q.item, TRUE); ELSE RETURN NIL; END; END; END LookUpQID; PROCEDURELookUp (t: T; name: M3ID.T; strict: BOOLEAN): Value.T = VAR o: Value.T; up_level := FALSE; x, y: CARDINAL; BEGIN LOOP IF (t = NIL) THEN RETURN NIL END; IF (t.n_elts < MinHashed) THEN o := t.head; WHILE (o # NIL) AND (o.name # name) DO o := o.next END; ELSE IF (t.n_elts # t.hash_size) THEN Rehash (t) END; y := NUMBER (t.hash^); x := M3ID.Hash (name) MOD y; LOOP o := t.hash [x]; IF (o = NIL) OR (o.name = name) THEN EXIT END; INC (x); IF (x >= y) THEN x := 0 END; END; END; IF (o # NIL) THEN EXIT END; IF (strict) OR (NOT t.open) THEN RETURN NIL END; up_level := up_level OR t.proc_frame; t := t.parent; END; o.up_level := o.up_level OR up_level; IF (Scanner.in_main) THEN (* this is a top-level use of the symbol! *) o.used := TRUE; IF o.obsolete THEN Error.WarnID (2, name, "<*OBSOLETE*> symbol used"); ELSIF o.unused THEN Error.WarnID (2, name, "<*UNUSED*> symbol used"); END; END; RETURN o; END LookUp; PROCEDURERehash (t: T) = VAR max := 2 * t.n_elts; x := NEW (REF ARRAY OF Value.T, max); v := t.head; hash : INTEGER; BEGIN WHILE (v # NIL) DO hash := M3ID.Hash (v.name) MOD max; WHILE (x[hash] # NIL) DO INC (hash); IF (hash >= max) THEN hash := 0 END; END; x[hash] := v; v := v.next; END; t.hash_size := t.n_elts; t.hash := x; END Rehash; PROCEDUREInsert (o: Value.T) = VAR t := top; BEGIN (* check for a reserved word *) IF (t # Initial) AND (LookUp (Initial, o.name, TRUE) # NIL) THEN Error.ID (o.name, "Reserved identifier redefined"); END; IF (o.next # NIL) THEN Error.ID (o.name, "INTERNAL ERROR: value reinserted in scope"); <*ASSERT FALSE*> END; (* finally, do the insertion *) IF (o.scope = NIL) THEN o.scope := t END; IF (t.tail # NIL) THEN t.tail.next := o; ELSE t.head := o; END; t.tail := o; INC (t.n_elts); END Insert; PROCEDUREToList (t: T): Value.T = BEGIN IF (t = NIL) THEN RETURN NIL; ELSE RETURN t.head; END; END ToList; PROCEDURETypeCheck (t: T; VAR cs: Value.CheckState) = (* note: we separate the type checking of procedures heads and bodies in an attempt to keep the error messages sorted in a rational order *) VAR v: Value.T; BEGIN IF (t = NIL) THEN RETURN END; CheckDuplicates (t); v := t.head; WHILE (v # NIL) DO Value.TypeCheck (v, cs); v := v.next; END; v := t.head; WHILE (v # NIL) DO TYPECASE Value.Base (v) OF | NULL => (* ignore *) | Procedure.T (p) => Procedure.CheckBody (p, cs); ELSE (* ignore *) END; v := v.next; END; END TypeCheck; PROCEDUREEnter (t: T) = VAR v: Value.T; c: Value.Class; BEGIN IF (t = NIL) THEN RETURN END; IF (t.nested) THEN CG.Begin_block () END; v := t.head; WHILE (v # NIL) DO c := Value.ClassOf (v); IF (c # Value.Class.Procedure) THEN Value.Declare (v) END; v := v.next; END; v := t.head; WHILE (v # NIL) DO c := Value.ClassOf (v); IF (c = Value.Class.Procedure) THEN Value.Declare (v) END; v := v.next; END; v := t.head; WHILE (v # NIL) DO Value.ConstInit (v); v := v.next; END; END Enter; PROCEDUREInitValues (t: T) = VAR v: Value.T; BEGIN IF t = NIL THEN RETURN; END; v := t.head; WHILE (v # NIL) DO Value.LangInit (v); v := v.next; END; Tracer.EmitPending (); v := t.head; WHILE (v # NIL) DO Value.UserInit (v); v := v.next; END; Tracer.EmitPending (); END InitValues; PROCEDUREExit (t: T) = BEGIN IF (t.nested) THEN CG.End_block () END; END Exit; PROCEDUREWarnUnused (t: T) = VAR save, level: INTEGER; vc: Value.Class; v: Value.T; BEGIN IF (t = NIL) THEN RETURN END; save := Scanner.offset; v := t.head; WHILE (v # NIL) DO IF (NOT v.used) AND (NOT v.exportable) THEN IF NOT (v.unused OR v.obsolete) THEN level := 2; vc := Value.ClassOf (v); IF (vc = Value.Class.Formal) OR ((vc = Value.Class.Var) AND Variable.IsFormal (Value.Base(v))) THEN level := 1; END; Scanner.offset := v.origin; Error.WarnID (level, v.name, "not used"); END; END; v := v.next; END; Scanner.offset := save; END WarnUnused; PROCEDURECheckDuplicates (t: T) = VAR v: Value.T; BEGIN M3ID.AdvanceMarks (); (* check each name *) v := t.head; WHILE (v # NIL) DO IF M3ID.SetMark (v.name) THEN ReportDuplicate (t, v) END; v := v.next; END; END CheckDuplicates; PROCEDUREReportDuplicate (t: T; v1: Value.T) = VAR save := Scanner.offset; v2: Value.T; BEGIN (* verify the duplicate *) v2 := t.head; WHILE (v2 # NIL) AND ((v2.name # v1.name) OR (v2 = v1)) DO v2 := v2.next; END; IF (v2 = NIL) THEN RETURN END; (* report the error *) Scanner.offset := v1.origin; IF (Value.Base (v1) = Value.Base (v2)) THEN (* same item duplicated => kill 2nd one *) Error.ID (v1.name, "duplicate import"); ELSE (* different items with the same name! *) Error.ID (v1.name, "symbol redefined"); END; Scanner.offset := save; END ReportDuplicate; PROCEDUREModuleName (v: Value.T): M3ID.T = BEGIN v := Value.Base (v); RETURN ScopeName (v.scope); END ModuleName; PROCEDUREPutStack (mbuf: M3Buf.T; READONLY s: IDStack) = BEGIN FOR i := 0 TO s.top-1 DO M3ID.Put (mbuf, s.stk[i]); END; END PutStack; PROCEDUREStackToText (READONLY s: IDStack): TEXT = BEGIN IF (stack_buf = NIL) THEN stack_buf := M3Buf.New (); END; FOR i := 0 TO s.top-1 DO M3ID.Put (stack_buf, s.stk[i]); END; RETURN M3Buf.ToText (stack_buf); END StackToText; PROCEDURENameToPrefix (v: Value.T; VAR p: IDStack; considerExternal := TRUE; dots := FALSE; with_module := TRUE) = VAR t: T; count: INTEGER := 0; dot, scope_name: M3ID.T; save: INTEGER; BEGIN v := Value.Base (v); IF (dots) THEN dot := Dot; ELSE dot := DUnderscore; END; IF considerExternal AND v.external THEN (* simple external name: foo *) p.stk [p.top] := v.extName; INC (p.top); ELSIF v.exported OR v.imported OR v.scope.module THEN (* global names: foo module.foo *) scope_name := ScopeName (v.scope); IF (scope_name = emptyStr) OR (NOT with_module) THEN p.stk [p.top] := v.name; INC (p.top, 1); ELSE p.stk [p.top] := scope_name; p.stk [p.top+1] := dot; p.stk [p.top+2] := v.name; INC (p.top, 3); END; ELSIF with_module OR Value.ClassOf (v) = Value.Class.Procedure OR Value.ClassOf (v) = Value.Class.Expr THEN (* procedure or constant => fully qualified name: module.p1.p2.p *) (* count how may strings we'll produce *) save := p.top; count := p.top; t := v.scope; LOOP IF t = NIL THEN EXIT END; IF (with_module) OR (NOT t.module) THEN scope_name := ScopeName (v.scope); IF scope_name # emptyStr THEN INC (count, 2); END; END; IF (NOT t.open) THEN EXIT END; IF (t.module) THEN EXIT END; t := t.parent; END; INC (count); p.top := count; DEC (count); p.stk [count] := v.name; t := v.scope; LOOP IF t = NIL THEN EXIT END; IF (with_module) OR (NOT t.module) THEN scope_name := ScopeName (t); IF scope_name # emptyStr THEN DEC (count, 2); p.stk [count + 1] := dot; p.stk [count] := scope_name; END; END; IF (NOT t.open) THEN EXIT END; IF (t.module) THEN EXIT END; t := t.parent; END; <* ASSERT count = save *> ELSE (* variable => simple name: foo *) p.stk [p.top] := v.name; INC (p.top); END; END NameToPrefix; PROCEDUREScopeName (t: T): M3ID.T = BEGIN IF (t.sname = M3ID.NoID) THEN IF (t.parent = NIL) THEN t.sname := emptyStr; ELSE INC (t.parent.children); t.sname := InternalName (t.parent.children); END; END; RETURN t.sname; END ScopeName; PROCEDUREInternalName (n: INTEGER): M3ID.T = BEGIN IF (n < 0) OR (LAST (int_cache) < n) THEN RETURN NewInt (n) END; IF int_cache [n] = M3ID.NoID THEN int_cache [n] := NewInt (n) END; RETURN int_cache [n]; END InternalName; PROCEDURENewInt (i: INTEGER): M3ID.T = <*FATAL Convert.Failed*> VAR buf : ARRAY [0..BITSIZE(INTEGER)-1] OF CHAR; len := Convert.FromInt (buf, i); BEGIN RETURN M3ID.FromStr (buf, len); END NewInt; PROCEDUREToUnit (v: Value.T): M3.Value = VAR t, t0: T; BEGIN v := Value.Base (v); (* look for the containing module scope *) t := v.scope; t0 := t; WHILE (t # NIL) AND (t.home = NIL) DO t := t.parent END; IF (t = NIL) THEN RETURN NIL END; (* mark any intervening scopes with the same "home" *) WHILE (t0 # t) DO t0.home := t.home; t0 := t0.parent END; RETURN t.home; END ToUnit; PROCEDUREInitialize () = BEGIN emptyStr := M3ID.Add (""); Dot := M3ID.Add ("."); DUnderscore := M3ID.Add ("__"); Initial := PushNew (FALSE, M3ID.Add ("M3_BUILTIN")(*emptyStr*)); END Initialize; PROCEDUREReset () = BEGIN allScopes := NIL; top := Initial; END Reset; BEGIN END Scope.