]> gitweb.factorcode.org Git - factor.git/commitdiff
add a .facts file for concurrency
authorchris.double <chris.double@double.co.nz>
Wed, 6 Sep 2006 11:53:41 +0000 (11:53 +0000)
committerchris.double <chris.double@double.co.nz>
Wed, 6 Sep 2006 11:53:41 +0000 (11:53 +0000)
contrib/concurrency/concurrency.factor
contrib/concurrency/concurrency.facts [new file with mode: 0644]
contrib/concurrency/load.factor

index 80a1cf5c826499af4ba57ba4ddf7d375e90a37f3..0ec8cbab0ecabb2befd6adc81867ebbf099623e2 100644 (file)
@@ -1,25 +1,5 @@
 ! Copyright (C) 2005 Chris Double. All Rights Reserved.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+! See http://factorcode.org/license.txt for BSD license.
 !
 ! Concurrency library for Factor based on Erlang/Termite style
 ! concurrency.
@@ -70,30 +50,17 @@ USE:  prettyprint
 TUPLE: mailbox threads data ;
 
 : make-mailbox ( -- mailbox )
-  #! A mailbox is an object that can be used for safe thread
-  #! communication. Items can be put in the mailbox and retrieved in a
-  #! FIFO order. If the mailbox is empty when a get operation is 
-  #! performed then the thread will block until another thread places 
-  #! something in the mailbox. If multiple threads are waiting on the 
-  #! same mailbox, only one of the waiting threads will be unblocked 
-  #! to process the get operation.
   0 <vector> <dlist> <mailbox> ;
 
 : mailbox-empty? ( mailbox -- bool )
-  #! Return true if the mailbox is empty
   mailbox-data dlist-empty? ;
 
 : mailbox-put ( obj mailbox -- )
-  #! Put the object into the mailbox. Any threads that have
-  #! a blocking get on the mailbox are resumed.
   [ mailbox-data dlist-push-end ] keep 
   [ mailbox-threads ] keep 0 <vector> swap set-mailbox-threads
   [ schedule-thread ] each yield ;
 
-: (mailbox-block-unless-pred) ( pred mailbox -- pred mailbox )  
-  #! Block the thread if there are not items in the mailbox
-  #! that return true when the predicate is called with the item
-  #! on the stack. The predicate must have stack effect ( X -- bool ).
+: (mailbox-block-unless-pred) ( pred mailbox -- pred2 mailbox2 )  
   dup mailbox-data pick swap dlist-pred? [
     [
       swap mailbox-threads push stop      
@@ -101,8 +68,7 @@ TUPLE: mailbox threads data ;
     (mailbox-block-unless-pred)
   ] unless ;
 
-: (mailbox-block-if-empty) ( mailbox -- mailbox )  
-  #! Block the thread if the mailbox is empty
+: (mailbox-block-if-empty) ( mailbox -- mailbox2 )  
   dup mailbox-empty? [
     [
       swap mailbox-threads push stop      
@@ -111,15 +77,10 @@ TUPLE: mailbox threads data ;
   ] when ;
   
 : mailbox-get ( mailbox -- obj )
-  #! Get the first item put into the mailbox. If it is
-  #! empty the thread blocks until an item is put into it.
-  #! The thread then resumes, leaving the item on the stack.
   (mailbox-block-if-empty)
   mailbox-data dlist-pop-front ;
 
 : while-mailbox-empty ( mailbox quot -- )
-  #! Run the quotation until there is an item in the mailbox.
-  #! Quotation should have stack effect ( -- ).
   over mailbox-empty? [
     dup >r swap >r call r> r> while-mailbox-empty
   ] [
@@ -127,12 +88,7 @@ TUPLE: mailbox threads data ;
   ] if ; inline
 
 : mailbox-get? ( pred mailbox -- obj )
-  #! Get the first item in the mailbox which satisfies the predicate.
-  #! 'pred' will be called with each item on the stack. When pred returns
-  #! true that item will be returned. If nothing in the mailbox 
-  #! satisfies the predicate then the thread will block until something does.
-  (mailbox-block-unless-pred)
-  mailbox-data dlist-pop? ;
+  (mailbox-block-unless-pred) mailbox-data dlist-pop? ;
 
 #! Processes run on nodes identified by a hostname and port.
 TUPLE: node hostname port ;
diff --git a/contrib/concurrency/concurrency.facts b/contrib/concurrency/concurrency.facts
new file mode 100644 (file)
index 0000000..b897329
--- /dev/null
@@ -0,0 +1,61 @@
+! Copyright (C) 2006 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help concurrency ;
+
+HELP: make-mailbox
+{ $values { "mailbox" "a mailbox object" } 
+}
+{ $description "A mailbox is an object that can be used for safe thread communication. Items can be put in the mailbox and retrieved in a FIFO order. If the mailbox is empty when a get operation is performed then the thread will block until another thread places something in the mailbox. If multiple threads are waiting on the same mailbox, only one of the waiting threads will be unblocked to process the get operation." } 
+{ $see-also mailbox-empty? mailbox-put mailbox-get while-mailbox-empty mailbox-get? } ;
+
+HELP: mailbox-empty?
+{ $values { "mailbox" "a mailbox object" } 
+          { "bool" "a boolean value" }
+}
+{ $description "Return true if the mailbox is empty." } 
+{ $see-also make-mailbox mailbox-put mailbox-get while-mailbox-empty mailbox-get? } ;
+
+HELP: mailbox-put
+{ $values { "obj" "an object" } 
+          { "mailbox" "a mailbox object" } 
+}
+{ $description "Put the object into the mailbox. Any threads that have a blocking get on the mailbox are resumed. Only one of those threads will successfully get the object, the rest will immediately block waiting for the next item in the mailbox." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-get while-mailbox-empty mailbox-get? } ;
+
+HELP: (mailbox-block-unless-pred)
+{ $values { "pred" "a quotation with stack effect " { $snippet "( X -- bool )" } } 
+          { "mailbox" "a mailbox object" } 
+         { "pred2" "same object as 'pred'" }
+         { "mailbox2" "same object as 'mailbox'" }
+}
+{ $description "Block the thread if there are no items in the mailbox that return true when the predicate is called with the item on the stack. The predicate must have stack effect " { $snippet "( X -- bool )" } "." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get while-mailbox-empty mailbox-get? } ;
+
+HELP: (mailbox-block-if-empty)
+{ $values { "mailbox" "a mailbox object" } 
+         { "mailbox2" "same object as 'mailbox'" }
+}
+{ $description "Block the thread if the mailbox is empty." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get while-mailbox-empty mailbox-get? } ;
+
+HELP: mailbox-get
+{ $values { "mailbox" "a mailbox object" } 
+         { "object" "an object" }
+}
+{ $description "Get the first item put into the mailbox. If it is empty the thread blocks until an item is put into it. The thread then resumes, leaving the item on the stack." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-put while-mailbox-empty mailbox-get? } ;
+
+HELP: while-mailbox-empty
+{ $values { "mailbox" "a mailbox object" } 
+         { "quot" "a quotation with stack effect " { $snippet "( -- )" } }
+}
+{ $description "Repeatedly call the quotation while there are no items in the mailbox. Quotation should have stack effect " { $snippet "( -- )" } "." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get mailbox-get? } ;
+
+HELP: mailbox-get?
+{ $values { "pred" "a quotation with stack effect " { $snippet "( X -- bool )" } }
+          { "mailbox" "a mailbox object" } 
+         { "obj" "an object" }
+}
+{ $description "Get the first item in the mailbox which satisfies the predicate. 'pred' will be called repeatedly for each item in the mailbox. When 'pred' returns true that item will be returned. If nothing in the mailbox satisfies the predicate then the thread will block until something does. 'pred' must have stack effect " { $snippet "( X -- bool }" } "." } 
+{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get while-mailbox-empty } ;
index 618499218899b8ee9c5d2589ac535b814646009c..ef79f37945bc166cd3700d2155ad7ef7b9d0900c 100644 (file)
@@ -1,5 +1,5 @@
-REQUIRES: contrib/dlists contrib/serialize contrib/match ;
+REQUIRES: dlists serialize match ;
 
-PROVIDE: contrib/concurrency
+PROVIDE: concurrency
 { "concurrency.factor" }
 { "concurrency-examples.factor" "concurrency-tests.factor" } ;