#lang scheme/base
(require scheme/contract
mzlib/trace
"base.ss"
)
(define-struct app (thread))
(define (make-app-handler call cast)
(define (helper state)
(receive/match
((list (? thread? thd) args)
(with-handlers ((exn?
(lambda (e)
(send-exn-to e thd)
(helper state))))
(let ((v (call thd args state)))
(thread-reply thd (car v))
(helper (cdr v)))))
((list args)
(with-handlers ((exn?
(lambda (e)
(helper state))))
(let ((v (cast args state)))
(helper (cdr v)))))))
helper)
(define (app-call app cmd #:timeout (timeout +inf.0) . args)
(thread-call (app-thread app) (cons cmd args) timeout))
(define (app-cast app cmd . args)
(thread-cast (app-thread app) (cons cmd args)))
(define (make-application call cast init-state)
(make-app (thread (lambda ()
((make-app-handler call cast) init-state)))))
(provide/contract
(make-app-handler (-> procedure? procedure?
(-> any/c any)))
(struct app ((thread thread?)))
(make-application (-> procedure? procedure? any/c app?))
(app-call (->* ((or/c symbol? app?) any/c)
(#:timeout number?)
#:rest (listof any/c)
any))
(app-cast (->* ((or/c symbol? app?) any/c)
()
#:rest (listof any/c)
any))
)