diff --git a/collects/compiler/commands/info.rkt b/collects/compiler/commands/info.rkt index 9a3106d696..41b92c0eae 100644 --- a/collects/compiler/commands/info.rkt +++ b/collects/compiler/commands/info.rkt @@ -7,4 +7,5 @@ ("decompile" compiler/commands/decompile "decompile bytecode" #f) ("expand" compiler/commands/expand "macro-expand source" #f) ("distribute" compiler/commands/exe-dir "prepare executable(s) in a directory for distribution" #f) - ("ctool" compiler/commands/ctool "compile and link C-based extensions" #f))) + ("ctool" compiler/commands/ctool "compile and link C-based extensions" #f) + ("demod" compiler/demodularizer/batch "produce a whole program from a single module" #f))) diff --git a/collects/compiler/demodularizer/batch.rkt b/collects/compiler/demodularizer/batch.rkt index b8e70bb143..1c685d67ba 100644 --- a/collects/compiler/demodularizer/batch.rkt +++ b/collects/compiler/demodularizer/batch.rkt @@ -65,13 +65,13 @@ Here's the idea: ;; Compile -#;(eprintf "Removing existing zo file~n") +#;(log-debug "Removing existing zo file~n") #;(define compiled-zo-path (build-compiled-path base (path-add-suffix name #".zo"))) #;(when (file-exists? compiled-zo-path) (delete-file compiled-zo-path)) -(eprintf "Compiling module~n") +(log-debug "Compiling module~n") (void (system* (find-executable-path "raco") "make" file-to-batch)) @@ -80,39 +80,39 @@ Here's the idea: (define merged-zo-path (build-compiled-path merged-source-base (path-add-suffix merged-source-name #".zo"))) ;; Transformations -(eprintf "Removing dependencies~n") +(log-debug "Removing dependencies~n") (define-values (batch-nodep top-lang-info top-self-modidx) (nodep-file file-to-batch (excluded-modules))) -(eprintf "Merging modules~n") +(log-debug "Merging modules~n") (define batch-merge (merge-compilation-top batch-nodep)) -(eprintf "GC-ing top-levels~n") +(log-debug "GC-ing top-levels~n") (define batch-gcd (gc-toplevels batch-merge)) -(eprintf "Alpha-varying top-levels~n") +(log-debug "Alpha-varying top-levels~n") (define batch-alpha (alpha-vary-ctop batch-gcd)) (define batch-modname (string->symbol (regexp-replace #rx"\\.rkt$" (path->string merged-source-name) ""))) -(eprintf "Modularizing into ~a~n" batch-modname) +(log-debug (format "Modularizing into ~a~n" batch-modname)) (define batch-mod (wrap-in-kernel-module batch-modname batch-modname top-lang-info top-self-modidx batch-alpha)) ;; Output (define batch-final batch-mod) -(eprintf "Writing merged source~n") +(log-debug "Writing merged source~n") (with-output-to-file merged-source-path (lambda () (pretty-print (decompile batch-final))) #:exists 'replace) -(eprintf "Writing merged zo~n") +(log-debug "Writing merged zo~n") (void (with-output-to-file merged-zo-path @@ -120,8 +120,6 @@ Here's the idea: (write-bytes (zo-marshal batch-final))) #:exists 'replace)) -(eprintf "Running merged source~n") -(void (system* (find-executable-path "racket") (path->string merged-source-path))) diff --git a/collects/compiler/demodularizer/gc-toplevels.rkt b/collects/compiler/demodularizer/gc-toplevels.rkt index df1d027969..d0b4ddbcba 100644 --- a/collects/compiler/demodularizer/gc-toplevels.rkt +++ b/collects/compiler/demodularizer/gc-toplevels.rkt @@ -41,12 +41,12 @@ (index<=? stx-pos ordered-stxs)) (prefix-syntax-start new-prefix)) form)) - (eprintf "Total TLS: ~S~n" (length normal-tls)) - (eprintf "Used TLS: ~S~n" normal-tls) - (eprintf "Total lifts: ~S~n" (length lifts)) - (eprintf "Used lifts: ~S~n" lifts) - (eprintf "Total stxs: ~S~n" (length stxs)) - (eprintf "Used stxs: ~S~n" ordered-stxs) + (log-debug (format "Total TLS: ~S~n" (length normal-tls))) + (log-debug (format "Used TLS: ~S~n" normal-tls)) + (log-debug (format "Total lifts: ~S~n" (length lifts))) + (log-debug (format "Used lifts: ~S~n" lifts)) + (log-debug (format "Total stxs: ~S~n" (length stxs))) + (log-debug (format "Used stxs: ~S~n" ordered-stxs)) (make-compilation-top max-let-depth new-prefix diff --git a/collects/compiler/demodularizer/merge.rkt b/collects/compiler/demodularizer/merge.rkt index 33187add17..7163de96d2 100644 --- a/collects/compiler/demodularizer/merge.rkt +++ b/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)) - (eprintf "max-let-depth ~S to ~S~n" max-let-depth new-max-let-depth) - (eprintf "total toplevels ~S~n" total-tls) - (eprintf "total stxs ~S~n" total-stxs) - (eprintf "num-lifts ~S~n" total-lifts) + (log-debug (format "max-let-depth ~S to ~S~n" max-let-depth new-max-let-depth)) + (log-debug (format "total toplevels ~S~n" total-tls)) + (log-debug (format "total stxs ~S~n" total-stxs)) + (log-debug (format "num-lifts ~S~n" 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)) - (eprintf "Rewriting ~a of ~S~n" pos (mpi->path* modidx)) + (log-debug (format "Rewriting ~a of ~S~n" pos (mpi->path* modidx))) (+ (hash-ref MODULE-TOPLEVEL-OFFSETS self-modidx (lambda () (error 'compute-new-modvar "toplevel offset not yet computed: ~S" self-modidx))) @@ -81,7 +81,7 @@ (cond ; Primitive module like #%paramz [(symbol? rw) - (eprintf "~S from ~S~n" sym rw) + (log-debug (format "~S from ~S~n" sym rw)) (values (add1 i) (list* tl new-toplevels) (list* (+ i toplevel-offset) remap))] @@ -124,20 +124,20 @@ (length mod-toplevels)) (error 'merge-module "Not remapping everything: ~S ~S~n" mod-toplevels toplevel-remap)) - (eprintf "[~S] Incrementing toplevels by ~a~n" + (log-debug (format "[~S] Incrementing toplevels by ~a~n" name - toplevel-offset) - (eprintf "[~S] Incrementing lifts by ~a~n" + toplevel-offset)) + (log-debug (format "[~S] Incrementing lifts by ~a~n" name - lift-offset) - (eprintf "[~S] Filtered mod-vars from ~a to ~a~n" + lift-offset)) + (log-debug (format "[~S] Filtered mod-vars from ~a to ~a~n" name (length mod-toplevels) - (length new-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) - (eprintf "[~S] Updating top-levels\n" name) + (log-debug (format "[~S] Updating top-levels\n" 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)) diff --git a/collects/compiler/demodularizer/nodep.rkt b/collects/compiler/demodularizer/nodep.rkt index f6878c2c0d..54507f2365 100644 --- a/collects/compiler/demodularizer/nodep.rkt +++ b/collects/compiler/demodularizer/nodep.rkt @@ -57,7 +57,7 @@ (current-directory))) (define-values (modvar-rewrite lang-info ctop) (begin - (fprintf (current-error-port) "Load ~S @ ~S~n" pth phase) + (log-debug (format "Load ~S @ ~S~n" pth phase)) (nodep/dir (parameterize ([current-load-relative-directory base-directory]) (path->comp-top @@ -98,7 +98,7 @@ (when (symbol? tl) (hash-set! provide-ht (intern tl) i))) (lambda (sym pos) - (eprintf "Looking up ~S@~a~n" sym pos) + (log-debug (format "Looking up ~S@~a~n" sym pos)) (hash-ref provide-ht (intern sym) (lambda () (error 'provide->toplevel "Cannot find ~S in ~S" sym prefix))))) @@ -114,15 +114,15 @@ [tl (void)]) (prefix-toplevels new-prefix)) - (eprintf "[~S] module-variables: ~S~n" name (length (filter module-variable? (prefix-toplevels new-prefix)))) + (log-debug (format "[~S] module-variables: ~S~n" name (length (filter module-variable? (prefix-toplevels new-prefix))))) (values (make-modvar-rewrite self-modidx (construct-provide->toplevel new-prefix provides)) lang-info (append (requires->modlist requires phase) (if (and phase (zero? phase)) - (begin (eprintf "[~S] lang-info : ~S~n" name lang-info) ; XXX Seems to always be #f now + (begin (log-debug (format "[~S] lang-info : ~S~n" name lang-info)) ; XXX Seems to always be #f now (list (make-mod name srcname self-modidx new-prefix provides requires body empty unexported max-let-depth dummy lang-info internal-context))) - (begin (eprintf "[~S] Dropping module @ ~S~n" name phase) + (begin (log-debug (format "[~S] Dropping module @ ~S~n" name phase)) empty))))] [else (error 'nodep-module "huh?: ~e" mod-form)])) diff --git a/collects/unstable/private/expand.ss b/collects/unstable/private/expand.ss deleted file mode 100644 index 3b35525b87..0000000000 --- a/collects/unstable/private/expand.ss +++ /dev/null @@ -1,16 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Trampoline Expansion -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(provide #%trampoline) - -(define-syntax (#%trampoline stx) - (syntax-case stx () - [(_ thunk) - (procedure? (syntax-e #'thunk)) - (#%app (syntax-e #'thunk))]))