From: Christopher Allan Webber 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 + (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)))))