Paste: pipes
Author: | flice |
Mode: | factor |
Date: | Fri, 28 Nov 2008 19:39:58 |
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 shuffle parser debugger math.parser namespaces ;
IN: ftest
DEFER: generate
DEFER: 2exec>files
SYMBOL: default-stdout inline
: .
[
default-stdout get-global
output-stream set
pprint nl flush
] with-scope ;
: send-noerr
"send-noerr" .
[ send ] [ 3drop ] recover ;
: read-loop
"read-loop" .
readln dup
[
over f send-noerr
write nl
read-loop
] [
drop t send-noerr
] if
;
: enter-read-loop
"enter-read-loop" .
ascii <file-writer> "after file-writer" .
[
[ dup read-loop ] with-streams
] [ print-error B 2drop "enter-read-loop - err handler" . ] recover
t swap send-noerr ;
: enter-generate
"enter-generate" .
[ generate ] [ print-error 2drop ] recover
t send-noerr ;
: w-control-loop
"w-control-loop" .
receive "w-control-loop received" . [
"preparing to stop w-c-l" .
stop
t send-noerr
] [
"w-c-l resume" .
dup [ resume w-control-loop ]
[ 2drop t send-noerr ] recover
] if ;
: enter-write-loop
"enter-write-loop" .
receive [
self -rot [ enter-generate ] 3curry "ftest-generator" spawn
w-control-loop
"done w-control-loop" .
] unless ;
: wait
100 milliseconds receive-timeout
[ wait ] unless
;
: controller-loop
[ wait t "controller-loop finished" . ] [ drop f ] recover
[ drop ]
[ f over send-noerr
controller-loop ] if
;
: read-commands
"read-commands" .
"cmds" ascii file-lines dup first swap second ;
: similar?
"similar?" .
[ "diff %s %s" sprintf try-process t ] 2curry [ drop f ] recover ;
: pass
"pass" .
3dup 0 = [ 4drop drop ] [
2exec>files similar?
[ 1 - pass ] [ 3drop ] if
] if ;
: main
output-stream get default-stdout set-global
[ read-commands 100 pass ] "main" spawn drop ;
: start-reader
"start-reader" .
self -rot [ enter-read-loop ] 3curry "reader" spawn ;
: out-file-names
"out-file-names" .
1 2 [ "/tmp/diffproc/%d" sprintf ] bi@ ;
: start-readers
"start-readers" .
out-file-names swapd [ start-reader ] 2bi@ ;
DEFER: pb
: open-proc-streams
"open-proc-streams" .
ascii <process-stream>
swap ascii <process-stream>
dup dup "12" swap stream-write stream-nl stream-flush B
dup dup "12" swap stream-write stream-nl stream-flush
;
: create-threads
"create-threads" .
open-proc-streams
2dup [ enter-write-loop ] 2curry "w-control" spawn
-rot start-readers rot
;
: await-termination
"await-termination" .
receive receive 2drop ;
: terminate-threads
"terminate-threads" .
[ t send-noerr ] tri@ await-termination ;
: 2exec>files
"2exec>files" .
create-threads "created threads" .
dup controller-loop "done controller loop" .
terminate-threads "terminating threads" .
out-file-names
;
: random-int 4096 random 2048 - ;
: random-real 0.0 4096.0 [a,b] random 2048 - ;
: floor1 10 * floor 10 / ;
: pb
"pb" .
rot number>string -rot
pick swap [ tuck stream-write dup stream-nl stream-flush ] 2bi@
"generator suspending" .
[ drop ] "suspending" suspend drop ;
:: pbl
"pbl" .
[| val | val out1 out2 pb ] ;
:: three
"three" .
lambda [ random-int swap keep ] dup bi
"three-ifs" .
2dup [ 0 <= ] bi@ or [
2dup [ 0 <= ] bi@ and [
2drop lambda three
] [
random-real lambda keep
2nip 0 <= [ lambda three ] when
] if
] [
2drop
] if
;
: interact-menu-mort
"interact-menu-mort" .
dup 10 random swap keep
dup 1 >= swap 8 < and
[ interact-menu-mort ] [ drop "POST_MORTEM" . ] if
;
: interact-mort
"interact-mort" .
dup random-real swap keep
"print 1 done" .
0 <= [ interact-mort ] [ dup three interact-menu-mort ] if
;
:: outval
"outval" .
quot call lambda keep
"outval after keep" .
0 <= [ lambda quot outval ] when ;
:: interact-menu-invest
"interact-menu-invest" .
9 random lambda keep
dup 1 >= swap 7 < and
[ lambda interact-menu-invest ] [ "AFTER INVEST" . ] if ;
: interact-invest
"interact-invest" .
dup [ random-int ] [ outval ] dup 2bi
dup [ random-real ] outval
interact-menu-invest
;
DEFER: generate2
DEFER: gen1
DEFER: gen2
DEFER: gen3
: generate
"generate" .
2dup pbl
gen1 ;
: gen1
5 random 1 -
gen2 ;
: gen2
swap
gen3 ;
: gen3
keep
generate2 ;
: generate2
"generate2" .
dup dup 0 <= swap 2 > or [
"recursing into generate, discarding %d" sprintf . generate
] [
"entering interaction" .
-rot pbl swap
1 = [ interact-mort ] [ interact-invest ] if
] if
;
MAIN: main
New Annotation