proto-async-loop

diff --git a/loopy.scm b/loopy.scm
new file mode 100644 (file)
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)))))