| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: dlists kernel math concurrency.promises | 
					
						
							| 
									
										
										
										
											2008-11-30 19:28:15 -05:00
										 |  |  | concurrency.mailboxes debugger accessors fry ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | IN: concurrency.count-downs | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! http://java.sun.com/j2se/1.5.0/docs/api/java/util/concurrent/CountDownLatch.html | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: count-down n promise ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 |  |  | : count-down-check ( count-down -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-06 22:23:07 -04:00
										 |  |  |     dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  | ERROR: invalid-count-down-count count ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | : <count-down> ( n -- count-down )
 | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  |     dup 0 < [ invalid-count-down-count ] when
 | 
					
						
							| 
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 |  |  |     <promise> \ count-down boa
 | 
					
						
							| 
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 |  |  |     dup count-down-check ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  | ERROR: count-down-already-done ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | : count-down ( count-down -- )
 | 
					
						
							| 
									
										
										
										
											2008-05-06 22:23:07 -04:00
										 |  |  |     dup n>> dup zero?
 | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  |     [ count-down-already-done ] | 
					
						
							| 
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 |  |  |     [ 1 - >>n count-down-check ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : await-timeout ( count-down timeout -- )
 | 
					
						
							| 
									
										
										
										
											2008-11-30 19:28:15 -05:00
										 |  |  |     [ promise>> ] dip ?promise-timeout ?linked t assert= ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 10:08:59 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : await ( count-down -- )
 | 
					
						
							|  |  |  |     f await-timeout ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : spawn-stage ( quot count-down -- )
 | 
					
						
							| 
									
										
										
										
											2008-11-30 19:28:15 -05:00
										 |  |  |     [ '[ @ _ count-down ] ] keep
 | 
					
						
							| 
									
										
										
										
											2008-02-18 17:20:18 -05:00
										 |  |  |     "Count down stage" | 
					
						
							| 
									
										
										
										
											2008-05-06 22:23:07 -04:00
										 |  |  |     swap promise>> mailbox>> spawn-linked-to drop ;
 |