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

report a reason when entering bootstrapping mode

Browse Source
This commit is contained in:
Robby Findler 2016-03-17 16:54:49 -05:00
parent 04b86b1d2f
commit 790096529c
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
racket/collects/setup/main.rkt
View File

@ -74,8 +74,9 @@
(member flag-name flags))) (member flag-name flags)))
(define-values (print-bootstrapping) (define-values (print-bootstrapping)
(lambda () (lambda (why)
(fprintf (current-output-port) "~a: bootstrapping from source...\n" short-name))) (fprintf (current-output-port) "~a: bootstrapping from source...\n (~a)\n"
short-name why)))
(define-values (main-collects-relative->path) (define-values (main-collects-relative->path)
(let ([main-collects #f]) (let ([main-collects #f])
@ -97,7 +98,7 @@
(when (or (on? "--clean") (when (or (on? "--clean")
(on? "-c")) (on? "-c"))
(use-compiled-file-paths null) (use-compiled-file-paths null)
(print-bootstrapping)) (print-bootstrapping "command-line --clean or -c"))
;; Load the cm instance to be installed while loading Setup PLT. ;; 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 ;; This has to be dynamic, so we get a chance to turn off compiled
@ -117,21 +118,22 @@
;; tree, and there's always --clean to turn this ;; tree, and there's always --clean to turn this
;; off. If an .so file is used, we give up using ;; off. If an .so file is used, we give up using
;; compiled files. ;; compiled files.
(let loop ([skip-zo? (null? (use-compiled-file-paths))]) (let loop ([skip-zo/reason (and (null? (use-compiled-file-paths))
(when skip-zo? "empty use-compiled-file-paths")])
(print-bootstrapping)) (when skip-zo/reason
(print-bootstrapping skip-zo/reason))
((call-with-escape-continuation ((call-with-escape-continuation
(lambda (escape) (lambda (escape)
;; Create a new namespace, and also install load handlers ;; Create a new namespace, and also install load handlers
;; to check file dates, if necessary. ;; to check file dates, if necessary.
(parameterize ([current-namespace (make-kernel-namespace)] (parameterize ([current-namespace (make-kernel-namespace)]
[use-compiled-file-paths [use-compiled-file-paths
(if skip-zo? (if skip-zo/reason
null null
(use-compiled-file-paths))] (use-compiled-file-paths))]
[current-load [current-load
(let ([orig-load (current-load)]) (let ([orig-load (current-load)])
(if skip-zo? (if skip-zo/reason
orig-load orig-load
(lambda (path modname) (lambda (path modname)
(if (regexp-match? #rx#"[.]zo$" (path->bytes path)) (if (regexp-match? #rx#"[.]zo$" (path->bytes path))
@ -159,24 +161,26 @@
;; Not a .zo! Don't use .zo files at all... ;; Not a .zo! Don't use .zo files at all...
(escape (lambda () (escape (lambda ()
;; Try again without .zo ;; Try again without .zo
(loop #t)))))))] (loop (format "loading non-.zo: ~a" path))))))))]
[current-load-extension [current-load-extension
(if skip-zo? (if skip-zo/reason
(current-load-extension) (current-load-extension)
(lambda (path modname) (lambda (path modname)
(escape (lambda () (escape (lambda ()
;; Try again without .zo ;; Try again without .zo
(loop #t)))))]) (loop "loading an extension")))))])
;; Other things could go wrong, such as a version mismatch. ;; Other things could go wrong, such as a version mismatch.
;; If something goes wrong, of course, give up on .zo files. ;; If something goes wrong, of course, give up on .zo files.
(parameterize ([uncaught-exception-handler (parameterize ([uncaught-exception-handler
(lambda (exn) (lambda (exn)
(when (exn:break? exn) (exit 1)) (when (exn:break? exn) (exit 1))
(if skip-zo? (if skip-zo/reason
(escape (escape
(lambda () (raise exn))) (lambda () (raise exn)))
(escape (escape
(lambda () (loop #t)))))]) (lambda () (loop (if (exn:fail? exn)
(regexp-replace* #rx"\n" (exn-message exn) "\n ")
(format "uncaught exn: ~s" exn)))))))])
;; Here's the main dynamic load of "cm.rkt": ;; Here's the main dynamic load of "cm.rkt":
(let ([mk (let ([mk
(dynamic-require 'compiler/cm (dynamic-require 'compiler/cm