fix for issue 86: pruning dead test targets away for now

compiler/compiler.rkt

@@ -312,9 +312,6 @@
 ;; Generates code to write out the top prefix, evaluate the rest of the body,
 ;; and then pop the top prefix off.
 (define (compile-module mod cenv target linkage)
-  ;; fixme: this is not right yet.  This should instead install a module record
-  ;; that has not yet been invoked.
-  ;; fixme: This also needs to generate code for the requires and provides.
   (match mod
     [(struct Module (name path prefix requires provides code))
      (let*: ([after-module-body (make-label 'afterModuleBody)]
@@ -341,8 +338,8 @@
          (make-Perform (make-ExtendEnvironment/Prefix! names))
          
          (make-AssignImmediate (make-ModulePrefixTarget path)
-                                        (make-EnvWholePrefixReference 0))
+                               (make-EnvWholePrefixReference 0))
-         ;; TODO: we need to sequester the prefix of the module with the record.
+
          (compile (Module-code mod) 
                   (cons (Module-prefix mod) module-cenv)
                   'val
@@ -353,7 +350,7 @@
          (make-AssignImmediate 'proc (make-ControlStackLabel))
          (make-PopControlFrame)
          
-         
+         ;; We sequester the prefix of the module with the record.
          (make-Perform (make-FinalizeModuleInvokation! path))
          (make-Goto (make-Reg 'proc))
          
@@ -381,9 +378,8 @@
             [on-return (make-LinkedLabel (make-label 'onReturn)
                                          on-return-multiple)])
        (append-instruction-sequences
-        (make-TestAndJump (make-TestTrue
+        (make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'linked?))
-                                    (make-IsModuleLinked a-module-name))
+                          linked)
-                                   linked)
         ;; TODO: raise an exception here that says that the module hasn't been
         ;; linked yet.
         (make-DebugPrint (make-Const 
@@ -392,8 +388,8 @@
         (make-Goto (make-Label (LinkedLabel-label on-return)))
         linked
         (make-TestAndJump (make-TestTrue 
-                                    (make-IsModuleInvoked a-module-name))
+                           (make-ModulePredicate a-module-name 'invoked?))
-                                   (LinkedLabel-label on-return))
+                          (LinkedLabel-label on-return))
         (make-PushControlFrame/Call on-return)
         (make-Goto (ModuleEntry a-module-name))
         on-return-multiple
@@ -409,6 +405,18 @@
   ((current-kernel-module-locator?) name))
 
 
+;; (: kernel-module-locator? (ModuleLocator -> Boolean))
+;; ;; Produces true if the ModuleLocator is pointing to a module that's marked
+;; ;; as kernel.
+;; (define (kernel-module-locator? a-module-locator)
+;;   (or (symbol=? (ModuleLocator-name
+;;                  a-module-locator)
+;;                 '#%kernel)
+;;       (symbol=? (ModuleLocator-name
+;;                  a-module-locator)
+;;                 'whalesong/lang/kernel.rkt)))
+
+
 
 
 (: emit-singular-context (Linkage -> InstructionSequence))
@@ -495,18 +503,28 @@
     (end-with-linkage linkage
                       cenv
                       (append-instruction-sequences
-                       
+
-                       (if (ToplevelRef-check-defined? exp)
+                       ;; If it's a module variable, we need to look there.
-                           (make-Perform (make-CheckToplevelBound!
+                       (cond
-                                                   (ToplevelRef-depth exp)
+                        [(ModuleVariable? prefix-element)
-                                                   (ToplevelRef-pos exp)))
+                         (cond [(kernel-module-name? (ModuleVariable-module-name prefix-element))
-                           empty-instruction-sequence)
+                                (make-AssignPrimOp target
-                       
+                                                   (make-PrimitivesReference
-                       (make-AssignImmediate 
+                                                    (ModuleVariable-name prefix-element)))]
-                        target
+                               [else
-                        (make-EnvPrefixReference (ToplevelRef-depth exp)
+                                (make-AssignPrimOp target prefix-element)])]
-                                                 (ToplevelRef-pos exp)))
+                        [else
-                       singular-context-check))))
+                         (append-instruction-sequences
+                          (if (ToplevelRef-check-defined? exp)
+                              (make-Perform (make-CheckToplevelBound!
+                                             (ToplevelRef-depth exp)
+                                             (ToplevelRef-pos exp)))
+                              empty-instruction-sequence)
+                          (make-AssignImmediate
+                           target
+                           (make-EnvPrefixReference (ToplevelRef-depth exp)
+                                                    (ToplevelRef-pos exp))))])
+                        singular-context-check))))
 
 
 (: compile-toplevel-set (ToplevelSet CompileTimeEnvironment Target Linkage -> InstructionSequence))
@@ -518,8 +536,13 @@
   (let ([lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
                                               (ToplevelSet-pos exp))])
     (let ([get-value-code
-           (compile (ToplevelSet-value exp) cenv lexical-pos
+           (cond
-                    next-linkage/expects-single)]
+            [(ModuleVariable? prefix-element)
+             (compile (ToplevelSet-value exp) cenv prefix-element
+                      next-linkage/expects-single)]
+            [else
+             (compile (ToplevelSet-value exp) cenv lexical-pos
+                      next-linkage/expects-single)])]
           [singular-context-check (emit-singular-context linkage)])
       (end-with-linkage
        linkage
@@ -991,7 +1014,7 @@
            id)]
         [(ModuleVariable? op-knowledge)
          (cond
-           [(kernel-module-locator? (ModuleVariable-module-name op-knowledge))
+           [(kernel-module-name? (ModuleVariable-module-name op-knowledge))
             (ModuleVariable-name op-knowledge)]
            [else
             #f])]
@@ -1000,16 +1023,6 @@
 
 
 
-(: kernel-module-locator? (ModuleLocator -> Boolean))
-;; Produces true if the ModuleLocator is pointing to a module that's marked
-;; as kernel.
-(define (kernel-module-locator? a-module-locator)
-  (or (symbol=? (ModuleLocator-name
-                 a-module-locator)
-                '#%kernel)
-      (symbol=? (ModuleLocator-name
-                 a-module-locator)
-                'whalesong/lang/kernel.rkt)))
 
   
   
@@ -1168,7 +1181,8 @@
                  [operand-poss
                   (simple-operands->opargs (map (lambda: ([op : Expression])
                                                   (adjust-expression-depth op n n))
-                                                (App-operands exp)))])
+                                                (App-operands exp))
+                                           operand-knowledge)])
             (end-with-linkage
              linkage cenv
              (append-instruction-sequences
@@ -1205,11 +1219,13 @@
                                                                  (length constant-operands)
                                                                  n))
                                       rest-operands))]
-                        
+                        [(constant-operand-knowledge)
+                         (map (lambda: ([arg : Expression])
+                                       (extract-static-knowledge arg extended-cenv))
+                              constant-operands)]
+                                 
                         [(operand-knowledge)
-                         (append (map (lambda: ([arg : Expression])
+                         (append constant-operand-knowledge
-                                        (extract-static-knowledge arg extended-cenv))
-                                      constant-operands)
                                  (map (lambda: ([arg : Expression])
                                         (extract-static-knowledge arg extended-cenv))
                                       rest-operands))]
@@ -1229,7 +1245,7 @@
                                               (make-Const 0))]
                         
                         [(constant-operand-poss)
-                         (simple-operands->opargs constant-operands)]
+                         (simple-operands->opargs constant-operands constant-operand-knowledge)]
                         
                         [(rest-operand-poss)
                          (build-list (length rest-operands)
@@ -1252,11 +1268,11 @@
               stack-pushing-code
               rest-operand-code
               (make-AssignPrimOp (adjust-target-depth target (length rest-operands))
-                                          (make-CallKernelPrimitiveProcedure 
+                                 (make-CallKernelPrimitiveProcedure 
-                                           kernel-op 
+                                  kernel-op 
-                                           (append constant-operand-poss rest-operand-poss)
+                                  (append constant-operand-poss rest-operand-poss)
-                                           expected-operand-types
+                                  expected-operand-types
-                                           typechecks?))
+                                  typechecks?))
               stack-popping-code
               singular-context-check)))])])))
 
@@ -1267,15 +1283,17 @@
 (define (ensure-simple-expression e)
   (if (or (Constant? e)
           (LocalRef? e)
-          (ToplevelRef? e))
+          (ToplevelRef? e)
+          )
       e
       (error 'ensure-simple-expression)))
 
 
-(: simple-operands->opargs ((Listof Expression) -> (Listof OpArg)))
+(: simple-operands->opargs ((Listof Expression) (Listof CompileTimeEnvironmentEntry) -> (Listof (U OpArg ModuleVariable))))
-;; Produces a list of OpArgs if all the operands are particularly simple, and false therwise.
+;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise.
-(define (simple-operands->opargs rands)
+(define (simple-operands->opargs rands knowledge)
-  (map (lambda: ([e : Expression])
+  (map (lambda: ([e : Expression]
+                 [k : CompileTimeEnvironmentEntry])
          (cond
            [(Constant? e)
             (make-Const (ensure-const-value (Constant-v e)))]
@@ -1283,11 +1301,15 @@
             (make-EnvLexicalReference (LocalRef-depth e)
                                       (LocalRef-unbox? e))]
            [(ToplevelRef? e)
-            (make-EnvPrefixReference (ToplevelRef-depth e)
+            (cond
-                                     (ToplevelRef-pos e))]
+             [(ModuleVariable? k)
+              k]
+             [else
+              (make-EnvPrefixReference (ToplevelRef-depth e) (ToplevelRef-pos e))])]
            [else 
             (error 'all-operands-are-constant "Impossible")]))
-       rands))
+       rands
+       knowledge))
 
 
 
@@ -2212,6 +2234,8 @@
     [(ControlFrameTemporary? target)
      target]
     [(ModulePrefixTarget? target)
+     target]
+    [(ModuleVariable? target)
      target]))
 
 

compiler/il-structs.rkt

@@ -35,10 +35,10 @@
                       CompiledProcedureEntry
                       CompiledProcedureClosureReference
                       ModuleEntry
-                      IsModuleInvoked
+                      ModulePredicate
-		      IsModuleLinked
                       PrimitiveKernelValue
-                      VariableReference))
+                      VariableReference
+                      ))
 
 
 ;; Targets: these are the allowable lhs's for a targetted assignment.
@@ -47,7 +47,11 @@
                        EnvPrefixReference
                        PrimitivesReference                   
                        ControlFrameTemporary
-                       ModulePrefixTarget))
+                       ModulePrefixTarget
+                       ModuleVariable
+                       ))
+
+(define-struct: ModuleVariableThing () #:transparent)
 
 
 ;; When we need to store a value temporarily in the top control frame, we can use this as a target.
@@ -63,6 +67,11 @@
 (define-struct: ModulePrefixTarget ([path : ModuleLocator])
   #:transparent)
 
+(define-struct: ModuleVariableReference ([name : Symbol]
+                                         [module-name : ModuleLocator])
+  #:transparent)
+
+
 
 (define-type const-value
   (Rec C
@@ -148,12 +157,9 @@
 (define-struct: ModuleEntry ([name : ModuleLocator])
   #:transparent)
 
-;; Produces true if the module has already been invoked
-(define-struct: IsModuleInvoked ([name : ModuleLocator])
-  #:transparent)
 
-;; Produces true if the module has been loaded into the machine
+(define-struct: ModulePredicate ([module-name : ModuleLocator]
-(define-struct: IsModuleLinked ([name : ModuleLocator])
+                                 [pred : (U 'invoked? 'linked?)])
   #:transparent)
 
 
@@ -281,11 +287,16 @@
 ;; Primitive Operators
 
 ;; The operators that return values, that are used in AssignPrimopStatement.
+;; The reason this is here is really to get around what looks like a Typed Racket issue.
+;; I would prefer to move these all to OpArgs, but if I do, Typed Racket takes much longer
+;; to type my program than I'd like.
 (define-type PrimitiveOperator (U GetCompiledProcedureEntry
                                   MakeCompiledProcedure
                                   MakeCompiledProcedureShell
-                                  
 
+                                  ModuleVariable
+                                  PrimitivesReference
+                                  
                                   MakeBoxedEnvironmentValue
 
                                   CaptureEnvironment
@@ -322,7 +333,7 @@
 
 (define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName/Inline]
 
-                                              [operands : (Listof OpArg)]
+                                              [operands : (Listof (U OpArg ModuleVariable))]
                                               [expected-operand-types : (Listof OperandDomain)]
                                               ;; For each operand, #t will add code to typecheck the operand
                                               [typechecks? : (Listof Boolean)])

compiler/optimize-il.rkt

@@ -102,9 +102,7 @@
         oparg]
        [(ModuleEntry? oparg)
         oparg]
-       [(IsModuleInvoked? oparg)
+       [(ModulePredicate? oparg)
-        oparg]
-       [(IsModuleLinked? oparg)
         oparg]
        [(PrimitiveKernelValue? oparg)
         oparg]
@@ -142,7 +140,14 @@
         op]
        
        [(ApplyPrimitiveProcedure? op)
-        op]))
+        op]
+
+       [(ModuleVariable? op)
+        op]
+       
+       [(PrimitivesReference? op)
+        op]
+       ))
 
 
     (: rewrite-primcmd (PrimitiveCommand -> PrimitiveCommand))
@@ -421,9 +426,7 @@
      oparg]
     [(ModuleEntry? oparg)
      oparg]
-    [(IsModuleInvoked? oparg)
+    [(ModulePredicate? oparg)
-     oparg]
-    [(IsModuleLinked? oparg)
      oparg]
     [(VariableReference? oparg)
      (let ([t (VariableReference-toplevel oparg)])

image/private/colordb.js

@@ -2,8 +2,8 @@
 // JavaScript land...
 
 
-var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].namespace;
+var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].getNamespace();
-var colorStruct = colorNamespace['struct:color'];
+var colorStruct = colorNamespace.get('struct:color');
 var makeColor = function(r,g,b,a) { return colorStruct.constructor([r,g,b,a]); };
 
 

image/private/kernel.js

@@ -4,8 +4,8 @@
 
 
 //////////////////////////////////////////////////////////////////////
-var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].namespace;
+var colorNamespace = MACHINE.modules['whalesong/image/private/color.rkt'].getNamespace();
-var colorStruct = colorNamespace['struct:color'];
+var colorStruct = colorNamespace.get('struct:color');
 var makeColor = function(r,g,b,a) { return colorStruct.constructor([r,g,b,a]); };
 var isColor = colorStruct.predicate;
 var colorRed = function(c) { return colorStruct.accessor(c, 0); };

js-assembler/assemble-expression.rkt

@@ -3,6 +3,7 @@
 (require "assemble-structs.rkt"
          "assemble-helpers.rkt"
          "assemble-open-coded.rkt"
+         "../compiler/lexical-structs.rkt"
          "../compiler/il-structs.rkt"
          racket/string)
 
@@ -69,5 +70,16 @@
 
     [(CallKernelPrimitiveProcedure? op)
      (open-code-kernel-primitive-procedure op blockht)]
+
     [(ApplyPrimitiveProcedure? op)
-     "M.p._i(M)"]))
+     "M.p._i(M)"]
+
+    [(ModuleVariable? op)
+     (format "M.modules[~s].getNamespace().get(~s)"
+             (symbol->string
+              (ModuleLocator-name
+               (ModuleVariable-module-name op)))
+             (symbol->string (ModuleVariable-name op)))]
+
+    [(PrimitivesReference? op)
+     (format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))]))

js-assembler/assemble-helpers.rkt

@@ -30,7 +30,8 @@
 	 assemble-display-name
 	 assemble-location
          assemble-numeric-constant
-
+         assemble-module-variable-ref
+         
          block-looks-like-context-expected-values?
          block-looks-like-pop-multiple-values-and-continue?)
 
@@ -69,10 +70,8 @@
      (assemble-primitive-kernel-value v)]
     [(ModuleEntry? v)
      (assemble-module-entry v)]
-    [(IsModuleInvoked? v)
+    [(ModulePredicate? v)
-     (assemble-is-module-invoked v)]
+     (assemble-module-predicate v)]
-    [(IsModuleLinked? v)
-     (assemble-is-module-linked v)]
     [(VariableReference? v)
      (assemble-variable-reference v)]))
 
@@ -90,25 +89,32 @@
                      (symbol->string (PrimitivesReference-name target))
                      (symbol->string (PrimitivesReference-name target))
                      rhs))]
+   [(ModuleVariable? target)
+    (lambda: ([rhs : String])
+             (format "M.modules[~s].getNamespace().set(~s,~s);"
+                     (symbol->string (ModuleLocator-name (ModuleVariable-module-name target)))
+                     (symbol->string (ModuleVariable-name target))
+                     rhs))]
    [else
     (lambda: ([rhs : String])
              (format "~a=~a;"
-                     (cond
+                     (ann (cond
-                      [(eq? target 'proc)
+                            [(eq? target 'proc)
-                       "M.p"]
+                             "M.p"]
-                      [(eq? target 'val)
+                            [(eq? target 'val)
-                       "M.v"]
+                             "M.v"]
-                      [(eq? target 'argcount)
+                            [(eq? target 'argcount)
-                       "M.a"]
+                             "M.a"]
-                      [(EnvLexicalReference? target)
+                            [(EnvLexicalReference? target)
-                       (assemble-lexical-reference target)]
+                             (assemble-lexical-reference target)]
-                      [(EnvPrefixReference? target)
+                            [(EnvPrefixReference? target)
-                       (assemble-prefix-reference target)]
+                             (assemble-prefix-reference target)]
-                      [(ControlFrameTemporary? target)
+                            [(ControlFrameTemporary? target)
-                       (assemble-control-frame-temporary target)]
+                             (assemble-control-frame-temporary target)]
-                      [(ModulePrefixTarget? target)
+                            [(ModulePrefixTarget? target)
-                       (format "M.modules[~s].prefix"
+                             (format "M.modules[~s].prefix"
-                               (symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
+                                     (symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])
+                           String)
                      rhs))]))
 
 
@@ -471,17 +477,25 @@
           (symbol->string (ModuleLocator-name (ModuleEntry-name entry)))))
 
 
-(: assemble-is-module-invoked (IsModuleInvoked -> String))
+(: assemble-module-variable-ref (ModuleVariable -> String))
-(define (assemble-is-module-invoked entry)
+(define (assemble-module-variable-ref var)
-  (format "M.modules[~s].isInvoked"
+  (format "M.modules[~s].getNamespace().get(~s)"
-          (symbol->string (ModuleLocator-name (IsModuleInvoked-name entry)))))
+          (symbol->string (ModuleLocator-name (ModuleVariable-module-name var)))
+          (symbol->string (ModuleVariable-name var))))
 
 
-(: assemble-is-module-linked (IsModuleLinked -> String))
+(: assemble-module-predicate (ModulePredicate -> String))
-(define (assemble-is-module-linked entry)
+(define (assemble-module-predicate entry)
-  (format "(M.modules[~s]!==undefined)"
+  (define modname (ModulePredicate-module-name entry))
-          (symbol->string (ModuleLocator-name (IsModuleLinked-name entry)))))
+  (define pred (ModulePredicate-pred entry))
+  (cond
+   [(eq? pred 'invoked?)
+    (format "M.modules[~s].isInvoked"
+            (symbol->string (ModuleLocator-name modname)))]
 
+   [(eq? pred 'linked?)
+    (format "(M.modules[~s]!==undefined)"
+            (symbol->string (ModuleLocator-name modname)))]))
 
 
 (: assemble-variable-reference (VariableReference -> String))

js-assembler/assemble-open-coded.rkt

@@ -19,8 +19,12 @@
 (: open-code-kernel-primitive-procedure (CallKernelPrimitiveProcedure Blockht -> String))
 (define (open-code-kernel-primitive-procedure op blockht)
   (let*: ([operator : KernelPrimitiveName/Inline (CallKernelPrimitiveProcedure-operator op)]
-          [operands : (Listof String) (map (lambda: ([op : OpArg])
+          [operands : (Listof String) (map (lambda: ([op : (U OpArg ModuleVariable)])
-                                                    (assemble-oparg op blockht))
+                                                    (cond
+                                                     [(OpArg? op)
+                                                      (assemble-oparg op blockht)]
+                                                     [(ModuleVariable? op)
+                                                      (assemble-module-variable-ref op)]))
                                            (CallKernelPrimitiveProcedure-operands op))]
           [checked-operands : (Listof String)
                             (map (lambda: ([dom : OperandDomain]

js-assembler/assemble-perform-statement.rkt

@@ -34,7 +34,7 @@
                    (string-join (map
                                  (lambda: ([n : (U Symbol False GlobalBucket ModuleVariable)])
                                           (cond [(symbol? n)
-                                                 (format "M.params.currentNamespace[~s]||M.primitives[~s]"
+                                                 (format "M.params.currentNamespace.get(~s)||M.primitives[~s]"
                                                          (symbol->string n) 
                                                          (symbol->string n))]
                                                 [(eq? n #f)
@@ -52,7 +52,8 @@
                                                    (format "M.primitives[~s]"
                                                            (symbol->string (ModuleVariable-name n)))]
                                                   [else
-                                                   (format "M.modules[~s].namespace[~s]"
+                                                   "'blah'"
+                                                   #;(format "M.modules[~s].getNamespace().get(~s)"
                                                            (symbol->string
                                                             (ModuleLocator-name
                                                              (ModuleVariable-module-name n)))

js-assembler/collect-jump-targets.rkt

@@ -87,9 +87,7 @@
        empty]
       [(ModuleEntry? an-input)
        empty]
-      [(IsModuleInvoked? an-input)
+      [(ModulePredicate? an-input)
-       empty]
-      [(IsModuleLinked? an-input)
        empty]
       [(VariableReference? an-input)
        empty]))
@@ -121,6 +119,10 @@
       [(MakeBoxedEnvironmentValue? op)
        empty]
       [(CallKernelPrimitiveProcedure? op)
+       empty]
+      [(ModuleVariable? op)
+       empty]
+      [(PrimitivesReference? op)
        empty]))
 
   
@@ -234,9 +236,7 @@
        empty]
       [(ModuleEntry? an-input)
        empty]
-      [(IsModuleInvoked? an-input)
+      [(ModulePredicate? an-input)
-       empty]
-      [(IsModuleLinked? an-input)
        empty]
       [(VariableReference? an-input)
        empty]))
@@ -268,6 +268,10 @@
       [(MakeBoxedEnvironmentValue? op)
        empty]
       [(CallKernelPrimitiveProcedure? op)
+       empty]
+      [(ModuleVariable? op)
+       empty]
+      [(PrimitivesReference? op)
        empty]))
   
   (: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))

js-assembler/package.rkt

@@ -170,7 +170,7 @@
       [(struct Top [_ (struct Module (name path prefix requires provides code))])
        (apply string-append
               (map (lambda (p)
-                     (format "modrec.namespace[~s] = exports[~s];\n"
+                     (format "modrec.getNamespace().set(~s,exports[~s]);\n"
                              (symbol->string (ModuleProvide-internal-name p))
                              (symbol->string (ModuleProvide-external-name p))))
                    provides))]

js-assembler/runtime-src/baselib-modules.js

@@ -7,13 +7,80 @@
     var exports = {};
     baselib.modules = exports;
 
+    var Namespace = function(modrec) {
+        this.modrec = modrec;
+        // string -> integer
+        // Returns the position within the prefix that we should be looking.
+        this.mapping = {}; 
+        this.extra = {};
+    };
+
+    Namespace.prototype.get = function(name) {
+        var i;
+        if (this.mapping.hasOwnProperty(name)) {
+            return this.modrec.prefix[this.mapping[name]];
+        }
+        if (this.extra.hasOwnProperty(name)) {
+            return this.extra[name];
+        }
+        if (this.modrec.prefix) {
+            for (i = 0; i < len; i++) {
+                if (this.modrec.prefix.names[i] === name) {
+                    this.mapping[name] = i;
+                    return this.modrec.prefix[this.mapping[name]];
+                }
+            }
+        }
+        return undefined;
+    };
+
+    Namespace.prototype.refreshPrefixMapping = function() {
+        var prefix = this.modrec.prefix;
+        var name;
+        var i;
+        for (i = 0; i < prefix.length; i++) {
+            name = prefix.names[i];
+            this.mapping[name] = i;
+            if (this.extra.hasOwnProperty(name)) {
+                prefix[i] = this.extra[name];
+                delete this.extra[name];
+            }
+        }
+    };
+
+    Namespace.prototype.hasKey = function(name) {
+        return this.mapping.hasOwnProperty(name);
+    };
+
+    Namespace.prototype.set = function(name, value) {
+        var i;
+        if (this.mapping.hasOwnProperty(name)) {
+            this.modrec.prefix[this.mapping[name]] = value;
+            return;
+        };
+        if (this.extra.hasOwnProperty(name)) {
+            this.extra[name] = value;
+            return;
+        }
+        if (this.modrec.prefix) {
+            for (i = 0; i < len; i++) {
+                if (this.modrec.prefix.names[i] === name) {
+                    this.mapping[name] = i;
+                    this.modrec.prefix[this.mapping[name]] = value;
+                    return;
+                }
+            }
+        }
+        this.extra[name] = value;
+        return;
+    };
 
     var ModuleRecord = function (name, label) {
         this.name = name;
         this.label = label;
         this.isInvoked = false;
         this.prefix = false;
-        this.namespace = {};
+        this.namespace = new Namespace(this);
 
         // JavaScript-implemented code will assign privateExports
         // with all of the exported identifiers.
@@ -27,9 +94,7 @@
 
     ModuleRecord.prototype.finalizeModuleInvokation = function () {
         var i, len = this.prefix.names.length;
-        for (i = 0; i < len; i++) {
+        this.namespace.refreshPrefixMapping();
-            this.namespace[this.prefix.names[i]] = this.prefix[i];
-        }
     };
     
 

js-assembler/runtime-src/runtime.js

@@ -278,7 +278,10 @@
                     toDomNode(exn, MACHINE.params['print-mode']));
             },
 
-	    'currentNamespace': {},
+	    'currentNamespace': { get: function() {}, 
+                                  set : function() {}, 
+                                  hasKey : function() { return false; }
+                                },
 
 	    // These parameters control how often
 	    // control yields back to the browser
@@ -307,14 +310,14 @@
     // Try to get the continuation mark key used for procedure application tracing.
     var getTracedAppKey = function(MACHINE) {
         if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
-            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-app-key'] || 'traced-app-key';
+            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].getNamespace().get('traced-app-key') || 'traced-app-key';
         }
         return undefined;
     };
 
     var getTracedCalleeKey = function(MACHINE) {
         if (MACHINE.modules['whalesong/lang/private/traced-app.rkt']) {
-            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].namespace['traced-callee-key'] || 'traced-callee-key';
+            return MACHINE.modules['whalesong/lang/private/traced-app.rkt'].getNamespace().get('traced-callee-key') || 'traced-callee-key';
         }
         return undefined;
     };
@@ -759,8 +762,8 @@
         machine = machine || runtime.currentMachine;
         for (i = 0; i < machine.mainModules.length; i++) {
             var ns = machine.mainModules[i].getNamespace();
-            if(ns.hasOwnProperty(name)) {
+            if(ns.hasKey(name)) {
-                return ns[name];
+                return ns.get(name);
             }
         }
     };

resource/js-impl.js

@@ -1,4 +1,4 @@
-var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace()['struct:resource'];
+var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
 
 var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
 

resource/specialize/js-impl.js

@@ -1,4 +1,4 @@
-var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace()['struct:resource'];
+var resourceType = MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
 
 var makeClosure = plt.baselib.functions.makeClosure;
 var finalizeClosureCall = plt.baselib.functions.finalizeClosureCall;

tests/more-tests/module-scoping-helper.rkt

@@ -1,10 +1,22 @@
 #lang planet dyoo/whalesong
 (require (for-syntax racket/base))
-(provide x x++ x=0)
+(provide x x++ x+1 x=0 get-x)
 (define x 0)
+
 (define (set-x v)
   (set! x v))
+
+(define (get-x)
+  x)
+
 (define-syntax (x++ stx)
+  #'(plusplus-x))
+
+(define-syntax (x+1 stx)
   #'(set-x (add1 x)))
+
+(define (plusplus-x)
+  (set! x (add1 x)))
+
 (define-syntax (x=0 stx)
   #'(set-x 0))

tests/more-tests/module-scoping.expected

@@ -0,0 +1,14 @@
+0
+0
+1
+1
+2
+2
+0
+0
+1
+1
+2
+2
+3
+3

tests/more-tests/module-scoping.rkt

@@ -1,13 +1,27 @@
 #lang planet dyoo/whalesong
 (require "module-scoping-helper.rkt")
-x
+x             ;; 0
-x++
+(get-x)       ;; 0
+
+x+1
+x             ;; 1
+(get-x)       ;; 1
+
 x++
 x
+(get-x)
+
 x=0
+x
+(get-x)
+
 x++
 x
+(get-x)
 x++
 x
-x++
+(get-x)
-x
+
+x+1
+x
+(get-x)

tests/run-more-tests.rkt

@@ -8,6 +8,7 @@
 
 (test "more-tests/simple.rkt")
 (test "more-tests/booleans.rkt")
+(test "more-tests/module-scoping.rkt")
 (test "more-tests/checking.rkt")
 (test "more-tests/string-tests.rkt")
 (test "more-tests/chars.rkt")

version.rkt

@@ -7,4 +7,4 @@
 (provide version)
 (: version String)
 
-(define version "1.168")
+(define version "1.170")

web-world/js-impl.js

@@ -33,10 +33,10 @@
 
 
     var resourceStructType = 
-        MACHINE.modules['whalesong/resource/structs.rkt'].namespace['struct:resource'];
+        MACHINE.modules['whalesong/resource/structs.rkt'].getNamespace().get('struct:resource');
 
     var eventStructType = 
-        MACHINE.modules['whalesong/web-world/event.rkt'].namespace['struct:event'];
+        MACHINE.modules['whalesong/web-world/event.rkt'].getNamespace().get('struct:event');