diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean index fdf12cb..044e9e7 100644 --- a/Pantograph/Goal.lean +++ b/Pantograph/Goal.lean @@ -565,7 +565,7 @@ protected def GoalState.tryLet (state : GoalState) (site : Site) (binderName : S /-- Enter conv tactic mode -/ @[export pantograph_goal_state_conv_enter_m] -protected def GoalState.conv (state : GoalState) (site : Site) : +protected def GoalState.convEnter (state : GoalState) (site : Site) : Elab.TermElabM TacticResult := do let .some goal := state.actingGoal? site | throwNoGoals if let .some (.conv ..) := state.fragments[goal]? then @@ -578,13 +578,13 @@ protected def GoalState.conv (state : GoalState) (site : Site) : acc.insert goal fragment } -/-- Exit from `conv` mode, and conclude all conversion tactic sentinels -descended from `goal`. -/ -@[export pantograph_goal_state_conv_exit_m] -protected def GoalState.convExit (state : GoalState) (goal : MVarId): +/-- Exit from a tactic fragment. -/ +@[export pantograph_goal_state_fragment_exit_m] +protected def GoalState.fragmentExit (state : GoalState) (site : Site): Elab.TermElabM TacticResult := do - let .some fragment@(.conv ..) := state.fragments[goal]? | - return .invalidAction "Not in conv state" + let .some goal := state.actingGoal? site | throwNoGoals + let .some fragment := state.fragments[goal]? | + return .invalidAction "Goal does not have a fragment" withCapturingError do let (fragments, state') ← state.step' goal (fragment.exit goal state.fragments) return { @@ -596,19 +596,17 @@ protected def GoalState.calcPrevRhsOf? (state : GoalState) (goal : MVarId) : Opt let .some (.calc prevRhs?) := state.fragments[goal]? | .none prevRhs? -@[export pantograph_goal_state_try_calc_m] -protected def GoalState.tryCalc (state : GoalState) (site : Site) (pred : String) +@[export pantograph_goal_state_calc_enter_m] +protected def GoalState.calcEnter (state : GoalState) (site : Site) : Elab.TermElabM TacticResult := do let .some goal := state.actingGoal? site | throwNoGoals - let prevRhs? := state.calcPrevRhsOf? goal + if let .some _ := state.fragments[goal]? then + return .invalidAction "Goal already has a fragment" withCapturingError do - let (moreFragments, state') ← state.step' goal do - let fragment := Fragment.calc prevRhs? - fragment.step goal pred - let fragments := moreFragments.fold (init := state.fragments.erase goal) λ acc mvarId f => - acc.insert mvarId f + let fragment := Fragment.enterCalc + let fragments := state.fragments.insert goal fragment return { - state' with + state with fragments, } diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean index c1d8d52..d8965fc 100644 --- a/Pantograph/Library.lean +++ b/Pantograph/Library.lean @@ -158,26 +158,26 @@ def goalPrint (state: GoalState) (rootExpr: Bool) (parentExprs: Bool) (goals: Bo } @[export pantograph_goal_have_m] -protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): Elab.TermElabM TacticResult := do +protected def GoalState.tryHave (state: GoalState) (site : Site) (binderName: String) (type: String): Elab.TermElabM TacticResult := do let type ← match (← parseTermM type) with | .ok syn => pure syn | .error error => return .parseError error state.restoreElabM - state.tryTacticM goal $ Tactic.evalHave binderName.toName type + state.tryTacticM site $ Tactic.evalHave binderName.toName type @[export pantograph_goal_try_define_m] -protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): Elab.TermElabM TacticResult := do +protected def GoalState.tryDefine (state: GoalState) (site : Site) (binderName: String) (expr: String): Elab.TermElabM TacticResult := do let expr ← match (← parseTermM expr) with | .ok syn => pure syn | .error error => return .parseError error state.restoreElabM - state.tryTacticM goal (Tactic.evalDefine binderName.toName expr) + state.tryTacticM site $ Tactic.evalDefine binderName.toName expr @[export pantograph_goal_try_draft_m] -protected def GoalState.tryDraft (state: GoalState) (goal: MVarId) (expr: String): Elab.TermElabM TacticResult := do +protected def GoalState.tryDraft (state: GoalState) (site : Site) (expr: String): Elab.TermElabM TacticResult := do let expr ← match (← parseTermM expr) with | .ok syn => pure syn | .error error => return .parseError error state.restoreElabM - state.tryTacticM goal (Tactic.evalDraft expr) + state.tryTacticM site $ Tactic.evalDraft expr -- Cancel the token after a timeout. @[export pantograph_run_cancel_token_with_timeout_m] diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean index d4e4a61..8773b1d 100644 --- a/Pantograph/Protocol.lean +++ b/Pantograph/Protocol.lean @@ -87,6 +87,7 @@ structure InteractionError where deriving Lean.ToJson def errorIndex (desc: String): InteractionError := { error := "index", desc } +def errorOperation (desc: String): InteractionError := { error := "operation", desc } def errorExpr (desc: String): InteractionError := { error := "expr", desc } @@ -248,17 +249,17 @@ structure GoalStartResult where root: String deriving Lean.ToJson structure GoalTactic where - -- Identifiers for tree, state, and goal stateId: Nat - goalId: Nat := 0 + -- If omitted, act on the first goal + goalId?: Option Nat := .none + -- If set to true, goal will not go dormant. Defaults to `automaticMode` + autoResume?: Option Bool := .none -- One of the fields here must be filled tactic?: Option String := .none + mode?: Option String := .none -- Changes the current category to {"tactic", "calc", "conv"} expr?: Option String := .none have?: Option String := .none let?: Option String := .none - calc?: Option String := .none - -- true to enter `conv`, `false` to exit. In case of exit the `goalId` is ignored. - conv?: Option Bool := .none draft?: Option String := .none -- In case of the `have` tactic, the new free variable name is provided here diff --git a/Pantograph/Tactic/Fragment.lean b/Pantograph/Tactic/Fragment.lean index f6ad6b7..ad01aaa 100644 --- a/Pantograph/Tactic/Fragment.lean +++ b/Pantograph/Tactic/Fragment.lean @@ -33,8 +33,7 @@ protected def Fragment.map (fragment : Fragment) (mapExpr : Expr → CoreM Expr) | .convSentinel parent => do return .convSentinel (← mapMVar parent) -protected def Fragment.enterCalc : Elab.Tactic.TacticM Fragment := do - return .calc .none +protected def Fragment.enterCalc : Fragment := .calc .none protected def Fragment.enterConv : Elab.Tactic.TacticM FragmentMap := do let goal ← Elab.Tactic.getMainGoal goal.checkNotAssigned `GoalState.conv diff --git a/Repl.lean b/Repl.lean index df38664..9927d6e 100644 --- a/Repl.lean +++ b/Repl.lean @@ -108,6 +108,73 @@ structure CompilationUnit where messages : Array String newConstants : List Name +def goal_tactic (args: Protocol.GoalTactic): EMainM Protocol.GoalTacticResult := do + let state ← getMainState + let .some goalState := state.goalStates[args.stateId]? | + Protocol.throw $ Protocol.errorIndex s!"Invalid state index {args.stateId}" + let unshielded := args.autoResume?.getD state.options.automaticMode + let site ← match args.goalId?, unshielded with + | .some goalId, true => do + let .some goal := goalState.goals[goalId]? | + Protocol.throw $ Protocol.errorIndex s!"Invalid goal index {goalId}" + pure (.prefer goal) + | .some goalId, false => do + let .some goal := goalState.goals[goalId]? | + Protocol.throw $ Protocol.errorIndex s!"Invalid goal index {goalId}" + pure (.focus goal) + | .none, true => pure .unfocus + | .none, false => do + let .some goal := goalState.mainGoal? | + Protocol.throw $ Protocol.errorIndex s!"No goals to be solved" + pure (.focus goal) + let nextGoalState?: Except _ TacticResult ← liftTermElabM do + -- NOTE: Should probably use a macro to handle this... + match args.tactic?, args.mode?, args.expr?, args.have?, args.let?, args.draft? with + | .some tactic, .none, .none, .none, .none, .none => do + pure $ Except.ok $ ← goalState.tryTactic site tactic + | .none, .some mode, .none, .none, .none, .none => match mode with + | "tactic" => do -- Exit from the current fragment + pure $ Except.ok $ ← goalState.fragmentExit site + | "conv" => do + pure $ Except.ok $ ← goalState.convEnter site + | "calc" => do + pure $ Except.ok $ ← goalState.calcEnter site + | _ => pure $ .error $ Protocol.errorOperation s!"Invalid mode {mode}" + | .none, .none, .some expr, .none, .none, .none => do + pure $ Except.ok $ ← goalState.tryAssign site expr + | .none, .none, .none, .some type, .none, .none => do + let binderName := args.binderName?.getD "" + pure $ Except.ok $ ← goalState.tryHave site binderName type + | .none, .none, .none, .none, .some type, .none => do + let binderName := args.binderName?.getD "" + pure $ Except.ok $ ← goalState.tryLet site binderName type + | .none, .none, .none, .none, .none, .some draft => do + pure $ Except.ok $ ← goalState.tryDraft site draft + | _, _, _, _, _, _ => + pure $ .error $ Protocol.errorOperation + "Exactly one of {tactic, mode, expr, have, let, draft} must be supplied" + match nextGoalState? with + | .error error => Protocol.throw error + | .ok (.success nextGoalState messages) => do + let nextStateId ← newGoalState nextGoalState + let parentExprs := nextGoalState.parentExprs + let hasSorry := parentExprs.any (·.hasSorry) + let hasUnsafe := parentExprs.any ((← getEnv).hasUnsafe ·) + let goals ← runCoreM $ nextGoalState.serializeGoals (options := state.options) |>.run' + return { + nextStateId? := .some nextStateId, + goals? := .some goals, + messages? := .some messages, + hasSorry, + hasUnsafe, + } + | .ok (.parseError message) => + return { messages? := .none, parseError? := .some message } + | .ok (.invalidAction message) => + Protocol.throw $ errorI "invalid" message + | .ok (.failure messages) => + return { messages? := .some messages } + def frontend_process (args: Protocol.FrontendProcess): EMainM Protocol.FrontendProcessResult := do let options := (← getMainState).options let (fileName, file) ← match args.fileName?, args.file? with @@ -225,7 +292,6 @@ def execute (command: Protocol.Command): MainM Json := do return toJson error where errorCommand := errorI "command" - errorIndex := errorI "index" errorIO := errorI "io" -- Command Functions reset (_: Protocol.Reset): EMainM Protocol.StatResult := do @@ -290,7 +356,7 @@ def execute (command: Protocol.Command): MainM Json := do | .some expr, .none => goalStartExpr expr |>.run | .none, .some copyFrom => do (match (← getEnv).find? <| copyFrom.toName with - | .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}" + | .none => return .error <| Protocol.errorIndex s!"Symbol not found: {copyFrom}" | .some cInfo => return .ok (← GoalState.create cInfo.type)) | _, _ => return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied" @@ -299,72 +365,14 @@ def execute (command: Protocol.Command): MainM Json := do | .ok goalState => let stateId ← newGoalState goalState return { stateId, root := goalState.root.name.toString } - goal_tactic (args: Protocol.GoalTactic): EMainM Protocol.GoalTacticResult := do - let state ← getMainState - let .some goalState := state.goalStates[args.stateId]? | - Protocol.throw $ errorIndex s!"Invalid state index {args.stateId}" - -- FIXME: Allow proper conversion tactic exit even in automatic mode - let .some goal := goalState.goals[args.goalId]? | - Protocol.throw $ errorIndex s!"Invalid goal index {args.goalId}" - let nextGoalState?: Except _ TacticResult ← liftTermElabM do - -- NOTE: Should probably use a macro to handle this... - match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv?, args.draft? with - | .some tactic, .none, .none, .none, .none, .none, .none => do - pure <| Except.ok <| ← goalState.tryTactic goal tactic - | .none, .some expr, .none, .none, .none, .none, .none => do - pure <| Except.ok <| ← goalState.tryAssign goal expr - | .none, .none, .some type, .none, .none, .none, .none => do - let binderName := args.binderName?.getD "" - pure <| Except.ok <| ← goalState.tryHave goal binderName type - | .none, .none, .none, .some type, .none, .none, .none => do - let binderName := args.binderName?.getD "" - pure <| Except.ok <| ← goalState.tryLet goal binderName type - | .none, .none, .none, .none, .some pred, .none, .none => do - pure <| Except.ok <| ← goalState.tryCalc goal pred - | .none, .none, .none, .none, .none, .some true, .none => do - pure <| Except.ok <| ← goalState.conv goal - | .none, .none, .none, .none, .none, .some false, .none => do - pure <| Except.ok <| ← goalState.convExit goal - | .none, .none, .none, .none, .none, .none, .some draft => do - pure <| Except.ok <| ← goalState.tryDraft goal draft - | _, _, _, _, _, _, _ => - let error := errorI "arguments" "Exactly one of {tactic, expr, have, let, calc, conv, draft} must be supplied" - pure $ .error error - match nextGoalState? with - | .error error => Protocol.throw error - | .ok (.success nextGoalState messages) => do - let nextGoalState ← match state.options.automaticMode, args.conv? with - | true, .none => do - pure $ nextGoalState.immediateResume goalState - | true, .some true => pure nextGoalState - | true, .some false => pure nextGoalState - | false, _ => pure nextGoalState - let nextStateId ← newGoalState nextGoalState - let parentExprs := nextGoalState.parentExprs - let hasSorry := parentExprs.any (·.hasSorry) - let hasUnsafe := parentExprs.any ((← getEnv).hasUnsafe ·) - let goals ← runCoreM $ nextGoalState.serializeGoals (options := state.options) |>.run' - return { - nextStateId? := .some nextStateId, - goals? := .some goals, - messages? := .some messages, - hasSorry, - hasUnsafe, - } - | .ok (.parseError message) => - return { messages? := .none, parseError? := .some message } - | .ok (.invalidAction message) => - Protocol.throw $ errorI "invalid" message - | .ok (.failure messages) => - return { messages? := .some messages } goal_continue (args: Protocol.GoalContinue): EMainM Protocol.GoalContinueResult := do let state ← getMainState let .some target := state.goalStates[args.target]? | - Protocol.throw $ errorIndex s!"Invalid state index {args.target}" + Protocol.throw $ Protocol.errorIndex s!"Invalid state index {args.target}" let nextGoalState? : GoalState ← match args.branch?, args.goals? with | .some branchId, .none => do match state.goalStates[branchId]? with - | .none => Protocol.throw $ errorIndex s!"Invalid state index {branchId}" + | .none => Protocol.throw $ Protocol.errorIndex s!"Invalid state index {branchId}" | .some branch => pure $ target.continue branch | .none, .some goals => let goals := goals.toList.map (λ n => { name := n.toName }) @@ -387,7 +395,7 @@ def execute (command: Protocol.Command): MainM Json := do goal_print (args: Protocol.GoalPrint): EMainM Protocol.GoalPrintResult := do let state ← getMainState let .some goalState := state.goalStates[args.stateId]? | - Protocol.throw $ errorIndex s!"Invalid state index {args.stateId}" + Protocol.throw $ Protocol.errorIndex s!"Invalid state index {args.stateId}" let result ← liftMetaM <| goalPrint goalState (rootExpr := args.rootExpr?.getD False) @@ -399,7 +407,7 @@ def execute (command: Protocol.Command): MainM Json := do goal_save (args: Protocol.GoalSave): EMainM Protocol.GoalSaveResult := do let state ← getMainState let .some goalState := state.goalStates[args.id]? | - Protocol.throw $ errorIndex s!"Invalid state index {args.id}" + Protocol.throw $ Protocol.errorIndex s!"Invalid state index {args.id}" goalStatePickle goalState args.path return {} goal_load (args: Protocol.GoalLoad): EMainM Protocol.GoalLoadResult := do diff --git a/Test/Proofs.lean b/Test/Proofs.lean index d3566a0..a6a827b 100644 --- a/Test/Proofs.lean +++ b/Test/Proofs.lean @@ -328,7 +328,7 @@ def test_conv: TestM Unit := do #[interiorGoal [] "a + b + c1 = b + a + c2"]) let goalConv := state1.goals[0]! - let state2 ← match ← state1.conv (state1.get! 0) with + let state2 ← match ← state1.convEnter (state1.get! 0) with | .success state _ => pure state | other => do addTest $ assertUnreachable $ other.toString @@ -399,7 +399,7 @@ def test_conv: TestM Unit := do addTest $ LSpec.check s!" · {convTactic}" ((← state6.serializeGoals (options := ← read)).map (·.devolatilize) = #[]) - let state1_1 ← match ← state6.convExit goalConv with + let state1_1 ← match ← state6.fragmentExit goalConv with | .success state _ => pure state | other => do addTest $ assertUnreachable $ other.toString @@ -441,7 +441,8 @@ def test_calc: TestM Unit := do addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) = #[interiorGoal [] "a + b = c + d"]) let pred := "a + b = b + c" - let state2 ← match ← state1.tryCalc (state1.get! 0) (pred := pred) with + let .success state1 _ ← state1.calcEnter state1.mainGoal?.get! | fail "Could not enter calc" + let state2 ← match ← state1.tacticOn 0 pred with | .success state _ => pure state | other => do addTest $ assertUnreachable $ other.toString @@ -466,7 +467,7 @@ def test_calc: TestM Unit := do addTest $ expectationFailure "continue" e return () let pred := "_ = c + d" - let state4 ← match ← state3.tryCalc (state3.get! 0) (pred := pred) with + let state4 ← match ← state3.tacticOn 0 pred with | .success state _ => pure state | other => do addTest $ assertUnreachable $ other.toString