F#: type matching on DU cases, make this slightly more generic

Question

In this previous question, there is a lovely solution to asking if an object is a particular union case:

let isUnionCase (c : Expr<_ -> 'T>)  = 
    match c with
    | Lambdas (_, NewUnionCase(uci, _)) ->
        let tagReader = Microsoft.FSharp.Reflection.FSharpValue.PreComputeUnionTagReader(uci.DeclaringType)
        fun (v : 'T) -> (tagReader v) = uci.Tag
    | _ -> failwith "Invalid expression"

which is great. If I have:

type Dog = 
    | Spaniel
    | Shepherd
type Cat =
    | Tabby
    | Manx
type Animal
    | Dog of Dog
    | Cat of Cat

I can ask if any particular Animal is a specific animal by doing isUnionCase <@ Animal.Dog @> someAnimal.

What I'd like to do is something this:

let typesMatch (c:Animal) t = isUnionCase t c

let rec typematch animals types =
match (animals, types) with
| ([], []) -> true
| (animal::atail, ty::tytail) -> if typesMatch animal ty then typematch atail tytail else false
| (_, _) -> false

Which generates a compiler error on typematch [ Animal.Dog(Spaniel); Animal.Cat(Tabby) ] [ <@ Animal.Dog @> ; <@ Animal.Cat @>]

The reason being that the second list invalid since it is not homogeneous, even though they are both Animal cases.

How does one generify this sufficiently so that you can ask the predicate "does this list of objects which are all cases of a discriminated union match the list of expressions describing their expected case types?"

Answer 1

Use untyped quotations <@@ ... @@> instead of typed quotations, and use a form of isUnionCase that can deal with those:

open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection

let rec isUnionCase = function
| Lambda (_, expr) | Let (_, _, expr) -> isUnionCase expr
| NewTuple exprs -> 
    let iucs = List.map isUnionCase exprs
    fun value -> List.exists ((|>) value) iucs
| NewUnionCase (uci, _) ->
    let utr = FSharpValue.PreComputeUnionTagReader uci.DeclaringType
    box >> utr >> (=) uci.Tag
| _ -> failwith "Expression is no union case."

type Dog = 
    | Spaniel
    | Shepherd
type Cat =
    | Tabby
    | Manx
type Animal =
    | Dog of Dog
    | Cat of Cat

let typesMatch (c:Animal) t = isUnionCase t c

let rec typematch animals types =
    match (animals, types) with
    | ([], []) -> true
    | (animal::atail, ty::tytail) -> if typesMatch animal ty then typematch atail tytail else false
    | (_, _) -> false

typematch [ Animal.Dog(Spaniel); Animal.Cat(Tabby) ] [ <@@ Animal.Dog @@> ; <@@ Animal.Cat @@>]
|> printfn "Result: %b"

System.Console.ReadKey true |> ignore

Additionally, I used my pimped up version of isUnionCase as described here, which can deal with expressions like:

isUnionCase <@ Spanial, Shepherd @>

...which matches anything that is a Spanial or Shepherd.