diff --git a/pkgs/compiler-lib/info.rkt b/pkgs/compiler-lib/info.rkt index 10e5d34b6b..0dc09693c7 100644 --- a/pkgs/compiler-lib/info.rkt +++ b/pkgs/compiler-lib/info.rkt @@ -13,4 +13,4 @@ (define pkg-authors '(mflatt)) -(define version "1.6") +(define version "1.7") diff --git a/pkgs/compiler-lib/setup/option-sig.rkt b/pkgs/compiler-lib/setup/option-sig.rkt index 5308450163..c288fc6731 100644 --- a/pkgs/compiler-lib/setup/option-sig.rkt +++ b/pkgs/compiler-lib/setup/option-sig.rkt @@ -5,6 +5,7 @@ (define-signature setup-option^ (setup-program-name + setup-compiled-file-paths verbose make-verbose compiler-verbose diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index 67506aa52a..c6077f25a5 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -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]]} diff --git a/racket/collects/setup/main.rkt b/racket/collects/setup/main.rkt index 1489a6b4e8..0473c8ea3e 100644 --- a/racket/collects/setup/main.rkt +++ b/racket/collects/setup/main.rkt @@ -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)) diff --git a/racket/collects/setup/option.rkt b/racket/collects/setup/option.rkt index c1aa581b35..53327dbb5a 100644 --- a/racket/collects/setup/option.rkt +++ b/racket/collects/setup/option.rkt @@ -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 diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 2ee8c6c780..0b3db73e03 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -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)) diff --git a/racket/collects/setup/setup-go.rkt b/racket/collects/setup/setup-go.rkt index cb514b3b38..12574bc38f 100644 --- a/racket/collects/setup/setup-go.rkt +++ b/racket/collects/setup/setup-go.rkt @@ -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)))