diff --git a/src/Lean/Meta/Tactic/Cbv/Main.lean b/src/Lean/Meta/Tactic/Cbv/Main.lean index 5e3f26ad1d..23b562155f 100644 --- a/src/Lean/Meta/Tactic/Cbv/Main.lean +++ b/src/Lean/Meta/Tactic/Cbv/Main.lean @@ -8,6 +8,7 @@ module prelude public import Lean.Meta.Sym.Simp.SimpM +public import Lean.Meta.Tactic.Cbv.Opaque import Lean.Meta.Tactic.Cbv.Util import Lean.Meta.Tactic.Cbv.TheoremsLookup import Lean.Meta.Sym @@ -78,6 +79,14 @@ def handleApp : Simproc := fun e => do | .lam .. => betaReduce e | _ => return .rfl +def isOpaqueApp : Simproc := fun e => do + let some fnName := e.getAppFn.constName? | return .rfl + return .rfl (← isCbvOpaque fnName) + +def isOpaqueConst : Simproc := fun e => do + let .const constName _ := e | return .rfl + return .rfl (← isCbvOpaque constName) + def foldLit : Simproc := fun e => do let some n := e.rawNatLit? | return .rfl -- TODO: check performance of sharing @@ -139,7 +148,9 @@ def handleConst : Simproc := fun e => do def cbvPre : Simproc := isBuiltinValue <|> isProofTerm <|> skipBinders - >> (tryMatcher >> simpControl) <|> (handleConst <|> simplifyAppFn <|> handleProj) + >> isOpaqueApp + >> (tryMatcher >> simpControl) + <|> ((isOpaqueConst >> handleConst) <|> simplifyAppFn <|> handleProj) def cbvPost : Simproc := evalGround diff --git a/src/Lean/Meta/Tactic/Cbv/Opaque.lean b/src/Lean/Meta/Tactic/Cbv/Opaque.lean new file mode 100644 index 0000000000..f85246d1ce --- /dev/null +++ b/src/Lean/Meta/Tactic/Cbv/Opaque.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Lean FRO, LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wojciech Różowski +-/ +module + +prelude +public import Lean.ScopedEnvExtension + +public section + +namespace Lean.Meta.Tactic.Cbv + +abbrev CbvOpaqueExtension := SimpleScopedEnvExtension Name (Std.HashSet Name) + +builtin_initialize cbvOpaqueExt : CbvOpaqueExtension ← + registerSimpleScopedEnvExtension { + name := `cbvOpaqueExt + initial := {} + addEntry := fun s n => s.insert n + } + +builtin_initialize + registerBuiltinAttribute { + ref := `cbvOpaqueAttr + name := `cbv_opaque + descr := "Mark declarations that should not be unfolded by the `cbv` tactic" + applicationTime := AttributeApplicationTime.afterCompilation + add := fun declName _ kind => + cbvOpaqueExt.add declName kind + erase := fun declName => do + let s := cbvOpaqueExt.getState (← getEnv) + modifyEnv fun env => cbvOpaqueExt.modifyState env fun _ => s.erase declName + } + +def cbvOpaque : CoreM (Std.HashSet Name) := do + return cbvOpaqueExt.getState (← getEnv) + +def isCbvOpaque (name : Name) : CoreM Bool := do + return cbvOpaqueExt.getState (← getEnv) |>.contains name + +end Lean.Meta.Tactic.Cbv diff --git a/tests/lean/run/cbv1.lean b/tests/lean/run/cbv1.lean index 6e53445e70..5af12ef451 100644 --- a/tests/lean/run/cbv1.lean +++ b/tests/lean/run/cbv1.lean @@ -171,3 +171,18 @@ example : Nat.brazilianFactorial 7 = 125411328000 := by conv => lhs cbv + +attribute [cbv_opaque] Std.DHashMap.emptyWithCapacity +attribute [cbv_opaque] Std.DHashMap.insert +attribute [cbv_opaque] Std.DHashMap.contains +attribute [cbv_opaque] Std.DHashMap.getEntry + +/-- +error: unsolved goals +⊢ (Std.DHashMap.emptyWithCapacity.insert 5 3).contains 5 = true +-/ +#guard_msgs in +example : ((Std.DHashMap.emptyWithCapacity : Std.DHashMap Nat (fun _ => Nat)).insert 5 3).contains 5 = true := by + conv => + lhs + cbv