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

compiler/cm: filtered logging propagation instead of manual

Browse Source 
With the new propagation-filtering support, CM's accomplice channel
doesn't need a receiver that accepts all events, and so less logging
logging work will be triggered during compilation.
This commit is contained in:
Matthew Flatt 2014-10-28 13:20:44 -06:00
parent 159c82fc4a
commit 38ac6e052c
2 changed files with 25 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
racket/collects/compiler/cm-accomplice.rkt
View File

@ -8,13 +8,11 @@
(define (register-external-module f)
(register-external 'register-external-module f #t))
(define cm-accomplice-logger (make-logger 'cm-accomplice
(current-logger)))
(define (register-external who f module?)
(unless (and (path? f) (complete-path? f))
(raise-type-error who "complete path" f))
(log-message cm-accomplice-logger
'info
(log-message (current-logger)
'info
'cm-accomplice
(format "file dependency: ~s" f)
`#s(file-dependency ,f ,module?)))

51
racket/collects/compiler/cm.rkt
View File

@ -317,12 +317,9 @@
(define deps-sema (make-semaphore 1))
(define done-key (gensym))
(define (external-dep! p module?)
(call-with-semaphore
deps-sema
(lambda ()
(if module?
(set! external-module-deps (cons (path->bytes p) external-module-deps))
(set! external-deps (cons (path->bytes p) external-deps))))))
(if module?
(set! external-module-deps (cons (path->bytes p) external-module-deps))
(set! external-deps (cons (path->bytes p) external-deps))))
(define (reader-dep! p)
(call-with-semaphore
deps-sema
@ -330,26 +327,15 @@
(set! reader-deps (cons (path->bytes p) reader-deps)))))
;; Set up a logger to receive and filter accomplice events:
(define accomplice-logger (make-logger))
(define log-th
(let ([orig-log (current-logger)]
[receiver (make-log-receiver accomplice-logger 'debug)])
(thread (lambda ()
(let loop ()
(let ([l (sync receiver)])
(unless (eq? (vector-ref l 2) done-key)
(if (and (eq? (vector-ref l 0) 'info)
(file-dependency? (vector-ref l 2))
(path? (file-dependency-path (vector-ref l 2))))
(external-dep! (file-dependency-path (vector-ref l 2))
(file-dependency-module? (vector-ref l 2)))
(log-message orig-log
(vector-ref l 0) (vector-ref l 3)
(vector-ref l 1)
(vector-ref l 2)
#f))
(loop))))))))
(define accomplice-logger (make-logger #f (current-logger)
;; Don't propoagate 'cm-accomplice events, so that
;; enclosing compilations don't see events intended
;; for this one:
'none 'cm-accomplice
;; Propagate everything else:
'debug))
(define receiver (make-log-receiver accomplice-logger 'info 'cm-accomplice))
;; Compile the code:
(define code
(parameterize ([current-reader-guard
@ -386,9 +372,16 @@
(define dest-roots (list (car roots)))
(define code-dir (get-compilation-dir path #:modes (list mode) #:roots dest-roots))
;; Wait for accomplice logging to finish:
(log-message accomplice-logger 'info "stop" done-key)
(sync log-th)
;; Get all accomplice data:
(let loop ()
(let ([l (sync/timeout 0 receiver)])
(when l
(when (and (eq? (vector-ref l 0) 'info)
(file-dependency? (vector-ref l 2))
(path? (file-dependency-path (vector-ref l 2))))
(external-dep! (file-dependency-path (vector-ref l 2))
(file-dependency-module? (vector-ref l 2))))
(loop))))
;; Write the code and dependencies:
(when code