Merge up

diff --git a/basis/concurrency/mailboxes/mailboxes-tests.factor b/basis/concurrency/mailboxes/mailboxes-tests.factor
index 3435a0145580541124074424c63601eabeaf25fb..87a4c3cdba7d87a96ae9969fcad166c8204a8961 100644 (file)
--- a/basis/concurrency/mailboxes/mailboxes-tests.factor
+++ b/basis/concurrency/mailboxes/mailboxes-tests.factor
@@ -1,54 +1,54 @@
-USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions\r
-vectors sequences threads tools.test math kernel strings namespaces\r
-continuations calendar destructors ;\r
-IN: concurrency.mailboxes.tests\r
-\r
-{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as\r
-\r
-[ V{ 1 2 3 } ] [\r
-    0 <vector>\r
-    <mailbox>\r
-    [ mailbox-get swap push ] in-thread\r
-    [ mailbox-get swap push ] in-thread\r
-    [ mailbox-get swap push ] in-thread\r
-    1 over mailbox-put\r
-    2 over mailbox-put\r
-    3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 2 3 } ] [\r
-    0 <vector>\r
-    <mailbox>\r
-    [ [ integer? ] mailbox-get? swap push ] in-thread\r
-    [ [ integer? ] mailbox-get? swap push ] in-thread\r
-    [ [ integer? ] mailbox-get? swap push ] in-thread\r
-    1 over mailbox-put\r
-    2 over mailbox-put\r
-    3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [\r
-    0 <vector>\r
-    <mailbox>\r
-    [ [ integer? ] mailbox-get? swap push ] in-thread\r
-    [ [ integer? ] mailbox-get? swap push ] in-thread\r
-    [ [ string? ] mailbox-get? swap push ] in-thread\r
-    [ [ string? ] mailbox-get? swap push ] in-thread\r
-    1 over mailbox-put\r
-    "junk" over mailbox-put\r
-    [ 456 ] over mailbox-put\r
-    3 over mailbox-put\r
-    "junk2" over mailbox-put\r
-    mailbox-get\r
-] unit-test\r
-\r
-[ { "foo" "bar" } ] [\r
-    <mailbox>\r
-    "foo" over mailbox-put\r
-    "bar" over mailbox-put\r
-    mailbox-get-all\r
-] unit-test\r
-\r
-[\r
-    <mailbox> 1 seconds mailbox-get-timeout\r
-] [ wait-timeout? ] must-fail-with\r
+USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
+vectors sequences threads tools.test math kernel strings namespaces
+continuations calendar destructors ;
+IN: concurrency.mailboxes.tests
+
+{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
+
+[ V{ 1 2 3 } ] [
+    0 <vector>
+    <mailbox>
+    [ mailbox-get swap push ] in-thread
+    [ mailbox-get swap push ] in-thread
+    [ mailbox-get swap push ] in-thread
+    1 over mailbox-put
+    2 over mailbox-put
+    3 swap mailbox-put
+] unit-test
+
+[ V{ 1 2 3 } ] [
+    0 <vector>
+    <mailbox>
+    [ [ integer? ] mailbox-get? swap push ] in-thread
+    [ [ integer? ] mailbox-get? swap push ] in-thread
+    [ [ integer? ] mailbox-get? swap push ] in-thread
+    1 over mailbox-put
+    2 over mailbox-put
+    3 swap mailbox-put
+] unit-test
+
+[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
+    0 <vector>
+    <mailbox>
+    [ [ integer? ] mailbox-get? swap push ] in-thread
+    [ [ integer? ] mailbox-get? swap push ] in-thread
+    [ [ string? ] mailbox-get? swap push ] in-thread
+    [ [ string? ] mailbox-get? swap push ] in-thread
+    1 over mailbox-put
+    "junk" over mailbox-put
+    [ 456 ] over mailbox-put
+    3 over mailbox-put
+    "junk2" over mailbox-put
+    mailbox-get
+] unit-test
+
+[ { "foo" "bar" } ] [
+    <mailbox>
+    "foo" over mailbox-put
+    "bar" over mailbox-put
+    mailbox-get-all
+] unit-test
+
+[
+    <mailbox> 1 seconds mailbox-get-timeout
+] [ wait-timeout? ] must-fail-with

diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index 06da3b34a6161afd57946a8f84f691cd3de682fd..221a5a1fa3457c741d34916826563153e9b47285 100644 (file)
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -1,94 +1,94 @@
-! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: dlists deques threads sequences continuations namespaces\r
-math quotations words kernel arrays assocs init system\r
-concurrency.conditions accessors debugger debugger.threads\r
-locals fry ;\r
-IN: concurrency.mailboxes\r
-\r
-TUPLE: mailbox threads data ;\r
-\r
-: <mailbox> ( -- mailbox )\r
-    mailbox new\r
-        <dlist> >>threads\r
-        <dlist> >>data ;\r
-\r
-: mailbox-empty? ( mailbox -- bool )\r
-    data>> deque-empty? ;\r
-\r
-: mailbox-put ( obj mailbox -- )\r
-    [ data>> push-front ]\r
-    [ threads>> notify-all ] bi yield ;\r
-\r
-: wait-for-mailbox ( mailbox timeout -- )\r
-    [ threads>> ] dip "mailbox" wait ;\r
-\r
-:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\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 mailbox-empty? [\r
-        2dup wait-for-mailbox block-if-empty\r
-    ] [\r
-        drop\r
-    ] if ;\r
-\r
-: mailbox-peek ( mailbox -- obj )\r
-    data>> peek-back ;\r
-\r
-: mailbox-get-timeout ( mailbox timeout -- obj )\r
-    block-if-empty data>> pop-back ;\r
-\r
-: mailbox-get ( mailbox -- obj )\r
-    f mailbox-get-timeout ;\r
-\r
-: mailbox-get-all-timeout ( mailbox timeout -- array )\r
-    block-if-empty\r
-    [ dup mailbox-empty? not ]\r
-    [ dup data>> pop-back ]\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? ] ] dip while ; inline\r
-\r
-: mailbox-get-timeout? ( mailbox timeout pred -- obj )\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
-\r
-: wait-for-close-timeout ( mailbox timeout -- )\r
-    over disposed>>\r
-    [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;\r
-\r
-: wait-for-close ( mailbox -- )\r
-    f wait-for-close-timeout ;\r
-\r
-TUPLE: linked-error error thread ;\r
-\r
-M: linked-error error.\r
-    [ thread>> error-in-thread. ] [ error>> error. ] bi ;\r
-\r
-C: <linked-error> linked-error\r
-\r
-: ?linked ( message -- message )\r
-    dup linked-error? [ rethrow ] when ;\r
-\r
-TUPLE: linked-thread < thread supervisor ;\r
-\r
-M: linked-thread error-in-thread\r
-    [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;\r
-\r
-: <linked-thread> ( quot name mailbox -- thread' )\r
-    [ linked-thread new-thread ] dip >>supervisor ;\r
-\r
-: spawn-linked-to ( quot name mailbox -- thread )\r
-    <linked-thread> [ (spawn) ] keep ;\r
+! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: dlists deques threads sequences continuations namespaces
+math quotations words kernel arrays assocs init system
+concurrency.conditions accessors debugger debugger.threads
+locals fry ;
+IN: concurrency.mailboxes
+
+TUPLE: mailbox threads data ;
+
+: <mailbox> ( -- mailbox )
+    mailbox new
+        <dlist> >>threads
+        <dlist> >>data ;
+
+: mailbox-empty? ( mailbox -- bool )
+    data>> deque-empty? ;
+
+: mailbox-put ( obj mailbox -- )
+    [ data>> push-front ]
+    [ threads>> notify-all ] bi yield ;
+
+: wait-for-mailbox ( mailbox timeout -- )
+    [ threads>> ] dip "mailbox" wait ;
+
+:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
+    mailbox data>> pred dlist-any? [
+        mailbox timeout wait-for-mailbox
+        mailbox timeout pred block-unless-pred
+    ] unless ; inline recursive
+
+: block-if-empty ( mailbox timeout -- mailbox )
+    over mailbox-empty? [
+        2dup wait-for-mailbox block-if-empty
+    ] [
+        drop
+    ] if ;
+
+: mailbox-peek ( mailbox -- obj )
+    data>> peek-back ;
+
+: mailbox-get-timeout ( mailbox timeout -- obj )
+    block-if-empty data>> pop-back ;
+
+: mailbox-get ( mailbox -- obj )
+    f mailbox-get-timeout ;
+
+: mailbox-get-all-timeout ( mailbox timeout -- array )
+    block-if-empty
+    [ dup mailbox-empty? not ]
+    [ dup data>> pop-back ]
+    produce nip ;
+
+: mailbox-get-all ( mailbox -- array )
+    f mailbox-get-all-timeout ;
+
+: while-mailbox-empty ( mailbox quot -- )
+    [ '[ _ mailbox-empty? ] ] dip while ; inline
+
+: mailbox-get-timeout? ( mailbox timeout pred -- obj )
+    [ block-unless-pred ]
+    [ [ drop data>> ] dip delete-node-if ]
+    3bi ; inline
+
+: mailbox-get? ( mailbox pred -- obj )
+    f swap mailbox-get-timeout? ; inline
+
+: wait-for-close-timeout ( mailbox timeout -- )
+    over disposed>>
+    [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
+
+: wait-for-close ( mailbox -- )
+    f wait-for-close-timeout ;
+
+TUPLE: linked-error error thread ;
+
+M: linked-error error.
+    [ thread>> error-in-thread. ] [ error>> error. ] bi ;
+
+C: <linked-error> linked-error
+
+: ?linked ( message -- message )
+    dup linked-error? [ rethrow ] when ;
+
+TUPLE: linked-thread < thread supervisor ;
+
+M: linked-thread error-in-thread
+    [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
+
+: <linked-thread> ( quot name mailbox -- thread' )
+    [ linked-thread new-thread ] dip >>supervisor ;
+
+: spawn-linked-to ( quot name mailbox -- thread )
+    <linked-thread> [ (spawn) ] keep ;

diff --git a/basis/concurrency/promises/promises.factor b/basis/concurrency/promises/promises.factor
index 3381bcc00ba97ad392d4b651b013d63deb3644c3..4d6439cf30a356114701e5ae991a4b1065e67b4c 100644 (file)
--- a/basis/concurrency/promises/promises.factor
+++ b/basis/concurrency/promises/promises.factor
@@ -1,27 +1,27 @@
-! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors concurrency.mailboxes kernel continuations ;\r
-IN: concurrency.promises\r
-\r
-TUPLE: promise mailbox ;\r
-\r
-: <promise> ( -- promise )\r
-    <mailbox> promise boa ;\r
-\r
-: promise-fulfilled? ( promise -- ? )\r
-    mailbox>> mailbox-empty? not ;\r
-\r
-ERROR: promise-already-fulfilled promise ;\r
-\r
-: fulfill ( value promise -- )\r
-    dup promise-fulfilled? [ \r
-        promise-already-fulfilled\r
-    ] [\r
-        mailbox>> mailbox-put\r
-    ] if ;\r
-\r
-: ?promise-timeout ( promise timeout -- result )\r
-    [ mailbox>> ] dip block-if-empty mailbox-peek ;\r
-\r
-: ?promise ( promise -- result )\r
-    f ?promise-timeout ;\r
+! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors concurrency.mailboxes kernel continuations ;
+IN: concurrency.promises
+
+TUPLE: promise mailbox ;
+
+: <promise> ( -- promise )
+    <mailbox> promise boa ;
+
+: promise-fulfilled? ( promise -- ? )
+    mailbox>> mailbox-empty? not ;
+
+ERROR: promise-already-fulfilled promise ;
+
+: fulfill ( value promise -- )
+    dup promise-fulfilled? [ 
+        promise-already-fulfilled
+    ] [
+        mailbox>> mailbox-put
+    ] if ;
+
+: ?promise-timeout ( promise timeout -- result )
+    [ mailbox>> ] dip block-if-empty mailbox-peek ;
+
+: ?promise ( promise -- result )
+    f ?promise-timeout ;