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

raco decompile: improve argument checking and reporting

Browse Source 
Relevant to PR 14525

original commit: e4189afb15
This commit is contained in:
Matthew Flatt 2014-05-27 06:34:19 +01:00
parent 03a0dbd9fd
commit 979299850e
1 changed files with 57 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
pkgs/compiler-pkgs/compiler-lib/compiler/commands/decompile.rkt
View File

@ -3,25 +3,80 @@
raco/command-name
compiler/zo-parse
compiler/decompile
racket/pretty)
racket/pretty
racket/format)
(define (get-name)
(string->symbol (short-program+command-name)))
(define force? #f)
(define source-files
(command-line
#:program (short-program+command-name)
#:once-each
[("--force") "Ignore timestamp mimatch on associated \".zo\""
(set! force? #t)]
[("--columns" "-n") n "Format for <n> columns"
(let ([num (string->number n)])
(unless (exact-positive-integer? num)
(raise-user-error (string->symbol (short-program+command-name))
(raise-user-error (get-name)
"not a valid column count: ~a" n))
(pretty-print-columns num))]
#:args source-or-bytecode-file
source-or-bytecode-file))
(define (check-files orig-file alt-file)
(cond
[(not (file-exists? alt-file))
(cond
[(file-exists? orig-file)
(unless (is-bytecode-file? orig-file)
(raise-user-error (get-name)
(~a "not a bytecode file, and no associated \".zo\" file\n"
" path: ~a\n"
" tried associated path: ~a")
orig-file
alt-file))]
[else
(raise-user-error (get-name)
(~a "no such file, and no associated \".zo\" file\n"
" path: ~a\n"
" tried associated path: ~a")
orig-file
alt-file)])]
[(not (is-bytecode-file? alt-file))
(raise-user-error (get-name)
(~a "associated \".zo\" file is not a bytecode file\n"
" original path: ~a\n"
" associated path: ~a")
orig-file
alt-file)]
[(and (not force?)
((file-or-directory-modify-seconds orig-file)
. > .
(file-or-directory-modify-seconds alt-file)))
;; return a warning:
(raise-user-error (get-name)
(~a "associated \".zo\" file's date is older than given file's date;\n"
" consider using `raco make` to rebuild the source file, or use `--force`\n"
" to skip the date check\n"
" original path: ~a\n"
" associated path: ~a")
orig-file
alt-file)]))
(define (is-bytecode-file? orig-file)
(call-with-input-file*
orig-file
(lambda (i)
(equal? #"#~" (read-bytes 2 i)))))
(for ([zo-file source-files])
(let ([zo-file (path->complete-path zo-file)])
(let-values ([(base name dir?) (split-path zo-file)])
(let ([alt-file (build-path base "compiled" (path-add-suffix name #".zo"))])
(check-files zo-file alt-file)
(parameterize ([current-load-relative-directory base]
[print-graph #t])
(pretty-write