modulevariables

NOTES

@@ -566,3 +566,10 @@ I've isolated exactly what primitives I need to get racket/base up and
 running.  It looks like I need 231 of them.  That's not that much,
 actually.  experiments/primitives-for-racket-base describes which ones
 we need.
+
+
+----------------------------------------------------------------------
+
+May 25, 2011
+
+About to make modules work.  Need to make sure exports can rename names.

il-structs.rkt

@@ -430,6 +430,11 @@
                                   [to : ModuleLocator])
   #:transparent)
 
+;; Given the module locator, do any finalizing operations, like
+;; setting up the module namespace.
+(define-struct: FinalizeModuleInvokation! ([path : ModuleLocator])
+  #:transparent)
+
 
 
 (define-type PrimitiveCommand (U                                
@@ -458,6 +463,7 @@
                                InstallModuleEntry!
                                MarkModuleInvoked!
                                AliasModuleName!
+                               FinalizeModuleInvokation!
                                ))
 
 

js-assembler/assemble-perform-statement.rkt

@@ -2,6 +2,7 @@
 (require "assemble-helpers.rkt"
          "../il-structs.rkt"
 	 "../lexical-structs.rkt"
+         "../parameters.rkt"
 	 racket/string)
 
 (provide assemble-op-statement)
@@ -46,8 +47,17 @@
                                                 ;; FIXME:  this should be looking at the module path and getting
                                                 ;; the value here!  It shouldn't be looking into Primitives...
                                                 [(ModuleVariable? n)
+                                                 (cond
+                                                  [((current-kernel-module-locator?)
+                                                    (ModuleVariable-module-name n))
                                                    (format "MACHINE.primitives[~s]"
-                                                         (symbol->string (ModuleVariable-name n)))]))
+                                                           (symbol->string (ModuleVariable-name n)))]
+                                                  [else
+                                                   (format "MACHINE.modules[~s].namespace[~s]"
+                                                           (symbol->string
+                                                            (ModuleLocator-name
+                                                             (ModuleVariable-module-name n)))
+                                                           (symbol->string (ModuleVariable-name n)))])]))
                                  names)
                                 ",")
                    (string-join (map
@@ -145,4 +155,7 @@
     [(AliasModuleName!? op)
      (format "MACHINE.modules[~s] = MACHINE.modules[~s];"
              (symbol->string (ModuleLocator-name (AliasModuleName!-to op)))
-             (symbol->string (ModuleLocator-name (AliasModuleName!-from op))))]))
+             (symbol->string (ModuleLocator-name (AliasModuleName!-from op))))]
+
+    [(FinalizeModuleInvokation!? op)
+     (format "MACHINE.modules[~s].finalizeModuleInvokation();")]))

js-assembler/mini-runtime.js

@@ -98,9 +98,22 @@
 	this.label = label;
 	this.isInvoked = false;
         this.prefix = false;
+	this.namespace = {};
     };
 
+    // Returns access to the names defined in the module.
+    ModuleRecord.prototype.getNamespace = function() {
+	return this.namespace;
+    };
 
+    ModuleRecord.prototype.finalizeModuleInvokation = function() {
+	var i, len = this.prefix.names.length;
+	for (i=0; i < len; i++) {
+	    this.namespace[this.prefix.names[i]] = this.prefix[i];
+	}
+    };
+    
+    // External invokation of a module.
     ModuleRecord.prototype.invoke = function(MACHINE, succ, fail) {
         var oldErrorHandler = MACHINE.params['currentErrorHandler'];
         var afterGoodInvoke = function(MACHINE) { 
@@ -113,11 +126,13 @@
         } else {
             MACHINE.params['currentErrorHandler'] = function(MACHINE, anError) {
                 MACHINE.params['currentErrorHandler'] = oldErrorHandler;
-                setTimeout(function() { fail(MACHINE, anError)}, 0);
+                setTimeout(
+		    function() { 
+			fail(MACHINE, anError)
+		    },
+		    0);
             };
-            MACHINE.control.push(new CallFrame(
+            MACHINE.control.push(new CallFrame(afterGoodInvoke, null));
-                afterGoodInvoke,
-                null));
             trampoline(MACHINE, this.label);
         }
     };

simulator/simulator-structs.rkt

@@ -74,7 +74,7 @@
                                [self-path : Symbol]
                                [label : Symbol]
                                [invoked? : Boolean]
-                               [exports : (HashTable Symbol PrimitiveValue)]
+                               [namespace : (HashTable Symbol PrimitiveValue)]
                                [toplevel : (U False toplevel)])
   #:transparent
   #:mutable)

simulator/simulator.rkt

@@ -337,16 +337,18 @@
           
           [(ExtendEnvironment/Prefix!? op)
            (env-push! m 
-                      (make-toplevel (ExtendEnvironment/Prefix!-names op)
+                      (make-toplevel
+                       (ExtendEnvironment/Prefix!-names op)
                        (map (lambda: ([name : (U False Symbol GlobalBucket ModuleVariable)])
                                      (cond [(eq? name #f)
                                             (make-undefined)]
                                            [(symbol? name)
                                             (lookup-primitive name)]
                                            [(GlobalBucket? name)
-                                                          (lookup-primitive (GlobalBucket-name name))]
+                                            (lookup-primitive
+                                             (GlobalBucket-name name))]
                                            [(ModuleVariable? name)
-                                                          (lookup-primitive (ModuleVariable-name name))]))
+                                            (lookup-module-variable m name)]))
                             (ExtendEnvironment/Prefix!-names op))))]
 
           [(InstallClosureValues!? op)
@@ -482,7 +484,57 @@
              (hash-set! (machine-modules m)
                         (ModuleLocator-name (AliasModuleName!-to op))
                         module-record)
-             'ok)])))
+             'ok)]
+          [(FinalizeModuleInvokation!? op)
+           (let* ([mrecord
+                   (hash-ref (machine-modules m)
+                             (ModuleLocator-name (FinalizeModuleInvokation!-path op)))]
+                  [ns (module-record-namespace mrecord)]
+                  [top
+                   (module-record-toplevel mrecord)])
+             (cond
+              [(toplevel? top)
+               (for-each (lambda: ([n : (U False Symbol GlobalBucket ModuleVariable)]
+                                   [v : PrimitiveValue])
+                           (cond
+                            [(eq? n #f)
+                             (void)]
+                            [(symbol? n)
+                             (hash-set! ns n v)]
+                            [(GlobalBucket? n)
+                             (hash-set! ns (GlobalBucket-name n) v)]
+                            [(ModuleVariable? n)
+                             (hash-set! ns (ModuleVariable-name n) v)]))
+                         (toplevel-names top)
+                         (toplevel-vals top))
+               'ok]
+              [(eq? top #f)
+               ;; This should never happen.  But let's make sure we can see the
+               ;; error.
+               (error 'FinalizeModuleInvokation
+                      "internal error: toplevel hasn't been initialized.")]))])))
+
+
+(: lookup-module-variable (machine ModuleVariable -> PrimitiveValue))
+(define (lookup-module-variable m mv)
+  (cond
+   [(or (eq?
+         (ModuleLocator-name
+          (ModuleVariable-module-name mv))
+         '#%kernel)
+        (eq?
+         (ModuleLocator-name
+          (ModuleVariable-module-name mv))
+         'whalesong/lang/kernel.rkt))
+    (lookup-primitive (ModuleVariable-name mv))]
+   [else
+    
+    (let ([mrecord
+           (hash-ref (machine-modules m)
+                     (ModuleLocator-name (ModuleVariable-module-name mv)))])
+      (hash-ref (module-record-namespace mrecord)
+                (ModuleVariable-name mv)))]))
+