From ae4b7709399eae6529fba0e213dc3719f18b0532 Mon Sep 17 00:00:00 2001
From: Blake Johnson <blake.johnson@byu.edu>
Date: Fri, 20 Aug 2010 13:47:03 -0600
Subject: [PATCH] zo-marshal fixes and read.c fix for hash tables in symbol
 table

original commit: 9599304ca90d1a76a80e5edcf13f13e9bc83ac53
---
 collects/compiler/zo-marshal.rkt   | 17 +++++++++++++----
 collects/compiler/zo-parse.rkt     |  4 ++--
 collects/tests/compiler/zo-exs.rkt | 16 +++++++++++++---
 3 files changed, 28 insertions(+), 9 deletions(-)

diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt
index fa3be595e9..42d143df7d 100644
--- a/collects/compiler/zo-marshal.rkt
+++ b/collects/compiler/zo-marshal.rkt
@@ -8,7 +8,9 @@
          racket/local
          racket/list
          racket/dict
-         racket/function)
+         racket/function
+         racket/pretty
+         racket/path)
 
 (provide/contract
  [zo-marshal (compilation-top? . -> . bytes?)]
@@ -305,8 +307,8 @@
                     (list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)])))
   encoded-bindings)
 
-(define encode-all-from-module
-  (match-lambda
+(define (encode-all-from-module afm)
+  (match afm
     [(struct all-from-module (path phase src-phase #f #f))
      (list* path phase src-phase)]
     [(struct all-from-module (path phase src-phase exns #f))
@@ -814,7 +816,7 @@
                               (lambda (v mode port)
                                 (display "#^" port)
                                 (write (path->bytes (make-relative v)) port))])
-                (pretty-write expr s))
+                (pretty-write v s))
               (out-byte CPT_ESCAPE out)
               (let ([bstr (get-output-bytes s)])
                 (out-number (bytes-length bstr) out)
@@ -986,5 +988,12 @@
 
 (define-struct svector (vec))
 
+(define (make-relative v)
+  (let ([r (current-write-relative-directory)])
+    (if r
+        (find-relative-path r v)
+        v)))
+
+
 ;; ----------------------------------------
 
diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt
index 9d57363ec8..3b1b820733 100644
--- a/collects/compiler/zo-parse.rkt
+++ b/collects/compiler/zo-parse.rkt
@@ -1043,10 +1043,10 @@
     (for ([i (in-range 1 symtabsize)])
       (read-sym cp i))
     
-    (for ([i (in-naturals)]
+    #;(for ([i (in-naturals)]
           [v (in-vector debug-symrefs)])
       (printf "~a: ~a~n" i v))
-    
+    #;(printf "SYMBOL TABLE:~n~n")
     #;(for ([i (in-naturals)]
           [v (in-vector (cport-symtab cp))])
       (printf "~a: ~s~n~n" i (placeholder-get v)))
diff --git a/collects/tests/compiler/zo-exs.rkt b/collects/tests/compiler/zo-exs.rkt
index 8fd5d3ee47..a5bd61d5f0 100644
--- a/collects/tests/compiler/zo-exs.rkt
+++ b/collects/tests/compiler/zo-exs.rkt
@@ -9,23 +9,33 @@
 
 (define (roundtrip ct)
   (define bs (zo-marshal ct))
+  (with-output-to-file "test_rkt.zo" (λ () (write-bytes bs)) #:exists 'replace)
   (test #:failure-prefix (format "~S" ct)
         (test bs
               (zo-parse (open-input-bytes bs)) => ct
               (read-compiled-bytes bs))))
 
+(define mpi (module-path-index-join #f #f))
+
 (test
- (roundtrip 
+ #;(roundtrip 
   (compilation-top 0 
                    (prefix 0 empty empty)
                    (current-directory)))
  
- (roundtrip 
+ #;(roundtrip 
   (compilation-top 0 
                    (prefix 0 empty empty)
                    (list (current-directory))))
  
- (local [(define (hash-test make-hash-placeholder)
+ (roundtrip
+  (compilation-top                                            
+      0                                                          
+      (prefix 0 empty empty)
+      (cons #hasheq()
+            #hasheq())))
+ 
+ #;(local [(define (hash-test make-hash-placeholder)
            (roundtrip 
             (compilation-top 0 
                              (prefix 0 empty empty)