suzanne.soy/racket-pkg-website
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Propagate exceptions over RPC reply channels

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-09-30 01:16:15 -04:00
parent 2bb8cbe5b3
commit 399788edae
1 changed files with 23 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
src/rpc.rkt
View File

@ -1,11 +1,15 @@
#lang racket/base #lang racket/base
(provide rpc-request-evt (provide (struct-out exn:fail:rpc)
rpc-request-evt
rpc-handler rpc-handler
rpc-call rpc-call
rpc-cast!) rpc-cast!)
(require racket/match) (require racket/match)
(require racket/exn)
(struct exn:fail:rpc exn:fail (inner-exn) #:transparent)
(define (rpc-request-evt) (define (rpc-request-evt)
(handle-evt (thread-receive-evt) (handle-evt (thread-receive-evt)
@ -15,16 +19,30 @@
(match ch-and-req (match ch-and-req
[(cons ch request) [(cons ch request)
(define-values (reply-value new-state) (define-values (reply-value new-state)
(match request (with-handlers [(exn:fail? (lambda (e)
[(list argpat ...) body ...] (channel-put ch e)
...)) (raise e)))]
(match request
[(list argpat ...) body ...]
...)))
(when ch (channel-put ch reply-value)) (when ch (channel-put ch reply-value))
new-state])) new-state]))
(define (rpc-call thread . request) (define (rpc-call thread . request)
(define ch (make-channel)) (define ch (make-channel))
(thread-send thread (cons ch request)) (thread-send thread (cons ch request))
(channel-get ch)) (define result
(sync (handle-evt thread
(lambda (_)
(raise (exn:fail:rpc "Server thread terminated unexpectedly"
(current-continuation-marks)
#f))))
ch))
(when (exn? result)
(raise (exn:fail:rpc (format "RPC exception:\n~a" (exn->string result))
(current-continuation-marks)
result)))
result)
(define (rpc-cast! thread . request) (define (rpc-cast! thread . request)
(thread-send thread (cons #f request))) (thread-send thread (cons #f request)))