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

change mzc verbosity

Browse Source 
svn: r12333
This commit is contained in:
Matthew Flatt 2008-11-06 18:54:12 +00:00
parent f78ce2c9f3
commit f076494c48
5 changed files with 67 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
collects/compiler/main.ss
View File

@ -360,8 +360,11 @@
"-------------------------- miscellaneous flags ------------------------------"] "-------------------------- miscellaneous flags ------------------------------"]
[once-each [once-each
[("-v") [("-v")
,(lambda (f) (compiler:option:verbose #t)) ,(lambda (f) (compiler:option:somewhat-verbose #t))
("Verbose mode")] ("Slightly verbose mode, including version banner and output files")]
[("--vv")
,(lambda (f) (compiler:option:somewhat-verbose #t) (compiler:option:verbose #t))
("Very verbose mode")]
[("--save-temps") [("--save-temps")
,(lambda (f) (compiler:option:clean-intermediate-files #f)) ,(lambda (f) (compiler:option:clean-intermediate-files #f))
("Keep intermediate files")] ("Keep intermediate files")]
@ -394,13 +397,14 @@
(void))))))) (void)))))))
(list "file/directory/collection"))) (list "file/directory/collection")))
(printf "mzc v~a [~a], Copyright (c) 2004-2008 PLT Scheme Inc.\n"
(version)
(system-type 'gc))
(define-values (mode source-files prefix) (define-values (mode source-files prefix)
(parse-options (current-command-line-arguments))) (parse-options (current-command-line-arguments)))
(when (compiler:option:somewhat-verbose)
(printf "mzc v~a [~a], Copyright (c) 2004-2008 PLT Scheme Inc.\n"
(version)
(system-type 'gc)))
(when (and (auto-dest-dir) (not (memq mode '(zo compile)))) (when (and (auto-dest-dir) (not (memq mode '(zo compile))))
(error 'mzc "--auto-dir works only with -z, --zo, -e, or --extension (or default mode)")) (error 'mzc "--auto-dir works only with -z, --zo, -e, or --extension (or default mode)"))
@ -465,29 +469,37 @@
(let ([n (make-base-empty-namespace)] (let ([n (make-base-empty-namespace)]
[mc (dynamic-require 'compiler/cm 'managed-compile-zo)] [mc (dynamic-require 'compiler/cm 'managed-compile-zo)]
[cnh (dynamic-require 'compiler/cm 'manager-compile-notify-handler)] [cnh (dynamic-require 'compiler/cm 'manager-compile-notify-handler)]
[cth (dynamic-require 'compiler/cm 'manager-trace-handler)]
[did-one? #f]) [did-one? #f])
(parameterize ([current-namespace n] (parameterize ([current-namespace n]
[cth (lambda (p)
(when (compiler:option:verbose)
(printf " ~a\n" p)))]
[cnh (lambda (p) [cnh (lambda (p)
(set! did-one? #t) (set! did-one? #t)
(printf " making ~s\n" (path->string p)))]) (when (compiler:option:somewhat-verbose)
(printf " making ~s\n" (path->string p))))])
(for ([file source-files]) (for ([file source-files])
(unless (file-exists? file) (unless (file-exists? file)
(error 'mzc "file does not exist: ~a" file)) (error 'mzc "file does not exist: ~a" file))
(set! did-one? #f) (set! did-one? #f)
(let ([name (extract-base-filename/ss file 'mzc)]) (let ([name (extract-base-filename/ss file 'mzc)])
(printf "\"~a\":\n" file) (when (compiler:option:somewhat-verbose)
(printf "\"~a\":\n" file))
(mc file) (mc file)
(let ([dest (append-zo-suffix (let ([dest (append-zo-suffix
(let-values ([(base name dir?) (split-path file)]) (let-values ([(base name dir?) (split-path file)])
(build-path (if (symbol? base) 'same base) (build-path (if (symbol? base) 'same base)
"compiled" name)))]) "compiled" name)))])
(when (compiler:option:somewhat-verbose)
(printf " [~a \"~a\"]\n" (printf " [~a \"~a\"]\n"
(if did-one? "output to" "already up-to-date at") (if did-one? "output to" "already up-to-date at")
dest))))))] dest)))))))]
[(collection-zos) [(collection-zos)
(parameterize ([compile-notify-handler (parameterize ([compile-notify-handler
(lambda (path) (lambda (path)
(printf " making ~s\n" (path->string path)))]) (when (compiler:option:somewhat-verbose)
(printf " making ~s\n" (path->string path))))])
(apply compile-collection-zos source-files))] (apply compile-collection-zos source-files))]
[(cc) [(cc)
(for ([file source-files]) (for ([file source-files])
@ -495,23 +507,27 @@
[dest (append-object-suffix [dest (append-object-suffix
(let-values ([(base name dir?) (split-path base)]) (let-values ([(base name dir?) (split-path base)])
(build-path (or (dest-dir) 'same) name)))]) (build-path (or (dest-dir) 'same) name)))])
(printf "\"~a\":\n" file) (when (compiler:option:somewhat-verbose)
(printf "\"~a\":\n" file))
(compile-extension (not (compiler:option:verbose)) file dest null) (compile-extension (not (compiler:option:verbose)) file dest null)
(printf " [output to \"~a\"]\n" dest)))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest))))]
[(ld) [(ld)
(extract-base-filename/ext (ld-output) 'mzc) (extract-base-filename/ext (ld-output) 'mzc)
;; (for ([file source-files]) (extract-base-filename/o file 'mzc)) ;; (for ([file source-files]) (extract-base-filename/o file 'mzc))
(let ([dest (if (dest-dir) (let ([dest (if (dest-dir)
(build-path (dest-dir) (ld-output)) (build-path (dest-dir) (ld-output))
(ld-output))]) (ld-output))])
(when (compiler:option:somewhat-verbose)
(printf "~a:\n" (let ([s (apply string-append (printf "~a:\n" (let ([s (apply string-append
(map (lambda (n) (format " \"~a\"" n)) (map (lambda (n) (format " \"~a\"" n))
source-files))]) source-files))])
(substring s 1 (string-length s)))) (substring s 1 (string-length s)))))
(link-extension (not (compiler:option:verbose)) (link-extension (not (compiler:option:verbose))
source-files source-files
dest) dest)
(printf " [output to \"~a\"]\n" dest))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest)))]
[(xform) [(xform)
(for ([file source-files]) (for ([file source-files])
(let* ([out-file (path-replace-suffix file ".3m.c")] (let* ([out-file (path-replace-suffix file ".3m.c")]
@ -523,7 +539,8 @@
file file
out-file out-file
(list (find-include-dir))) (list (find-include-dir)))
(printf " [output to \"~a\"]\n" out-file)))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" out-file))))]
[(exe gui-exe) [(exe gui-exe)
(unless (= 1 (length source-files)) (unless (= 1 (length source-files))
(error 'mzc "expected a single module source file to embed; given: ~e" (error 'mzc "expected a single module source file to embed; given: ~e"
@ -554,7 +571,8 @@
#:collects-path (exe-embedded-collects-path) #:collects-path (exe-embedded-collects-path)
#:collects-dest (exe-embedded-collects-dest) #:collects-dest (exe-embedded-collects-dest)
#:aux (exe-aux)) #:aux (exe-aux))
(printf " [output to \"~a\"]\n" dest))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest)))]
[(c-mods) [(c-mods)
(let ([dest (mods-output)]) (let ([dest (mods-output)])
(let-values ([(in out) (make-pipe)]) (let-values ([(in out) (make-pipe)])
@ -592,14 +610,16 @@
(fprintf out "XFORM_END_SKIP;\n") (fprintf out "XFORM_END_SKIP;\n")
(fprintf out "#endif\n") (fprintf out "#endif\n")
(close-output-port out))) (close-output-port out)))
(printf " [output to \"~a\"]\n" dest))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" dest)))]
[(exe-dir) [(exe-dir)
((dynamic-require 'compiler/distribute 'assemble-distribution) ((dynamic-require 'compiler/distribute 'assemble-distribution)
(exe-dir-output) (exe-dir-output)
source-files source-files
#:collects-path (exe-embedded-collects-path) #:collects-path (exe-embedded-collects-path)
#:copy-collects (exe-dir-add-collects-dirs)) #:copy-collects (exe-dir-add-collects-dirs))
(printf " [output to \"~a\"]\n" (exe-dir-output))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" (exe-dir-output)))]
[(plt) [(plt)
(for ([fd source-files]) (for ([fd source-files])
(unless (relative-path? fd) (unless (relative-path? fd)
@ -622,7 +642,8 @@
(let* ([i (get-info '("mzscheme"))] (let* ([i (get-info '("mzscheme"))]
[v (and i (i 'version (lambda () #f)))]) [v (and i (i 'version (lambda () #f)))])
(list (list '("mzscheme") v)))) (list (list '("mzscheme") v))))
(printf " [output to \"~a\"]\n" (plt-output))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" (plt-output)))]
[(plt-collect) [(plt-collect)
(pack-collections-plt (pack-collections-plt
(plt-output) (plt-output)
@ -640,5 +661,6 @@
std-filter) std-filter)
#:at-plt-home? (plt-files-plt-home-relative?) #:at-plt-home? (plt-files-plt-home-relative?)
#:test-plt-collects? (not (plt-force-install-dir?))) #:test-plt-collects? (not (plt-force-install-dir?)))
(printf " [output to \"~a\"]\n" (plt-output))] (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]\n" (plt-output)))]
[else (printf "bad mode: ~a\n" mode)]) [else (printf "bad mode: ~a\n" mode)])

1
collects/compiler/option-unit.ss
View File

@ -23,6 +23,7 @@
(define disable-interrupts (make-parameter #f)) (define disable-interrupts (make-parameter #f))
(define fixnum-arithmetic (make-parameter #f)) (define fixnum-arithmetic (make-parameter #f))
(define somewhat-verbose (make-parameter #f))
(define verbose (make-parameter #f)) (define verbose (make-parameter #f))
(define debug (make-parameter #f)) (define debug (make-parameter #f))
(define test (make-parameter #f)) (define test (make-parameter #f))

15
collects/compiler/private/driver.ss
View File

@ -628,8 +628,9 @@
;; read all top-level s-expressions ;; read all top-level s-expressions
;; ;;
(when (compiler:option:somewhat-verbose)
(printf "\"~a\": " input-path) (printf "\"~a\": " input-path)
(unless (compiler:option:verbose) (newline)) (unless (compiler:option:verbose) (newline)))
(let ([read-thunk (let ([read-thunk
(lambda () (lambda ()
(with-handlers ([void top-level-exn-handler]) (with-handlers ([void top-level-exn-handler])
@ -1398,11 +1399,13 @@
;; ;;
(if c-only? (if c-only?
(printf " [output to \"~a\"]~n" (or c3m-output-path c-output-path)) (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]~n" (or c3m-output-path c-output-path)))
(begin (begin
(unless input-path (unless input-path
(printf "\"~a\": ~n" (or c3m-output-path c-output-path))) (when (compiler:option:somewhat-verbose)
(printf "\"~a\": ~n" (or c3m-output-path c-output-path))))
(when (compiler:option:verbose) (printf " [compiling native code to \"~a\"]~n" (when (compiler:option:verbose) (printf " [compiling native code to \"~a\"]~n"
obj-output-path)) obj-output-path))
@ -1436,7 +1439,8 @@
(clean-up)) (clean-up))
(if multi-o? (if multi-o?
(printf " [output to \"~a\"]~n" obj-output-path) (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]~n" obj-output-path))
(begin (begin
;; Link ;; Link
@ -1460,7 +1464,8 @@
(when (compiler:option:clean-intermediate-files) (when (compiler:option:clean-intermediate-files)
(delete-file obj-output-path)) (delete-file obj-output-path))
(printf " [output to \"~a\"]~n" dll-output-path))))) (when (compiler:option:somewhat-verbose)
(printf " [output to \"~a\"]~n" dll-output-path))))))
(when debug:port (when debug:port
(close-output-port debug:port)) (close-output-port debug:port))

4
collects/compiler/sig.ss
View File

@ -9,7 +9,9 @@
;; Compiler options ;; Compiler options
(define-signature compiler:option^ (define-signature compiler:option^
(verbose ; default = #f (somewhat-verbose ; default = #f
verbose ; default = #f
setup-prefix ; string to embed in public names; setup-prefix ; string to embed in public names;
; used mainly for compiling extensions ; used mainly for compiling extensions

5
collects/scribblings/mzc/api.scrbl
View File

@ -185,6 +185,11 @@ More options are defined by the @schememodname[dynext/compile] and
@schememodname[dynext/link] libraries, which control the actual C @schememodname[dynext/link] libraries, which control the actual C
compiler and linker that are used for compilation via C. compiler and linker that are used for compilation via C.
@defboolparam[somewhat-verbose on?]{
A @scheme[#t] value for the parameter causes the compiler to print
the files that it compiles and produces. The default is @scheme[#f].}
@defboolparam[verbose on?]{ @defboolparam[verbose on?]{
A @scheme[#t] value for the parameter causes the compiler to print A @scheme[#t] value for the parameter causes the compiler to print