Paste: ftest
Author: | flice |
Mode: | factor |
Date: | Tue, 25 Nov 2008 01:52:36 |
Plain Text |
USING: io io.files io.timeouts io.launcher concurrency.messaging threads printf random kernel continuations calendar prettyprint math math.ranges math.functions locals io.encodings.ascii ;
IN: ftest
DEFER: generate
DEFER: 2exec>files
: read-loop
readln dup
[
over f send
write nl
read-loop
] [
drop t send
] if
;
: enter-read-loop
<file-writer> [
[ dup read-loop ] with-streams
] ignore-errors
t swap send ;
: enter-generate
dup [ generate ] ignore-errors
t send ;
: w-control-loop
receive [
stop
t send
] [
dup resume
w-control-loop
] if ;
: enter-write-loop
receive [
self -rot [ enter-generate ] 3curry "generator" spawn
w-control-loop
] unless ;
: controller-loop
: wait
[
100 milliseconds receive-timeout
[ wait ] unless
]
;
[ wait t ] [ drop f ] recover
[ dup f send
controller-loop ] unless
;
: read-commands
"cmds" ascii file-lines dup first swap second ;
: similar?
[ "diff %s %s" sprintf try-process t ] [ f ] recover ;
: pass
3dup 0 = [ 2drop ] [
2exec>files similar? [ 1 - pass ] when
] if ;
: main
"hello" .
read-commands 100 pass ;
: start-reader
self -rot [ enter-read-loop ] 3curry spawn ;
: out-file-names
1 2 [ "/tmp/diffproc/%d" sprintf ] 2bi@ ;
: start-readers
out-file-names swapd [ start-reader ] 2bi@ ;
: create-threads
[ ascii <process-stream> ] bi@ 2dup
[ enter-write-loop ] "w-control" spawn
-rot start-readers rot
;
: await-termination
receive receive 2drop ;
: terminate-threads
[ t send ] tri@ await-termination ;
: 2exec>files
create-threads
dup controller-loop
terminate-threads
;
: random-int 4096 random 2048 - ;
: random-real 0.0 4096.0 [a,b] random 2048 - ;
: floor1 10 * floor 10 / ;
: pb
pick swap [ write nl ] bi@
suspend ;
:: pbl
[| val | val out1 out2 pb ] ;
: interact-mort
2dup pbl
:: three
lambda [ random-int swap keep ] bi@
2dup [ 0 <= ] bi@ or [
2dup [ 0 <= ] bi@ and [
2drop lambda three
] [
random-real lambda keep
0 <= -rot [ 0 <= ] bi@ and or [ lambda three ] when
] if
] when
2drop
;
: interact-menu-mort
10 random swap keep
dup 1 >= swap 8 < and
[ interact-menu-mort ] [ "AFTER_MORT" . ] if
;
random-real swap keep
0 <= [ interact-mort ] [ three interact-menu-mort ] if
;
: interact-invest
pbl
:: outval
quot call lambda keep
0 <= [ lambda outval ] when ;
dup [ random-int ] [ outval ] 2bi@
[ random-real ] outval
:: interact-menu-invest
9 random swap keep
dup 1 >= swap 7 < and
[ lambda interact-menu-invest ] [ "AFTER INVEST" . ] if
interact-menu-invest
;
: generate
2dup pbl
5 random 1 - swap keep
dup dup dup 0 <= swap 2 > or [
drop generate
] [
1 = [ interact-mort ] [ interact-invest ] if
]
;
MAIN: main ;
Author: | flice |
Mode: | factor |
Date: | Tue, 25 Nov 2008 02:51:35 |
Plain Text |
USING: io io.files io.timeouts io.launcher concurrency.messaging threads printf random kernel continuations calendar prettyprint math math.ranges math.functions locals io.encodings.ascii sequences ;
IN: ftest
DEFER: generate
DEFER: 2exec>files
: read-loop
readln dup
[
over f send
write nl
read-loop
] [
drop t send
] if
;
: enter-read-loop
<file-writer> [
[ dup read-loop ] with-streams
] ignore-errors
t swap send ;
: enter-generate
dup [ generate ] ignore-errors
t send ;
: w-control-loop
receive [
stop
t send
] [
dup resume
w-control-loop
] if ;
: enter-write-loop
receive [
self -rot [ enter-generate ] 3curry "generator" spawn
w-control-loop
] unless ;
: wait
100 milliseconds receive-timeout
[ wait ] unless
;
: controller-loop
[ wait t ] [ drop f ] recover
[ f over send
controller-loop ] unless
;
: read-commands
"cmds" ascii file-lines dup first swap second ;
: similar?
[ "diff %s %s" sprintf try-process t ] [ f ] recover ;
: pass
3dup 0 = [ 2drop ] [
2exec>files similar? [ 1 - pass ] when
] if ;
: main
"hello" .
read-commands 100 pass ;
: start-reader
self -rot [ enter-read-loop ] 3curry "reader" spawn ;
: out-file-names
1 2 [ "/tmp/diffproc/%d" sprintf ] bi@ ;
: start-readers
out-file-names swapd [ start-reader ] 2bi@ ;
: open-proc-streams
[ ascii <process-stream> ] bi@ ;
: create-threads
open-proc-streams
2dup [ enter-write-loop ] 2curry "w-control" spawn
-rot start-readers rot
;
: await-termination
receive receive 2drop ;
: terminate-threads
[ t send ] tri@ await-termination ;
: 2exec>files
create-threads
dup controller-loop
terminate-threads
;
: random-int 4096 random 2048 - ;
: random-real 0.0 4096.0 [a,b] random 2048 - ;
: floor1 10 * floor 10 / ;
: pb
pick swap [ write nl ] bi@
suspend ;
:: pbl
[| val | val out1 out2 pb ] ;
: interact-mort
2dup pbl
:: three
lambda [ random-int swap keep ] bi@
2dup [ 0 <= ] bi@ or [
2dup [ 0 <= ] bi@ and [
2drop lambda three
] [
random-real lambda keep
0 <= -rot [ 0 <= ] bi@ and or [ lambda three ] when
] if
] when
2drop
;
: interact-menu-mort
10 random swap keep
dup 1 >= swap 8 < and
[ interact-menu-mort ] [ "AFTER_MORT" . ] if
;
random-real swap keep
0 <= [ interact-mort ] [ three interact-menu-mort ] if
;
: interact-invest
pbl
:: outval
quot call lambda keep
0 <= [ lambda outval ] when ;
dup [ random-int ] [ outval ] 2bi@
[ random-real ] outval
:: interact-menu-invest
9 random swap keep
dup 1 >= swap 7 < and
[ lambda interact-menu-invest ] [ "AFTER INVEST" . ] if ;
interact-menu-invest
;
: generate
2dup pbl
5 random 1 - swap keep
dup dup dup 0 <= swap 2 > or [
drop generate
] [
1 = [ interact-mort ] [ interact-invest ] if
]
;
MAIN: main
New Annotation