unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* Patches for module/ice-9/occam-channel.scm
@ 2012-04-30 12:42 Daniel Krueger
  2012-05-04  2:58 ` Noah Lavine
  0 siblings, 1 reply; 8+ messages in thread
From: Daniel Krueger @ 2012-04-30 12:42 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 214 bytes --]

Hi,

I've done some work on (ice-9 occam-channel) and fixed the module
exports, the alt macro and extended it a little bit. Here are the
patches, but they are all just micro-commits, I hope that is okay.

- Daniel

[-- Attachment #2: 0001-fixed-exports-of-module-ice-9-occam-channel.scm.patch --]
[-- Type: application/octet-stream, Size: 5835 bytes --]

From 5a685e4cdeb8a994d175f7d015dfa805cbda4d6e Mon Sep 17 00:00:00 2001
From: Daniel Krueger <keenbug@gmail.com>
Date: Mon, 30 Apr 2012 13:42:43 +0200
Subject: [PATCH 1/4] fixed exports of module/ice-9/occam-channel.scm

---
 module/ice-9/occam-channel.scm |  110 +++++++++++++++++++---------------------
 1 file changed, 51 insertions(+), 59 deletions(-)

diff --git a/module/ice-9/occam-channel.scm b/module/ice-9/occam-channel.scm
index ea1154b..c009478 100644
--- a/module/ice-9/occam-channel.scm
+++ b/module/ice-9/occam-channel.scm
@@ -19,20 +19,12 @@
 (define-module (ice-9 occam-channel)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
-  #:export-syntax (alt
-		   ;; macro use:
-		   oc:lock oc:unlock oc:consequence
-		   oc:immediate-dispatch oc:late-dispatch oc:first-channel
-		   oc:set-handshake-channel oc:unset-handshake-channel)
   #:export (make-channel
-	    ?
-	    !
-	    make-timer
-	    ;; macro use:
-	    handshake-channel mutex
-	    sender-waiting?
-	    immediate-receive late-receive
-	    )
+            ?
+            !
+            make-timer
+            alt
+            )
   )
 
 (define no-data '(no-data))
@@ -73,16 +65,16 @@
 (define-method (? (ch <data-channel>))
   (lock-mutex (mutex ch))
   (let ((res (cond ((receiver-waiting? ch)
-		    (unlock-mutex (mutex ch))
-		    (scm-error 'misc-error '?
-			       "another process is already receiving on ~A"
-			       (list ch) #f))
-		   ((sender-waiting? ch)
-		    (immediate-receive ch))
-		   (else
-		    (set! (data ch) receiver-waiting)
-		    (wait-condition-variable (cv ch) (mutex ch))
-		    (late-receive ch)))))
+                    (unlock-mutex (mutex ch))
+                    (scm-error 'misc-error '?
+                               "another process is already receiving on ~A"
+                               (list ch) #f))
+                   ((sender-waiting? ch)
+                    (immediate-receive ch))
+                   (else
+                    (set! (data ch) receiver-waiting)
+                    (wait-condition-variable (cv ch) (mutex ch))
+                    (late-receive ch)))))
     (unlock-mutex (mutex ch))
     res))
 
@@ -92,15 +84,15 @@
 (define-method (! (ch <data-channel>) (x <top>))
   (lock-mutex (mutex (handshake-channel ch)))
   (cond ((receiver-waiting? ch)
-	 (set! (data ch) x)
-	 (signal-condition-variable (cv (handshake-channel ch))))
-	((sender-waiting? ch)
-	 (unlock-mutex (mutex (handshake-channel ch)))
-	 (scm-error 'misc-error '! "another process is already sending on ~A"
-		    (list ch) #f))
-	(else
-	 (set! (data ch) x)
-	 (wait-condition-variable (cv ch) (mutex ch))))
+         (set! (data ch) x)
+         (signal-condition-variable (cv (handshake-channel ch))))
+        ((sender-waiting? ch)
+         (unlock-mutex (mutex (handshake-channel ch)))
+         (scm-error 'misc-error '! "another process is already sending on ~A"
+                    (list ch) #f))
+        (else
+         (set! (data ch) x)
+         (wait-condition-variable (cv ch) (mutex ch))))
   (unlock-mutex (mutex (handshake-channel ch))))
 
 ;;; Add protocols?
@@ -132,7 +124,7 @@
 
 (define (us->timeofday n)
   (cons (quotient n 1000000)
-	(remainder n 1000000)))
+        (remainder n 1000000)))
 
 (define-method (? (ch <timer-channel>))
   (timeofday->us (gettimeofday)))
@@ -226,36 +218,36 @@
   (lambda (x)
     (define (else-clause? x)
       (syntax-case x (else)
-	((_) #f)
-	((_ (else e1 e2 ...)) #t)
-	((_ c1 c2 ...) (else-clause? (syntax (_ c2 ...))))))
+        ((_) #f)
+        ((_ (else e1 e2 ...)) #t)
+        ((_ c1 c2 ...) (else-clause? (syntax (_ c2 ...))))))
     
     (syntax-case x (else)
       ((_ c1 c2 ...)
        (else-clause? x)
        (syntax (begin
-		 (oc:lock c1)
-		 (oc:lock c2) ...
-		 (let ((res (cond (oc:immediate-dispatch c1)
-				  (oc:immediate-dispatch c2) ...)))
-		   (oc:unlock c1)
-		   (oc:unlock c2) ...
-		   res))))
+                 (oc:lock c1)
+                 (oc:lock c2) ...
+                 (let ((res (cond (oc:immediate-dispatch c1)
+                                  (oc:immediate-dispatch c2) ...)))
+                   (oc:unlock c1)
+                   (oc:unlock c2) ...
+                   res))))
       ((_ c1 c2 ...)
        (syntax (begin
-		 (oc:lock c1)
-		 (oc:lock c2) ...
-		 (let ((res (cond (oc:immediate-dispatch c1)
-				  (oc:immediate-dispatch c2) ...
-				  (else (let ((ch (oc:first-channel c1 c2 ...)))
-					  (oc:set-handshake-channel c1 ch)
-					  (oc:set-handshake-channel c2 ch) ...
-					  (wait-condition-variable (cv ch)
-								   (mutex ch))
-					  (oc:unset-handshake-channel c1)
-					  (oc:unset-handshake-channel c2) ...
-					  (cond (oc:late-dispatch c1)
-						(oc:late-dispatch c2) ...))))))
-		   (oc:unlock c1)
-		   (oc:unlock c2) ...
-		   res)))))))
+                 (oc:lock c1)
+                 (oc:lock c2) ...
+                 (let ((res (cond (oc:immediate-dispatch c1)
+                                  (oc:immediate-dispatch c2) ...
+                                  (else (let ((ch (oc:first-channel c1 c2 ...)))
+                                          (oc:set-handshake-channel c1 ch)
+                                          (oc:set-handshake-channel c2 ch) ...
+                                          (wait-condition-variable (cv ch)
+                                                                   (mutex ch))
+                                          (oc:unset-handshake-channel c1)
+                                          (oc:unset-handshake-channel c2) ...
+                                          (cond (oc:late-dispatch c1)
+                                                (oc:late-dispatch c2) ...))))))
+                   (oc:unlock c1)
+                   (oc:unlock c2) ...
+                   res)))))))
-- 
1.7.10


[-- Attachment #3: 0002-added-some-commentary-to-module-ice-9-occam-channel..patch --]
[-- Type: application/octet-stream, Size: 1152 bytes --]

From d5e3ecbb57b5c0ac40699b31c9fe5aa3eba03d5b Mon Sep 17 00:00:00 2001
From: Daniel Krueger <keenbug@gmail.com>
Date: Mon, 30 Apr 2012 13:47:19 +0200
Subject: [PATCH 2/4] added some commentary to module/ice-9/occam-channel.scm

---
 module/ice-9/occam-channel.scm |    6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/occam-channel.scm b/module/ice-9/occam-channel.scm
index c009478..cee04ce 100644
--- a/module/ice-9/occam-channel.scm
+++ b/module/ice-9/occam-channel.scm
@@ -51,12 +51,16 @@
 (define-method (receiver-waiting? (ch <data-channel>))
   (eq? (data ch) receiver-waiting))
 
+;;; receive data if the sender already put something
+;;; on the channel
 (define-method (immediate-receive (ch <data-channel>))
-  (signal-condition-variable (cv ch))
+  (signal-condition-variable (cv ch)) ; we read the data now, so the sender can go on
   (let ((res (data ch)))
     (set! (data ch) no-data)
     res))
 
+;;; receive data after we waited fo the sender to
+;;; put something on the channel
 (define-method (late-receive (ch <data-channel>))
   (let ((res (data ch)))
     (set! (data ch) no-data)
-- 
1.7.10


[-- Attachment #4: 0003-module-ice-9-occam-channel.scm-now-channels-can-also.patch --]
[-- Type: application/octet-stream, Size: 5423 bytes --]

From 9b0e0dcbd5668b19c758dc80f08e6b18abcb89e3 Mon Sep 17 00:00:00 2001
From: Daniel Krueger <keenbug@gmail.com>
Date: Mon, 30 Apr 2012 14:26:49 +0200
Subject: [PATCH 3/4] module/ice-9/occam-channel.scm: now channels can also be
 accessed in alt clauses

---
 module/ice-9/occam-channel.scm |  106 ++++++++++++++++++++--------------------
 1 file changed, 54 insertions(+), 52 deletions(-)

diff --git a/module/ice-9/occam-channel.scm b/module/ice-9/occam-channel.scm
index cee04ce..ae47d86 100644
--- a/module/ice-9/occam-channel.scm
+++ b/module/ice-9/occam-channel.scm
@@ -163,33 +163,11 @@
 
 (define-syntax oc:consequence
   (syntax-rules (=>)
-    ((_ data) data)
-    ((_ data => (lambda (x) e1 e2 ...))
-     (let ((x data)) e1 e2 ...))
-    ((_ data e1 e2 ...)
-     (begin data e1 e2 ...))))
-
-(define-syntax oc:immediate-dispatch
-  (syntax-rules (?)
-    ((_ ((? ch) e1 ...))
-     ((sender-waiting? ch)
-      (oc:consequence (immediate-receive ch) e1 ...)))
-    ((_ (exp (? ch) e1 ...))
-     ((and exp (sender-waiting? ch))
-      (oc:consequence (immediate-receive ch) e1 ...)))
-    ((_ (exp e1 ...))
-     (exp e1 ...))))
-
-(define-syntax oc:late-dispatch
-  (syntax-rules (?)
-    ((_ ((? ch) e1 ...))
-     ((sender-waiting? ch)
-      (oc:consequence (late-receive ch) e1 ...)))
-    ((_ (exp (? ch) e1 ...))
-     ((and exp (sender-waiting? ch))
-      (oc:consequence (late-receive ch) e1 ...)))
-    ((_ (exp e1 ...))
-     (#f))))
+    ((_ unlock data) data)
+    ((_ unlock data => (lambda (x) e1 e2 ...))
+     (let ((x data)) (unlock) e1 e2 ...))
+    ((_ unlock data e1 e2 ...)
+     (begin data (unlock) e1 e2 ...))))
 
 (define-syntax oc:first-channel
   (syntax-rules (?)
@@ -218,8 +196,33 @@
     ((_ (exp e1 ...))
      #f)))
 
+
 (define-syntax alt
   (lambda (x)
+    (define (oc:immediate-dispatcher unlock)
+      (lambda (clause)
+        (syntax-case clause (?)
+          (((? ch) e1 ...)
+           #`((sender-waiting? ch)
+              (oc:consequence #,unlock (immediate-receive ch) e1 ...)))
+          ((exp (? ch) e1 ...)
+           #`((and exp (sender-waiting? ch))
+              (oc:consequence #,unlock (immediate-receive ch) e1 ...)))
+          ((exp e1 ...)
+           #`(exp (#,unlock) e1 ...)))))
+
+    (define (oc:late-dispatcher unlock)
+      (lambda (clause)
+        (syntax-case clause (?)
+          (((? ch) e1 ...)
+           #`((sender-waiting? ch)
+              (oc:consequence #,unlock (late-receive ch) e1 ...)))
+          ((exp (? ch) e1 ...)
+           #`((and exp (sender-waiting? ch))
+              (oc:consequence #,unlock (late-receive ch) e1 ...)))
+          ((exp e1 ...)
+           #`(#f)))))
+
     (define (else-clause? x)
       (syntax-case x (else)
         ((_) #f)
@@ -229,29 +232,28 @@
     (syntax-case x (else)
       ((_ c1 c2 ...)
        (else-clause? x)
-       (syntax (begin
-                 (oc:lock c1)
-                 (oc:lock c2) ...
-                 (let ((res (cond (oc:immediate-dispatch c1)
-                                  (oc:immediate-dispatch c2) ...)))
-                   (oc:unlock c1)
-                   (oc:unlock c2) ...
-                   res))))
+       #`(let ((unlock (lambda ()
+                         (oc:unlock c1)
+                         (oc:unlock c2) ...)))
+           (oc:lock c1)
+           (oc:lock c2) ...
+           (cond #,@(map (oc:immediate-dispatcher #'unlock)
+                         #'(c1 c2 ...)))))
       ((_ c1 c2 ...)
-       (syntax (begin
-                 (oc:lock c1)
-                 (oc:lock c2) ...
-                 (let ((res (cond (oc:immediate-dispatch c1)
-                                  (oc:immediate-dispatch c2) ...
-                                  (else (let ((ch (oc:first-channel c1 c2 ...)))
-                                          (oc:set-handshake-channel c1 ch)
-                                          (oc:set-handshake-channel c2 ch) ...
-                                          (wait-condition-variable (cv ch)
-                                                                   (mutex ch))
-                                          (oc:unset-handshake-channel c1)
-                                          (oc:unset-handshake-channel c2) ...
-                                          (cond (oc:late-dispatch c1)
-                                                (oc:late-dispatch c2) ...))))))
-                   (oc:unlock c1)
-                   (oc:unlock c2) ...
-                   res)))))))
+       #`(let ((unlock (lambda ()
+                         (oc:unlock c1)
+                         (oc:unlock c2) ...)))
+           (oc:lock c1)
+           (oc:lock c2) ...
+           (cond #,@(map (oc:immediate-dispatcher #'unlock)
+                         #'(c1 c2 ...))
+                 (else (let ((ch (oc:first-channel c1 c2 ...)))
+                         (oc:set-handshake-channel c1 ch)
+                         (oc:set-handshake-channel c2 ch) ...
+                         (wait-condition-variable (cv ch)
+                                                  (mutex ch))
+                         (oc:unset-handshake-channel c1)
+                         (oc:unset-handshake-channel c2) ...
+                         (cond #,@(map (oc:late-dispatcher #'unlock)
+                                       #'(c1 c2 ...))
+                               (else (unlock) (if #f #f)))))))))))
-- 
1.7.10


[-- Attachment #5: 0004-module-ice-9-occam-channel.scm-alt-now-also-a-proc-i.patch --]
[-- Type: application/octet-stream, Size: 812 bytes --]

From d9d2199c90f6f4adffb645d4c4a6161b8c91d8ad Mon Sep 17 00:00:00 2001
From: Daniel Krueger <keenbug@gmail.com>
Date: Mon, 30 Apr 2012 14:28:27 +0200
Subject: [PATCH 4/4] module/ice-9/occam-channel.scm: alt: now also a =>
 proc-identifier clause works

---
 module/ice-9/occam-channel.scm |    2 ++
 1 file changed, 2 insertions(+)

diff --git a/module/ice-9/occam-channel.scm b/module/ice-9/occam-channel.scm
index ae47d86..2ecf2fa 100644
--- a/module/ice-9/occam-channel.scm
+++ b/module/ice-9/occam-channel.scm
@@ -166,6 +166,8 @@
     ((_ unlock data) data)
     ((_ unlock data => (lambda (x) e1 e2 ...))
      (let ((x data)) (unlock) e1 e2 ...))
+    ((_ unlock data => proc)
+     (let ((x data)) (unlock) (proc x)))
     ((_ unlock data e1 e2 ...)
      (begin data (unlock) e1 e2 ...))))
 
-- 
1.7.10


^ permalink raw reply related	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2012-05-18 20:14 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-04-30 12:42 Patches for module/ice-9/occam-channel.scm Daniel Krueger
2012-05-04  2:58 ` Noah Lavine
2012-05-04  3:18   ` Nala Ginrut
2012-05-04 13:17     ` Andrew Gwozdziewycz
2012-05-06  9:33       ` Daniel Krueger
2012-05-09 12:06         ` Noah Lavine
2012-05-15 22:37           ` Mark H Weaver
2012-05-18 20:14             ` Daniel Krueger

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).