repairs to cm refactoring

This commit is contained in:
Matthew Flatt 2010-06-28 16:55:55 -06:00
parent 47c7c1a27b
commit e78b5d722e

View File

@ -416,7 +416,7 @@
(cond (cond
[(cached?) => (lambda (x) x)] ; already up to date, no need to compile [(cached?) => (lambda (x) x)] ; already up to date, no need to compile
[((manager-skip-file-handler) orig-path) => (lambda (x) (update-cache x))] [((manager-skip-file-handler) orig-path) => (lambda (x) (update-cache x) x)]
[else [else
(let-values ([(path path-time path-zo-time update-cache-with-zo-time) (get-ss-rkt-resolved-path orig-path)]) (let-values ([(path path-time path-zo-time update-cache-with-zo-time) (get-ss-rkt-resolved-path orig-path)])
(define (path-does-not-exist) (not path-time)) (define (path-does-not-exist) (not path-time))
@ -463,7 +463,7 @@
(let ([src-sha1 (get-valid-src-sha1)]) (let ([src-sha1 (get-valid-src-sha1)])
(if (sha1-equivalent? src-sha1) (if (sha1-equivalent? src-sha1)
(touch-update-cache"hash-equivalent src and deps") (touch-update-cache"hash-equivalent src and deps")
(compile-thunk deps path zo-name src-sha1 update-cache-with-zo-time)))))) (compile-thunk deps path zo-name src-sha1 update-cache-with-zo-time zo-exists?))))))
(cond (cond
[(newer-version?) [(newer-version?)
(trace-printf "newer racket bytecode version...") (trace-printf "newer racket bytecode version...")
@ -477,8 +477,8 @@
(define (compile-root mode raw-path up-to-date read-src-syntax) (define (compile-root mode raw-path up-to-date read-src-syntax)
(let ([actual-path (actual-source-path (simple-form-path raw-path))]) (let ([actual-path (actual-source-path (simple-form-path raw-path))])
(define (compile-it deps path zo-name src-sha1 update-cache-with-zo-time) (define (compile-it deps path zo-name src-sha1 update-cache-with-zo-time zo-exists?)
;(when zo-exists? (delete-file zo-name)) (when zo-exists? (delete-file zo-name))
((manager-compile-notify-handler) actual-path) ((manager-compile-notify-handler) actual-path)
(trace-printf "compiling: ~a" actual-path) (trace-printf "compiling: ~a" actual-path)
(parameterize ([depth (+ (depth) 1)] (parameterize ([depth (+ (depth) 1)]