From 75b4648ba9d53e7032c1196b55e92483ca761a24 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 14 Apr 2024 15:40:57 -0700 Subject: [PATCH] feat: mapply stub --- Pantograph/Goal.lean | 66 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean index c6700b6..176e48e 100644 --- a/Pantograph/Goal.lean +++ b/Pantograph/Goal.lean @@ -252,6 +252,7 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String let goal ← match state.savedState.tactic.goals.get? goalId with | .some goal => pure goal | .none => return .indexError goalId + goal.checkNotAssigned `GoalState.tryAssign let expr ← match Parser.runParserCategory (env := state.env) (catName := `term) @@ -275,6 +276,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St let goal ← match state.savedState.tactic.goals.get? goalId with | .some goal => pure goal | .none => return .indexError goalId + goal.checkNotAssigned `GoalState.tryHave let type ← match Parser.runParserCategory (env := state.env) (catName := `term) @@ -324,6 +326,7 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str let goal ← match state.savedState.tactic.goals.get? goalId with | .some goal => pure goal | .none => return .indexError goalId + goal.checkNotAssigned `GoalState.tryLet let type ← match Parser.runParserCategory (env := state.env) (catName := `term) @@ -369,6 +372,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat): let goal ← match state.savedState.tactic.goals.get? goalId with | .some goal => pure goal | .none => return .indexError goalId + goal.checkNotAssigned `GoalState.conv let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do state.restoreTacticM goal @@ -452,6 +456,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String): (fileName := filename) with | .ok syn => pure syn | .error error => return .parseError error + goal.checkNotAssigned `GoalState.tryCalc let calcPrevRhs? := state.calcPrevRhsOf? goalId let target ← instantiateMVars (← goal.getDecl).type let tag := (← goal.getDecl).userName @@ -510,4 +515,65 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String): catch exception => return .failure #[← exception.toMessageData.toString] +def getForallArgsBody: Expr → List Expr × Expr + | .forallE _ d b _ => + let (innerArgs, innerBody) := getForallArgsBody b + (d :: innerArgs, innerBody) + | e => ([], e) +def collectMotiveArguments (forallBody: Expr): SSet Nat := + -- Get all de Bruijn indices + Id.run $ do + Expr.foldlM (λ acc subexpr => do + match subexpr with + | .app (.bvar i) _ => return acc.insert i + | _ => return acc + ) SSet.empty forallBody + +protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): + Elab.TermElabM TacticResult := do + state.restoreElabM + let goal ← match state.savedState.tactic.goals.get? goalId with + | .some goal => pure goal + | .none => return .indexError goalId + goal.checkNotAssigned `GoalState.tryMotivatedApply + + let recursor ← match Parser.runParserCategory + (env := state.env) + (catName := `term) + (input := recursor) + (fileName := filename) with + | .ok syn => pure syn + | .error error => return .parseError error + try + -- Implemented similarly to the intro tactic + let nextGoals: List MVarId ← goal.withContext do + let recursor ← Elab.Term.elabType (stx := recursor) + let recursorType ← Meta.inferType recursor + + let (forallArgs, forallBody) := getForallArgsBody recursorType + let motiveIndices := collectMotiveArguments forallBody + + let numArgs ← Meta.getExpectedNumArgs recursorType + + let rec go (i: Nat): MetaM (List MVarId × Expr) := do + let argType := forallArgs.get! i + sorry + let (newMVars, assign) ← go numArgs + + goal.assign assign + + pure newMVars + return .success { + root := state.root, + savedState := { + term := ← MonadBacktrack.saveState, + tactic := { goals := nextGoals } + }, + newMVars := nextGoals.toSSet, + parentMVar? := .some goal, + calcPrevRhs? := .none + } + catch exception => + return .failure #[← exception.toMessageData.toString] + end Pantograph