Created by
orbitzN
last modified
| type 'a t = (unit -> ('a * ('a -> unit)))
;;
let app : ('a -> 'b) t -> 'a t -> 'b t = fun f v ->
fun () ->
let (x, clean_up) = v () in
let (x', clean_up') = f () in
(x' x, fun _ -> clean_up' x'; clean_up x)
;;
let ( <*> ) = app
;;
let const : 'a -> 'a t = fun v () -> (v, fun _ -> ())
;;
let revop ~create ~teardown () =
(create (), teardown)
;;
let fmap : ('a -> 'b) -> 'a t -> 'b t = fun f v -> const f <*> v
;;
let ( <$> ) = fmap
;;
let r1 =
revop
~create:(fun () -> print_endline "hi"; 2)
~teardown:(fun _ -> print_endline "bye")
;;
let r2 =
revop
~create:(fun () -> print_endline "hi1"; 3)
~teardown:(fun _ -> print_endline "bye1")
;;
let run a =
let (v, cleanup) = a () in
cleanup v;
v
;;
run ((+) <$> r1 <*> r2);;
(*
# run ((+) <$> r1 <*> r2);;
hi1
hi
bye
bye1
- : int = 5
*)
|