module List {
  let map(f, lst) {
    case lst
    | []     => []
    | [x|xs] => [f(x) | map(f, xs)]
  };

  let iter(f, lst) {
    case lst
    | []     => ()
    | [x|xs] => { f(x); iter(f, xs); }
  };

  let fold(f, acc, lst) {
    case lst
    | []        => acc
    | [x|xs] => fold(f, f(acc, x), xs)
  };

  let foldr(f, acc, lst) {
    case lst
    | []        => acc
    | [x|xs] => f(x, foldr(f, acc, xs))
  };

  let reverse(lst) {
    let iter(lst, result) {
      case lst
      | []        => result
      | [x|xs] => iter(xs, [x | result])
    };
    iter(lst, [])
  };
};

module Queue {

  let make() {
    let node = [ data = (), next = node, is_end = True ];
    [ front = node, back = node ]
  };

  let is_empty(q) { q.front.is_end };

  let length(q) {
    let iter(n) {
      if n.is_end then
        0
      else
        1 + iter(n.next)
    };
    iter(q.front)
  };

  let print_queue(q) {
    let iter(n) {
      if n.is_end then
        ()
      else {
        print "element" n.data;
        iter(n.next);
      }
    };
    iter(q.front)
  };

  let pop(q) {
    let first = q.front;
    q.front := first.next;
    first.data
  };

  let push(q,x) {
    let node = [ data = x, next = node, is_end = True ];
    q.back.data   := x;
    q.back.next   := node;
    q.back.is_end := False;
    q.back        := node;
  };

};




let ready_fibres = Queue.make ();

type terminate = | Terminated;

let make_ready(f) {
  Queue.push(ready_fibres, f);
};

let schedule() {
  if Queue.is_empty(ready_fibres) then
    throw Terminated
  else {
    let f = Queue.pop(ready_fibres);
    f();
    schedule()
  }
};

let start_scheduler() {
  try
    schedule()
  catch e => case e
  | Terminated => ()
  | else       => print "uncaught exception" e
};

let spawn(f) {
  letcc k => {
    make_ready(k);
    make_ready(f);
    schedule()
  }
};

let yield() {
  letcc k => { make_ready(k); schedule() }
};





let make_trigger(k) {
  [ cont = k, triggered = False ]
};

let resume_trigger(t,v) {
  if t.triggered then
    ()
  else {
    t.triggered := True;
    make_ready(fun () { t.cont(v) });
  }
};

let new_condition() {
  [ waiting = [] ]
};

let resume(c,v) {
  let waiting = c.waiting;
  c.waiting := [];
  List.iter(fun (k) { resume_trigger(k,v) },
            waiting);
};

let wait(c) {
  letcc k => {
    let t = make_trigger(k);
    c.waiting := [t | c.waiting];
    schedule();
  }
};

let wait_multi(cs) {
  letcc k => {
    let t = make_trigger(k);
    List.iter(fun (c) { c.waiting := [t | c.waiting] },
              cs);
    schedule();
  }
};







type channel_state(a) = | Free | Reading | Written(a);

let new_channel() {
  [ state   = Free,
    readers = new_condition(),
    writers = new_condition() ]
};

let receive(ch) {
  case ch.state
  | Free       => { ch.state := Reading; wait(ch.readers) }
  | Written(v) => { ch.state := Free;    resume(ch.writers, ()); v }
  | Reading    => error
};

let send(ch,v) {
  case ch.state
  | Free       => { ch.state := Written(v); wait(ch.writers); }
  | Written(v) => error
  | Reading    => { ch.state := Free; resume(ch.readers,v); }
};

let merge(ch1,ch2) {
  let merge_fibre(ch1,ch2,c) {
    while True {
      case ch1.state
      | Written(v) => send(c,receive(ch1))
      | else       => case ch2.state
          | Written(v) => send(c,receive(ch2))
          | else       => { ch1.state := Reading;
                            ch2.state := Reading;
                            wait_multi([ch1, ch2]); }
    }
  };
  let c = new_channel();
  spawn(fun () { merge_fibre(ch1,ch2,c) });
  c
};