raco setup: adjust --clean mode
Make `raco setup` propagate the original value of `use-compiled-file-paths` in case it's reset to avoid loading bytecode files. Then, `--clean` mode can remove bytecode relevant to that setting, instead of always clearing "compiled" subdirectories. There's no external way to initialize `use-compiled-file-paths` right now, other than forcing it to `null` with the `-c` flag at the `racket` level, but the current "racket7" implementation uses different `use-compiled-file-paths` settings for different build modes, and it seems to make sense in general. Also, make `--clean` sensitive to `-D` and `-d`, so that it's easy to clean just bytecode.
This commit is contained in:
Matthew Flatt
parent
5ecbc54fff
commit
808bd1b897
|
|
@ -13,4 +13,4 @@
|
|||
|
||||
(define pkg-authors '(mflatt))
|
||||
|
||||
(define version "1.6")
|
||||
(define version "1.7")
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
|
||||
(define-signature setup-option^
|
||||
(setup-program-name
|
||||
setup-compiled-file-paths
|
||||
verbose
|
||||
make-verbose
|
||||
compiler-verbose
|
||||
|
|
|
|||
|
|
@ -143,7 +143,10 @@ flags:
|
|||
@item{@DFlag{clean} or @Flag{c} --- delete existing @filepath{.zo}
|
||||
files, thus ensuring a clean build from the source files. The exact
|
||||
set of deleted files can be controlled by @filepath{info.rkt}; see
|
||||
@elemref["clean"]{@racket[clean]} for more information.}
|
||||
@elemref["clean"]{@racket[clean]} for more information. Unless
|
||||
@DFlag{no-info-domain} or @Flag{d} is also specified, the @filepath{info.rkt}
|
||||
cache is cleared. Unless @DFlag{no-docs} or @Flag{D} is also
|
||||
specified, the documentation-index database is reset.}
|
||||
|
||||
@item{@DFlag{fast-clean} or @Flag{c} --- like @DFlag{clean}, but
|
||||
without forcing a bootstrap of @exec{raco setup} from source (which
|
||||
|
|
@ -1030,7 +1033,14 @@ form.}
|
|||
The prefix used when printing status messages.
|
||||
@defaults[@racket["raco setup"]]
|
||||
}
|
||||
|
||||
|
||||
@defparam[setup-compiled-file-paths paths (or/c #f (listof (and/c path? relative-path?)))]{
|
||||
If not @racket[#f], supplies a value like the one for @racket[use-compiled-file-paths]
|
||||
to control operations such as cleaning, where @racket[use-compiled-file-paths]
|
||||
may have been set to @racket[null] to avoid loading bytecode.
|
||||
|
||||
@history[#:added "1.7"]}
|
||||
|
||||
@defboolparam[verbose on?]{
|
||||
If on, prints messages from @exec{make} to @envvar{stderr}.
|
||||
@defaults[@racket[#f]]}
|
||||
|
|
|
|||
|
|
@ -75,8 +75,10 @@
|
|||
|
||||
(define-values (print-bootstrapping)
|
||||
(lambda (why)
|
||||
(fprintf (current-output-port) "~a: bootstrapping from source...\n (~a)\n"
|
||||
short-name why)))
|
||||
(fprintf (current-output-port)
|
||||
"~a: bootstrapping from source...\n ~a\n"
|
||||
short-name
|
||||
why)))
|
||||
|
||||
(define-values (main-collects-relative->path)
|
||||
(let ([main-collects #f])
|
||||
|
|
@ -89,6 +91,8 @@
|
|||
(map bytes->path (cdr p)))
|
||||
p))))
|
||||
|
||||
(define-values (original-compiled-file-paths) (use-compiled-file-paths))
|
||||
|
||||
(if (or (on? "--clean")
|
||||
(on? "-c")
|
||||
(on? "--no-zo")
|
||||
|
|
@ -98,7 +102,7 @@
|
|||
(when (or (on? "--clean")
|
||||
(on? "-c"))
|
||||
(use-compiled-file-paths null)
|
||||
(print-bootstrapping "command-line --clean or -c"))
|
||||
(print-bootstrapping "triggered by command-line `--clean` or `-c`"))
|
||||
|
||||
;; Load the cm instance to be installed while loading Setup PLT.
|
||||
;; This has to be dynamic, so we get a chance to turn off compiled
|
||||
|
|
@ -161,14 +165,14 @@
|
|||
;; Not a .zo! Don't use .zo files at all...
|
||||
(escape (lambda ()
|
||||
;; Try again without .zo
|
||||
(loop (format "loading non-.zo: ~a" path))))))))]
|
||||
(loop (format "triggered by use of non-\".zo\" file\n path: ~a" path))))))))]
|
||||
[current-load-extension
|
||||
(if skip-zo/reason
|
||||
(current-load-extension)
|
||||
(lambda (path modname)
|
||||
(escape (lambda ()
|
||||
;; Try again without .zo
|
||||
(loop "loading an extension")))))])
|
||||
(loop "triggered by loading an extension")))))])
|
||||
;; Other things could go wrong, such as a version mismatch.
|
||||
;; If something goes wrong, of course, give up on .zo files.
|
||||
(parameterize ([uncaught-exception-handler
|
||||
|
|
@ -179,7 +183,7 @@
|
|||
(lambda () (raise exn)))
|
||||
(escape
|
||||
(lambda () (loop (if (exn:fail? exn)
|
||||
(regexp-replace* #rx"\n" (exn-message exn) "\n ")
|
||||
(exn-message exn)
|
||||
(format "uncaught exn: ~s" exn)))))))])
|
||||
;; Here's the main dynamic load of "cm.rkt":
|
||||
(let ([mk
|
||||
|
|
@ -195,4 +199,4 @@
|
|||
|
||||
;; This has to be dynamic, so we get a chance to turn off
|
||||
;; .zo use and turn on the compilation manager.
|
||||
(dynamic-require 'setup/setup-go #f))
|
||||
((dynamic-require 'setup/setup-go 'go) original-compiled-file-paths))
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
(provide call-with-flag-params
|
||||
set-flag-params
|
||||
setup-program-name
|
||||
setup-compiled-file-paths
|
||||
specific-collections
|
||||
specific-packages
|
||||
specific-planet-dirs
|
||||
|
|
@ -47,6 +48,11 @@
|
|||
|
||||
(define setup-program-name (make-parameter "raco setup"))
|
||||
|
||||
;; If non-`#f`, tells operations like `--clean` to use a particular
|
||||
;; compile-file path, even though `use-compiled-file-paths` may have
|
||||
;; been set to null to avoid loading bytecode:
|
||||
(define setup-compiled-file-paths (make-parameter #f))
|
||||
|
||||
(define-flag-param parallel-workers (min (processor-count)
|
||||
(if (fixnum? (arithmetic-shift 1 40))
|
||||
8 ; 64-bit machine
|
||||
|
|
|
|||
|
|
@ -77,10 +77,16 @@
|
|||
(values (simple-form-path p) #t)))
|
||||
(define main-links-files (for/hash ([p (in-list (get-links-search-files))])
|
||||
(values (simple-form-path p) #t)))
|
||||
|
||||
(define mode-dir
|
||||
(if (compile-mode)
|
||||
(build-path "compiled" (compile-mode))
|
||||
(build-path "compiled")))
|
||||
(let ([compiled-dir (let ([l (or (setup-compiled-file-paths)
|
||||
(use-compiled-file-paths))])
|
||||
(if (pair? l)
|
||||
(car l)
|
||||
"compiled"))])
|
||||
(if (compile-mode)
|
||||
(build-path compiled-dir (compile-mode))
|
||||
(build-path compiled-dir))))
|
||||
|
||||
(unless (make-user)
|
||||
(current-library-collection-paths
|
||||
|
|
@ -837,21 +843,23 @@
|
|||
(delete-file/record-dependency zo dependencies)
|
||||
(delete-file/record-dependency dep dependencies))))
|
||||
(when did-something? (loop dependencies)))
|
||||
(setup-printf #f "clearing info-domain caches")
|
||||
(define (check-one-info-domain fn)
|
||||
(when (file-exists? fn)
|
||||
(with-handlers ([exn:fail:filesystem? (warning-handler (void))])
|
||||
(with-output-to-file fn void #:exists 'truncate/replace))))
|
||||
(for ([p (current-library-collection-paths)])
|
||||
(check-one-info-domain (build-path p "info-domain" "compiled" "cache.rktd")))
|
||||
(check-one-info-domain (build-path (find-share-dir) "info-cache.rktd"))
|
||||
(check-one-info-domain (build-path (find-user-share-dir) "info-cache.rktd"))
|
||||
(setup-printf #f "deleting documentation databases")
|
||||
(for ([d (in-list (list (find-doc-dir) (find-user-doc-dir)))])
|
||||
(when d
|
||||
(define f (build-path d "docindex.sqlite"))
|
||||
(when (file-exists? f)
|
||||
(delete-file f))))))
|
||||
(when (make-info-domain)
|
||||
(setup-printf #f "clearing info-domain caches")
|
||||
(define (check-one-info-domain fn)
|
||||
(when (file-exists? fn)
|
||||
(with-handlers ([exn:fail:filesystem? (warning-handler (void))])
|
||||
(with-output-to-file fn void #:exists 'truncate/replace))))
|
||||
(for ([p (current-library-collection-paths)])
|
||||
(check-one-info-domain (build-path p "info-domain" "compiled" "cache.rktd")))
|
||||
(check-one-info-domain (build-path (find-share-dir) "info-cache.rktd"))
|
||||
(check-one-info-domain (build-path (find-user-share-dir) "info-cache.rktd")))
|
||||
(when make-docs?
|
||||
(setup-printf #f "deleting documentation databases")
|
||||
(for ([d (in-list (list (find-doc-dir) (find-user-doc-dir)))])
|
||||
(when d
|
||||
(define f (build-path d "docindex.sqlite"))
|
||||
(when (file-exists? f)
|
||||
(delete-file f)))))))
|
||||
|
||||
(define (do-install-part part)
|
||||
(when (if (eq? part 'post) (call-post-install) (call-install))
|
||||
|
|
|
|||
|
|
@ -1,36 +1,38 @@
|
|||
(module setup-go racket/base
|
||||
(require "setup-cmdline.rkt"
|
||||
"option.rkt"
|
||||
"setup-core.rkt"
|
||||
compiler/cm)
|
||||
#lang racket/base
|
||||
(require "setup-cmdline.rkt"
|
||||
"option.rkt"
|
||||
"setup-core.rkt"
|
||||
compiler/cm)
|
||||
|
||||
(module test racket/base)
|
||||
(provide go)
|
||||
|
||||
(define-values (short-name x-flags
|
||||
x-specific-collections x-specific-packages x-specific-planet-packages
|
||||
x-archives)
|
||||
(parse-cmdline (current-command-line-arguments)))
|
||||
(module test racket/base)
|
||||
|
||||
(define (has-x-flag? s)
|
||||
(define a (assq s x-flags))
|
||||
(and a (cadr a)))
|
||||
(define-values (short-name x-flags
|
||||
x-specific-collections x-specific-packages x-specific-planet-packages
|
||||
x-archives)
|
||||
(parse-cmdline (current-command-line-arguments)))
|
||||
|
||||
(parameterize
|
||||
;; Converting parse-cmdline results into parameter settings:
|
||||
([current-target-plt-directory-getter
|
||||
(if (has-x-flag? 'all-users)
|
||||
(lambda (preferred main-collects-parent-dir choices)
|
||||
main-collects-parent-dir)
|
||||
(current-target-plt-directory-getter))]
|
||||
[trust-existing-zos (or (has-x-flag? 'trust-existing-zos)
|
||||
(trust-existing-zos))]
|
||||
[specific-collections x-specific-collections]
|
||||
[specific-packages x-specific-packages]
|
||||
[archives x-archives]
|
||||
[specific-planet-dirs x-specific-planet-packages]
|
||||
|
||||
[setup-program-name short-name])
|
||||
|
||||
(call-with-flag-params
|
||||
x-flags
|
||||
setup-core)))
|
||||
(define (has-x-flag? s)
|
||||
(define a (assq s x-flags))
|
||||
(and a (cadr a)))
|
||||
|
||||
(define (go orig-compile-file-paths)
|
||||
;; Conver parse-cmdline results into parameter settings:
|
||||
(parameterize ([current-target-plt-directory-getter
|
||||
(if (has-x-flag? 'all-users)
|
||||
(lambda (preferred main-collects-parent-dir choices)
|
||||
main-collects-parent-dir)
|
||||
(current-target-plt-directory-getter))]
|
||||
[trust-existing-zos (or (has-x-flag? 'trust-existing-zos)
|
||||
(trust-existing-zos))]
|
||||
[specific-collections x-specific-collections]
|
||||
[specific-packages x-specific-packages]
|
||||
[archives x-archives]
|
||||
[specific-planet-dirs x-specific-planet-packages]
|
||||
|
||||
[setup-program-name short-name]
|
||||
[setup-compiled-file-paths orig-compile-file-paths])
|
||||
(call-with-flag-params
|
||||
x-flags
|
||||
setup-core)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user