Paste: Literal value expected

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 ;
IN: ftest

DEFER: generate
DEFER: 2exec>files


: send-noerr ( thread msg -- )
  [ send ] [ 3drop ] recover ;

: read-loop ( controller -- )
  readln dup
  [
    over f send-noerr
    write nl
    read-loop
  ] [
    drop t send-noerr
  ] if
;

: enter-read-loop ( controller in out-file -- )
   [
    [ dup read-loop ] with-streams
  ] ignore-errors
  t swap send-noerr ;
  

: enter-generate ( w-control out1 out2 -- )
  dup [ generate ] ignore-errors
  t send-noerr ;
  
: w-control-loop ( controller generator -- )
  receive [
    stop
    t send-noerr
  ] [
    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 ;

  
: wait ( -- )
    100 milliseconds receive-timeout
    [ wait ] unless
;

: controller-loop ( writer -- )
  [ wait t ] [ drop f ] recover
  
  [ drop ]
  [ f over send-noerr
    controller-loop ] if
;


: read-commands ( -- cmd1 cmd2 )
  "cmds" ascii file-lines dup first swap second ;

: similar? ( file1 file2 -- similar? )
  [ "diff %s %s" sprintf try-process t ] 2curry [ drop f ] recover ;

: pass ( cmd1 cmd2 i -- )
  3dup 0 = [ 4drop drop ] [
    2exec>files similar?
    [ 1 - pass ] [ 3drop ] if
  ] if ;

: main ( -- )
  "hello" .
  read-commands 100 pass ;


#! : create-process ( cmd -- )  ascii <process-stream> ;
  
: start-reader ( in out-file -- thread )
  self -rot [ enter-read-loop ] 3curry "reader" spawn ;

: out-file-names ( -- file1 file2 )
  1 2 [ "/tmp/diffproc/%d" sprintf ] bi@ ;
  
: start-readers ( in1 in2 -- thread1 thread2 )
  out-file-names swapd [ start-reader ] 2bi@ ;

#! : create-writer ( out1 out2 -- )
#!  [ enter-write-loop ] 2curry spawn ;


: open-proc-streams ( cmd1 cmd2 -- stream1 stream2 )
  [ ascii <process-stream> ] bi@ ;

: create-threads ( cmd1 cmd2 -- reader1 reader2 writer )
    open-proc-streams
    2dup [ enter-write-loop ] 2curry "w-control" spawn
    -rot start-readers rot
;


: await-termination ( -- )
  receive receive 2drop ;


: terminate-threads ( reader1 reader2 writer -- )
  [ t send-noerr ] tri@ await-termination ;


: 2exec>files ( cmd1 cmd2 -- file1 file2 )
  create-threads
  dup controller-loop
  terminate-threads
  out-file-names
;


#! ##### 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 [ tuck stream-write stream-nl ] 2bi@
  [ drop ] "suspending" suspend drop ;

:: pbl ( out1 out2 -- quot )
  [| 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
;


DEFER: generate2
DEFER: gen1
DEFER: gen2
DEFER: gen3
#!  : yield *coyield drop ;

: generate ( out1 out2 -- )
  2dup pbl
  gen1 ;

: gen1 ( out1 out2 lambda -- )
  5 random 1 -
  gen2 ;

: gen2 ( out1 out2 lambda num -- )
  swap
  gen3 ;

: gen3 ( out1 out2 num lambda -- )
  keep
  generate2 ;

: generate2 ( out1 out2 val -- )
  dup dup dup 0 <= swap 2 > or [
    drop generate
  ] [
    1 = [ interact-mort ] [ interact-invest ] if
  ] if
;

MAIN: main