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 queue stuff with using pfds based immutable queues?
   8
   9 (define-immutable-record-type <agenda>
  10   (make-agenda-intern queue prompt-tag)
  11   agenda?
  12   (queue agenda-queue)
  13   (prompt-tag agenda-prompt-tag))
  14
  15 (define (make-async-prompt-tag)
  16   (make-prompt-tag "prompt"))
  17
  18 (define* (make-agenda #:key
  19                       (queue (make-q))
  20                       (prompt (make-prompt-tag)))
  21   (make-agenda-intern queue prompt))
  22
  23 (define %current-agenda (make-parameter #f))
  24
  25 (define* (start-agenda agenda #:optional stop-condition)
  26   (let loop ((agenda agenda))
  27     (let ((new-agenda
  28            ;; @@: Hm, maybe here would be a great place to handle
  29            ;;   select'ing on ports.
  30            ;;   We could compose over agenda-run-once and agenda-read-ports
  31            (parameterize ((%current-agenda agenda))
  32              (agenda-run-once agenda))))
  33       (if (and stop-condition (stop-condition agenda))
  34           'done
  35           (loop new-agenda)))))
  36
  37 (define (agenda-run-once agenda)
  38   "Run once through the agenda, and produce a new agenda
  39 based on the results"
  40   (define (call-proc proc)
  41     (call-with-prompt
  42         (agenda-prompt-tag agenda)
  43       (lambda ()
  44         (proc))
  45       ;; TODO
  46       (lambda (k) k)))
  47
  48   (let ((queue (agenda-queue agenda))
  49         (next-queue (make-q)))
  50     (while (not (q-empty? queue))
  51       (let* ((proc (q-pop! queue))
  52              (proc-result (call-proc proc))
  53              (enqueue
  54               (lambda (new-proc)
  55                 (enq! next-queue new-proc))))
  56         ;; @@: We might support delay-wrapped procedures here
  57         (match proc-result
  58           ((? procedure? new-proc)
  59            (enqueue new-proc))
  60           (((? procedure? new-procs) ...)
  61            (for-each
  62             (lambda (new-proc)
  63               (enqueue new-proc))
  64             new-procs)))))
  65     ;; TODO: Selecting on ports would happen here?
  66     ;; Return new agenda, with next queue set
  67     (set-field agenda (agenda-queue) next-queue)))