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

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

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

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

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