type _ tree =
  | Node  : 'a tree * 'a tree -> 'a tree
  | Leaf  : [ `good ] tree
  | Taint : [< `good | `bad ] tree -> [ `bad ] tree

let rec untaint : 'a. 'a tree -> [ `good ] tree =
  fun (type t) (tr : t tree) -> match tr with
    | Taint _ -> failwith "Cannot untaint this tree"
    | Leaf -> Leaf
    | Node (l, r) -> Node (untaint l, untaint r)