120 lines
4.6 KiB
Racket
120 lines
4.6 KiB
Racket
#lang racket/base
|
|
(require racket/cmdline
|
|
raco/command-name
|
|
compiler/cm
|
|
compiler/compiler
|
|
compiler/compilation-path
|
|
dynext/file
|
|
setup/parallel-build
|
|
setup/path-to-relative
|
|
racket/match)
|
|
|
|
(module test racket/base)
|
|
|
|
(define verbose (make-parameter #f))
|
|
(define very-verbose (make-parameter #f))
|
|
(define disable-inlining (make-parameter #f))
|
|
|
|
(define disable-deps (make-parameter #f))
|
|
(define disable-const (make-parameter #f))
|
|
(define prefixes (make-parameter null))
|
|
(define assume-primitives (make-parameter #t))
|
|
(define worker-count (make-parameter 1))
|
|
|
|
(define mzc-symbol (string->symbol (short-program+command-name)))
|
|
|
|
(define source-files
|
|
(command-line
|
|
#:program (short-program+command-name)
|
|
#:once-each
|
|
[("-j") n "Compile with up to <n> tasks in parallel"
|
|
(let ([num (string->number n)])
|
|
(unless num (raise-user-error (format "~a: bad count for -j: ~s"
|
|
(short-program+command-name)
|
|
n)))
|
|
(worker-count num))]
|
|
[("--disable-inline") "Disable procedure inlining during compilation"
|
|
(disable-inlining #t)]
|
|
[("--disable-constant") "Disable enforcement of module constants"
|
|
(disable-const #t)]
|
|
[("--no-deps") "Compile immediate files without updating dependencies"
|
|
(disable-deps #t)]
|
|
[("-p" "--prefix") file "Add elaboration-time prefix file for --no-deps"
|
|
(prefixes (append (prefixes) (list file)))]
|
|
[("--no-prim") "Do not assume `scheme' bindings at top level for --no-deps"
|
|
(assume-primitives #f)]
|
|
[("-v") "Verbose mode"
|
|
(verbose #t)]
|
|
[("--vv") "Very verbose mode"
|
|
(verbose #t)
|
|
(very-verbose #t)]
|
|
#:args (file . another-file) (cons file another-file)))
|
|
|
|
(cond
|
|
;; Just compile one file:
|
|
[(disable-deps)
|
|
(let ([prefix
|
|
`(begin
|
|
(require scheme)
|
|
,(if (assume-primitives)
|
|
'(void)
|
|
'(namespace-require/copy 'scheme))
|
|
,@(map (lambda (s) `(load ,s)) (prefixes))
|
|
(void))])
|
|
((compile-zos prefix #:verbose? (verbose))
|
|
source-files
|
|
'auto))]
|
|
;; Normal make:
|
|
[(= (worker-count) 1)
|
|
(let ([n (make-base-empty-namespace)]
|
|
[did-one? #f])
|
|
(parameterize ([current-namespace n]
|
|
[manager-trace-handler
|
|
(lambda (p)
|
|
(when (very-verbose)
|
|
(printf " ~a\n" p)))]
|
|
[manager-compile-notify-handler
|
|
(lambda (p)
|
|
(set! did-one? #t)
|
|
(when (verbose)
|
|
(printf " making ~s\n" p)))])
|
|
(for ([file source-files])
|
|
(unless (file-exists? file)
|
|
(error mzc-symbol "file does not exist: ~a" file))
|
|
(set! did-one? #f)
|
|
(let ([name (extract-base-filename/ss file mzc-symbol)])
|
|
(when (verbose)
|
|
(printf "\"~a\":\n" file))
|
|
(parameterize ([compile-context-preservation-enabled
|
|
(disable-inlining)]
|
|
[compile-enforce-module-constants
|
|
(not (disable-const))])
|
|
(managed-compile-zo file))
|
|
(when (verbose)
|
|
(printf " [~a \"~a\"]\n"
|
|
(if did-one? "output to" "already up-to-date at")
|
|
(get-compilation-bytecode-file file)))))))]
|
|
;; Parallel make:
|
|
[else
|
|
(define path-cache (make-hash))
|
|
(or (parallel-compile-files
|
|
source-files
|
|
#:worker-count (worker-count)
|
|
#:handler (lambda (id type work msg out err)
|
|
(define (->rel p)
|
|
(path->relative-string/library p #:cache path-cache))
|
|
(match type
|
|
['start (when (verbose) (printf " ~a making ~a\n" id (->rel work)))]
|
|
['done (when (verbose) (printf " ~a made ~a\n" id (->rel work)))]
|
|
['output (printf " ~a output from: ~a\n~a~a" id work out err)]
|
|
[else (printf " ~a error compiling ~a\n~a\n~a~a" id work msg out err)]))
|
|
#:options (let ([cons-if-true (lambda (bool carv cdrv)
|
|
(if bool
|
|
(cons carv cdrv)
|
|
cdrv))])
|
|
(cons-if-true
|
|
(very-verbose)
|
|
'very-verbose
|
|
(cons-if-true (disable-inlining) 'disable-inlining null))))
|
|
(exit 1))])
|