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-intern queue)
  11   agenda?
  12   (queue agenda-queue))
  13
  14 (define* (make-agenda #:key (queue (make-q)))
  15   (make-agenda-intern queue))
  16
  17 (define %current-agenda (make-parameter #f))
  18
  19 (define* (start-agenda agenda #:optional stop-condition)
  20   (let loop ((agenda agenda))
  21     (let ((new-agenda
  22            (parameterize ((%current-agenda agenda))
  23              (agenda-run-once agenda))))
  24       (if (and stop-condition (stop-condition agenda))
  25           'done
  26           (loop new-agenda)))))
  27
  28 (define (agenda-run-once agenda)
  29   "Run once through the agenda, and produce a new agenda
  30 based on the results"
  31   (let ((queue (agenda-queue agenda))
  32         (next-queue (make-q)))
  33     (while (not (q-empty? queue))
  34       (let* ((proc (q-pop! queue))
  35              (proc-result (proc))
  36              (enqueue
  37               (lambda (new-proc)
  38                 (enq! next-queue new-proc))))
  39         ;; @@: We might support delay-wrapped procedures here
  40         (match proc-result
  41           ((? procedure? new-proc)
  42            (enqueue new-proc))
  43           (((? procedure? new-procs) ...)
  44            (for-each
  45             (lambda (new-proc)
  46               (enqueue new-proc))
  47             new-procs)))))
  48     ;; TODO: Selecting on ports would happen here?
  49     ;; Return new agenda, with next queue set
  50     (set-field agenda (agenda-queue) next-queue)))