CCA

http://lambda-the-ultimate.org/node/3659 より。とりあえずそれっぽいの(loopはいんちき)を実装してみたんだけど、何が嬉しいのか未だ分からん...。なんとなくすごく使えそうな気がするんだけど。[追記]あー、switchとかchoiseとか無いのかー。これは厳しいなぁ。

(* causal commutative arrows *)
type ('a, 'b) t = {
  run : 'a -> 'b * ('a, 'b) t Lazy.t
}

let (!$) = Lazy.force

(* val arr : ('a -> 'b) -> ('a, 'b) t *)
let rec arr f =
  { run = fun input -> f input, lazy (arr f) }

(* val ( >>> ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t *)
let rec (>>>) f g =
  { run = fun input -> 
      let x, f' = f.run input in
      let z, g' = g.run x in
      z, lazy (!$f' >>> !$g') }

(* val first : ('a, 'b) t -> ('a * 'c, 'b * 'c) t *)
let rec first f =
  { run = fun (x, y) -> 
      let x', f' = f.run x in
      (x', y), lazy (first !$f') }

(* val second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t *)
let second f = 
  let swap (a, b) = (b, a) in
  arr swap >>> first f >>> arr swap

(* val ( $$$ ) : ('a, 'b) t -> ('c, 'd) t -> ('a * 'c, 'b * 'd) t *)
let ($$$) f g =
  first f >>> second g

let dup2 () = arr (fun x -> (x, x))
let (&&&) f g = dup2 () >>> (f $$$ g)

(* val loop : 'a -> ('b * 'c, 'd * 'a) t -> ('b * 'c, 'd) t *)
let rec loop init f =
  { run = fun (x, z) ->
      let (y, z), f' = f.run (x, z) in
      y, lazy (loop z !$f') }

(* val init : 'a -> ('a, 'a) t *)
let rec init x = 
  { run = fun input -> x, lazy (init input) }

(* val run : ('a, 'b) t -> 'a -> 'b *)
let run f x =
  fst (f.run x)