Make reloaders in turn reloadable
This commit is contained in:
parent
8b516b0190
commit
28d7bd6653
|
@ -36,14 +36,18 @@
|
||||||
(stop-when (asserted (reload-pending '#,(path->string (syntax-source stx))))
|
(stop-when (asserted (reload-pending '#,(path->string (syntax-source stx))))
|
||||||
body ...))]))
|
body ...))]))
|
||||||
|
|
||||||
(define-syntax-rule (spawn-reloader module-path)
|
(define-syntax (spawn-reloader stx)
|
||||||
(spawn-reloader* 'module-path))
|
(syntax-case stx ()
|
||||||
|
[(_ module-path)
|
||||||
|
(quasisyntax/loc stx
|
||||||
|
(spawn-reloader* 'module-path '#,(path->string (syntax-source stx))))]))
|
||||||
|
|
||||||
(define (spawn-reloader* module-path)
|
(define (spawn-reloader* module-path loading-module-pathstr)
|
||||||
(match (module-path->path-string module-path)
|
(match (module-path->path-string module-path)
|
||||||
[#f #f]
|
[#f #f]
|
||||||
[pathstr
|
[pathstr
|
||||||
(supervise #:name (reloader pathstr)
|
(supervise #:name (reloader pathstr)
|
||||||
|
(stop-when (asserted (reload-pending loading-module-pathstr)))
|
||||||
(reloader-mixin** module-path pathstr))
|
(reloader-mixin** module-path pathstr))
|
||||||
#t]))
|
#t]))
|
||||||
|
|
||||||
|
@ -74,9 +78,10 @@
|
||||||
(define (reload!)
|
(define (reload!)
|
||||||
(when (not (reloading?))
|
(when (not (reloading?))
|
||||||
(reloading? #t)
|
(reloading? #t)
|
||||||
(react (field [obstacles-cleared? #f])
|
(react (field [obstacles-cleared? #f] [obstacles-existed? #f])
|
||||||
(define/query-value obstacles-exist? #f (observe (reload-pending pathstr)) #t
|
(define/query-value obstacles-exist? #f (observe (reload-pending pathstr)) #t
|
||||||
#:on-add (log-syndicate/reload-info "waiting to reload ~v" pathstr)
|
#:on-add (begin (log-syndicate/reload-info "waiting to reload ~v" pathstr)
|
||||||
|
(obstacles-existed? #t))
|
||||||
#:on-remove (obstacles-cleared? #t))
|
#:on-remove (obstacles-cleared? #t))
|
||||||
(assert #:when (obstacles-exist?) (reload-pending pathstr))
|
(assert #:when (obstacles-exist?) (reload-pending pathstr))
|
||||||
(on-start (flush!)
|
(on-start (flush!)
|
||||||
|
@ -85,11 +90,17 @@
|
||||||
(flush!) ;; Wait one turn for effects of newly-cleared obstacles
|
(flush!) ;; Wait one turn for effects of newly-cleared obstacles
|
||||||
(log-syndicate/reload-info "(re)loading ~v" pathstr)
|
(log-syndicate/reload-info "(re)loading ~v" pathstr)
|
||||||
(dynamic-rerequire module-path)
|
(dynamic-rerequire module-path)
|
||||||
(spawn* #:name module-path
|
(let ((force-reactivation? (obstacles-existed?)))
|
||||||
((dynamic-require `(submod ,module-path syndicate-main)
|
(when force-reactivation?
|
||||||
'activate!)))
|
(log-syndicate/reload-info "forcing reactivation of ~v" pathstr))
|
||||||
|
(spawn* #:name module-path
|
||||||
|
((dynamic-require `(submod ,module-path syndicate-main)
|
||||||
|
(if force-reactivation? 'activate!* 'activate!)))))
|
||||||
(reloading? #f)))))
|
(reloading? #f)))))
|
||||||
|
|
||||||
|
(on-start (log-syndicate/reload-debug "reloader ~v starting" pathstr))
|
||||||
|
(on-stop (log-syndicate/reload-debug "reloader ~v stopping" pathstr))
|
||||||
|
|
||||||
(field [previous-version 'unknown])
|
(field [previous-version 'unknown])
|
||||||
(define/query-value latest-version 'unknown (file-content pathstr file->sha1 $p) p)
|
(define/query-value latest-version 'unknown (file-content pathstr file->sha1 $p) p)
|
||||||
(begin/dataflow
|
(begin/dataflow
|
||||||
|
|
Loading…
Reference in New Issue