loopy.scm

   1 (use-modules (srfi srfi-9)
   2              (srfi srfi-9 gnu)
   3              (ice-9 q)
   4              (ice-9 match))
   5
   6 ;; @@: Using immutable agendas here, so wouldn't it make sense to
   7 ;;   replace this
   8
   9 (define-immutable-record-type <agenda>
  10   (make-agenda queue)
  11   agenda?
  12   (queue agenda-queue))
  13
  14 (define %current-agenda
  15   (make-parameter (make-agenda (make-q))))
  16
  17 (define* (start-agenda agenda #:optional stop-condition)
  18   (let loop ((agenda agenda))
  19     (let ((new-agenda
  20            (agenda-run-once agenda)))
  21       (%current-agenda new-agenda)
  22       (if (and stop-condition (stop-condition))
  23           'done
  24           (loop new-agenda)))))
  25
  26 (define (agenda-run-once agenda)
  27   "Run once through the agenda, and produce a new agenda
  28 based on the results"
  29   (let ((queue (agenda-queue agenda))
  30         (next-queue (make-q)))
  31     (while (not (q-empty? queue))
  32       (let* ((proc (q-pop! queue))
  33              (proc-result (proc))
  34              (enqueue
  35               (lambda (new-proc)
  36                 (enq! next-queue new-proc))))
  37         ;; @@: We might support delay-wrapped procedures here
  38         (match proc-result
  39           ((? procedure? new-proc)
  40            (enqueue new-proc))
  41           (((? procedure? new-procs) ..)
  42            (for-each
  43             (lambda (new-proc)
  44               (enqueue new-proc))
  45             new-procs)))
  46         ;; TODO: Selecting on ports would happen here?
  47         ;; Return new agenda, with next queue set
  48         (set-field agenda (agenda-queue) next-queue)))))