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

some improvements

Browse Source 
svn: r11362
This commit is contained in:
Eli Barzilay 2008-08-21 07:01:55 +00:00
parent afe17e511c
commit ebcee44f7f
1 changed files with 23 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/compiler/cm.ss
View File

@ -110,12 +110,13 @@
", which appears to be in the future" ", which appears to be in the future"
""))])) ""))]))
(define-struct ext-reader-guard (proc prev) (define-struct ext-reader-guard (proc top)
#:property prop:procedure (struct-field-index proc)) #:property prop:procedure (struct-field-index proc))
(define-struct file-dependency (path) #:prefab) (define-struct file-dependency (path) #:prefab)
(define (compile-zo* mode path read-src-syntax zo-name) (define (compile-zo* mode path read-src-syntax zo-name)
;; External dependencies registered through reader guard and accomplice-logged events: ;; External dependencies registered through reader guard and
;; accomplice-logged events:
(define external-deps null) (define external-deps null)
(define deps-sema (make-semaphore 1)) (define deps-sema (make-semaphore 1))
(define done-key (gensym)) (define done-key (gensym))
@ -127,38 +128,35 @@
;; Set up a logger to receive and filter accomplice events: ;; Set up a logger to receive and filter accomplice events:
(define accomplice-logger (make-logger)) (define accomplice-logger (make-logger))
(define accomplice-log-receiver
(make-log-receiver accomplice-logger 'info))
(define log-th (define log-th
(let ([orig-log (current-logger)]) (let ([orig-log (current-logger)]
[receiver (make-log-receiver accomplice-logger 'info)])
(thread (lambda () (thread (lambda ()
(let loop () (let loop ()
(let ([l (sync accomplice-log-receiver)]) (let ([l (sync receiver)])
(cond (unless (eq? (vector-ref l 2) done-key)
[(eq? (vector-ref l 2) done-key) 'done] (if (and (eq? (vector-ref l 0) 'info)
[(and (eq? (vector-ref l 0) 'info) (file-dependency? (vector-ref l 2))
(file-dependency? (vector-ref l 2)) (path? (file-dependency-path (vector-ref l 2))))
(path? (file-dependency-path (vector-ref l 2)))) (external-dep! (file-dependency-path (vector-ref l 2)))
(external-dep! (file-dependency-path (vector-ref l 2))) (log-message orig-log (vector-ref l 0) (vector-ref l 1)
(loop)] (vector-ref l 2)))
[else (loop))))))))
(log-message orig-log (vector-ref l 0) (vector-ref l 1) (vector-ref l 2))
(loop)])))))))
;; Compile the code: ;; Compile the code:
(define code (define code
(parameterize ([current-reader-guard (parameterize ([current-reader-guard
(let ([rg (current-reader-guard)]) (let* ([rg (current-reader-guard)]
[rg (if (ext-reader-guard? rg)
(ext-reader-guard-top rg)
rg)])
(make-ext-reader-guard (make-ext-reader-guard
(lambda (d) (lambda (d)
;; Start by calling the previously installed guard ;; Start by calling the top installed guard to
;; to transform the module path, but also avoid ;; transform the module path, avoiding redundant
;; redundant dependencies by skipping over cm guards ;; dependencies by avoiding accumulation of these
;; for files being compiled. ;; guards.
(let ([d (let loop ([rg rg]) (let ([d (rg d)])
(if (ext-reader-guard? rg)
(loop (ext-reader-guard-prev rg))
(rg d)))])
(when (module-path? d) (when (module-path? d)
(let ([p (resolved-module-path-name (let ([p (resolved-module-path-name
(module-path-index-resolve (module-path-index-resolve