feat: do not display inaccessible proposition names if they do not have forward dependencies

Even if `pp.inaccessibleNames = true`

RELEASES.md

@@ -1,6 +1,49 @@
 Unreleased
 ---------
 
+* When displaying goals, we do not display inaccessible proposition names
+if they do not have forward dependencies. We still display their types.
+For example, the goal
+```lean
+case node.inl.node
+β : Type u_1
+b : BinTree β
+k : Nat
+v : β
+left : Tree β
+key : Nat
+value : β
+right : Tree β
+ihl : BST left → Tree.find? (Tree.insert left k v) k = some v
+ihr : BST right → Tree.find? (Tree.insert right k v) k = some v
+h✝ : k < key
+a✝³ : BST left
+a✝² : ForallTree (fun k v => k < key) left
+a✝¹ : BST right
+a✝ : ForallTree (fun k v => key < k) right
+⊢ BST left
+```
+is now displayed as
+```lean
+case node.inl.node
+β : Type u_1
+b : BinTree β
+k : Nat
+v : β
+left : Tree β
+key : Nat
+value : β
+right : Tree β
+ihl : BST left → Tree.find? (Tree.insert left k v) k = some v
+ihr : BST right → Tree.find? (Tree.insert right k v) k = some v
+ : k < key
+ : BST left
+ : ForallTree (fun k v => k < key) left
+ : BST right
+ : ForallTree (fun k v => key < k) right
+⊢ BST left
+```
+
 * The hypothesis name is now optional in the `by_cases` tactic.
 
 * [Fix inconsistency between `syntax` and kind names](https://github.com/leanprover/lean4/issues/1090).

src/Lean/Meta/PPGoal.lean

@@ -34,7 +34,12 @@ structure State where
   modified               : Bool := false
 
 structure Context where
-  goalTarget : Expr
+  /--
+   If true we make a declaration "visible" if it has visible backward dependencies.
+   Remark: recall that for the `Prop` case, the declaration is moved to `hiddenInaccessibleProp`
+   -/
+  backwardDeps : Bool
+  goalTarget   : Expr
 
 abbrev M := ReaderT Context $ StateRefT State MetaM
 
@@ -95,17 +100,17 @@ def fixpointStep : M Unit := do
   (← getLCtx).forM fun localDecl => do
     let fvarId := localDecl.fvarId
     if (← get).hiddenInaccessible.contains fvarId then
-      if (← hasVisibleDep localDecl) then
-        /- localDecl is marked to be hidden, but it has a (backward) visible dependency. -/
-        unmark fvarId
-      if (← isProp localDecl.type) then
-        unless (← hasInaccessibleNameDep localDecl) do
-          moveToHiddeProp fvarId
+      if (← read).backwardDeps then
+        if (← hasVisibleDep localDecl) then
+          /- localDecl is marked to be hidden, but it has a (backward) visible dependency. -/
+          unmark fvarId
+        if (← isProp localDecl.type) then
+          unless (← hasInaccessibleNameDep localDecl) do
+            moveToHiddeProp fvarId
     else
       visitVisibleExpr localDecl.type
-      match localDecl.value? with
-      | some value => visitVisibleExpr value
-      | _ => pure ()
+      let some value := localDecl.value? | return ()
+      visitVisibleExpr value
 
 partial def fixpoint : M Unit := do
   modify fun s => { s with modified := false }
@@ -113,6 +118,16 @@ partial def fixpoint : M Unit := do
   if (← get).modified then
     fixpoint
 
+/--
+  Construct initial `FVarIdSet` containting free variables ids that have inaccessible user names.
+-/
+private def getInitialHiddenInaccessible (propOnly : Bool) : MetaM FVarIdSet := do
+  (← getLCtx).foldlM (init := {}) fun r localDecl => do
+    if localDecl.userName.isInaccessibleUserName then
+      if (← pure !propOnly <||> isProp localDecl.type) then
+        return r.insert localDecl.fvarId
+    return r
+
 /-
 If pp.inaccessibleNames == false, then collect two sets of `FVarId`s : `hiddenInaccessible` and `hiddenInaccessibleProp`
 1- `hiddenInaccessible` contains `FVarId`s of free variables with inaccessible names that
@@ -123,19 +138,23 @@ Both sets do not contain `FVarId`s that contain visible backward or forward depe
 The `goalTarget` counts as a forward dependency.
 
 We say a name is visible if it is a free variable with FVarId not in `hiddenInaccessible` nor `hiddenInaccessibleProp`
+
+For propositions in `hiddenInaccessibleProp`, we show only their types when displaying a goal.
+
+Remark: when `pp.inaccessibleNames == true`, we still compute `hiddenInaccessibleProp` to prevent the
+goal from being littered with irrelevant names.
+
 -/
 def collect (goalTarget : Expr) : MetaM (FVarIdSet × FVarIdSet) := do
+  let lctx ← getLCtx
   if pp.inaccessibleNames.get (← getOptions) then
-    /- Don't hide inaccessible names when `pp.inaccessibleNames` is set to true. -/
-    return ({}, {})
+    -- If `pp.inaccessibleNames == true`, we still must compute `hiddenInaccessibleProp`.
+    let hiddenInaccessible ← getInitialHiddenInaccessible (propOnly := true)
+    let (_, s) ← fixpoint.run { backwardDeps := false, goalTarget } |>.run { hiddenInaccessible }
+    return ({}, s.hiddenInaccessible)
   else
-    let lctx ← getLCtx
-    let hiddenInaccessible := lctx.foldl (init := {}) fun hiddenInaccessible localDecl => Id.run <| do
-      if localDecl.userName.isInaccessibleUserName then
-        hiddenInaccessible.insert localDecl.fvarId
-      else
-        hiddenInaccessible
-    let (_, s) ← fixpoint.run { goalTarget := goalTarget } |>.run { hiddenInaccessible := hiddenInaccessible }
+    let hiddenInaccessible ← getInitialHiddenInaccessible (propOnly := false)
+    let (_, s) ← fixpoint.run { backwardDeps := true, goalTarget } |>.run { hiddenInaccessible }
     return (s.hiddenInaccessible, s.hiddenInaccessibleProp)
 
 end ToHide

tests/lean/1074b.lean.expected.out

@@ -5,5 +5,5 @@ a n : Term
 1074b.lean:11:9-11:55: error: unsolved goals
 case id
 a n z✝ : Term
-a✝ : Brx z✝
+ : Brx z✝
 ⊢ True ∧ Brx (sorryAx Term)

tests/lean/361.lean.expected.out

@@ -8,11 +8,11 @@ h2 : p → q
 361.lean:5:11-5:13: error: unsolved goals
 p q r : Prop
 h2 : p → q
-h✝ : p
+ : p
 ⊢ q
 361.lean:3:60-5:13: error: unsolved goals
 case inr
 p q r : Prop
 h2 : p → q
-h✝ : q
+ : q
 ⊢ q

tests/lean/badIhName.lean.expected.out

@@ -4,5 +4,5 @@ case z
 
 case s
 a✝ : Nat
-a_ih✝ : add Nat.z a✝ = a✝
+ : add Nat.z a✝ = a✝
 ⊢ add Nat.z (Nat.s a✝) = Nat.s a✝

tests/lean/bintreeGoal.lean

@@ -0,0 +1,67 @@
+inductive Tree (β : Type v) where
+  | leaf
+  | node (left : Tree β) (key : Nat) (value : β) (right : Tree β)
+  deriving Repr
+
+def Tree.find? (t : Tree β) (k : Nat) : Option β :=
+  match t with
+  | leaf => none
+  | node left key value right =>
+    if k < key then
+      left.find? k
+    else if key < k then
+      right.find? k
+    else
+      some value
+
+def Tree.insert (t : Tree β) (k : Nat) (v : β) : Tree β :=
+  match t with
+  | leaf => node leaf k v leaf
+  | node left key value right =>
+    if k < key then
+      node (left.insert k v) key value right
+    else if key < k then
+      node left key value (right.insert k v)
+    else
+      node left k v right
+
+inductive ForallTree (p : Nat → β → Prop) : Tree β → Prop
+  | leaf : ForallTree p .leaf
+  | node :
+     ForallTree p left →
+     p key value →
+     ForallTree p right →
+     ForallTree p (.node left key value right)
+
+inductive BST : Tree β → Prop
+  | leaf : BST .leaf
+  | node :
+     {value : β} →
+     ForallTree (fun k v => k < key) left →
+     ForallTree (fun k v => key < k) right →
+     BST left → BST right →
+     BST (.node left key value right)
+
+def BinTree (β : Type u) := { t : Tree β // BST t }
+
+def BinTree.mk : BinTree β :=
+  ⟨.leaf, .leaf⟩
+
+def BinTree.find? (b : BinTree β) (k : Nat) : Option β :=
+  b.val.find? k
+
+def BinTree.insert (b : BinTree β) (k : Nat) (v : β) : BinTree β :=
+  ⟨b.val.insert k v, sorry⟩
+
+attribute [local simp]
+  BinTree.mk BinTree.find?
+  BinTree.insert Tree.find? Tree.insert
+
+theorem BinTree.find_insert (b : BinTree β) (k : Nat) (v : β)
+        : (b.insert k v).find? k = some v := by
+  let ⟨t, h⟩ := b; simp
+  induction t with simp
+  | node left key value right ihl ihr =>
+    by_cases k < key <;> simp [*]
+    . cases h; apply ihl; done
+    . sorry

tests/lean/bintreeGoal.lean.expected.out

@@ -0,0 +1,20 @@
+bintreeGoal.lean:54:21-54:26: warning: declaration uses 'sorry'
+bintreeGoal.lean:66:26-66:30: error: unsolved goals
+case node.inl.node
+β : Type u_1
+b : BinTree β
+k : Nat
+v : β
+left : Tree β
+key : Nat
+value : β
+right : Tree β
+ihl : BST left → Tree.find? (Tree.insert left k v) k = some v
+ihr : BST right → Tree.find? (Tree.insert right k v) k = some v
+ : k < key
+ : BST left
+ : ForallTree (fun k v => k < key) left
+ : BST right
+ : ForallTree (fun k v => key < k) right
+⊢ BST left
+bintreeGoal.lean:67:6-67:11: warning: declaration uses 'sorry'

tests/lean/hidingInaccessibleNames.lean.expected.out

@@ -13,18 +13,18 @@ context:
 hidingInaccessibleNames.lean:9:19-9:20: error: don't know how to synthesize placeholder
 context:
 a b x✝¹ : Nat
-x✝ : [a, b] ≠ []
+ : [a, b] ≠ []
 ⊢ Nat
 hidingInaccessibleNames.lean:8:16-8:17: error: don't know how to synthesize placeholder
 context:
 x✝¹ : Nat
-x✝ : [] ≠ []
+ : [] ≠ []
 ⊢ Nat
 hidingInaccessibleNames.lean:10:16-10:17: error: don't know how to synthesize placeholder
 context:
 x✝² : List Nat
 x✝¹ : Nat
-x✝ : x✝² ≠ []
+ : x✝² ≠ []
 ⊢ Nat
 case inl
 p q : Prop

tests/lean/interactive/plainGoal.lean.expected.out

@@ -29,9 +29,9 @@
 {"textDocument": {"uri": "file://plainGoal.lean"},
  "position": {"line": 17, "character": 5}}
 {"rendered":
- "```lean\ncase succ\nn✝ : Nat\nn_ih✝ : 0 + n✝ = n✝\n⊢ 0 + Nat.succ n✝ = Nat.succ n✝\n```",
+ "```lean\ncase succ\nn✝ : Nat\n : 0 + n✝ = n✝\n⊢ 0 + Nat.succ n✝ = Nat.succ n✝\n```",
  "goals":
- ["case succ\nn✝ : Nat\nn_ih✝ : 0 + n✝ = n✝\n⊢ 0 + Nat.succ n✝ = Nat.succ n✝"]}
+ ["case succ\nn✝ : Nat\n : 0 + n✝ = n✝\n⊢ 0 + Nat.succ n✝ = Nat.succ n✝"]}
 {"textDocument": {"uri": "file://plainGoal.lean"},
  "position": {"line": 21, "character": 9}}
 {"rendered": "```lean\nα : Sort ?u\na : α\n⊢ α\n```",

tests/lean/tacUnsolvedGoalsErrors.lean.expected.out

@@ -24,23 +24,23 @@ tacUnsolvedGoalsErrors.lean:17:9-17:10: error: unsolved goals
 case inl
 p q r : Prop
 h2 : p → q
-h✝ : p
+ : p
 ⊢ q
 tacUnsolvedGoalsErrors.lean:19:9-19:10: error: unsolved goals
 case inr
 p q r : Prop
 h2 : p → q
-h✝ : q
+ : q
 ⊢ q
 tacUnsolvedGoalsErrors.lean:26:2-27:8: error: unsolved goals
 case inl
 p q r : Prop
 h2 : p → q
-h✝ : p
+ : p
 ⊢ q
 tacUnsolvedGoalsErrors.lean:28:2-29:8: error: unsolved goals
 case inr
 p q r : Prop
 h2 : p → q
-h✝ : q
+ : q
 ⊢ q

tests/lean/unknownTactic.lean.expected.out

@@ -1,7 +1,7 @@
 unknownTactic.lean:3:3: error: unknown tactic
 unknownTactic.lean:1:41-3:8: error: unsolved goals
 x : Nat
-a✝ : x = x
+ : x = x
 ⊢ x = x
 ---
 unknownTactic.lean:8:22: error: unknown tactic