Crude steps toward reloadable Syndicate modules

2016-11-28 12:27:10 +13:00 · 2016-11-28 12:27:10 +13:00 · bab5aba083
parent 8202220fec
commit bab5aba083
1 changed files with 79 additions and 0 deletions
--- a/racket/syndicate/reload.rkt
+++ b/racket/syndicate/reload.rkt
@ -0,0 +1,79 @@
+#lang syndicate/actor
+;; Crude steps toward reloadable Syndicate modules
+
+(provide (except-out (struct-out reload-pending) reload-pending)
+         (rename-out [reload-pending <reload-pending>])
+         (rename-out [make-reload-pending reload-pending])
+
+         stop-when-reloaded
+         spawn-reloader
+         spawn-reloader*)
+
+(define-logger syndicate/reload)
+
+(require (for-syntax racket/base))
+(require racket/rerequire)
+
+(require/activate syndicate/drivers/filesystem)
+
+(struct reload-pending (filename) #:prefab) ;; ASSERTION
+
+(define-syntax (make-reload-pending stx)
+  (quasisyntax/loc stx
+    (reload-pending '#,(path->string (syntax-source stx)))))
+
+(define-syntax (stop-when-reloaded stx)
+  (syntax-case stx ()
+    [(_ body ...)
+     (quasisyntax/loc stx
+       (stop-when (asserted (reload-pending '#,(path->string (syntax-source stx))))
+                  body ...))]))
+
+(define-syntax-rule (spawn-reloader module-path)
+  (spawn-reloader* 'module-path))
+
+(define (spawn-reloader* module-path)
+  (define mpi (module-path-index-join module-path #f))
+  (define rpath (module-path-index-resolve mpi))
+  (define path (let ((p (resolved-module-path-name rpath)))
+                 (if (pair? p) (car p) p)))
+  (if (path? path)
+      (spawn-reloader** module-path (path->string path))
+      (log-syndicate/reload-error "Could not process module-path ~v" module-path)))
+
+(define counter
+  (let ((count 0))
+    (lambda (_pathstr)
+      (begin0 count
+        (set! count (+ count 1))))))
+
+(define (spawn-reloader** module-path pathstr)
+  (actor #:name (list 'reloader pathstr)
+         (field [reloading? #f])
+         (define (reload!)
+           (when (not (reloading?))
+             (reloading? #t)
+             (react (field [obstacles-cleared? #f])
+                    (define/query-value obstacles-exist? #f (observe (reload-pending pathstr)) #t
+                      #:on-add (log-syndicate/reload-info "waiting to reload ~v" pathstr)
+                      #:on-remove (obstacles-cleared? #t))
+                    (assert #:when (obstacles-exist?) (reload-pending pathstr))
+                    (on-start (flush!)
+                              (obstacles-cleared? (not (obstacles-exist?))))
+                    (stop-when (rising-edge (obstacles-cleared?))
+                               (flush!) ;; Wait one turn for effects of newly-cleared obstacles
+                               (log-syndicate/reload-info "(re)loading ~v" pathstr)
+                               (dynamic-rerequire module-path)
+                               (schedule-actions!
+                                ((dynamic-require `(submod ,module-path syndicate-main)
+                                                  'activate!)))
+                               (reloading? #f)))))
+
+         (field [previous-version #f])
+         (define/query-value latest-version #f (file-content pathstr counter $p) p)
+         (begin/dataflow
+           (when (not (equal? (latest-version) (previous-version)))
+             (if (latest-version)
+                 (reload!)
+                 (log-syndicate/reload-warning "Module ~v does not exist" pathstr))
+             (previous-version (latest-version))))))