feat: remove ignoreImplict workaround

src/Init/Lean/Meta/DiscrTree.lean

@@ -132,26 +132,61 @@ private def tmpStar := mkMVar tmpMVarId
 
 instance {α} : Inhabited (DiscrTree α) := ⟨{}⟩
 
-private partial def pushArgsAux (infos : Array ParamInfo) (ignoreImplicit : Bool) : Nat → Expr → Array Expr → MetaM (Array Expr)
+/--
+  Return true iff the argument should be treated as a "wildcard" by the discrimination tree.
+
+  - We ignore proofs because of proof irrelevance. It doesn't make sense to try to
+    index their structure.
+
+  - We ignore instance implicit arguments (e.g., `[HasAdd α]`) because they are "morally" canonical.
+    Moreover, we may have many definitionally equal terms floating around.
+    Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`.
+
+  - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them,
+    and may not even understand why some simplification rule is not firing.
+    However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`,
+    where `Nat` is an implicit argument. Thus, we would add the path
+    ```
+    Decidable -> Eq -> * -> * -> * -> [Nat.decEq]
+    ```
+    to the discrimination tree IF we ignored the implict `Nat` argument.
+    This would be BAD since **ALL** decidable equality instances would be in the same path.
+    So, we index implicit arguments if they are types.
+    This setting seems sensible for simplification lemmas such as:
+    ```
+    forall (x y : Unit), (@Eq Unit x y) = true
+    ```
+    If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate
+    simplification lemma for any equality in our goal.
+
+  Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation,
+  and `ignoreArg` would return true for any term of the form `noIndexing t`.
+-/
+private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool :=
+if h : i < infos.size then
+  let info := infos.get ⟨i, h⟩;
+  if info.instImplicit then
+    pure true
+  else if info.implicit then
+    not <$> isType a
+  else
+    isProof a
+else
+  isProof a
+
+private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → MetaM (Array Expr)
 | i, Expr.app f a _, todo =>
-  if h : i < infos.size then
-    let info := infos.get ⟨i, h⟩;
-    if (info.implicit && ignoreImplicit) || info.instImplicit then
-      pushArgsAux (i-1) f (todo.push tmpStar)
-    else condM (isProof a)
-      (pushArgsAux (i-1) f (todo.push tmpStar))
-      (pushArgsAux (i-1) f (todo.push a))
-  else condM (isProof a)
+  condM (ignoreArg a i infos)
     (pushArgsAux (i-1) f (todo.push tmpStar))
     (pushArgsAux (i-1) f (todo.push a))
 | _, _, todo => pure todo
 
-private def pushArgs (todo : Array Expr) (e : Expr) (ignoreImplicit : Bool) : MetaM (Key × Array Expr) :=
+private def pushArgs (todo : Array Expr) (e : Expr) : MetaM (Key × Array Expr) :=
 do e ← whnf e;
    let fn    := e.getAppFn;
    let push (k : Key) (nargs : Nat) : MetaM (Key × Array Expr) := do {
      info ← getFunInfoNArgs fn nargs;
-     todo ← pushArgsAux info.paramInfo ignoreImplicit (nargs-1) e todo;
+     todo ← pushArgsAux info.paramInfo (nargs-1) e todo;
      pure (k, todo)
    };
    match fn with
@@ -167,23 +202,23 @@ do e ← whnf e;
        (pure (Key.star, todo))
    | _                  => pure (Key.other, todo)
 
-partial def mkPathAux (ignoreImplicit : Bool) : Array Expr → Array Key → MetaM (Array Key)
+partial def mkPathAux : Array Expr → Array Key → MetaM (Array Key)
 | todo, keys =>
   if todo.isEmpty then
     pure keys
   else do
     let e    := todo.back;
     let todo := todo.pop;
-    (k, todo) ← pushArgs todo e ignoreImplicit;
+    (k, todo) ← pushArgs todo e;
     mkPathAux todo (keys.push k)
 
 private def initCapacity := 8
 
-def mkPath (e : Expr) (ignoreImplicit : Bool) : MetaM (Array Key) :=
+def mkPath (e : Expr) : MetaM (Array Key) :=
 usingTransparency TransparencyMode.reducible $ do
   let todo : Array Expr := Array.mkEmpty initCapacity;
   let keys : Array Key  := Array.mkEmpty initCapacity;
-  mkPathAux ignoreImplicit (todo.push e) keys
+  mkPathAux (todo.push e) keys
 
 private partial def createNodes {α} (keys : Array Key) (v : α) : Nat → Trie α
 | i =>
@@ -222,8 +257,8 @@ else
     let c := insertAux keys v 1 c;
     { root := d.root.insert k c }
 
-def insert {α} [HasBeq α] (d : DiscrTree α) (e : Expr) (v : α) (ignoreImplicit : Bool := true) : MetaM (DiscrTree α) :=
-do keys ← mkPath e ignoreImplicit;
+def insert {α} [HasBeq α] (d : DiscrTree α) (e : Expr) (v : α) : MetaM (DiscrTree α) :=
+do keys ← mkPath e;
    pure $ d.insertCore keys v
 
 partial def Trie.format {α} [HasFormat α] : Trie α → Format

src/Init/Lean/Meta/Instances.lean

@@ -32,7 +32,7 @@ private def mkInstanceKey (e : Expr) : MetaM (Array DiscrTree.Key) :=
 do type ← inferType e;
    withNewMCtxDepth $ do
      (_, _, type) ← forallMetaTelescopeReducing type;
-     DiscrTree.mkPath type false /- Do not ignore implicit arguments, only instImplicit -/
+     DiscrTree.mkPath type
 
 def addGlobalInstance (env : Environment) (constName : Name) : IO Environment :=
 match env.find constName with

stage0/src/Init/Lean/Meta/DiscrTree.lean

@@ -132,26 +132,61 @@ private def tmpStar := mkMVar tmpMVarId
 
 instance {α} : Inhabited (DiscrTree α) := ⟨{}⟩
 
-private partial def pushArgsAux (infos : Array ParamInfo) (ignoreImplicit : Bool) : Nat → Expr → Array Expr → MetaM (Array Expr)
+/--
+  Return true iff the argument should be treated as a "wildcard" by the discrimination tree.
+
+  - We ignore proofs because of proof irrelevance. It doesn't make sense to try to
+    index their structure.
+
+  - We ignore instance implicit arguments (e.g., `[HasAdd α]`) because they are "morally" canonical.
+    Moreover, we may have many definitionally equal terms floating around.
+    Example: `Ring.hasAdd Int Int.isRing` and `Int.hasAdd`.
+
+  - We considered ignoring implicit arguments (e.g., `{α : Type}`) since users don't "see" them,
+    and may not even understand why some simplification rule is not firing.
+    However, in type class resolution, we have instance such as `Decidable (@Eq Nat x y)`,
+    where `Nat` is an implicit argument. Thus, we would add the path
+    ```
+    Decidable -> Eq -> * -> * -> * -> [Nat.decEq]
+    ```
+    to the discrimination tree IF we ignored the implict `Nat` argument.
+    This would be BAD since **ALL** decidable equality instances would be in the same path.
+    So, we index implicit arguments if they are types.
+    This setting seems sensible for simplification lemmas such as:
+    ```
+    forall (x y : Unit), (@Eq Unit x y) = true
+    ```
+    If we ignore the implicit argument `Unit`, the `DiscrTree` will say it is a candidate
+    simplification lemma for any equality in our goal.
+
+  Remark: if users have problems with the solution above, we may provide a `noIndexing` annotation,
+  and `ignoreArg` would return true for any term of the form `noIndexing t`.
+-/
+private def ignoreArg (a : Expr) (i : Nat) (infos : Array ParamInfo) : MetaM Bool :=
+if h : i < infos.size then
+  let info := infos.get ⟨i, h⟩;
+  if info.instImplicit then
+    pure true
+  else if info.implicit then
+    not <$> isType a
+  else
+    isProof a
+else
+  isProof a
+
+private partial def pushArgsAux (infos : Array ParamInfo) : Nat → Expr → Array Expr → MetaM (Array Expr)
 | i, Expr.app f a _, todo =>
-  if h : i < infos.size then
-    let info := infos.get ⟨i, h⟩;
-    if (info.implicit && ignoreImplicit) || info.instImplicit then
-      pushArgsAux (i-1) f (todo.push tmpStar)
-    else condM (isProof a)
-      (pushArgsAux (i-1) f (todo.push tmpStar))
-      (pushArgsAux (i-1) f (todo.push a))
-  else condM (isProof a)
+  condM (ignoreArg a i infos)
     (pushArgsAux (i-1) f (todo.push tmpStar))
     (pushArgsAux (i-1) f (todo.push a))
 | _, _, todo => pure todo
 
-private def pushArgs (todo : Array Expr) (e : Expr) (ignoreImplicit : Bool) : MetaM (Key × Array Expr) :=
+private def pushArgs (todo : Array Expr) (e : Expr) : MetaM (Key × Array Expr) :=
 do e ← whnf e;
    let fn    := e.getAppFn;
    let push (k : Key) (nargs : Nat) : MetaM (Key × Array Expr) := do {
      info ← getFunInfoNArgs fn nargs;
-     todo ← pushArgsAux info.paramInfo ignoreImplicit (nargs-1) e todo;
+     todo ← pushArgsAux info.paramInfo (nargs-1) e todo;
      pure (k, todo)
    };
    match fn with
@@ -167,23 +202,23 @@ do e ← whnf e;
        (pure (Key.star, todo))
    | _                  => pure (Key.other, todo)
 
-partial def mkPathAux (ignoreImplicit : Bool) : Array Expr → Array Key → MetaM (Array Key)
+partial def mkPathAux : Array Expr → Array Key → MetaM (Array Key)
 | todo, keys =>
   if todo.isEmpty then
     pure keys
   else do
     let e    := todo.back;
     let todo := todo.pop;
-    (k, todo) ← pushArgs todo e ignoreImplicit;
+    (k, todo) ← pushArgs todo e;
     mkPathAux todo (keys.push k)
 
 private def initCapacity := 8
 
-def mkPath (e : Expr) (ignoreImplicit : Bool) : MetaM (Array Key) :=
+def mkPath (e : Expr) : MetaM (Array Key) :=
 usingTransparency TransparencyMode.reducible $ do
   let todo : Array Expr := Array.mkEmpty initCapacity;
   let keys : Array Key  := Array.mkEmpty initCapacity;
-  mkPathAux ignoreImplicit (todo.push e) keys
+  mkPathAux (todo.push e) keys
 
 private partial def createNodes {α} (keys : Array Key) (v : α) : Nat → Trie α
 | i =>
@@ -222,8 +257,8 @@ else
     let c := insertAux keys v 1 c;
     { root := d.root.insert k c }
 
-def insert {α} [HasBeq α] (d : DiscrTree α) (e : Expr) (v : α) (ignoreImplicit : Bool := true) : MetaM (DiscrTree α) :=
-do keys ← mkPath e ignoreImplicit;
+def insert {α} [HasBeq α] (d : DiscrTree α) (e : Expr) (v : α) : MetaM (DiscrTree α) :=
+do keys ← mkPath e;
    pure $ d.insertCore keys v
 
 partial def Trie.format {α} [HasFormat α] : Trie α → Format

stage0/src/Init/Lean/Meta/Instances.lean

@@ -32,7 +32,7 @@ private def mkInstanceKey (e : Expr) : MetaM (Array DiscrTree.Key) :=
 do type ← inferType e;
    withNewMCtxDepth $ do
      (_, _, type) ← forallMetaTelescopeReducing type;
-     DiscrTree.mkPath type false /- Do not ignore implicit arguments, only instImplicit -/
+     DiscrTree.mkPath type
 
 def addGlobalInstance (env : Environment) (constName : Name) : IO Environment :=
 match env.find constName with