diff --git a/src/Lean/Meta/Basic.lean b/src/Lean/Meta/Basic.lean index 2b4f5a4da2..6bc9ee7e0f 100644 --- a/src/Lean/Meta/Basic.lean +++ b/src/Lean/Meta/Basic.lean @@ -415,6 +415,10 @@ structure PostponedEntry where structure Diagnostics where /-- Number of times each declaration has been unfolded -/ unfoldCounter : PHashMap Name Nat := {} + /-- + Number of times each axiom was tried to be unfolded, which may point to an inaccessible def value. + -/ + unfoldAxiomCounter : PHashMap Name Nat := {} /-- Number of times `f a =?= f b` heuristic has been used per function `f`. -/ heuristicCounter : PHashMap Name Nat := {} /-- Number of times a TC instance is used. -/ @@ -670,21 +674,30 @@ def mkInfoCacheKey (expr : Expr) (nargs? : Option Nat) : MetaM InfoCacheKey := /-- If diagnostics are enabled, record that `declName` has been unfolded. -/ def recordUnfold (declName : Name) : MetaM Unit := do - modifyDiag fun { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures } => + modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } => let newC := if let some c := unfoldCounter.find? declName then c + 1 else 1 - { unfoldCounter := unfoldCounter.insert declName newC, heuristicCounter, instanceCounter, synthPendingFailures } + { unfoldCounter := unfoldCounter.insert declName newC, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } + +def recordUnfoldAxiom (declName : Name) : MetaM Unit := do + modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } => + let newC := if let some c := unfoldAxiomCounter.find? declName then c + 1 else 1 + { unfoldCounter, unfoldAxiomCounter := unfoldAxiomCounter.insert declName newC, heuristicCounter, instanceCounter, synthPendingFailures } + +def resetUnfoldAxiom : MetaM Unit := do + modifyDiag fun { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures, .. } => + { unfoldCounter, unfoldAxiomCounter := {}, heuristicCounter, instanceCounter, synthPendingFailures } /-- If diagnostics are enabled, record that heuristic for solving `f a =?= f b` has been used. -/ def recordDefEqHeuristic (declName : Name) : MetaM Unit := do - modifyDiag fun { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures } => + modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } => let newC := if let some c := heuristicCounter.find? declName then c + 1 else 1 - { unfoldCounter, heuristicCounter := heuristicCounter.insert declName newC, instanceCounter, synthPendingFailures } + { unfoldCounter, unfoldAxiomCounter, heuristicCounter := heuristicCounter.insert declName newC, instanceCounter, synthPendingFailures } /-- If diagnostics are enabled, record that instance `declName` was used during TC resolution. -/ def recordInstance (declName : Name) : MetaM Unit := do - modifyDiag fun { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures } => + modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } => let newC := if let some c := instanceCounter.find? declName then c + 1 else 1 - { unfoldCounter, heuristicCounter, instanceCounter := instanceCounter.insert declName newC, synthPendingFailures } + { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter := instanceCounter.insert declName newC, synthPendingFailures } /-- If diagnostics are enabled, record that synth pending failures. -/ def recordSynthPendingFailure (type : Expr) : MetaM Unit := do @@ -692,8 +705,8 @@ def recordSynthPendingFailure (type : Expr) : MetaM Unit := do unless (← get).diag.synthPendingFailures.contains type do -- We need to save the full context since type class resolution uses multiple metavar contexts and different local contexts let msg ← addMessageContextFull m!"{type}" - modifyDiag fun { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures } => - { unfoldCounter, heuristicCounter, instanceCounter, synthPendingFailures := synthPendingFailures.insert type msg } + modifyDiag fun { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures } => + { unfoldCounter, unfoldAxiomCounter, heuristicCounter, instanceCounter, synthPendingFailures := synthPendingFailures.insert type msg } def getLocalInstances : MetaM LocalInstances := return (← read).localInstances diff --git a/src/Lean/Meta/Check.lean b/src/Lean/Meta/Check.lean index 2e5b1c41b9..a4156653c4 100644 --- a/src/Lean/Meta/Check.lean +++ b/src/Lean/Meta/Check.lean @@ -8,6 +8,7 @@ module prelude public import Lean.Meta.InferType public import Lean.Meta.Sorry +import Lean.AddDecl public section @@ -206,13 +207,13 @@ def mkHasTypeButIsExpectedMsg (givenType expectedType : Expr) (trailing? : Option MessageData := none) (trailingExprs : Array Expr := #[]) : MetaM MessageData := do return MessageData.ofLazyM (es := #[givenType, expectedType] ++ trailingExprs) do - try + let mut msg ← (try let givenTypeType ← inferType givenType let expectedTypeType ← inferType expectedType if (← isDefEqGuarded givenTypeType expectedTypeType) then let (givenType, expectedType) ← addPPExplicitToExposeDiff givenType expectedType let trailing := trailing?.map (m!"\n" ++ ·) |>.getD .nil - return m!"has type{indentExpr givenType}\n\ + pure m!"has type{indentExpr givenType}\n\ but is expected to have type{indentExpr expectedType}{trailing}" else let (givenType, expectedType) ← addPPExplicitToExposeDiff givenType expectedType @@ -220,12 +221,25 @@ def mkHasTypeButIsExpectedMsg (givenType expectedType : Expr) let trailing := match trailing? with | none => inlineExprTrailing expectedTypeType | some trailing => inlineExpr expectedTypeType ++ trailing - return m!"has type{indentExpr givenType}\nof sort{inlineExpr givenTypeType}\ + pure m!"has type{indentExpr givenType}\nof sort{inlineExpr givenTypeType}\ but is expected to have type{indentExpr expectedType}\nof sort{trailing}" catch _ => let (givenType, expectedType) ← addPPExplicitToExposeDiff givenType expectedType let trailing := trailing?.map (m!"\n" ++ ·) |>.getD .nil - return m!"has type{indentExpr givenType}\nbut is expected to have type{indentExpr expectedType}{trailing}" + pure m!"has type{indentExpr givenType}\nbut is expected to have type{indentExpr expectedType}{trailing}") + let env ← getEnv + if env.header.isModule then + let origDiag := (← get).diag + let _ ← observing <| withOptions (diagnostics.set · true) <| isDefEq givenType expectedType + let blocked := (← get).diag.unfoldAxiomCounter.toList.filterMap fun (n, count) => do + let count := count - origDiag.unfoldAxiomCounter.findD n 0 + guard <| count > 0 && getOriginalConstKind? env n matches some .defn + return m!"{.ofConstName n} ↦ {count}" + if !blocked.isEmpty then + msg := msg ++ MessageData.note m!"The following definitions were not unfolded because \ + their definition is not exposed:{indentD <| .joinSep blocked Format.line}" + modify ({ · with diag := origDiag }) + return msg def throwAppTypeMismatch (f a : Expr) : MetaM α := do -- Clarify that `a` is "last" only if it may be confused with some preceding argument; otherwise, diff --git a/src/Lean/Meta/GetUnfoldableConst.lean b/src/Lean/Meta/GetUnfoldableConst.lean index 7d5b1a1a33..ddd3f13809 100644 --- a/src/Lean/Meta/GetUnfoldableConst.lean +++ b/src/Lean/Meta/GetUnfoldableConst.lean @@ -58,6 +58,7 @@ def getUnfoldableConstNoEx? (constName : Name) : MetaM (Option ConstantInfo) := match (← getEnv).find? constName with | some (info@(.thmInfo _)) => getTheoremInfo info | some (info@(.defnInfo _)) => if (← canUnfold info) then return info else return none + | some (.axiomInfo _) => recordUnfoldAxiom constName; return none | _ => return none end Meta diff --git a/src/Lean/Meta/WHNF.lean b/src/Lean/Meta/WHNF.lean index 8cb60b50d3..6ab878d83a 100644 --- a/src/Lean/Meta/WHNF.lean +++ b/src/Lean/Meta/WHNF.lean @@ -691,6 +691,7 @@ where deltaBetaDefinition c lvls e.getAppRevArgs (fun _ => return e) go else return e + | .axiomInfo val => recordUnfoldAxiom val.name; return e | _ => return e | .proj _ i c => let k (c : Expr) := do @@ -813,6 +814,8 @@ mutual recordUnfold fInfo.name deltaBetaDefinition fInfo fLvls e.getAppRevArgs (fun _ => pure none) (fun e => pure (some e)) else + if fInfo.isAxiom then + recordUnfoldAxiom fInfo.name return none if smartUnfolding.get (← getOptions) then match ((← getEnv).find? (skipRealize := true) (mkSmartUnfoldingNameFor fInfo.name)) with @@ -882,7 +885,10 @@ mutual if smartUnfolding.get (← getOptions) && (← getEnv).contains (mkSmartUnfoldingNameFor declName) then return none else - unless cinfo.hasValue do return none + unless cinfo.hasValue do + if cinfo.isAxiom then + recordUnfoldAxiom cinfo.name + return none deltaDefinition cinfo lvls (fun _ => pure none) (fun e => do recordUnfold declName; pure (some e)) diff --git a/tests/pkg/module/Module/Basic.lean b/tests/pkg/module/Module/Basic.lean index e6a0ff0a25..4a92ec5580 100644 --- a/tests/pkg/module/Module/Basic.lean +++ b/tests/pkg/module/Module/Basic.lean @@ -96,6 +96,9 @@ has type Vector Unit 1 but is expected to have type Vector Unit f + +Note: The following definitions were not unfolded because their definition is not exposed: + f ↦ 1 -/ #guard_msgs in public theorem v (x : Vector Unit f) (y : Vector Unit 1) : x = y := testSorry diff --git a/tests/pkg/module/Module/Imported.lean b/tests/pkg/module/Module/Imported.lean index d6a40c804b..63e17f13e9 100644 --- a/tests/pkg/module/Module/Imported.lean +++ b/tests/pkg/module/Module/Imported.lean @@ -12,6 +12,20 @@ info: def f : Nat := #guard_msgs in #print f +/-- +error: Type mismatch + rfl +has type + ?m.5 = ?m.5 +but is expected to have type + f = 1 + +Note: The following definitions were not unfolded because their definition is not exposed: + f ↦ 1 +-/ +#guard_msgs in +example : f = 1 := rfl + /-! Theorems should be exported without their bodies -/ /-- diff --git a/tests/pkg/module/Module/ImportedAll.lean b/tests/pkg/module/Module/ImportedAll.lean index f2ef22a419..a2b1b22e25 100644 --- a/tests/pkg/module/Module/ImportedAll.lean +++ b/tests/pkg/module/Module/ImportedAll.lean @@ -24,6 +24,9 @@ has type Vector Unit 1 but is expected to have type Vector Unit f + +Note: The following definitions were not unfolded because their definition is not exposed: + f ↦ 1 -/ #guard_msgs in public theorem v (x : Vector Unit f) (y : Vector Unit 1) : x = y := sorry