suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changed eprintfs to log-debug

Browse Source
This commit is contained in:
Blake Johnson 2010-09-24 12:49:52 -06:00 committed by Jay McCarthy
parent 4676662e4b
commit 3ddda200e8
6 changed files with 35 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/compiler/commands/info.rkt
View File

@ -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)))

20
collects/compiler/demodularizer/batch.rkt
View File

@ -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)))

12
collects/compiler/demodularizer/gc-toplevels.rkt
View File

@ -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

26
collects/compiler/demodularizer/merge.rkt
View File

@ -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))

10
collects/compiler/demodularizer/nodep.rkt
View File

@ -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)]))

16
collects/unstable/private/expand.ss
View File

@ -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))]))