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 ( controller -- ) readln dup [ over f send write nl read-loop ] [ drop t send ] if ; : enter-read-loop ( controller in out-file -- ) [ [ dup read-loop ] with-streams ] ignore-errors t swap send ; : enter-generate ( w-control out1 out2 -- ) dup [ generate ] ignore-errors t send ; : w-control-loop ( controller generator -- ) receive [ stop t send ] [ dup resume w-control-loop ] if ; : enter-write-loop ( out1 out2 -- ) #! [ generate ] cocreate write-loop ; receive [ self -rot [ enter-generate ] 3curry "generator" spawn w-control-loop ] unless ; : controller-loop ( writer -- ) : wait ( -- ) [ 100 milliseconds receive-timeout [ wait ] unless ] ; [ wait t ] [ drop f ] recover [ dup f send controller-loop ] unless ; : read-commands ( -- cmd1 cmd2 ) "cmds" ascii file-lines dup first swap second ; : similar? ( file1 file2 -- similar? ) [ "diff %s %s" sprintf try-process t ] [ f ] recover ; : pass ( cmd1 cmd2 i -- ) 3dup 0 = [ 2drop ] [ 2exec>files similar? [ 1 - pass ] when ] if ; : main ( -- ) "hello" . read-commands 100 pass ; #! : create-process ( cmd -- ) ascii ; : start-reader ( in out-file -- ) self -rot [ enter-read-loop ] 3curry spawn ; : out-file-names ( -- file1 file2 ) 1 2 [ "/tmp/diffproc/%d" sprintf ] 2bi@ ; : start-readers ( in1 in2 -- thread1 thread2 ) out-file-names swapd [ start-reader ] 2bi@ ; #! : create-writer ( out1 out2 -- ) #! [ enter-write-loop ] 2curry spawn ; : create-threads ( cmd1 cmd2 -- reader1 reader2 writer ) [ ascii ] bi@ 2dup [ enter-write-loop ] "w-control" spawn -rot start-readers rot ; : await-termination ( -- ) receive receive 2drop ; : terminate-threads ( reader1 reader2 writer -- ) [ t send ] tri@ await-termination ; : 2exec>files ( cmd1 cmd2 -- file1 file2 ) create-threads dup controller-loop terminate-threads ; #! ##### BUSINESS LOGIC ##### : random-int ( -- val ) 4096 random 2048 - ; : random-real ( -- val ) 0.0 4096.0 [a,b] random 2048 - ; : floor1 ( n -- n ) 10 * floor 10 / ; : pb ( val out1 out2 -- ) pick swap [ write nl ] bi@ suspend ; :: pbl ( out1 out2 -- ) [| val | val out1 out2 pb ] ; : interact-mort ( out1 out2 -- ) 2dup pbl :: three ( lambda -- ) 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 ( lambda -- ) 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 ( out1 out2 -- ) pbl :: outval ( lambda quot -- ) quot call lambda keep 0 <= [ lambda outval ] when ; dup [ random-int ] [ outval ] 2bi@ [ random-real ] outval :: interact-menu-invest ( lambda -- ) 9 random swap keep dup 1 >= swap 7 < and [ lambda interact-menu-invest ] [ "AFTER INVEST" . ] if interact-menu-invest ; : generate ( out1 out2 -- ) #! : yield *coyield drop ; 2dup pbl 5 random 1 - swap keep dup dup dup 0 <= swap 2 > or [ drop generate ] [ 1 = [ interact-mort ] [ interact-invest ] if ] ; MAIN: main ;