Provide a way to break away through an agenda's prompt tag

[8sync.git] / loopy.scm

diff --git a/loopy.scm b/loopy.scm
index 3db157d4cf3f05ca18e8a06135d96a9dd97c04a1..e03cab6ae59d03ec34b72cd84f511f3ec6ca8c00 100644 (file)
--- a/loopy.scm
+++ b/loopy.scm
@@ -7,30 +7,46 @@
 ;;   replace this
 
 (define-immutable-record-type <agenda>
-  (make-agenda queue)
+  (make-agenda-intern queue prompt-tag)
   agenda?
-  (queue agenda-queue))
+  (queue agenda-queue)
+  (prompt-tag agenda-prompt-tag))
 
-(define %current-agenda
-  (make-parameter (make-agenda (make-q))))
+(define (make-async-prompt-tag)
+  (make-prompt-tag "prompt"))
+
+(define* (make-agenda #:key
+                      (queue (make-q))
+                      (prompt (make-prompt-tag)))
+  (make-agenda-intern queue prompt))
+
+(define %current-agenda (make-parameter #f))
 
 (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))
+           (parameterize ((%current-agenda agenda))
+             (agenda-run-once agenda))))
+      (if (and stop-condition (stop-condition agenda))
           'done
           (loop new-agenda)))))
 
 (define (agenda-run-once agenda)
   "Run once through the agenda, and produce a new agenda
 based on the results"
+  (define (call-proc proc)
+    (call-with-prompt
+        (agenda-prompt-tag agenda)
+      (lambda ()
+        (proc))
+      ;; TODO
+      (lambda (k) k)))
+
   (let ((queue (agenda-queue agenda))
         (next-queue (make-q)))
     (while (not (q-empty? queue))
       (let* ((proc (q-pop! queue))
-             (proc-result (proc))
+             (proc-result (call-proc proc))
              (enqueue
               (lambda (new-proc)
                 (enq! next-queue new-proc))))
@@ -38,11 +54,11 @@ based on the results"
         (match proc-result
           ((? procedure? new-proc)
            (enqueue new-proc))
-          (((? procedure? new-procs) ..)
+          (((? 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)))))
+            new-procs)))))
+    ;; TODO: Selecting on ports would happen here?
+    ;; Return new agenda, with next queue set
+    (set-field agenda (agenda-queue) next-queue)))