From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Tue, 17 Nov 2015 22:30:52 +0000 (-0600)
Subject: proto-async-loop
X-Git-Tag: v0.1.0~177
X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=3d3254bb7e398a28b6eb2f7596836684b897aeb0;p=8sync.git

proto-async-loop
---

3d3254bb7e398a28b6eb2f7596836684b897aeb0
diff --git a/loopy.scm b/loopy.scm
new file mode 100644
index 0000000..3db157d
--- /dev/null
+++ b/loopy.scm
@@ -0,0 +1,48 @@
+(use-modules (srfi srfi-9)
+             (srfi srfi-9 gnu)
+             (ice-9 q)
+             (ice-9 match))
+
+;; @@: Using immutable agendas here, so wouldn't it make sense to
+;;   replace this
+
+(define-immutable-record-type <agenda>
+  (make-agenda queue)
+  agenda?
+  (queue agenda-queue))
+
+(define %current-agenda
+  (make-parameter (make-agenda (make-q))))
+
+(define* (start-agenda agenda #:optional stop-condition)
+  (let loop ((agenda agenda))
+    (let ((new-agenda
+           (agenda-run-once agenda)))
+      (%current-agenda new-agenda)
+      (if (and stop-condition (stop-condition))
+          'done
+          (loop new-agenda)))))
+
+(define (agenda-run-once agenda)
+  "Run once through the agenda, and produce a new agenda
+based on the results"
+  (let ((queue (agenda-queue agenda))
+        (next-queue (make-q)))
+    (while (not (q-empty? queue))
+      (let* ((proc (q-pop! queue))
+             (proc-result (proc))
+             (enqueue
+              (lambda (new-proc)
+                (enq! next-queue new-proc))))
+        ;; @@: We might support delay-wrapped procedures here
+        (match proc-result
+          ((? procedure? new-proc)
+           (enqueue new-proc))
+          (((? procedure? new-procs) ..)
+           (for-each
+            (lambda (new-proc)
+              (enqueue new-proc))
+            new-procs)))
+        ;; TODO: Selecting on ports would happen here?
+        ;; Return new agenda, with next queue set
+        (set-field agenda (agenda-queue) next-queue)))))