fix(library/tactic/rewrite_tactic): improve krewrite

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<expr> const & e) { return !e; }));
                     bool r;
                     if (m_keyed) {
-                        expr const & f = get_app_fn(t);
+                        r = compare_head(pattern, t);
-                        r = f == pattern;
                     } else {
                         bool assigned = false;
                         r = match(pattern, t, m_lsubst, m_esubst, nullptr, nullptr, &m_mplugin, &assigned);

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