gib-gab-gob/gib-gab-gob/util/chickadee-vat.scm

57 lines
2.0 KiB
Scheme

;; Taken from https://gitlab.com/spritely/community-garden example,
;; which appears to be licensed Apache 2.0.
;; Small modifications have been made.
(define-module (gib-gab-gob util chickadee-vat)
#:use-module (gib-gab-gob util concurrent-queue)
#:use-module (chickadee)
#:use-module (chickadee scripting)
#:use-module (chickadee scripting agenda)
#:use-module (goblins vat)
#:use-module (ice-9 match)
#:export (make-chickadee-vat))
(define* (make-chickadee-vat #:key (name 'chickadee)
(agenda (current-agenda))
(log? #f))
(define vat-script #f)
(define message-queue (make-concurrent-queue))
(define (start churn)
(define (handle-messages)
(format #t "handle messages...")
(if (concurrent-queue-empty? message-queue)
(begin
(format #t "sleep... ~a\n" (current-timestep))
(sleep (current-timestep))
(format #t "sleep done."))
(match (concurrent-dequeue! message-queue)
((msg return-channel)
(format #t "dequeue w/ return....\n")
(channel-put return-channel (churn msg)))
(msg
(format #t "dequeue w/o return....\n")
(churn msg))))
(format #t "done.\n")
(handle-messages))
(format #t "churning... ~a\n" churn)
(with-agenda agenda
(format #t "agenda... ~a" agenda)
(set! vat-script (script (handle-messages)))))
(define (halt)
(cancel-script vat-script))
(define (send envelope)
(format #t "env send\n")
(if (vat-envelope-return? envelope)
(let ((return-channel (make-channel)))
(format #t "env enqueue\n")
(concurrent-enqueue! message-queue (list envelope return-channel))
(format #t "enqueued\n")
(channel-get return-channel)
(format #t "got return\n"))
(concurrent-enqueue! message-queue envelope)))
(make-vat #:name name
#:start start
#:halt halt
#:send send
#:log? log?))