gistfile1.ml

type one = [ `One ]
type two = [ `Two ]

type +_ t = OneA | OneB | TwoA | TwoB

let oneA : [> one ] t = OneA
let oneB : [> one ] t = OneB

let twoA : [> two ] t = TwoA
let twoB : [> two ] t = TwoB

let over_ones : [< one] t -> string = function
  | OneA -> "onea"
  | OneB -> "oneb"
  | _ -> assert false

let over_twos : [< two ] t -> string = function
  | TwoA -> "onea"
  | TwoB -> "oneb"
  | _ -> assert false