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

Always supervise reloaders

This commit is contained in:
Tony Garnock-Jones 2016-11-29 15:04:13 +13:00
parent d0d7e677fe
commit 97bb848611
1 changed files with 31 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
racket/syndicate/reload.rkt
View File

@ -14,6 +14,7 @@
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require racket/rerequire) (require racket/rerequire)
(require/activate syndicate/supervise)
(require/activate syndicate/drivers/filesystem) (require/activate syndicate/drivers/filesystem)
(struct reload-pending (filename) #:prefab) ;; ASSERTION (struct reload-pending (filename) #:prefab) ;; ASSERTION
@ -50,33 +51,34 @@
(set! count (+ count 1)))))) (set! count (+ count 1))))))
(define (spawn-reloader** module-path pathstr) (define (spawn-reloader** module-path pathstr)
(actor #:name (list 'reloader 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)))))))