impredicative_polymorphism_with_poly_variants.ml

type x = [ `A ]
type y = [ x | `B ]
type z = [ y | `C ]

type 'a t =
  | X_1 of x * 'a
  | X_2 of x * 'a
  | Y_a of x
  | Y_var of 'a
  constraint 'a = [< z ]

type handler = { f : 'a . ([< z] as 'a) -> int }

let foo handle_var t =
  let handle_a s = handle_var.f (s :> z) in
  let handle_x id a var =
    let var_i = handle_var.f var in
    let a_i = handle_a a in
    [id lor var_i lor a_i] in
  let handle_y id var =
    let var_i = handle_var.f var in
    [id lor var_i] in
  match t with
  | X_1 (a, var) -> handle_x 1 a var
  | X_2 (a, var) -> handle_x 2 a var
  | Y_a a -> handle_y 3 (a :> z)
  | Y_var var -> handle_y 4 var

let bar things =
  let handle_b = { f = fun _ -> failwith "forget it" } in
  List.map (foo handle_b) things |> List.concat

let baz things =
  let handle_c = { f = function `A -> 1 | _ -> failwith "!" } in
  List.map (foo handle_c) things |> List.concat