diff options
| author | Matthieu Sozeau | 2019-03-26 18:53:32 +0100 |
|---|---|---|
| committer | Matthieu Sozeau | 2019-03-26 18:53:32 +0100 |
| commit | 2ac275c0f3e65a402951de86a61c77dd0e0782f8 (patch) | |
| tree | 797d2176e120935f1acb9342f1a5751f2c38618c | |
| parent | 0ff2e4b9f845ff280ee7adb865f837bc6040efbf (diff) | |
| parent | b4561c5047eb2383c2b718fd1cf9da8076497511 (diff) | |
Merge PR #9690: Fix 9663 (Miller pattern unification fails on evars)
Ack-by: ggonthier
Reviewed-by: mattam82
| -rw-r--r-- | pretyping/evarconv.ml | 17 | ||||
| -rw-r--r-- | test-suite/bugs/closed/bug_9663.v | 2 |
2 files changed, 15 insertions, 4 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 28a97bb91a..0ccc4fd9f9 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -503,14 +503,23 @@ let rec evar_conv_x flags env evd pbty term1 term2 = | Evar ev, _ when Evd.is_undefined evd (fst ev) && not (is_frozen flags ev) -> (match solve_simple_eqn (conv_fun evar_conv_x) flags env evd (position_problem true pbty,ev,term2) with - | UnifFailure (_,OccurCheck _) -> - (* Eta-expansion might apply *) default () + | UnifFailure (_,(OccurCheck _ | NotClean _)) -> + (* Eta-expansion might apply *) + (* OccurCheck: eta-expansion could solve + ?X = {| foo := ?X.(foo) |} + NotClean: pruning in solve_simple_eqn is incomplete wrt + Miller patterns *) + default () | x -> x) | _, Evar ev when Evd.is_undefined evd (fst ev) && not (is_frozen flags ev) -> (match solve_simple_eqn (conv_fun evar_conv_x) flags env evd (position_problem false pbty,ev,term1) with - | UnifFailure (_, OccurCheck _) -> - (* Eta-expansion might apply *) default () + | UnifFailure (_, (OccurCheck _ | NotClean _)) -> + (* OccurCheck: eta-expansion could solve + ?X = {| foo := ?X.(foo) |} + NotClean: pruning in solve_simple_eqn is incomplete wrt + Miller patterns *) + default () | x -> x) | _ -> default () end diff --git a/test-suite/bugs/closed/bug_9663.v b/test-suite/bugs/closed/bug_9663.v new file mode 100644 index 0000000000..b5fa601278 --- /dev/null +++ b/test-suite/bugs/closed/bug_9663.v @@ -0,0 +1,2 @@ +Definition id_depfn S T (f : forall x : S, T x) := f. +Definition idn : nat -> nat := @id_depfn _ _ (fun x => x). |