fix: implement assertAfter using revert

This commit is contained in:
Gabriel Ebner 2022-12-18 14:43:18 -08:00
parent eeab2af7ae
commit 572ffe77e3
3 changed files with 32 additions and 25 deletions

View file

@ -5,6 +5,7 @@ Authors: Leonardo de Moura
-/
import Lean.Meta.Tactic.FVarSubst
import Lean.Meta.Tactic.Intro
import Lean.Meta.Tactic.Revert
namespace Lean.Meta
@ -72,27 +73,15 @@ structure AssertAfterResult where
It assumes `val` has type `type`, and that `type` is well-formed after `fvarId`.
Note that `val` does not need to be well-formed after `fvarId`. That is, it may contain variables that are defined after `fvarId`. -/
def _root_.Lean.MVarId.assertAfter (mvarId : MVarId) (fvarId : FVarId) (userName : Name) (type : Expr) (val : Expr) : MetaM AssertAfterResult := do
mvarId.withContext do
mvarId.checkNotAssigned `assertAfter
let tag ← mvarId.getTag
let target ← mvarId.getType
let localDecl ← fvarId.getDecl
let lctx ← getLCtx
let localInsts ← getLocalInstances
let fvarIds := lctx.foldl (init := #[]) (start := localDecl.index+1) fun fvarIds decl => fvarIds.push decl.fvarId
let xs := fvarIds.map mkFVar
let targetNew ← mkForallFVars xs target (usedLetOnly := false)
let targetNew := Lean.mkForall userName BinderInfo.default type targetNew
let lctxNew := fvarIds.foldl (init := lctx) fun lctxNew fvarId => lctxNew.erase fvarId
let localInstsNew := localInsts.filter fun inst => !fvarIds.contains inst.fvar.fvarId!
let mvarNew ← mkFreshExprMVarAt lctxNew localInstsNew targetNew MetavarKind.syntheticOpaque tag
let args := (fvarIds.filter fun fvarId => !(lctx.get! fvarId).isLet).map mkFVar
let args := #[val] ++ args
mvarId.assign (mkAppN mvarNew args)
let (fvarIdNew, mvarIdNew) ← mvarNew.mvarId!.intro1P
let (fvarIdsNew, mvarIdNew) ← mvarIdNew.introNP fvarIds.size
let subst := fvarIds.size.fold (init := {}) fun i subst => subst.insert fvarIds[i]! (mkFVar fvarIdsNew[i]!)
return { fvarId := fvarIdNew, mvarId := mvarIdNew, subst := subst }
mvarId.checkNotAssigned `assertAfter
let (fvarIds, mvarId) ← mvarId.revertAfter fvarId
let mvarId ← mvarId.assert userName type val
let (fvarIdNew, mvarId) ← mvarId.intro1P
let (fvarIdsNew, mvarId) ← mvarId.introNP fvarIds.size
let mut subst := {}
for f in fvarIds, fNew in fvarIdsNew do
subst := subst.insert f (mkFVar fNew)
return { fvarId := fvarIdNew, mvarId, subst }
@[deprecated MVarId.assertAfter]
def assertAfter (mvarId : MVarId) (fvarId : FVarId) (userName : Name) (type : Expr) (val : Expr) : MetaM AssertAfterResult := do

View file

@ -10,14 +10,16 @@ namespace Lean.Meta
/--
Revert free variables `fvarIds` at goal `mvarId`.
-/
def _root_.Lean.MVarId.revert (mvarId : MVarId) (fvarIds : Array FVarId) (preserveOrder : Bool := false) : MetaM (Array FVarId × MVarId) := do
def _root_.Lean.MVarId.revert (mvarId : MVarId) (fvarIds : Array FVarId) (preserveOrder : Bool := false)
(clearAuxDeclsInsteadOfRevert := false) : MetaM (Array FVarId × MVarId) := do
if fvarIds.isEmpty then
pure (#[], mvarId)
else mvarId.withContext do
mvarId.checkNotAssigned `revert
for fvarId in fvarIds do
if (← fvarId.getDecl) |>.isAuxDecl then
throwError "failed to revert {mkFVar fvarId}, it is an auxiliary declaration created to represent recursive definitions"
unless clearAuxDeclsInsteadOfRevert do
for fvarId in fvarIds do
if (← fvarId.getDecl) |>.isAuxDecl then
throwError "failed to revert {mkFVar fvarId}, it is an auxiliary declaration created to represent recursive definitions"
let fvars := fvarIds.map mkFVar
let toRevert ← collectForwardDeps fvars preserveOrder
/- We should clear any `auxDecl` in `toRevert` -/
@ -43,6 +45,13 @@ def _root_.Lean.MVarId.revert (mvarId : MVarId) (fvarIds : Array FVarId) (preser
mvar.mvarId!.setTag tag
return (toRevert.map Expr.fvarId!, mvar.mvarId!)
/-- Reverts all local declarations after `fvarId`. -/
def _root_.Lean.MVarId.revertAfter (mvarId : MVarId) (fvarId : FVarId) : MetaM (Array FVarId × MVarId) :=
mvarId.withContext do
let localDecl ← fvarId.getDecl
let fvarIds := (← getLCtx).foldl (init := #[]) (start := localDecl.index+1) fun fvarIds decl => fvarIds.push decl.fvarId
mvarId.revert fvarIds (preserveOrder := true) (clearAuxDeclsInsteadOfRevert := true)
@[deprecated MVarId.revert]
def revert (mvarId : MVarId) (fvarIds : Array FVarId) (preserveOrder : Bool := false) : MetaM (Array FVarId × MVarId) := do
mvarId.revert fvarIds preserveOrder

9
tests/lean/run/1963.lean Normal file
View file

@ -0,0 +1,9 @@
variable (x : Id Nat) (h : x = x)
theorem Id_def : Id α = α := rfl
theorem bar : x = x.succ := by
rw [Id_def] at x
-- rw should not expose the auxdecl `bar`:
fail_if_success assumption
sorry