mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

srfi-18: Simplify thread-sleep!, thread-terminate!.

Browse source 
* module/srfi/srfi-18.scm (thread-sleep!): Use `when'.
  (thread-terminate!): Simplify.
This commit is contained in:
Andy Wingo 2016-10-30 21:43:51 +01:00
parent 4d23c835c4
commit bbcc128153
1 changed files with 15 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

34
module/srfi/srfi-18.scm
View file

@ -233,8 +233,8 @@
'()))))
(secs (inexact->exact (truncate t)))
(usecs (inexact->exact (truncate (* (- t secs) 1000000)))))
(and (> secs 0) (sleep secs))
(and (> usecs 0) (usleep usecs))
(when (> secs 0) (sleep secs))
(when (> usecs 0) (usleep usecs))
*unspecified*))
;; A convenience function for installing exception handlers on SRFI-18
@ -254,23 +254,19 @@
;; terminated-thread exception, as per SRFI-18,
(define (thread-terminate! thread)
(define (thread-terminate-inner!)
(let ((current-handler (threads:thread-cleanup thread)))
(if (thunk? current-handler)
(threads:set-thread-cleanup!
thread
(lambda ()
(with-exception-handler initial-handler
current-handler)
(srfi-18-exception-preserver
terminated-thread-exception)))
(threads:set-thread-cleanup!
thread
(lambda () (srfi-18-exception-preserver
terminated-thread-exception))))
(threads:cancel-thread thread)
*unspecified*))
(thread-terminate-inner!))
(let ((current-handler (threads:thread-cleanup thread)))
(threads:set-thread-cleanup!
thread
(if (thunk? current-handler)
(lambda ()
(with-exception-handler initial-handler
current-handler)
(srfi-18-exception-preserver
terminated-thread-exception))
(lambda () (srfi-18-exception-preserver
terminated-thread-exception))))
(threads:cancel-thread thread)
*unspecified*))
(define (thread-join! thread . args)
(define thread-join-inner!