fix: tag refine subgoals

This commit is contained in:
Leonardo de Moura 2020-01-19 09:04:25 -08:00
parent 15bed7c95c
commit 655da9baef
3 changed files with 33 additions and 1 deletions

View file

@ -59,6 +59,7 @@ def liftMetaM {α} (ref : Syntax) (x : MetaM α) : TacticM α := liftTermElabM $
def getEnv : TacticM Environment := do s ← get; pure s.env
def getMCtx : TacticM MetavarContext := do s ← get; pure s.mctx
@[inline] def modifyMCtx (f : MetavarContext → MetavarContext) : TacticM Unit := modify $ fun s => { mctx := f s.mctx, .. s }
def getLCtx : TacticM LocalContext := do ctx ← read; pure ctx.lctx
def getLocalInsts : TacticM LocalInstances := do ctx ← read; pure ctx.localInstances
def getOptions : TacticM Options := do ctx ← read; pure ctx.config.opts
@ -237,6 +238,25 @@ done ref;
setGoals gs;
pure a
/--
Use `parentTag` to tag untagged goals at `newGoals`.
If there are multiple new goals, they are named using `<parentTag>.<newSuffix>_<idx>` where `idx > 0`.
If there is only one new goal, then we just use `parentTag` -/
def tagUntaggedGoals (parentTag : Name) (newSuffix : Name) (newGoals : List MVarId) : TacticM Unit := do
mctx ← getMCtx;
match newGoals with
| [g] => modifyMCtx $ fun mctx => if mctx.isAnonymousMVar g then mctx.renameMVar g parentTag else mctx
| _ => modifyMCtx $ fun mctx =>
let (mctx, _) := newGoals.foldl
(fun (acc : MetavarContext × Nat) (g : MVarId) =>
let (mctx, idx) := acc;
if mctx.isAnonymousMVar g then
(mctx.renameMVar g (parentTag ++ newSuffix.appendIndexAfter idx), idx+1)
else
acc)
(mctx, 1);
mctx
@[builtinTactic seq] def evalSeq : Tactic :=
fun stx => (stx.getArg 0).forSepArgsM evalTactic

View file

@ -44,7 +44,9 @@ fun stx => match_syntax stx with
val ← elabTerm e decl.type;
val ← ensureHasType ref decl.type val;
assignExprMVar g val;
collectMVars ref val
gs' ← collectMVars ref val;
tagUntaggedGoals decl.userName `refine gs';
pure gs'
};
setGoals (gs' ++ gs)
| _ => throwUnsupportedSyntax

View file

@ -332,6 +332,16 @@ match mctx.findLevelDepth? mvarId with
| some d => d
| none => panic! "unknown metavariable"
def isAnonymousMVar (mctx : MetavarContext) (mvarId : MVarId) : Bool :=
match mctx.findDecl? mvarId with
| none => false
| some mvarDecl => mvarDecl.userName.isAnonymous
def renameMVar (mctx : MetavarContext) (mvarId : MVarId) (newUserName : Name) : MetavarContext :=
match mctx.findDecl? mvarId with
| none => panic! "unknown metavariable"
| some mvarDecl => { decls := mctx.decls.insert mvarId { userName := newUserName, .. mvarDecl }, .. mctx }
@[export lean_metavar_ctx_assign_level]
def assignLevel (m : MetavarContext) (mvarId : MVarId) (val : Level) : MetavarContext :=
{ lAssignment := m.lAssignment.insert mvarId val, .. m }