fixing logging and running code in zo-exs

original commit: 0688c18593

collects/compiler/demodularizer/batch.rkt

@@ -46,6 +46,7 @@ Here's the idea:
          "gc-toplevels.rkt"
          "alpha.rkt"
          "module.rkt"
+         "replace-modidx.rkt"
          compiler/decompile
          compiler/zo-marshal
          racket/set)
@@ -65,13 +66,13 @@ Here's the idea:
 
 
 ;; Compile 
-#;(log-debug "Removing existing zo file~n")
+#;(log-debug "Removing existing zo file")
 #;(define compiled-zo-path (build-compiled-path base (path-add-suffix name #".zo")))
 
 #;(when (file-exists? compiled-zo-path)
     (delete-file compiled-zo-path))
 
-(log-debug "Compiling module~n")
+(log-debug "Compiling module")
 (void (system* (find-executable-path "raco") "make" file-to-batch)) 
 
 
@@ -81,52 +82,49 @@ Here's the idea:
 (define merged-zo-path (build-compiled-path merged-source-base (path-add-suffix merged-source-name #".zo")))
 
 ;; Transformations
-(log-debug "Removing dependencies~n")
+(log-debug "Removing dependencies")
 (define-values (batch-nodep top-lang-info top-self-modidx)
   (nodep-file file-to-batch (excluded-modules)))
 
-(log-debug "Merging modules~n")
+(log-debug "Merging modules")
 (define batch-merge
   (merge-compilation-top batch-nodep))
 
-(log-debug "GC-ing top-levels~n")
+(log-debug "GC-ing top-levels")
 (define batch-gcd
   batch-merge
   #;(gc-toplevels batch-merge))
 
-(log-debug "Alpha-varying top-levels~n")
+(log-debug "Alpha-varying top-levels")
 (define batch-alpha
   (alpha-vary-ctop batch-gcd))
 
+(log-debug "Replacing self-modidx")
+(define batch-replace-modidx
+  (replace-modidx batch-alpha top-self-modidx))
+
 (define batch-modname
   (string->symbol (regexp-replace #rx"\\.rkt$" (path->string merged-source-name) "")))
-(log-debug (format "Modularizing into ~a~n" batch-modname))
+(log-debug (format "Modularizing into ~a" batch-modname))
 (define batch-mod
-  (wrap-in-kernel-module batch-modname batch-modname top-lang-info top-self-modidx batch-alpha))
+  (wrap-in-kernel-module batch-modname batch-modname top-lang-info top-self-modidx batch-replace-modidx))
 
 ;; Output
 (define batch-final batch-mod)
 
-(log-debug "Writing merged source~n")
+(log-debug "Writing merged source")
 (with-output-to-file
     merged-source-path
   (lambda ()
-    (pretty-print (decompile batch-final)))
+    (write batch-final))
   #:exists 'replace)
 
-(log-debug "Writing merged struct~n")
+(log-debug "Writing merged zo")
-(with-output-to-file
-    merged-struct-path
-  (lambda ()
-    (pretty-write batch-final))
-  #:exists 'replace)
-
-(log-debug "Writing merged zo~n")
 (void
  (with-output-to-file 
      merged-zo-path
    (lambda ()
-     (write-bytes (zo-marshal batch-final)))
+     (zo-marshal-to batch-final (current-output-port)))
    #:exists 'replace))
 
 

collects/compiler/demodularizer/merge.rkt

@@ -15,10 +15,10 @@
      (define total-tls (length (prefix-toplevels new-prefix)))
      (define total-stxs (length (prefix-stxs new-prefix)))
      (define total-lifts (prefix-num-lifts new-prefix))
-     (log-debug (format "max-let-depth ~S to ~S~n" max-let-depth new-max-let-depth))
+     (log-debug (format "max-let-depth ~S to ~S" max-let-depth new-max-let-depth))
-     (log-debug (format "total toplevels ~S~n" total-tls))
+     (log-debug (format "total toplevels ~S" total-tls))
-     (log-debug (format "total stxs ~S~n" total-stxs))
+     (log-debug (format "total stxs ~S" total-stxs))
-     (log-debug (format "num-lifts ~S~n" total-lifts))
+     (log-debug (format "num-lifts ~S" total-lifts))
      (make-compilation-top 
       new-max-let-depth new-prefix 
       (make-splice (gen-new-forms new-prefix)))]
@@ -60,7 +60,7 @@
     [(struct module-variable (modidx sym pos phase))
      (match rw
        [(struct modvar-rewrite (self-modidx provide->toplevel))
-        (log-debug (format "Rewriting ~a of ~S~n" pos (mpi->path* modidx)))
+        (log-debug (format "Rewriting ~a of ~S" pos (mpi->path* modidx)))
         ((hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx
                      (lambda ()
                        (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx)))
@@ -82,7 +82,7 @@
          (cond
            ; Primitive module like #%paramz
            [(symbol? rw)
-            (log-debug (format "~S from ~S~n" sym rw))
+            (log-debug (format "~S from ~S" sym rw))
             (values (add1 i)
                     (list* tl new-toplevels)
                     (list* (+ i toplevel-offset) remap))]
@@ -126,22 +126,22 @@
                   (list-ref toplevel-remap n)))
      (unless (= (length toplevel-remap)
                 (length mod-toplevels))
-       (error 'merge-module "Not remapping everything: ~S ~S~n" 
+       (error 'merge-module "Not remapping everything: ~S ~S" 
               mod-toplevels toplevel-remap))    
-     (log-debug (format "[~S] Incrementing toplevels by ~a~n"
+     (log-debug (format "[~S] Incrementing toplevels by ~a"
               name
               toplevel-offset))
-     (log-debug (format "[~S] Incrementing lifts by ~a~n"
+     (log-debug (format "[~S] Incrementing lifts by ~a"
               name
               lift-offset))
-     (log-debug (format "[~S] Filtered mod-vars from ~a to ~a~n" 
+     (log-debug (format "[~S] Filtered mod-vars from ~a to ~a" 
               name
               (length mod-toplevels)
               (length new-mod-toplevels)))
      (values (max max-let-depth mod-max-let-depth)
              (merge-prefix top-prefix new-mod-prefix)
              (lambda (top-prefix)
-               (log-debug (format "[~S] Updating top-levels\n" name))
+               (log-debug (format "[~S] Updating top-levels" name))
                (define top-lift-start (prefix-lift-start top-prefix))
                (define mod-lift-start (prefix-lift-start mod-prefix))
                (define total-lifts (prefix-num-lifts top-prefix))

collects/compiler/zo-parse.rkt

@@ -950,7 +950,12 @@
              (make-closure 
               v
               ; XXX Why call gensym here?
-              (gensym
+              (let ([s (lam-name v)])
+                 (cond
+                   [(symbol? s) s]
+                   [(vector? s) (vector-ref s 0)]
+                   [else 'closure]))
+              #;(gensym
                (let ([s (lam-name v)])
                  (cond
                    [(symbol? s) s]
@@ -1046,6 +1051,7 @@
     (for ([i (in-range 1 symtabsize)])
       (read-sym cp i))
     
+    #;(printf "Parsed table:\n")
     #;(for ([(i v) (in-dict (cport-symtab cp))])
       (printf "~a = ~a\n" i (placeholder-get v)) )
     (set-cport-pos! cp shared-size)

collects/tests/compiler/zo-exs.rkt

@@ -7,13 +7,19 @@
   (parameterize ([read-accept-compiled #t])
     (read (open-input-bytes bs))))
 
+(define (run-compiled-bytes bs [delayed? #t])
+  (system "touch test.rkt")
+  (system "touch compiled/test_rkt.zo")
+  (system (format "racket ~a -t test.rkt" (if delayed? "" "-d"))))
+
 (define (roundtrip ct)
   (define bs (zo-marshal ct))
-  (with-output-to-file "test_rkt.zo" (λ () (write-bytes bs)) #:exists 'replace)
+  (with-output-to-file "compiled/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))))
+              (run-compiled-bytes bs #t)
+              (run-compiled-bytes bs #f))))
 
 (define mpi (module-path-index-join #f #f))