Sketch of exit-status preserving threads

standard-thread.rkt

#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))))