| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-08-29 17:18:09 -04:00
										 |  |  | USING: accessors concurrency.mailboxes kernel continuations ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | IN: concurrency.promises | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: promise mailbox ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <promise> ( -- promise )
 | 
					
						
							| 
									
										
										
										
											2008-04-13 16:06:27 -04:00
										 |  |  |     <mailbox> promise boa ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : promise-fulfilled? ( promise -- ? )
 | 
					
						
							| 
									
										
										
										
											2008-08-29 17:18:09 -04:00
										 |  |  |     mailbox>> mailbox-empty? not ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  | ERROR: promise-already-fulfilled promise ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | : fulfill ( value promise -- )
 | 
					
						
							|  |  |  |     dup promise-fulfilled? [  | 
					
						
							| 
									
										
										
										
											2008-09-15 11:30:06 -04:00
										 |  |  |         promise-already-fulfilled | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  |     ] [ | 
					
						
							| 
									
										
										
										
											2008-08-29 17:18:09 -04:00
										 |  |  |         mailbox>> mailbox-put | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  |     ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : ?promise-timeout ( promise timeout -- result )
 | 
					
						
							| 
									
										
										
										
											2008-11-30 19:28:15 -05:00
										 |  |  |     [ mailbox>> ] dip block-if-empty mailbox-peek ;
 | 
					
						
							| 
									
										
										
										
											2008-02-18 06:07:40 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : ?promise ( promise -- result )
 | 
					
						
							|  |  |  |     f ?promise-timeout ;
 |