Extensible variant typesを使ってバリアントを拡張すると、パターンマッチも拡張しなければなりません。しかも、もし二つの独立したバリアントの拡張を合成しようとすると、二つの独立した(パターンマッチを内部的に使っている)関数を合成しなければなりません。(下記の例ではPlus.open_evalとNeg.open_eval)

これを実現するために、下記の例では例外を使ってorElseという合成関数を定義しました。
しかし、例外を使っているあたりが残念です。
パターンマッチに失敗したら次の指定したパターンマッチに移るといった「パターンマッチの合成」のような事をする慣用句、定番の方法はあるのでしょうか?

exception ParticalMatchFailure

(* fのパターンマッチが失敗したら、例外で検知して次の関数へ移る *)
let orElse f g x =
  try f x with ParticalMatchFailure -> g x

module Lang = struct
  module Type = struct
    type 'a expr = ..
    type 'a expr +=
         Num : int -> int expr
       | App : ('a -> 'b) expr * 'a expr -> 'b expr
  end
  include Type

  type reval = { f : 'a. 'a expr -> 'a }

  let open_eval (type a) (eval:reval) (exp:a expr) : a =
    match exp with
      Num i -> i
    | App (f, x) -> eval.f f (eval.f x)
    | _ -> raise ParticalMatchFailure

end

(* Langの拡張 *)
module Plus = struct
  module Type = struct
    type 'a Lang.expr += 
         Plus : (int -> int -> int) Lang.expr
  end
  include Type

  let open_eval (type a) (eval:Lang.reval) (expr:a Lang.expr) : a = 
    match expr with
      Plus -> (+)
    | x -> raise ParticalMatchFailure

  let show : type a. a Lang.expr -> string = function
      Plus -> "plus"
    | Lang.App _ -> "app"
    | Lang.Num _ -> "num"
    | _ -> "no match"
end

(* LangのPlusとは関係ない拡張 *)
module Neg = struct
  module Type = struct
    type 'a Lang.expr += 
         Neg : (int -> int -> int) Lang.expr
  end
  include Type

  let open_eval (type a) (eval:Lang.reval) (expr:a Lang.expr) : a = 
    match expr with
      Neg -> (-)
    | x -> raise ParticalMatchFailure
end

(* 二つの独立したバリアント拡張(Plus, Neg)の合成 *)
module PlusNegLang = struct
  (* includeで型は用意に合成できる *)
  include Lang.Type
  include Plus.Type
  include Neg.Type

  let rec eval : 'a . 'a Lang.expr -> 'a =
    fun x ->
      let reval = Lang.{ f = eval } in
      (* open_evalを合成するために、orElseを使う *)
      (Neg.open_eval reval
       |> orElse (Plus.open_eval reval)
       |> orElse (Lang.open_eval reval)) x

  let () =
    eval
      (App
         (App (Plus, (App (App (Neg, Num 21), Num 21))),
          App (App (Plus, Num 21), Num 21)))
    |> print_int
end