Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / concurrency / mailboxes / mailboxes.factor

diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index 993c26d922e2e0340aa76228d05730e584711742..419277647d778d7679ff74f765ae59de6b2af94f 100755 (executable)
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-IN: concurrency.mailboxes\r
 USING: dlists deques threads sequences continuations\r
-destructors namespaces random math quotations words kernel\r
+destructors namespaces math quotations words kernel\r
 arrays assocs init system concurrency.conditions accessors\r
-debugger debugger.threads ;\r
+debugger debugger.threads locals fry ;\r
+IN: concurrency.mailboxes\r
 \r
 TUPLE: mailbox threads data disposed ;\r
 \r
@@ -21,15 +21,14 @@ M: mailbox dispose* threads>> notify-all ;
     [ threads>> notify-all ] bi yield ;\r
 \r
 : wait-for-mailbox ( mailbox timeout -- )\r
-    >r threads>> r> "mailbox" wait ;\r
+    [ threads>> ] dip "mailbox" wait ;\r
 \r
-: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\r
-    pick check-disposed\r
-    pick data>> over dlist-contains? [\r
-        3drop\r
-    ] [\r
-        >r 2dup wait-for-mailbox r> block-unless-pred\r
-    ] if ; inline recursive\r
+:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\r
+    mailbox check-disposed\r
+    mailbox data>> pred dlist-any? [\r
+        mailbox timeout wait-for-mailbox\r
+        mailbox timeout pred block-unless-pred\r
+    ] unless ; inline recursive\r
 \r
 : block-if-empty ( mailbox timeout -- mailbox )\r
     over check-disposed\r
@@ -50,19 +49,20 @@ M: mailbox dispose* threads>> notify-all ;
 \r
 : mailbox-get-all-timeout ( mailbox timeout -- array )\r
     block-if-empty\r
-    [ dup mailbox-empty? ]\r
+    [ dup mailbox-empty? not ]\r
     [ dup data>> pop-back ]\r
-    [ ] produce nip ;\r
+    produce nip ;\r
 \r
 : mailbox-get-all ( mailbox -- array )\r
     f mailbox-get-all-timeout ;\r
 \r
 : while-mailbox-empty ( mailbox quot -- )\r
-    [ [ mailbox-empty? ] curry ] dip [ ] while ; inline\r
+    [ '[ _ mailbox-empty? ] ] dip while ; inline\r
 \r
 : mailbox-get-timeout? ( mailbox timeout pred -- obj )\r
-    3dup block-unless-pred\r
-    nip >r data>> r> delete-node-if ; inline\r
+    [ block-unless-pred ]\r
+    [ [ drop data>> ] dip delete-node-if ]\r
+    3bi ; inline\r
 \r
 : mailbox-get? ( mailbox pred -- obj )\r
     f swap mailbox-get-timeout? ; inline\r
@@ -90,7 +90,7 @@ M: linked-thread error-in-thread
     [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;\r
 \r
 : <linked-thread> ( quot name mailbox -- thread' )\r
-    >r linked-thread new-thread r> >>supervisor ;\r
+    [ linked-thread new-thread ] dip >>supervisor ;\r
 \r
 : spawn-linked-to ( quot name mailbox -- thread )\r
     <linked-thread> [ (spawn) ] keep ;\r