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

drracket's online compilation now tracks files loaded during expansion

Browse Source 
use these files to determine if a file is dirty (and thus needs
to be recompiled) when another file is saved.

closes PR 13307
This commit is contained in:
Robby Findler 2012-12-21 21:16:29 -06:00
parent a567de9a48
commit 200ec130a0
2 changed files with 54 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/drracket/private/expanding-place.rkt
View File

@ -137,9 +137,25 @@
(define io-sema (make-semaphore 0))
(when log-io?
(thread (λ () (catch-and-log in io-sema))))
(define original-path (make-parameter #f))
(define loaded-paths '())
(define expanded
(parameterize ([current-output-port out]
[current-error-port out])
[current-error-port out]
[current-load/use-compiled
(let ([ol (current-load/use-compiled)])
(λ (path mod-name)
(parameterize ([original-path path])
(ol path mod-name))))]
[current-load
(let ([cl (current-load)])
(λ (path mod-name)
(set! loaded-paths
(cons (or (current-module-declare-source)
(original-path)
path)
loaded-paths))
(cl path mod-name)))])
(expand transformed-stx)))
(when log-io?
(close-output-port out)
@ -162,7 +178,7 @@
(λ ()
(stop-watching-abnormal-termination)
(semaphore-post sema)
(channel-put result-chan handler-results))))
(channel-put result-chan (list handler-results loaded-paths)))))
(semaphore-wait sema)
(ep-log-info "expanding-place.rkt: 12 finished"))))))
@ -197,8 +213,10 @@
'()))))
(handle-evt
result-chan
(λ (val)
(place-channel-put response-pc (vector 'handler-results val))))
(λ (val+loaded-files)
(place-channel-put response-pc (vector 'handler-results
(list-ref val+loaded-files 0)
(list-ref val+loaded-files 1)))))
(handle-evt
exn-chan
(λ (exn)

35
collects/drracket/private/module-language.rkt
View File

@ -9,6 +9,7 @@
racket/runtime-path
racket/math
racket/match
racket/set
racket/gui/base
compiler/embed
compiler/cm
@ -893,7 +894,10 @@
set-bottom-bar-status
get-oc-status
set-oc-status)
set-oc-status
set-dep-paths
set-dirty-if-dep)
(define online-expansion-logger (make-logger 'online-expansion-state-machine (current-logger)))
(define-syntax-rule
@ -1065,6 +1069,12 @@
(set! bkg-colors (filter (λ (x) (not (eq? (car x) id))) bkg-colors))
(update-little-dot))
(define dep-paths (set))
(define/public (set-dep-paths d) (set! dep-paths d))
(define/public (set-dirty-if-dep path)
(when (set-member? dep-paths path)
(oc-set-dirty this)))
(super-new)))
(define module-language-online-expand-text-mixin
@ -1319,6 +1329,18 @@
(oc-language-change (get-tab))
(inner (void) after-set-next-settings new-settings))
(define/augment (after-save-file success?)
(when success?
(define bx (box #f))
(define path (get-filename bx))
(when (and path
(not (unbox bx)))
(for ([frame (in-list (send (group:get-the-frame-group) get-frames))])
(when (is-a? frame drracket:unit:frame%)
(for ([tab (in-list (send frame get-tabs))])
(send tab set-dirty-if-dep path))))))
(inner (void) after-save-file success?))
(super-new)))
(define module-language-online-expand-frame-mixin
@ -1901,7 +1923,8 @@
(send running-tab get-defs)
val))))
(send running-tab set-oc-status (clean #f #f '()))]
(send running-tab set-oc-status (clean #f #f '()))
(send running-tab set-dep-paths (vector-ref res 2))]
[else
(line-of-interest)
(send running-tab set-oc-status
@ -1981,13 +2004,19 @@
'finished-expansion
sc-online-expansion-running))))))
(define res (place-channel-get pc-out))
(define res/set
(if (eq? (vector-ref res 0) 'handler-results)
(vector (vector-ref res 0)
(vector-ref res 1)
(list->set (vector-ref res 2)))
res))
(queue-callback
(λ ()
(when (eq? us pending-thread)
(set-pending-thread #f #f))
(when (getenv "PLTDRPLACEPRINT")
(printf "PLTDRPLACEPRINT: got results back from the place\n"))
(show-results res)))))))
(show-results res/set)))))))
(define (stop-place-running)
(when expanding-place