From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Israelsson Tampe Newsgroups: gmane.lisp.guile.devel Subject: Fwd: Concurrent MVars for Guile Date: Wed, 4 Sep 2013 08:27:34 +0200 Message-ID: References: <87fvtn1wv8.fsf@tines.lan> <87r4d6yvag.fsf@tines.lan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/alternative; boundary=e89a8ff1c51ca35dbf04e588e6d7 X-Trace: ger.gmane.org 1378276067 18998 80.91.229.3 (4 Sep 2013 06:27:47 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 4 Sep 2013 06:27:47 +0000 (UTC) To: guile-devel Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Sep 04 08:27:48 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VH6Z7-0006Li-BT for guile-devel@m.gmane.org; Wed, 04 Sep 2013 08:27:45 +0200 Original-Received: from localhost ([::1]:50564 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VH6Z6-0005aC-Sm for guile-devel@m.gmane.org; Wed, 04 Sep 2013 02:27:44 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43472) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VH6Z0-0005Zw-Et for guile-devel@gnu.org; Wed, 04 Sep 2013 02:27:41 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VH6Yy-00020K-DW for guile-devel@gnu.org; Wed, 04 Sep 2013 02:27:38 -0400 Original-Received: from mail-pa0-x22c.google.com ([2607:f8b0:400e:c03::22c]:46880) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VH6Yx-0001zI-UG for guile-devel@gnu.org; Wed, 04 Sep 2013 02:27:36 -0400 Original-Received: by mail-pa0-f44.google.com with SMTP id fz6so1632pac.31 for ; Tue, 03 Sep 2013 23:27:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:in-reply-to:references:date:message-id:subject:from:to :content-type; bh=fr0OzE71BSAYw6kRms2H8QLTPoitTH69ilic2wJm71E=; b=LypOs1//EMofCXXfLEaFA2vLsDoKzVDy1ul6Ga+iXh0E1PwGxX26kE8qd4qNI21Dnq tTzQRssmyCdTMe3V69OuQdVwzHa/m7y9V29w/PatwHuzhtYADblnRcF9pUdyDngG0nAV 8LBUG+BSNbi6bjULWG1orVjI13pDi/RqGnS2khhIxuQviaQAzn6otyRCfHen6qGUOdXf wciIl8wsNw3pGqS7epxSRWRo6vK+uI7c13lbI9f9WAiJAg5kfn/tetXpeOdiWpQxv1gp ooKc/JjhmIfbVvYBcqP745gyeB3LJvcy7uVmnGkFJR3v3S172uyxjs0eCJBDSn12KMEO m11g== X-Received: by 10.68.189.39 with SMTP id gf7mr1383567pbc.184.1378276054619; Tue, 03 Sep 2013 23:27:34 -0700 (PDT) Original-Received: by 10.70.2.34 with HTTP; Tue, 3 Sep 2013 23:27:34 -0700 (PDT) In-Reply-To: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2607:f8b0:400e:c03::22c X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16611 Archived-At: --e89a8ff1c51ca35dbf04e588e6d7 Content-Type: text/plain; charset=ISO-8859-1 ---------- Forwarded message ---------- From: Stefan Israelsson Tampe Date: Tue, Sep 3, 2013 at 6:22 PM Subject: Re: Concurrent MVars for Guile To: Mark H Weaver I find this code good to include due to. 1. Small and tidy code 2. Good for study to see how to how to use the primitive primitives 3. Nice semantics that are useful. One could argue that this belongs to a library, but I agree with mark that we need to have these primitives out of the box due to. 1. To low level to be in a library e.g. prevent dependency hell 2. It will force fine documentation of the code 3. It will unify the interface. For 3 one could argue that it is better to allow people to play with semantics and develop this field in many direction. I think on the other hand that this has been done already in other programming environments and we should be able to steal the well proven semantics for guile and include it with guile. My 2c Cheers On Tue, Sep 3, 2013 at 1:55 PM, Mark H Weaver wrote: > Hello all, > > I've attached an improved (but still preliminary) implementation of > MVars for Guile. Apart from fixing some bugs, this version follows the > Haskell API and semantics more closely. In particular, I now refrain > from adding atomicity guarantees beyond those promised by the Haskell > API. I also added locking to 'mvar-empty?', to ensure that we meet the > "ordering" requirement of the Haskell API. > > Comments and suggestions welcome. > > Mark > > > > (define-module (ice-9 mvars) > #:use-module (ice-9 threads) > #:use-module (srfi srfi-8) ; receive > #:use-module (srfi srfi-9) ; records > #:use-module (srfi srfi-9 gnu) > #:export (mvar? > mvar-empty? new-empty-mvar new-mvar > take-mvar put-mvar read-mvar swap-mvar > try-take-mvar try-put-mvar > with-mvar modify-mvar modify-mvar*)) > > (define-record-type > (make-mvar contents empty? mutex full-condition empty-condition) > mvar? > (contents %mvar-contents %set-mvar-contents!) > (empty? %mvar-empty? %set-mvar-empty?!) > (mutex mvar-mutex) > (full-condition mvar-full-condition) > (empty-condition mvar-empty-condition)) > > (define (mvar-empty? mvar) > (with-mutex (mvar-mutex mvar) > (%mvar-empty? mvar))) > > (define (new-empty-mvar) > "Return a freshly allocated mvar that is initially empty." > (make-mvar #f ; contents > #t ; empty? > (make-mutex) > (make-condition-variable) > (make-condition-variable))) > > (define (new-mvar x) > "Return a freshly allocated mvar with initial contents X." > (make-mvar x ; contents > #f ; empty? > (make-mutex) > (make-condition-variable) > (make-condition-variable))) > > (define (take-mvar mvar) > "Block until MVAR is full, then atomically remove and return its > contents." > (with-mutex (mvar-mutex mvar) > (when (%mvar-empty? mvar) > (wait-condition-variable (mvar-full-condition mvar) (mvar-mutex > mvar))) > (let ((x (%mvar-contents mvar))) > (%set-mvar-contents! mvar #f) > (%set-mvar-empty?! mvar #t) > (signal-condition-variable (mvar-empty-condition mvar)) > x))) > > (define (put-mvar mvar x) > "Block until MVAR is empty, then put X into it." > (with-mutex (mvar-mutex mvar) > (unless (%mvar-empty? mvar) > (wait-condition-variable (mvar-empty-condition mvar) (mvar-mutex > mvar))) > (%set-mvar-contents! mvar x) > (%set-mvar-empty?! mvar #f) > (signal-condition-variable (mvar-full-condition mvar)) > *unspecified*)) > > (define (read-mvar mvar) > "Take a value x from MVAR, then put it back and return x. This > procedure is atomic only if there are no other producers for MVAR." > (let ((x (take-mvar mvar))) > (put-mvar mvar x) > x)) > > (define (swap-mvar mvar y) > "Take a value x from MVAR, then put Y into MVAR and return x. This > procedure is atomic only if there are no other producers for MVAR." > (let ((x (take-mvar mvar))) > (put-mvar mvar y) > x)) > > (define (try-take-mvar mvar) > "If MVAR is full, return its contents and #t, else return #f and #f." > (with-mutex (mvar-mutex mvar) > (if (%mvar-empty? mvar) > (values #f #f) > (let ((x (%mvar-contents mvar))) > (%set-mvar-contents! mvar #f) > (%set-mvar-empty?! mvar #t) > (signal-condition-variable (mvar-empty-condition mvar)) > (values x #t))))) > > (define (try-put-mvar mvar x) > "If MVAR is empty, put X into it and return #t, else return #f." > (with-mutex (mvar-mutex mvar) > (and (%mvar-empty? mvar) > (begin > (%set-mvar-contents! mvar x) > (%set-mvar-empty?! mvar #f) > (signal-condition-variable (mvar-full-condition mvar)) > #t)))) > > (define (with-mvar mvar proc) > "Take a value from MVAR and apply PROC to it. If an exception is raised, > the original value is put back into MVAR. This procedure is atomic only if > there are no other producers for MVAR." > (let ((x (take-mvar mvar))) > (catch #t > (lambda () (proc x)) > (lambda (key . args) > (put-mvar mvar x) > (apply throw key args))))) > > (define (modify-mvar mvar f) > "Take a value x from MVAR, and then put back (F x). If an exception is > raised, the original value is put back into MVAR. This procedure is > atomic only if there are no other producers for MVAR." > (let ((old (take-mvar mvar))) > (catch #t > (lambda () (put-mvar mvar (f old))) > (lambda (key . args) > (put-mvar mvar old) > (apply throw key args))))) > > (define (modify-mvar* mvar f) > "Take a value x from MVAR, and apply F to it. (F x) should return one > or more values: the new value to be put back into MVAR, and zero or more > additional values to be returned from MODIFY-MVAR*. If an exception is > raised, the original value is put back into MVAR. This procedure is > atomic only if there are no other producers for MVAR." > (let ((old (take-mvar mvar))) > (catch #t > (lambda () > (receive (new . results) (f old) > (put-mvar mvar new) > (apply values results))) > (lambda (key . args) > (put-mvar mvar old) > (apply throw key args))))) > > (set-record-type-printer! > > (lambda (mvar port) > (display "# (display (number->string (object-address mvar) 16) port) > (display " " port) > (write (with-mutex (mvar-mutex mvar) > (if (%mvar-empty? mvar) > '() > (list (%mvar-contents mvar)))) > port) > (display ">" port))) > > --e89a8ff1c51ca35dbf04e588e6d7 Content-Type: text/html; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable


---------- Forwarded me= ssage ----------
From: Stefan Israelsson T= ampe <s= tefan.itampe@gmail.com>
Date: Tue, Sep 3, 2013 at 6:22 PM
Subject: Re: Concurrent MVars for Guil= e
To: Mark H Weaver <mhw@netris.org= >


I find this code good to include due t= o.
1. Small and tidy code
2. Good for study to see how to how to use= the primitive primitives
3. Nice semantics that are useful.

One could argue that this belongs to a library, but I a= gree with mark that
we need to have these primitives out of the b= ox due to.
1. To low level to be in a library e.g. prevent depend= ency hell
2. It will force fine documentation of the code
3. It will u= nify the interface.

For 3 one could argue that it = is better to allow people to play with semantics
and develop this field in many direction. I think on the other hand th= at this has been
done already in other programming environments a= nd we should be able to steal=A0
the well proven semantics for gu= ile and include it with guile.

My 2c

Cheers




On Tue, Sep 3, 2013 at 1:55 PM, Mark H We= aver <mhw@netris.org> wrote:
Hello all= ,

I've attached an improved (but still preliminary) implementation of
MVars for Guile. =A0Apart from fixing some bugs, this version follows the Haskell API and semantics more closely. =A0In particular, I now refrain
from adding atomicity guarantees beyond those promised by the Haskell
API. =A0I also added locking to 'mvar-empty?', to ensure that we me= et the
"ordering" requirement of the Haskell API.

Comments and suggestions welcome.

=A0 =A0 =A0 Mark



(define-module (ice-9 mvars)
=A0 #:use-module (ice-9 threads)
=A0 #:use-module (srfi srfi-8) =A0 =A0 =A0 =A0 =A0 =A0; receive
=A0 #:use-module (srfi srfi-9) =A0 =A0 =A0 =A0 =A0 =A0; records
=A0 #:use-module (srfi srfi-9 gnu)
=A0 #:export (mvar?
=A0 =A0 =A0 =A0 =A0 =A0 mvar-empty? new-empty-mvar new-mvar
=A0 =A0 =A0 =A0 =A0 =A0 take-mvar put-mvar read-mvar swap-mvar
=A0 =A0 =A0 =A0 =A0 =A0 try-take-mvar try-put-mvar
=A0 =A0 =A0 =A0 =A0 =A0 with-mvar modify-mvar modify-mvar*))

(define-record-type <mvar>
=A0 (make-mvar contents empty? mutex full-condition empty-condition)
=A0 mvar?
=A0 (contents =A0 =A0 =A0 =A0 %mvar-contents =A0 %set-mvar-contents!)
=A0 (empty? =A0 =A0 =A0 =A0 =A0 %mvar-empty? =A0 =A0 %set-mvar-empty?!)
=A0 (mutex =A0 =A0 =A0 =A0 =A0 =A0mvar-mutex)
=A0 (full-condition =A0 mvar-full-condition)
=A0 (empty-condition =A0mvar-empty-condition))

(define (mvar-empty? mvar)
=A0 (with-mutex (mvar-mutex mvar)
=A0 =A0 (%mvar-empty? mvar)))

(define (new-empty-mvar)
=A0 "Return a freshly allocated mvar that is initially empty." =A0 (make-mvar #f =A0; contents
=A0 =A0 =A0 =A0 =A0 =A0 =A0#t =A0; empty?
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-mutex)
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-condition-variable)
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-condition-variable)))

(define (new-mvar x)
=A0 "Return a freshly allocated mvar with initial contents X." =A0 (make-mvar x =A0 ; contents
=A0 =A0 =A0 =A0 =A0 =A0 =A0#f =A0; empty?
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-mutex)
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-condition-variable)
=A0 =A0 =A0 =A0 =A0 =A0 =A0(make-condition-variable)))

(define (take-mvar mvar)
=A0 "Block until MVAR is full, then atomically remove and return its c= ontents."
=A0 (with-mutex (mvar-mutex mvar)
=A0 =A0 (when (%mvar-empty? mvar)
=A0 =A0 =A0 (wait-condition-variable (mvar-full-condition mvar) (mvar-mutex= mvar)))
=A0 =A0 (let ((x (%mvar-contents mvar)))
=A0 =A0 =A0 (%set-mvar-contents! mvar #f)
=A0 =A0 =A0 (%set-mvar-empty?! mvar #t)
=A0 =A0 =A0 (signal-condition-variable (mvar-empty-condition mvar))
=A0 =A0 =A0 x)))

(define (put-mvar mvar x)
=A0 "Block until MVAR is empty, then put X into it."
=A0 (with-mutex (mvar-mutex mvar)
=A0 =A0 (unless (%mvar-empty? mvar)
=A0 =A0 =A0 (wait-condition-variable (mvar-empty-condition mvar) (mvar-mute= x mvar)))
=A0 =A0 (%set-mvar-contents! mvar x)
=A0 =A0 (%set-mvar-empty?! mvar #f)
=A0 =A0 (signal-condition-variable (mvar-full-condition mvar))
=A0 =A0 *unspecified*))

(define (read-mvar mvar)
=A0 "Take a value x from MVAR, then put it back and return x. =A0This<= br> procedure is atomic only if there are no other producers for MVAR." =A0 (let ((x (take-mvar mvar)))
=A0 =A0 (put-mvar mvar x)
=A0 =A0 x))

(define (swap-mvar mvar y)
=A0 "Take a value x from MVAR, then put Y into MVAR and return x. =A0T= his
procedure is atomic only if there are no other producers for MVAR." =A0 (let ((x (take-mvar mvar)))
=A0 =A0 (put-mvar mvar y)
=A0 =A0 x))

(define (try-take-mvar mvar)
=A0 "If MVAR is full, return its contents and #t, else return #f and #= f."
=A0 (with-mutex (mvar-mutex mvar)
=A0 =A0 (if (%mvar-empty? mvar)
=A0 =A0 =A0 =A0 (values #f #f)
=A0 =A0 =A0 =A0 (let ((x (%mvar-contents mvar)))
=A0 =A0 =A0 =A0 =A0 (%set-mvar-contents! mvar #f)
=A0 =A0 =A0 =A0 =A0 (%set-mvar-empty?! mvar #t)
=A0 =A0 =A0 =A0 =A0 (signal-condition-variable (mvar-empty-condition mvar))=
=A0 =A0 =A0 =A0 =A0 (values x #t)))))

(define (try-put-mvar mvar x)
=A0 "If MVAR is empty, put X into it and return #t, else return #f.&qu= ot;
=A0 (with-mutex (mvar-mutex mvar)
=A0 =A0 (and (%mvar-empty? mvar)
=A0 =A0 =A0 =A0 =A0(begin
=A0 =A0 =A0 =A0 =A0 =A0(%set-mvar-contents! mvar x)
=A0 =A0 =A0 =A0 =A0 =A0(%set-mvar-empty?! mvar #f)
=A0 =A0 =A0 =A0 =A0 =A0(signal-condition-variable (mvar-full-condition mvar= ))
=A0 =A0 =A0 =A0 =A0 =A0#t))))

(define (with-mvar mvar proc)
=A0 "Take a value from MVAR and apply PROC to it. =A0If an exception i= s raised,
the original value is put back into MVAR. =A0This procedure is atomic only = if
there are no other producers for MVAR."
=A0 (let ((x (take-mvar mvar)))
=A0 =A0 (catch #t
=A0 =A0 =A0 (lambda () (proc x))
=A0 =A0 =A0 (lambda (key . args)
=A0 =A0 =A0 =A0 (put-mvar mvar x)
=A0 =A0 =A0 =A0 (apply throw key args)))))

(define (modify-mvar mvar f)
=A0 "Take a value x from MVAR, and then put back (F x). =A0If an excep= tion is
raised, the original value is put back into MVAR. =A0This procedure is
atomic only if there are no other producers for MVAR."
=A0 (let ((old (take-mvar mvar)))
=A0 =A0 (catch #t
=A0 =A0 =A0 (lambda () (put-mvar mvar (f old)))
=A0 =A0 =A0 (lambda (key . args)
=A0 =A0 =A0 =A0 (put-mvar mvar old)
=A0 =A0 =A0 =A0 (apply throw key args)))))

(define (modify-mvar* mvar f)
=A0 "Take a value x from MVAR, and apply F to it. =A0(F x) should retu= rn one
or more values: the new value to be put back into MVAR, and zero or more additional values to be returned from MODIFY-MVAR*. =A0If an exception is raised, the original value is put back into MVAR. =A0This procedure is
atomic only if there are no other producers for MVAR."
=A0 (let ((old (take-mvar mvar)))
=A0 =A0 (catch #t
=A0 =A0 =A0 (lambda ()
=A0 =A0 =A0 =A0 (receive (new . results) (f old)
=A0 =A0 =A0 =A0 =A0 (put-mvar mvar new)
=A0 =A0 =A0 =A0 =A0 (apply values results)))
=A0 =A0 =A0 (lambda (key . args)
=A0 =A0 =A0 =A0 (put-mvar mvar old)
=A0 =A0 =A0 =A0 (apply throw key args)))))

(set-record-type-printer!
=A0<mvar>
=A0(lambda (mvar port)
=A0 =A0(display "#<mvar " port)
=A0 =A0(display (number->string (object-address mvar) 16) port)
=A0 =A0(display " " port)
=A0 =A0(write (with-mutex (mvar-mutex mvar)
=A0 =A0 =A0 =A0 =A0 =A0 (if (%mvar-empty? mvar)
=A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 '()
=A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 (list (%mvar-contents mvar))))
=A0 =A0 =A0 =A0 =A0 port)
=A0 =A0(display ">" port)))



--e89a8ff1c51ca35dbf04e588e6d7--