app.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; THREAD.plt
;;
;; microthread-based toolkit.  Inspired by Erlang.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; app.ss
;; implementation of basic application pattern.
;; yc 8/31/2009
(require scheme/contract
         mzlib/trace
         "base.ss"
         )

(define-struct app (thread))

;; we can use the handler to track the actual state of the object!!
(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)
                         ;; no error handling... hmmm...
                         (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))
 )