]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/concurrency/messaging/messaging.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / basis / concurrency / messaging / messaging.factor
index c5140e7506029823e0db168241e4b1e488531e73..dc3e810871157f0418abb05c11b33edd4b38529a 100644 (file)
@@ -1,72 +1,72 @@
-! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel kernel.private threads concurrency.mailboxes\r
-continuations namespaces assocs accessors summary fry ;\r
-IN: concurrency.messaging\r
-\r
-GENERIC: send ( message thread -- )\r
-\r
-GENERIC: mailbox-of ( thread -- mailbox )\r
-\r
-M: thread mailbox-of\r
-    dup mailbox>>\r
-    [ { mailbox } declare ]\r
-    [ <mailbox> [ >>mailbox drop ] keep ] ?if ; inline\r
-\r
-M: thread send ( message thread -- )\r
-    mailbox-of mailbox-put ;\r
-\r
-: my-mailbox ( -- mailbox ) self mailbox-of ; inline\r
-\r
-: receive ( -- message )\r
-    my-mailbox mailbox-get ?linked ;\r
-\r
-: receive-timeout ( timeout -- message )\r
-    [ my-mailbox ] dip mailbox-get-timeout ?linked ;\r
-\r
-: receive-if ( pred -- message )\r
-    [ my-mailbox ] dip mailbox-get? ?linked ; inline\r
-\r
-: receive-if-timeout ( timeout pred -- message )\r
-    [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline\r
-\r
-: rethrow-linked ( error process supervisor -- )\r
-    [ <linked-error> ] dip send ;\r
-\r
-: spawn-linked ( quot name -- thread )\r
-    my-mailbox spawn-linked-to ;\r
-\r
-TUPLE: synchronous data sender tag ;\r
-\r
-: <synchronous> ( data -- sync )\r
-    self synchronous counter synchronous boa ;\r
-\r
-TUPLE: reply data tag ;\r
-\r
-: <reply> ( data synchronous -- reply )\r
-    tag>> \ reply boa ;\r
-\r
-: synchronous-reply? ( response synchronous -- ? )\r
-    over reply? [ [ tag>> ] same? ] [ 2drop f ] if ;\r
-\r
-ERROR: cannot-send-synchronous-to-self message thread ;\r
-\r
-M: cannot-send-synchronous-to-self summary\r
-    drop "Cannot synchronous send to myself" ;\r
-\r
-: send-synchronous ( message thread -- reply )\r
-    dup self eq? [\r
-        cannot-send-synchronous-to-self\r
-    ] [\r
-        [ <synchronous> dup ] dip send\r
-        '[ _ synchronous-reply? ] receive-if\r
-        data>>\r
-    ] if ;\r
-\r
-: reply-synchronous ( message synchronous -- )\r
-    [ <reply> ] keep sender>> send ;\r
-\r
-: handle-synchronous ( quot -- )\r
-    receive [\r
-        data>> swap call\r
-    ] keep reply-synchronous ; inline\r
+! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel kernel.private threads concurrency.mailboxes
+continuations namespaces assocs accessors summary fry ;
+IN: concurrency.messaging
+
+GENERIC: send ( message thread -- )
+
+GENERIC: mailbox-of ( thread -- mailbox )
+
+M: thread mailbox-of
+    dup mailbox>>
+    [ { mailbox } declare ]
+    [ <mailbox> [ >>mailbox drop ] keep ] ?if ; inline
+
+M: thread send ( message thread -- )
+    mailbox-of mailbox-put ;
+
+: my-mailbox ( -- mailbox ) self mailbox-of ; inline
+
+: receive ( -- message )
+    my-mailbox mailbox-get ?linked ;
+
+: receive-timeout ( timeout -- message )
+    [ my-mailbox ] dip mailbox-get-timeout ?linked ;
+
+: receive-if ( pred -- message )
+    [ my-mailbox ] dip mailbox-get? ?linked ; inline
+
+: receive-if-timeout ( timeout pred -- message )
+    [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline
+
+: rethrow-linked ( error process supervisor -- )
+    [ <linked-error> ] dip send ;
+
+: spawn-linked ( quot name -- thread )
+    my-mailbox spawn-linked-to ;
+
+TUPLE: synchronous data sender tag ;
+
+: <synchronous> ( data -- sync )
+    self synchronous counter synchronous boa ;
+
+TUPLE: reply data tag ;
+
+: <reply> ( data synchronous -- reply )
+    tag>> \ reply boa ;
+
+: synchronous-reply? ( response synchronous -- ? )
+    over reply? [ [ tag>> ] same? ] [ 2drop f ] if ;
+
+ERROR: cannot-send-synchronous-to-self message thread ;
+
+M: cannot-send-synchronous-to-self summary
+    drop "Cannot synchronous send to myself" ;
+
+: send-synchronous ( message thread -- reply )
+    dup self eq? [
+        cannot-send-synchronous-to-self
+    ] [
+        [ <synchronous> dup ] dip send
+        '[ _ synchronous-reply? ] receive-if
+        data>>
+    ] if ;
+
+: reply-synchronous ( message synchronous -- )
+    [ <reply> ] keep sender>> send ;
+
+: handle-synchronous ( quot -- )
+    receive [
+        data>> swap call
+    ] keep reply-synchronous ; inline