diff --git a/src/library/tactic/rewrite_tactic.cpp b/src/library/tactic/rewrite_tactic.cpp index 99902b532..b2bb031d6 100644 --- a/src/library/tactic/rewrite_tactic.cpp +++ b/src/library/tactic/rewrite_tactic.cpp @@ -1229,6 +1229,14 @@ class rewrite_fn { } } + static bool compare_head(expr const & pattern, expr const & t) { + expr const & f = get_app_fn(t); + if (is_constant(pattern) && is_constant(f)) + return const_name(pattern) == const_name(f); + else + return pattern == f; + } + // Search for \c pattern in \c e. If \c t is a match, then try to unify the type of the rule // in the rewrite step \c orig_elem with \c t. // When successful, this method returns the target \c t, the fully elaborated rule \c r, @@ -1245,8 +1253,7 @@ class rewrite_fn { lean_assert(std::all_of(m_esubst.begin(), m_esubst.end(), [&](optional const & e) { return !e; })); bool r; if (m_keyed) { - expr const & f = get_app_fn(t); - r = f == pattern; + r = compare_head(pattern, t); } else { bool assigned = false; r = match(pattern, t, m_lsubst, m_esubst, nullptr, nullptr, &m_mplugin, &assigned); diff --git a/tests/lean/hott/krewrite_bug.hlean b/tests/lean/hott/krewrite_bug.hlean new file mode 100644 index 000000000..e34259247 --- /dev/null +++ b/tests/lean/hott/krewrite_bug.hlean @@ -0,0 +1,34 @@ +import algebra.category.functor + +open function category eq prod prod.ops equiv is_equiv sigma sigma.ops is_trunc funext iso +open pi + +namespace functor + variables {A B C D E : Precategory} + + definition compose_pentagon_test (K : D ⇒ E) (H : C ⇒ D) (G : B ⇒ C) (F : A ⇒ B) : + (calc K ∘f H ∘f G ∘f F = (K ∘f H) ∘f G ∘f F : functor.assoc + ... = ((K ∘f H) ∘f G) ∘f F : functor.assoc) + = + (calc K ∘f H ∘f G ∘f F = K ∘f (H ∘f G) ∘f F : ap (λx, K ∘f x) !functor.assoc + ... = (K ∘f H ∘f G) ∘f F : functor.assoc + ... = ((K ∘f H) ∘f G) ∘f F : ap (λx, x ∘f F) !functor.assoc) := + begin + have lem1 : Π{F₁ F₂ : A ⇒ D} (p : F₁ = F₂) (a : A), + ap010 to_fun_ob (ap (λx, K ∘f x) p) a = ap (to_fun_ob K) (ap010 to_fun_ob p a), + by intros; cases p; esimp, + have lem2 : Π{F₁ F₂ : B ⇒ E} (p : F₁ = F₂) (a : A), + ap010 to_fun_ob (ap (λx, x ∘f F) p) a = ap010 to_fun_ob p (F a), + by intros; cases p; esimp, + apply functor_eq2, + intro a, esimp, + krewrite [ap010_con], + rewrite [+ap010_con,lem1,lem2, + ap010_assoc K H (G ∘f F) a, + ap010_assoc (K ∘f H) G F a, + ap010_assoc H G F a, + ap010_assoc K H G (F a), + ap010_assoc K (H ∘f G) F a] + end + +end functor