]> gitweb.factorcode.org Git - factor.git/commitdiff
use new accessors, throw -> ERROR:
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 29 Aug 2008 06:00:39 +0000 (01:00 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 29 Aug 2008 06:00:39 +0000 (01:00 -0500)
basis/concurrency/messaging/messaging.factor
basis/concurrency/semaphores/semaphores.factor

index e77760408c1f090bd5a18661001cd6627925f304..810e4430f19a5ad75dd24186bd3faebc45ae802d 100755 (executable)
@@ -4,7 +4,7 @@
 ! Concurrency library for Factor, based on Erlang/Termite style\r
 ! concurrency.\r
 USING: kernel threads concurrency.mailboxes continuations\r
-namespaces assocs random ;\r
+namespaces assocs random accessors ;\r
 IN: concurrency.messaging\r
 \r
 GENERIC: send ( message thread -- )\r
@@ -45,11 +45,11 @@ TUPLE: synchronous data sender tag ;
 TUPLE: reply data tag ;\r
 \r
 : <reply> ( data synchronous -- reply )\r
-    synchronous-tag \ reply boa ;\r
+    tag>> \ reply boa ;\r
 \r
 : synchronous-reply? ( response synchronous -- ? )\r
     over reply?\r
-    [ >r reply-tag r> synchronous-tag = ]\r
+    [ >r tag>> r> tag>> = ]\r
     [ 2drop f ] if ;\r
 \r
 : send-synchronous ( message thread -- reply )\r
@@ -58,15 +58,15 @@ TUPLE: reply data tag ;
     ] [\r
         >r <synchronous> dup r> send\r
         [ synchronous-reply? ] curry receive-if\r
-        reply-data\r
+        data>>\r
     ] if ;\r
 \r
 : reply-synchronous ( message synchronous -- )\r
-    [ <reply> ] keep synchronous-sender send ;\r
+    [ <reply> ] keep sender>> send ;\r
 \r
 : handle-synchronous ( quot -- )\r
     receive [\r
-        synchronous-data swap call\r
+        data>> swap call\r
     ] keep reply-synchronous ; inline\r
 \r
 <PRIVATE\r
index 8b88c540bc629dd414f22c03d8afc70da71dc354..1b55c7afa5641ffde0cdf5b4763e70fdc25b15a5 100755 (executable)
@@ -1,29 +1,34 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: dlists kernel threads math concurrency.conditions\r
-continuations ;\r
+continuations accessors summary ;\r
 IN: concurrency.semaphores\r
 \r
 TUPLE: semaphore count threads ;\r
 \r
+ERROR: negative-count-semaphore ;\r
+\r
+M: negative-count-semaphore summary\r
+    drop "Cannot have semaphore with negative count" ;\r
+\r
 : <semaphore> ( n -- semaphore )\r
-    dup 0 < [ "Cannot have semaphore with negative count" throw ] when\r
+    dup 0 < [ negative-count-semaphore ] when\r
     <dlist> semaphore boa ;\r
 \r
 : wait-to-acquire ( semaphore timeout -- )\r
-    >r semaphore-threads r> "semaphore" wait ;\r
+    [ threads>> ] dip "semaphore" wait ;\r
 \r
 : acquire-timeout ( semaphore timeout -- )\r
-    over semaphore-count zero?\r
+    over count>> zero?\r
     [ dupd wait-to-acquire ] [ drop ] if\r
-    dup semaphore-count 1- swap set-semaphore-count ;\r
+    [ 1- ] change-count drop ;\r
 \r
 : acquire ( semaphore -- )\r
     f acquire-timeout ;\r
 \r
 : release ( semaphore -- )\r
-    dup semaphore-count 1+ over set-semaphore-count\r
-    semaphore-threads notify-1 ;\r
+    [ 1+ ] change-count\r
+    threads>> notify-1 ;\r
 \r
 : with-semaphore-timeout ( semaphore timeout quot -- )\r
     pick rot acquire-timeout swap\r