public
Created

Sketch of exit-status preserving threads

  • Download Gist
standard-thread.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
#lang racket/base
;; Standard Thread
 
(provide exit-status?
exit-status-exception?
exit-status-value
 
current-thread-exit-status
exit-status-evt
 
standard-thread)
 
(struct exit-status (thread
[exception? #:mutable]
[value #:mutable]
ready))
 
(define *current-thread-exit-status* (make-parameter #f))
 
(define (current-thread-exit-status)
(define v (*current-thread-exit-status*))
(if (exit-status? v)
(if (eq? (current-thread) (exit-status-thread v))
v
(begin (*current-thread-exit-status* #f)
#f))
#f))
 
(define (exit-status-evt es)
(wrap-evt (semaphore-peek-evt (exit-status-ready es))
(lambda (dummy) es)))
 
(define (fill-exit-status! es exn? v)
(set-exit-status-exception?! es exn?)
(set-exit-status-value! es v)
(semaphore-post (exit-status-ready es))
v)
 
(define (call-capturing-exit-status thunk)
(define es (exit-status (current-thread) #f #f (make-semaphore 0)))
(parameterize ((*current-thread-exit-status* es))
(with-handlers
((exn? (lambda (e)
(raise (fill-exit-status! es #t e)))))
(fill-exit-status! es #f (thunk)))))
 
(define (standard-thread thunk)
(thread (lambda ()
(call-capturing-exit-status thunk))))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.