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
*)