From 08c7f4cd98c86fbb6551c7c0b6f17262c67e7b23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= Date: Sat, 25 Jun 2016 16:43:36 +0200 Subject: [PATCH] Fix 'monitor' macro. * module/ice-9/threads.scm (monitor-mutex-table) (monitor-mutex-table-mutex, monitor-mutex-with-id): New variables. (monitor): Fix it. --- module/ice-9/threads.scm | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm index 9f9e1bf..14da113 100644 --- a/module/ice-9/threads.scm +++ b/module/ice-9/threads.scm @@ -85,9 +85,24 @@ (lambda () (begin e0 e1 ...)) (lambda () (unlock-mutex x))))) -(define-syntax-rule (monitor first rest ...) - (with-mutex (make-mutex) - first rest ...)) +(define monitor-mutex-table (make-hash-table)) + +(define monitor-mutex-table-mutex (make-mutex)) + +(define (monitor-mutex-with-id id) + (with-mutex monitor-mutex-table-mutex + (or (hashq-ref monitor-mutex-table id) + (let ((mutex (make-mutex))) + (hashq-set! monitor-mutex-table id mutex) + mutex)))) + +(define-syntax monitor + (lambda (stx) + (syntax-case stx () + ((_ body body* ...) + (let ((id (datum->syntax #'body (gensym)))) + #`(with-mutex (monitor-mutex-with-id '#,id) + body body* ...)))))) (define (par-mapper mapper cons) (lambda (proc . lists) -- 2.8.4