Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

45 lines (37 sloc) 1.708 kb
#lang racket/base
(provide (struct-out exn:fail:timeout)
call-with-timeout)
(define-struct (exn:fail:timeout exn:fail) (msecs))
(define-struct good-value (v))
(define-struct bad-value (exn))
;; call-with-timeout: (-> any) number -> any
;; Calls a thunk, with a given timeout.
(define (call-with-timeout thunk timeout)
(let ([ch (make-channel)]
[alarm-e
(alarm-evt (+ (current-inexact-milliseconds)
timeout))])
(let* ([cust (make-custodian)]
[th (parameterize ([current-custodian cust])
(thread (lambda ()
(channel-put ch
(with-handlers ([void
(lambda (e)
(make-bad-value e))])
(make-good-value (thunk)))))))])
(let ([result (sync ch
(handle-evt alarm-e
(lambda (false-value)
(begin0
(make-bad-value
(make-exn:fail:timeout
"timeout"
(current-continuation-marks)
timeout))
(custodian-shutdown-all cust)
(kill-thread th)))))])
(cond
[(good-value? result)
(good-value-v result)]
[(bad-value? result)
(raise (bad-value-exn result))])))))
Jump to Line
Something went wrong with that request. Please try again.