test.ml

type _ t =
  | Return : 'a -> 'a t
  | Bind :
      { t : 'a t
      ; f : 'a -> 'b t
      }
      -> 'b t
  | Isolated : 'a t -> 'a t
  | Map :
      { t : 'a t
      ; f : 'a -> 'b
      }
      -> 'b t
  | Both :
      { a : 'a t
      ; b : 'b t
      }
      -> ('a * 'b) t
  | X : v t
  | Y : v t
  | Z : v t
  | Set_x : v -> unit t
  | Set_y : v -> unit t
  | Set_z : v -> unit t
  [@@deriving sexp_of]

let rec eval : type a. a t -> x:v -> y:v -> z:v -> a * v * v * v =
 fun v ~x ~y ~z ->
  match v with
  | Return a -> a, x, y, z
  | Bind { t; f } ->
    let o, x, y, z = eval t ~x ~y ~z in
    eval (f o) ~x ~y ~z
  | Map { t; f } ->
    let o, x, y, z = eval t ~x ~y ~z in
    f o, x, y, z
  | Both { a; b } ->
    let a, x, y, z = eval a ~x ~y ~z in
    let b, x, y, z = eval b ~x ~y ~z in
    (a, b), x, y, z
  | Isolated t ->
    let o, _, _, _ = eval t ~x ~y ~z in
    o, x, y, z
  | X -> x, x, y, z
  | Y -> y, x, y, z
  | Z -> z, x, y, z
  | Set_x x -> (), x, y, z
  | Set_y y -> (), x, y, z
  | Set_z z -> (), x, y, z
;;