diff --git a/src/Lean/Meta/Sym/Simp/Forall.lean b/src/Lean/Meta/Sym/Simp/Forall.lean index 9d98a3571b..4032430bd7 100644 --- a/src/Lean/Meta/Sym/Simp/Forall.lean +++ b/src/Lean/Meta/Sym/Simp/Forall.lean @@ -81,7 +81,7 @@ public def simpForall (e : Expr) : SimpM Result := do else if (← isProp e) then let n := getForallTelescopeSize e.bindingBody! 1 forallBoundedTelescope e n fun xs b => withoutModifyingCacheIfNotWellBehaved do - main xs b + main xs (← share b) else return .rfl where @@ -90,7 +90,7 @@ where | .rfl _ => return .rfl | .step b' h _ => let h ← mkLambdaFVars xs h - let e' ← shareCommonInc (← mkForallFVars xs b') + let e' ← share (← mkForallFVars xs b') -- **Note**: consider caching the forall-congr theorems let hcongr ← mkForallCongrFor xs return .step e' (mkApp3 hcongr (← mkLambdaFVars xs b) (← mkLambdaFVars xs b') h) diff --git a/src/Lean/Meta/Sym/Simp/Lambda.lean b/src/Lean/Meta/Sym/Simp/Lambda.lean index 7ee3694695..98a4d0f223 100644 --- a/src/Lean/Meta/Sym/Simp/Lambda.lean +++ b/src/Lean/Meta/Sym/Simp/Lambda.lean @@ -48,14 +48,14 @@ def mkFunextFor (xs : Array Expr) (β : Expr) : MetaM Expr := do public def simpLambda (e : Expr) : SimpM Result := do lambdaTelescope e fun xs b => withoutModifyingCacheIfNotWellBehaved do - main xs b + main xs (← share b) where main (xs : Array Expr) (b : Expr) : SimpM Result := do match (← simp b) with | .rfl _ => return .rfl | .step b' h _ => let h ← mkLambdaFVars xs h - let e' ← shareCommonInc (← mkLambdaFVars xs b') + let e' ← share (← mkLambdaFVars xs b') let funext ← getFunext xs b return .step e' (mkApp3 funext e e' h) diff --git a/src/Lean/Meta/Sym/Util.lean b/src/Lean/Meta/Sym/Util.lean index 509ba81d8e..22e7b314c6 100644 --- a/src/Lean/Meta/Sym/Util.lean +++ b/src/Lean/Meta/Sym/Util.lean @@ -9,6 +9,7 @@ public import Lean.Meta.Sym.SymM public import Lean.Meta.Transform import Init.Grind.Util import Lean.Meta.WHNF +import Lean.Util.ForEachExpr namespace Lean.Meta.Sym /-- @@ -91,4 +92,21 @@ public def preprocessMVar (mvarId : MVarId) : SymM MVarId := do mvarId.assign mvarNew return mvarNew.mvarId! +/-- Debug helper: throws if any subexpression of `e` is not in the table of maximally shared terms. -/ +public def _root_.Lean.Expr.checkMaxShared (e : Expr) (msg := "") : SymM Unit := do + e.forEach fun e => do + if let some prev := (← get).share.set.find? { expr := e } then + unless isSameExpr prev.expr e do + throwNotMaxShared e + else + throwNotMaxShared e +where + throwNotMaxShared (e : Expr) : SymM Unit := do + let msg := if msg == "" then msg else s!"[{msg}] " + throwError "{msg}term is not in the maximally shared table{indentExpr e}" + +/-- Debug helper: throws if any subexpression of the goal's target type is not in the table of maximally shared. -/ +public def _root_.Lean.MVarId.checkMaxShared (mvarId : MVarId) (msg := "") : SymM Unit := do + (← mvarId.getDecl).type.checkMaxShared msg + end Lean.Meta.Sym