syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Split out reloader-mixin and reloader-mixin*

This commit is contained in:
Tony Garnock-Jones 2016-12-07 09:47:53 +13:00
parent d9905df4e5
commit b87639b7a4
1 changed files with 53 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
racket/syndicate/reload.rkt
View File

@ -7,7 +7,9 @@
stop-when-reloaded stop-when-reloaded
spawn-reloader spawn-reloader
spawn-reloader*) spawn-reloader*
reloader-mixin
reloader-mixin*)
(define-logger syndicate/reload) (define-logger syndicate/reload)
@ -36,13 +38,32 @@
(spawn-reloader* 'module-path)) (spawn-reloader* 'module-path))
(define (spawn-reloader* module-path) (define (spawn-reloader* module-path)
(match (module-path->path-string module-path)
[#f #f]
[pathstr
(supervise #:name (list 'reloader-supervisor pathstr)
(actor #:name 'reloader
(reloader-mixin** module-path pathstr)))
#t]))
(define-syntax-rule (reloader-mixin module-path)
(reloader-mixin* 'module-path))
(define (reloader-mixin* module-path)
(define pathstr (module-path->path-string module-path))
(when (not pathstr)
(error 'reloader-mixin "Cannot deduce source path from module-path ~v" module-path))
(reloader-mixin** module-path pathstr))
(define (module-path->path-string module-path)
(define mpi (module-path-index-join module-path #f)) (define mpi (module-path-index-join module-path #f))
(define rpath (module-path-index-resolve mpi)) (define rpath (module-path-index-resolve mpi))
(define path (let ((p (resolved-module-path-name rpath))) (define path (let ((p (resolved-module-path-name rpath)))
(if (pair? p) (car p) p))) (if (pair? p) (car p) p)))
(if (path? path) (if (path? path)
(spawn-reloader** module-path (path->string path)) (path->string path)
(log-syndicate/reload-error "Could not process module-path ~v" module-path))) (begin (log-syndicate/reload-error "Could not process module-path ~v" module-path)
#f)))
(define counter (define counter
(let ((count 0)) (let ((count 0))
@ -50,35 +71,33 @@
(begin0 count (begin0 count
(set! count (+ count 1)))))) (set! count (+ count 1))))))
(define (spawn-reloader** module-path pathstr) (define (reloader-mixin** module-path pathstr)
(supervise #:name (list 'reloader-supervisor pathstr) (field [reloading? #f])
(actor #:name 'reloader (define (reload!)
(field [reloading? #f]) (when (not (reloading?))
(define (reload!) (reloading? #t)
(when (not (reloading?)) (react (field [obstacles-cleared? #f])
(reloading? #t) (define/query-value obstacles-exist? #f (observe (reload-pending pathstr)) #t
(react (field [obstacles-cleared? #f]) #:on-add (log-syndicate/reload-info "waiting to reload ~v" pathstr)
(define/query-value obstacles-exist? #f (observe (reload-pending pathstr)) #t #:on-remove (obstacles-cleared? #t))
#:on-add (log-syndicate/reload-info "waiting to reload ~v" pathstr) (assert #:when (obstacles-exist?) (reload-pending pathstr))
#:on-remove (obstacles-cleared? #t)) (on-start (flush!)
(assert #:when (obstacles-exist?) (reload-pending pathstr)) (obstacles-cleared? (not (obstacles-exist?))))
(on-start (flush!) (stop-when (rising-edge (obstacles-cleared?))
(obstacles-cleared? (not (obstacles-exist?)))) (flush!) ;; Wait one turn for effects of newly-cleared obstacles
(stop-when (rising-edge (obstacles-cleared?)) (log-syndicate/reload-info "(re)loading ~v" pathstr)
(flush!) ;; Wait one turn for effects of newly-cleared obstacles (dynamic-rerequire module-path)
(log-syndicate/reload-info "(re)loading ~v" pathstr) (schedule-actions!
(dynamic-rerequire module-path) ((dynamic-require `(submod ,module-path syndicate-main)
(schedule-actions! 'activate!)))
((dynamic-require `(submod ,module-path syndicate-main) (reloading? #f)))))
'activate!)))
(reloading? #f)))))
(field [previous-version #f]) (field [previous-version #f])
(define/query-value latest-version 'unknown (file-content pathstr counter $p) p) (define/query-value latest-version 'unknown (file-content pathstr counter $p) p)
(begin/dataflow (begin/dataflow
(when (and (not (eq? (latest-version) 'unknown)) (when (and (not (eq? (latest-version) 'unknown))
(not (equal? (latest-version) (previous-version)))) (not (equal? (latest-version) (previous-version))))
(if (latest-version) (if (latest-version)
(reload!) (reload!)
(log-syndicate/reload-warning "Module ~v does not exist" pathstr)) (log-syndicate/reload-warning "Module ~v does not exist" pathstr))
(previous-version (latest-version))))))) (previous-version (latest-version)))))