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 ;
|