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
old mode 100644 (file)
new mode 100755 (executable)
index 39b21e0..4192776
--- 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 math quotations words kernel\r
 arrays assocs init system concurrency.conditions accessors\r
-debugger debugger.threads locals ;\r
+debugger debugger.threads locals fry ;\r
+IN: concurrency.mailboxes\r
 \r
 TUPLE: mailbox threads data disposed ;\r
 \r
@@ -21,11 +21,11 @@ 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
     mailbox check-disposed\r
-    mailbox data>> pred dlist-contains? [\r
+    mailbox data>> pred dlist-any? [\r
         mailbox timeout wait-for-mailbox\r
         mailbox timeout pred block-unless-pred\r
     ] unless ; inline recursive\r
@@ -49,19 +49,19 @@ 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
     [ block-unless-pred ]\r
-    [ nip >r data>> r> delete-node-if ]\r
+    [ [ drop data>> ] dip delete-node-if ]\r
     3bi ; inline\r
 \r
 : mailbox-get? ( mailbox pred -- obj )\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