1

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?"

Community
  • 1
  • 1
plinth
  • 48,267
  • 11
  • 78
  • 120

1 Answers1

3

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.

Community
  • 1
  • 1
Nikon the Third
  • 2,771
  • 24
  • 35
  • Nicely done. Thanks. Is there a way to dig deeper if one of the cases is itself a DU (if Shepherd was say English | German), so <@@ Animal.Dog @@> would match any dog, but <@@ English @@> would match Animal.Dog(English)? – plinth Feb 27 '15 at 21:46
  • This is not possible with a ``isUnionCase`` defined this way, because only the tags of the outermost union case - which in your case would be ``Animal.Dog`` - are matched by the ``NewUnionCase`` active pattern. It is possible to extend ``isUnionCase`` in a way to dig deeper into the quotation expression and create a more complex matching function, but this would mean a lot of reflection. Regular old pattern matching seems like the better way to go here. – Nikon the Third Feb 27 '15 at 21:59