| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! Copyright (C) 2007 Chris Double. All Rights Reserved. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | !
 | 
					
						
							|  |  |  | ! Examples of using channels | 
					
						
							| 
									
										
										
										
											2008-02-18 08:30:16 -05:00
										 |  |  | USING: kernel threads channels math namespaces | 
					
						
							|  |  |  | locals sequences ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | IN: channels.examples | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : (counter) ( channel n -- )
 | 
					
						
							| 
									
										
										
										
											2009-08-13 20:21:44 -04:00
										 |  |  |     [ swap to ] 2keep 1 + (counter) ;
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : counter ( channel -- )
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  |     2 (counter) ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : counter-test ( -- n1 n2 n3 )
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  |     <channel> dup [ counter ] curry "Counter" spawn drop
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     [ from ] keep [ from ] keep from ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : filter ( send prime recv -- )
 | 
					
						
							| 
									
										
										
										
											2015-09-08 19:15:10 -04:00
										 |  |  |     ! Receives numbers from the 'send' channel, | 
					
						
							|  |  |  |     ! filters out all those divisible by 'prime', | 
					
						
							|  |  |  |     ! and sends to the 'recv' channel. | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     [ | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  |         from swap dupd mod zero? not [ swap to ] [ 2drop ] if
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     ] 3keep filter ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-02-26 19:40:32 -05:00
										 |  |  | :: (sieve) ( prime c -- )
 | 
					
						
							| 
									
										
										
										
											2009-10-27 22:50:31 -04:00
										 |  |  |     c from :> p | 
					
						
							|  |  |  |     <channel> :> newc | 
					
						
							|  |  |  |     p prime to | 
					
						
							|  |  |  |     [ newc p c filter ] "Filter" spawn drop
 | 
					
						
							|  |  |  |     prime newc (sieve) ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | : sieve ( prime -- )
 | 
					
						
							| 
									
										
										
										
											2015-09-08 19:15:10 -04:00
										 |  |  |     ! Send prime numbers to 'prime' channel | 
					
						
							| 
									
										
										
										
											2008-02-18 08:30:16 -05:00
										 |  |  |     <channel> dup [ counter ] curry "Counter" spawn drop
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     (sieve) ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : sieve-test ( -- seq )
 | 
					
						
							| 
									
										
										
										
											2008-02-18 08:30:16 -05:00
										 |  |  |     <channel> dup [ sieve ] curry "Sieve" spawn drop
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  |     V{ } clone swap
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     [ from swap push ] 2keep
 | 
					
						
							|  |  |  |     drop ;
 |