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

compiler/cm: avoid rewriting machine-indepedent files

Browse Source 
The multi-cross mode, don't rewrite a machine-indepedent file
by recompiling it to itself. This shouldn't matter, but not
touching files makes the result cleaner.
This commit is contained in:
Matthew Flatt 2018-12-09 11:02:09 -07:00
parent 344b72b4f8
commit db2ac559a7
1 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
racket/collects/compiler/private/cm-minimal.rkt
View File

@ -447,7 +447,16 @@
;; Propagate everything else: ;; Propagate everything else:
'debug)) 'debug))
(define receiver (make-log-receiver accomplice-logger 'info 'cm-accomplice)) (define receiver (make-log-receiver accomplice-logger 'info 'cm-accomplice))
(define dest-roots (list (car roots)))
(define-values (code-dir code-name)
(get-compilation-dir+name path #:modes (list (path->mode path)) #:roots dest-roots))
(define zo-name
;; If we have multiple roots, make sure that compilation uses the first one
(if (or (pair? (cdr roots)) (not orig-zo-name))
(build-path code-dir (path-add-suffix code-name #".zo"))
orig-zo-name))
;; Compile the code: ;; Compile the code:
(define code (define code
(parameterize ([current-reader-guard (parameterize ([current-reader-guard
@ -482,6 +491,11 @@
managed-compiled-context-key managed-compiled-context-key
path path
(cond (cond
[(and (equal? recompile-from zo-name)
(not (current-compile-target-machine)))
;; We don't actually need to do anything, so
;; avoid updating the file
#f]
[recompile-from [recompile-from
(recompile-module-code recompile-from (recompile-module-code recompile-from
path path
@ -493,29 +507,22 @@
#:extension-handler (lambda (a b) #f) #:extension-handler (lambda (a b) #f)
#:roots (list (car roots)) #:roots (list (car roots))
#:source-reader read-src-syntax)])))) #:source-reader read-src-syntax)]))))
(define dest-roots (list (car roots)))
(define-values (code-dir code-name)
(get-compilation-dir+name path #:modes (list (path->mode path)) #:roots dest-roots))
(define zo-name
;; If we have multiple roots, make sure that compilation uses the first one
(if (or (pair? (cdr roots)) (not orig-zo-name))
(build-path code-dir (path-add-suffix code-name #".zo"))
orig-zo-name))
;; Get all accomplice data: ;; Get all accomplice data:
(let loop () (when code
(let ([l (sync/timeout 0 receiver)]) (let loop ()
(when l (let ([l (sync/timeout 0 receiver)])
(when (and (eq? (vector-ref l 0) 'info) (when l
(file-dependency? (vector-ref l 2)) (when (and (eq? (vector-ref l 0) 'info)
(path? (file-dependency-path (vector-ref l 2)))) (file-dependency? (vector-ref l 2))
(external-dep! (file-dependency-path (vector-ref l 2)) (path? (file-dependency-path (vector-ref l 2))))
(file-dependency-module? (vector-ref l 2)) (external-dep! (file-dependency-path (vector-ref l 2))
(and (file-dependency/options? (vector-ref l 2)) (file-dependency-module? (vector-ref l 2))
(hash-ref (file-dependency/options-table (vector-ref l 2)) (and (file-dependency/options? (vector-ref l 2))
'indirect (hash-ref (file-dependency/options-table (vector-ref l 2))
#f)))) 'indirect
(loop)))) #f))))
(loop)))))
;; Write the code and dependencies: ;; Write the code and dependencies:
(when code (when code