X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Frepl.scm;h=ddcd50b0f168d82748dc2ee0e74182c8407af9a1;hp=98931edaf91689369b0a6ac07c6e14f6a74ea028;hb=a02a901d3869fc56d10597347ccbdd0df5c7e119;hpb=68472a819457ce0e6053b59b2b9a1657669e8801

diff --git a/8sync/repl.scm b/8sync/repl.scm
index 98931ed..ddcd50b 100644
--- a/8sync/repl.scm
+++ b/8sync/repl.scm
@@ -1,5 +1,5 @@
 ;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2015, 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of 8sync.
 ;;;
@@ -19,39 +19,87 @@
 (define-module (8sync repl)
   #:use-module (oop goops)
   #:use-module (8sync)
+  #:use-module (fibers)
+  #:use-module (8sync daydream)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 atomic)
   #:use-module (system repl server)
   #:use-module (system repl coop-server)
-  #:export (<repl-manager>))
+  #:export (<repl-manager>
+            spawn-repl))
 
-(define-class <repl-manager> (<actor>)
+(define-actor <repl-manager> (<actor>)
+  ((add-subscriber repl-manager-add-subscriber)
+   (remove-subscriber repl-manager-remove-subscriber)
+   (main-loop repl-manager-main-loop))
   (path #:init-keyword #:path
         #:init-value "/tmp/8sync-socket"
-        #:getter repl-manager-path)
+        #:getter .path)
   (socket #:init-value #f
-          #:accessor repl-manager-socket)
+          #:accessor .socket)
   (poll-every #:init-keyword #:poll-every
               #:init-value (/ 1 30)
-              #:getter repl-manager-poll-every)
-  (actions #:allocation #:each-subclass
-           ;; @@: Should we add a stop action?
-           #:init-value (build-actions
-                         (*cleanup* repl-manager-cleanup)
-                         (*init* repl-manager-init))))
-
-(define (repl-manager-cleanup repl-manager message)
+              #:getter .poll-every)
+  (subscribers #:init-keyword #:subscribers
+               #:init-value '()
+               #:accessor .subscribers))
+
+(define-method (actor-cleanup! (repl-manager <repl-manager>))
   ;; Close the socket, if open
-  (and=> (repl-manager-socket repl-manager)
+  (and=> (.socket repl-manager)
          close)
   ;; Delete the file, if it exists
-  (when (file-exists? (repl-manager-path repl-manager))
-    (delete-file (repl-manager-path repl-manager))))
+  (when (file-exists? (.path repl-manager))
+    (delete-file (.path repl-manager))))
+
+(define-method (actor-init! (repl-manager <repl-manager>))
+  (<- (actor-id repl-manager) 'main-loop))
 
-(define (repl-manager-init repl-manager message)
+(define-method (repl-manager-main-loop repl-manager message)
   (define socket
-    (make-unix-domain-server-socket #:path (repl-manager-path repl-manager)))
+    (make-unix-domain-server-socket #:path (.path repl-manager)))
   (define server
     (spawn-coop-repl-server socket))
-  (set! (repl-manager-socket repl-manager) socket)
-  (while (actor-alive? repl-manager)
+  (define (inform-subscribers)
+    (for-each
+     (lambda (subscriber)
+       (<- subscriber 'repl-update))
+     (.subscribers repl-manager)))
+  (set! (.socket repl-manager) socket)
+  (while #t
+    (daydream (.poll-every repl-manager))
     (poll-coop-repl-server server)
-    (8sleep (repl-manager-poll-every repl-manager))))
+    (inform-subscribers)))
+
+(define (repl-manager-add-subscriber repl-manager message)
+  (define from (message-from message))
+  (unless (member from (.subscribers repl-manager))
+    (set! (.subscribers repl-manager)
+          (cons from (.subscribers repl-manager)))))
+
+(define (repl-manager-remove-subscriber repl-manager message)
+  (define from (message-from message))
+  (set! (.subscribers repl-manager)
+        (remove (lambda (x) (equal? x (message-from message)))
+                (.subscribers repl-manager))))
+
+
+
+(define* (spawn-repl #:key (path "/tmp/8sync-socket")
+                     (socket (make-unix-domain-server-socket #:path path))
+                     (poll-every 1/30)
+                     (stop? (make-atomic-box #f))
+                     (on-update #f))
+  "Spawn a cooperative REPL in a new fiber."
+  (define server
+    (spawn-coop-repl-server socket))
+  (spawn-fiber
+   (lambda ()
+     (while (not (atomic-box-ref stop?))
+       ;; Poll the server
+       (poll-coop-repl-server server)
+       ;; Call update hook, if any
+       (and on-update (on-update))
+       ;; Take a break!
+       (sleep poll-every))
+     (close socket))))