Suggestion for solving fragile pattern matching

问题

I often need to match a tuple of values that should have the same constructor. The catchall _,_ always winds-up at the end. This of course is fragile, any additional constructor added to the type will compile perfectly fine. My current thoughts are to have matches that connect the first but not second argument. But, is there any other options?

For example,

type data = | States of int array 
            | Chars  of (char list) array

let median a b = match a,b with
    | States xs, States ys ->
        assert( (Array.length xs) = (Array.length ys) );
        States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
    | Chars xs, Chars ys -> 
        assert( (Array.length xs) = (Array.length ys) );
        let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) @ c2 in
        Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
    (* inconsistent pairs of matching *)
    | Chars  _, _
    | States _, _ -> assert false

回答1:

You can use the slightly shorter pattern below:

| (Chars _| States _), _ -> assert false

In fact, you can let the compiler generate it for you, because it's still a little tedious. Type the following and compile:

let median a b = match a,b with
| States xs, States ys ->
    assert( (Array.length xs) = (Array.length ys) );
    States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
| Chars xs, Chars ys -> 
    assert( (Array.length xs) = (Array.length ys) );
    let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) @ c2 in
    Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))

Warning 8: this pattern-matching is not exhaustive. Here is an example of a value that is not matched: (Chars _, States _)

You can now copy-paste the suggested pattern back into your code. This is usually how I generate non-fragile catch-all patterns for types with tens of constructors. You may need to launch the compiler several times, but it's still faster than typing them yourself.

回答2:

It's only a matter of taste/style, but I tend to prefer grouping clauses on the same constructor together, rather than having the useful clauses for everything first, then all the "absurd cases" together. This can be quite helpful when you get to write several "useful" clauses for one given constructor, and want to check you didn't forget anything.

let median a b = match a,b with
  | States xs, States ys ->
    assert( (Array.length xs) = (Array.length ys) );
    States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
  | States _, _ -> assert false

  | Chars xs, Chars ys -> 
    assert( (Array.length xs) = (Array.length ys) );
    let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) @ c2 in
    Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
  | Chars _, _ -> assert false

回答3:

This is pretty hackish (and results in warnings) but you can use Obj to check if the tags are equal or not. It should catch all cases where a and b have different values:

type data = | States of int array 
            | Chars  of (char list) array

let median a b = match a,b with
    | States xs, States ys ->
        assert( (Array.length xs) = (Array.length ys) );
        States (Array.init (Array.length xs) (fun i -> xs.(i) lor ys.(i)))
    | Chars xs, Chars ys -> 
        assert( (Array.length xs) = (Array.length ys) );
        let union c1 c2 = (List.filter (fun x -> not (List.mem x c2)) c1) @ c2 in
        Chars (Array.init (Array.length xs) (fun i -> union xs.(i) ys.(i)))
    (* inconsistent pairs of matching *)
    | x, y when (Obj.tag (Obj.repr x)) <> (Obj.tag (Obj.repr y)) -> assert false

The warning is for non-exhaustive pattern-matching (since it can't tell whether or not the guarded clause matches the rest or not).

EDIT: you don't need to use Obj at all, you can just compare x and y directly:

| x, y when x <> y -> assert false

Though this still results in a warning, unfortunately.

来源：https://stackoverflow.com/questions/4346901/suggestion-for-solving-fragile-pattern-matching