trying to get module name resolution more deterministic.

parse-bytecode-5.1.1.rkt

@@ -30,9 +30,9 @@
    (lambda (mpi relative-to)
      (cond
        [(eq? mpi #f)
-        'self]
+        (current-module-path)]
        [(self-module-path-index? mpi)
-        'self]
+        (current-module-path)]
        [else
         (resolve-module-path-index mpi relative-to)]))))
 
@@ -122,6 +122,11 @@
        (let ([compilation-top (zo-parse in)])
          (parse-top compilation-top)))]
     
+    [(compiled-expression? in)
+     (let ([op (open-output-bytes)])
+       (write in op)
+       (parse-bytecode (open-input-bytes (get-output-bytes op))))]
+
     [(path? in)
      (let*-values ([(normal-path) (normalize-path in)]
                    [(base file-path dir?) (split-path normal-path)])
@@ -144,8 +149,32 @@
 (define (parse-top a-top)
   (match a-top
     [(struct compilation-top (max-let-depth prefix code))
+     (maybe-fix-module-name
       (make-Top (parse-prefix prefix) 
-               (parse-top-code code))]))
+                (parse-top-code code)))]))
+
+
+
+;; maybe-fix-module-name: expression -> expression
+;; When we're compiling a module directly from memory, it doesn't have a file path.
+;; We rewrite the ModuleName to its given name.
+(define (maybe-fix-module-name exp)
+  (match exp
+    [(struct Top (top-prefix 
+                  (struct Module ((and name (? symbol?))
+                                  (struct ModuleName ('self 'self))
+                                  module-prefix
+                                  module-requires
+                                  module-code))))
+     (make-Top top-prefix
+               (make-Module name
+                            (make-ModuleName name name) (current-module-path)
+                            module-prefix
+                            module-requires
+                            module-code))]
+    [else
+     exp]))
+
 
 
 (define (parse-prefix a-prefix)
@@ -197,7 +226,8 @@
           (make-ModuleName (rewrite-path resolved-path-name)
                            (normalize-path resolved-path-name))]
          [else
-          (error 'wrap-module-name "Unable to resolve module path ~s" resolved-path-name)]))]))
+          (error 'wrap-module-name "Unable to resolve module path ~s."
+                 resolved-path-name)]))]))
           
        
 

tests/test-parse-bytecode.rkt

@@ -3,12 +3,15 @@
 (require compiler/zo-parse
          rackunit
          racket/match
+         racket/path
          "../parameters.rkt"
          "../parse-bytecode.rkt"
          "../lexical-structs.rkt"
          "../expression-structs.rkt"
+         racket/runtime-path
          (for-syntax racket/base))
 
+(define-runtime-path this-test-path ".")
 
 (define (run-zo-parse stx)
   (parameterize ([current-namespace (make-base-namespace)]
@@ -398,7 +401,30 @@
                    (#%provide f))))
               
 
+(parameterize ([current-root-path this-test-path]
+               [current-module-path (build-path this-test-path "foo.rkt")])
   (check-true
+   (match (run-my-parse #'(module foo racket/base))
+     [(struct Top ((? Prefix?)
+                   (struct Module ('foo
+                                   (struct ModuleName 
+                                     ('whalesong/tests/foo.rkt
+                                      (? (lambda (p)
+                                           (and (path? p)
+                                                (equal? (normalize-path p)
+                                                        (normalize-path 
+                                                         (build-path this-test-path "foo.rkt"))))))))
+                                      
+                                   (struct Prefix (list))
+                                   (list (struct ModuleName ('collects/racket/base.rkt
+                                                             _)))
+                                   (struct Splice ('()))))))
+      #t]
+     [else
+      #f])))
+
+
+#;(check-true
  (match (parameterize ([current-root-path (build-path "/blah")]
                        [current-module-path (build-path "/blah" "foo" "bar.rkt")])
                 (run-my-parse '(module foo '#%kernel