syntax nonfix synchronise 156 1;

let SmallProcess(f) = NewProcess(f,800,800);
let Seed = ref 0;

let type 
  '_a port <=> [|both; empty; input; output|] # (object list)
with
  port(): 'a port =
    absport (let a = array(2,[|empty|]:[|both; empty; input; output|]) in 
             (update(forgettype(a),2,[]); forgettype(a)));
            

let rec type {
  iorequest <=> 
    object port # ((object -> beh) + (object # (. -> beh)))
and
  beh <=> [|guard  :iorequest list;
            par    :(beh # beh);
            channel:(object port -> beh)
          |]
  }
with
  rec synchronise(b: iorequest list): (('a -> beh) # 'a) = synchronise(b)
ins
  NIL =
    absbeh([|guard = []|])
and
  pfl_read(c: 'a port, b: ('a -> beh)): beh =
    absbeh([|guard = 
      [absiorequest(forgettype(c), inl(forgettype(b)))]|])
and
  pfl_write(c: 'a port, v: 'a, b: (. -> beh)): beh =
    absbeh([|guard = 
      [absiorequest(forgettype(c), inr(mkobj(v),b))]|])
and
  pfl_choice(b1: beh, b2: beh): beh =
    absbeh([|guard = 
             (append((repbeh(b1) as guard),(repbeh(b2) as guard)))|]) 
    ? failwith `choice`
and
  pfl_par(b1: beh, b2: beh): beh =
    absbeh([|par=(b1,b2)|])
and
  rec execute(b: beh): . =
    case (repbeh b) of
    [|guard = iol.
        let {(behav, value) = 
            (Seed := (23501* !Seed + 6923) mod 32768;
             if !Seed < 16384 then synchronise(iol) else synchronise(rev(iol)))
        enc  b' = behav(value) } in
        execute(b');
      par = (b1, b2).
       (SpawnProcess(SmallProcess(\().execute(b2)),false);
        execute(b1));
      channel = b.
        execute(b(port()))
    |]
    
;

let exec(b: beh): . =
 (Seed := (CpuTime() mod 32768);
  SpawnProcess(SmallProcess(\(). execute(b)), true);
  WaitForProcesses());

let pexec(b: beh): . =
 (Seed := (CpuTime() mod 32768);
  SpawnProcess(SmallProcess(\(). execute(b)), true));

