Add REPL tactics
This commit is contained in:
parent
15aab3d31f
commit
083ec8beec
|
@ -1,25 +0,0 @@
|
||||||
import Lean
|
|
||||||
|
|
||||||
def strToName (s: String): Lean.Name :=
|
|
||||||
(s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous
|
|
||||||
|
|
||||||
unsafe def main (args: List String): IO Unit := do
|
|
||||||
Lean.enableInitializersExecution
|
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
|
||||||
let imports := ["Init"]
|
|
||||||
let env: Lean.Environment ← Lean.importModules
|
|
||||||
(imports := imports.map (λ str => { module := strToName str, runtimeOnly := false }))
|
|
||||||
(opts := {})
|
|
||||||
(trustLevel := 1)
|
|
||||||
|
|
||||||
let expr := args.head?.getD "a + b"
|
|
||||||
|
|
||||||
match Lean.Parser.runParserCategory
|
|
||||||
(env := env)
|
|
||||||
(catName := `term)
|
|
||||||
(input := expr)
|
|
||||||
(fileName := "<stdin>") with
|
|
||||||
| Except.error error => IO.println s!"{error}"
|
|
||||||
| Except.ok (syn: Lean.Syntax) =>
|
|
||||||
let reprint := Lean.Syntax.reprint syn |>.get!
|
|
||||||
IO.println reprint
|
|
|
@ -1,5 +1,6 @@
|
||||||
import Lean
|
import Lean
|
||||||
import Pantograph.Proofs
|
import Pantograph.Meta
|
||||||
|
import Pantograph.Serial
|
||||||
import Pantograph.Symbols
|
import Pantograph.Symbols
|
||||||
|
|
||||||
open Pantograph
|
open Pantograph
|
||||||
|
@ -8,29 +9,50 @@ open Pantograph
|
||||||
Example of using the internal API to execute tactics!
|
Example of using the internal API to execute tactics!
|
||||||
-/
|
-/
|
||||||
|
|
||||||
def execute_proof (env: Lean.Environment): IO Unit := do
|
def serialise (result: Meta.TacticResult): String := match result with
|
||||||
let name := strToName "Nat.add_comm"
|
| .invalid message => s!"Invalid: {message}"
|
||||||
let context := createContext name env
|
| .success 0 _ => s!"Completed!"
|
||||||
(do
|
| .success nextId _ => s!"Success: {nextId}"
|
||||||
let state ← start_proof_state
|
| .failure messages => s!"Failures: {messages}"
|
||||||
IO.println "Proof state started!"
|
|
||||||
let tactic := "intro n m"
|
def start_proof: IO Meta.ProofTree := do
|
||||||
let (state, response) ← execute_tactic state tactic
|
let imports := ["Init"]
|
||||||
IO.println s! "Executed {tactic} Errors: {response.errors} Goals: {response.goals}"
|
let env: Lean.Environment ← Lean.importModules
|
||||||
let tactic := "assumption" -- should fail
|
(imports := imports.map (λ str => { module := str_to_name str, runtimeOnly := false }))
|
||||||
let (_, response) ← execute_tactic state tactic
|
(opts := {})
|
||||||
IO.println s! "Executed {tactic} Errors: {response.errors} Goals: {response.goals}"
|
(trustLevel := 1)
|
||||||
let tactic := "rw [Nat.add_comm]"
|
let name := str_to_name "Nat.add_comm"
|
||||||
let (state, response) ← execute_tactic state tactic
|
let state := Meta.createProofTree
|
||||||
IO.println s! "Executed {tactic} Errors: {response.errors} Goals: {response.goals}"
|
(name := str_to_name "aa") env
|
||||||
) |>.run context
|
(coreContext := {
|
||||||
|
currNamespace := str_to_name "Aniva",
|
||||||
|
openDecls := [], -- No 'open' directives needed
|
||||||
|
fileName := "<Pantograph>",
|
||||||
|
fileMap := { source := "", positions := #[0], lines := #[1] }
|
||||||
|
})
|
||||||
|
let s := "∀ (n m : Nat), n + m = m + n"
|
||||||
|
let syn: Lean.Syntax := Serial.syntax_from_str env s |>.toOption |>.get!
|
||||||
|
IO.println "Created syntax"
|
||||||
|
let expr: Lean.Expr := (← Meta.ProofM.syntax_to_expr syn |>.run' state) |>.toOption |>.get!
|
||||||
|
IO.println "Created expr"
|
||||||
|
--let expr := env.find? name |>.get! |>.type
|
||||||
|
let (_, state) ← Meta.ProofM.start expr |>.run state
|
||||||
|
return state
|
||||||
|
|
||||||
|
def execute_proof: IO Unit := do
|
||||||
|
let state ← start_proof
|
||||||
|
IO.println "Proof state started!"
|
||||||
|
let tactic := "intro n m"
|
||||||
|
let (result, state) ← Meta.ProofM.execute 0 tactic |>.run state
|
||||||
|
IO.println s! "Executed {tactic}, Response: [{serialise result}]"
|
||||||
|
let tactic := "assumption" -- should fail
|
||||||
|
let (result, state) ← Meta.ProofM.execute 1 tactic |>.run state
|
||||||
|
IO.println s! "Executed {tactic}, Response: [{serialise result}]"
|
||||||
|
let tactic := "rw [Nat.add_comm]"
|
||||||
|
let (result, state) ← Meta.ProofM.execute 1 tactic |>.run state
|
||||||
|
IO.println s! "Executed {tactic}, Response: [{serialise result}]"
|
||||||
|
|
||||||
unsafe def main : IO Unit := do
|
unsafe def main : IO Unit := do
|
||||||
Lean.enableInitializersExecution
|
Lean.enableInitializersExecution
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
let imports := ["Init"]
|
execute_proof
|
||||||
let env: Lean.Environment ← Lean.importModules
|
|
||||||
(imports := imports.map (λ str => { module := strToName str, runtimeOnly := false }))
|
|
||||||
(opts := {})
|
|
||||||
(trustLevel := 1)
|
|
||||||
execute_proof env
|
|
||||||
|
|
108
Main.lean
108
Main.lean
|
@ -2,7 +2,8 @@ import Lean.Data.Json
|
||||||
import Lean.Environment
|
import Lean.Environment
|
||||||
|
|
||||||
import Pantograph.Commands
|
import Pantograph.Commands
|
||||||
import Pantograph.IO
|
import Pantograph.Serial
|
||||||
|
import Pantograph.Meta
|
||||||
import Pantograph.Symbols
|
import Pantograph.Symbols
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
@ -14,6 +15,7 @@ structure Context where
|
||||||
/-- Stores state of the REPL -/
|
/-- Stores state of the REPL -/
|
||||||
structure State where
|
structure State where
|
||||||
environments: Array Lean.Environment := #[]
|
environments: Array Lean.Environment := #[]
|
||||||
|
proofTrees: Array Meta.ProofTree := #[]
|
||||||
|
|
||||||
-- State monad
|
-- State monad
|
||||||
abbrev Subroutine := ReaderT Context (StateT State IO)
|
abbrev Subroutine := ReaderT Context (StateT State IO)
|
||||||
|
@ -70,9 +72,17 @@ unsafe def execute (command: Command): Subroutine Lean.Json := do
|
||||||
match Lean.fromJson? command.payload with
|
match Lean.fromJson? command.payload with
|
||||||
| .ok args => inspect args
|
| .ok args => inspect args
|
||||||
| .error x => return errorJson x
|
| .error x => return errorJson x
|
||||||
| "proof.trace" =>
|
| "proof.start" =>
|
||||||
match Lean.fromJson? command.payload with
|
match Lean.fromJson? command.payload with
|
||||||
| .ok args => proof_trace args
|
| .ok args => proof_start args
|
||||||
|
| .error x => return errorJson x
|
||||||
|
| "proof.tactic" =>
|
||||||
|
match Lean.fromJson? command.payload with
|
||||||
|
| .ok args => proof_tactic args
|
||||||
|
| .error x => return errorJson x
|
||||||
|
| "proof.printTree" =>
|
||||||
|
match Lean.fromJson? command.payload with
|
||||||
|
| .ok args => proof_print_tree args
|
||||||
| .error x => return errorJson x
|
| .error x => return errorJson x
|
||||||
| cmd =>
|
| cmd =>
|
||||||
let error: InteractionError := { error := "unknown", desc := s!"Unknown command {cmd}" }
|
let error: InteractionError := { error := "unknown", desc := s!"Unknown command {cmd}" }
|
||||||
|
@ -84,7 +94,7 @@ unsafe def execute (command: Command): Subroutine Lean.Json := do
|
||||||
let state ← get
|
let state ← get
|
||||||
let id := nextId state
|
let id := nextId state
|
||||||
let env ← Lean.importModules
|
let env ← Lean.importModules
|
||||||
(imports := args.imports.map (λ str => { module := strToName str, runtimeOnly := false }))
|
(imports := args.imports.map (λ str => { module := str_to_name str, runtimeOnly := false }))
|
||||||
(opts := {})
|
(opts := {})
|
||||||
(trustLevel := 1)
|
(trustLevel := 1)
|
||||||
modify fun s => { environments := s.environments.push env }
|
modify fun s => { environments := s.environments.push env }
|
||||||
|
@ -109,7 +119,7 @@ unsafe def execute (command: Command): Subroutine Lean.Json := do
|
||||||
let nEnv := state.environments.size
|
let nEnv := state.environments.size
|
||||||
for env in state.environments do
|
for env in state.environments do
|
||||||
env.freeRegions
|
env.freeRegions
|
||||||
set { state with environments := #[] }
|
set ({ }: State)
|
||||||
return Lean.toJson ({ nEnv := nEnv }: ClearResult)
|
return Lean.toJson ({ nEnv := nEnv }: ClearResult)
|
||||||
inspect (args: Inspect): Subroutine Lean.Json := do
|
inspect (args: Inspect): Subroutine Lean.Json := do
|
||||||
let context ← read
|
let context ← read
|
||||||
|
@ -117,35 +127,83 @@ unsafe def execute (command: Command): Subroutine Lean.Json := do
|
||||||
match state.getEnv args.id with
|
match state.getEnv args.id with
|
||||||
| .error error => return Lean.toJson <| errorIndex error
|
| .error error => return Lean.toJson <| errorIndex error
|
||||||
| .ok env =>
|
| .ok env =>
|
||||||
let info? := env.find? <| strToName args.symbol
|
let info? := env.find? <| str_to_name args.symbol
|
||||||
match info? with
|
match info? with
|
||||||
| none => return Lean.toJson <| errorIndex s!"Symbol not found {args.symbol}"
|
| none => return Lean.toJson <| errorIndex s!"Symbol not found {args.symbol}"
|
||||||
| some info =>
|
| some info =>
|
||||||
let format ← IO.exprToStr
|
let format ← Serial.expr_to_str
|
||||||
(env := env)
|
(env := env)
|
||||||
(coreContext := context.coreContext)
|
(coreContext := context.coreContext)
|
||||||
(expr := info.toConstantVal.type)
|
(expr := info.toConstantVal.type)
|
||||||
return Lean.toJson ({ type := format }: InspectResult)
|
return Lean.toJson ({ type := format }: InspectResult)
|
||||||
proof_trace (args: ProofTrace): Subroutine Lean.Json := do
|
proof_start (args: ProofStart): Subroutine Lean.Json := do
|
||||||
-- Step 1: Create tactic state
|
let context ← read
|
||||||
-- Step 2: Execute tactic
|
let state ← get
|
||||||
-- Step 3: ??
|
let ret?: Except Lean.Json Meta.ProofTree ← ExceptT.run <| (do
|
||||||
return Lean.toJson ({ expr := "test" }: ProofTraceResult)
|
let env ← match state.getEnv args.id with
|
||||||
|
| .error error => throw <| Lean.toJson <| errorIndex error
|
||||||
|
| .ok env => pure env
|
||||||
|
let tree := Meta.createProofTree
|
||||||
|
(name := args.name)
|
||||||
|
(env := env)
|
||||||
|
(coreContext := context.coreContext)
|
||||||
|
let expr: Lean.Expr ← match args.expr, args.copyFrom with
|
||||||
|
| "", "" =>
|
||||||
|
throw <| Lean.toJson ({ error := "arguments", desc := "At least one of {expr, copyFrom} must be supplied" }: InteractionError)
|
||||||
|
| expr, "" =>
|
||||||
|
let syn ← match Serial.syntax_from_str env expr with
|
||||||
|
| .error str => throw <| Lean.toJson ({ error := "parsing", desc := str }: InteractionError)
|
||||||
|
| .ok syn => pure syn
|
||||||
|
let expr: Lean.Expr ← match (← Meta.ProofM.syntax_to_expr syn |>.run' tree) with
|
||||||
|
| .error str => throw <| Lean.toJson ({ error := "elab", desc := str }: InteractionError)
|
||||||
|
| .ok expr => pure expr
|
||||||
|
pure expr
|
||||||
|
| "", copyFrom =>
|
||||||
|
match Serial.expr_from_const env (name := str_to_name copyFrom) with
|
||||||
|
| .error str =>
|
||||||
|
IO.println "Symbol not found"
|
||||||
|
throw <| errorIndex str
|
||||||
|
| .ok expr => pure expr
|
||||||
|
| _, _ => throw <| Lean.toJson ({ error := "arguments", desc := "Cannot populate both of {expr, copyFrom}" }: InteractionError)
|
||||||
|
let (_, tree) := ← (Meta.ProofM.start expr |>.run tree)
|
||||||
|
return tree
|
||||||
|
)
|
||||||
|
match ret? with
|
||||||
|
| .error error => return error
|
||||||
|
| .ok tree =>
|
||||||
|
-- Put the new tree in the environment
|
||||||
|
let nextId := state.proofTrees.size
|
||||||
|
set { state with proofTrees := state.proofTrees.push tree }
|
||||||
|
return Lean.toJson ({ treeId := nextId }: ProofStartResult)
|
||||||
|
proof_tactic (args: ProofTactic): Subroutine Lean.Json := do
|
||||||
|
let state ← get
|
||||||
|
match state.proofTrees.get? args.treeId with
|
||||||
|
| .none => return Lean.toJson <| errorIndex "Invalid tree index {args.treeId}"
|
||||||
|
| .some tree =>
|
||||||
|
let (result, nextTree) ← Meta.ProofM.execute args.stateId args.goalId args.tactic |>.run tree
|
||||||
|
match result with
|
||||||
|
| .invalid message => return Lean.toJson <| errorIndex message
|
||||||
|
| .success nextId goals =>
|
||||||
|
set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
|
||||||
|
return Lean.toJson ({ nextId := nextId, goals := goals }: ProofTacticResultSuccess)
|
||||||
|
| .failure messages =>
|
||||||
|
return Lean.toJson ({ errorMessages := messages }: ProofTacticResultFailure)
|
||||||
|
proof_print_tree (args: ProofPrintTree): Subroutine Lean.Json := do
|
||||||
|
let state ← get
|
||||||
|
match state.proofTrees.get? args.treeId with
|
||||||
|
| .none => return Lean.toJson <| errorIndex "Invalid tree index {args.treeId}"
|
||||||
|
| .some tree =>
|
||||||
|
let parents := tree.states.map λ state => match state.parent with
|
||||||
|
| .none => ""
|
||||||
|
| .some parent => s!"{parent}.{state.parentGoalId}"
|
||||||
|
return Lean.toJson ({parents := parents}: ProofPrintTreeResult)
|
||||||
|
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
|
||||||
open Pantograph
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- Main IO functions
|
-- Main IO functions
|
||||||
|
open Pantograph
|
||||||
unsafe def getLines : IO String := do
|
|
||||||
match (← (← IO.getStdin).getLine) with
|
|
||||||
| "" => pure ""
|
|
||||||
| "\n" => pure "\n"
|
|
||||||
| line => pure <| line ++ (← getLines)
|
|
||||||
|
|
||||||
unsafe def loop : Subroutine Unit := do
|
unsafe def loop : Subroutine Unit := do
|
||||||
let command ← (← IO.getStdin).getLine
|
let command ← (← IO.getStdin).getLine
|
||||||
|
@ -163,10 +221,14 @@ unsafe def main : IO Unit := do
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
let context: Context := {
|
let context: Context := {
|
||||||
coreContext := {
|
coreContext := {
|
||||||
currNamespace := strToName "Aniva",
|
currNamespace := str_to_name "Aniva",
|
||||||
openDecls := [], -- No 'open' directives needed
|
openDecls := [], -- No 'open' directives needed
|
||||||
fileName := "<Pantograph>",
|
fileName := "<Pantograph>",
|
||||||
fileMap := { source := "", positions := #[0], lines := #[1] }
|
fileMap := { source := "", positions := #[0], lines := #[1] }
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
loop.run context |>.run' {}
|
try
|
||||||
|
loop.run context |>.run' {}
|
||||||
|
catch ex =>
|
||||||
|
IO.println "Uncaught IO exception"
|
||||||
|
IO.println ex.toString
|
||||||
|
|
|
@ -48,11 +48,38 @@ structure InspectResult where
|
||||||
type: String := ""
|
type: String := ""
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
structure ProofTrace where
|
structure ProofStart where
|
||||||
id: Nat -- Environment id
|
id: Nat -- Environment id
|
||||||
|
name: String := "Untitled" -- Identifier of the proof
|
||||||
|
-- Only one of the fields below may be populated.
|
||||||
|
expr: String := "" -- Proof expression
|
||||||
|
copyFrom: String := "" -- Theorem name
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
structure ProofTraceResult where
|
structure ProofStartResult where
|
||||||
expr: String
|
error: String := ""
|
||||||
|
treeId: Nat := 0 -- Proof tree id
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
structure ProofTactic where
|
||||||
|
treeId: Nat
|
||||||
|
stateId: Nat
|
||||||
|
goalId: Nat := 0
|
||||||
|
tactic: String
|
||||||
|
deriving Lean.FromJson
|
||||||
|
structure ProofTacticResultSuccess where
|
||||||
|
goals: Array String
|
||||||
|
nextId: Nat
|
||||||
|
deriving Lean.ToJson
|
||||||
|
structure ProofTacticResultFailure where
|
||||||
|
errorMessages: Array String -- Error messages generated by tactic
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
structure ProofPrintTree where
|
||||||
|
treeId: Nat
|
||||||
|
deriving Lean.FromJson
|
||||||
|
structure ProofPrintTreeResult where
|
||||||
|
-- "" if no parents, otherwise "parentId.goalId"
|
||||||
|
parents: Array String
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
end Pantograph.Commands
|
end Pantograph.Commands
|
||||||
|
|
|
@ -1,19 +0,0 @@
|
||||||
import Lean
|
|
||||||
|
|
||||||
/-
|
|
||||||
Expression IO
|
|
||||||
-/
|
|
||||||
|
|
||||||
|
|
||||||
namespace Pantograph.IO
|
|
||||||
|
|
||||||
|
|
||||||
def exprToStr (env: Lean.Environment) (coreContext: Lean.Core.Context) (expr: Lean.Expr): IO String := do
|
|
||||||
let metaM := Lean.Meta.ppExpr expr
|
|
||||||
let coreM : Lean.CoreM Lean.Format := metaM.run'
|
|
||||||
let coreState : Lean.Core.State := { env := env }
|
|
||||||
let (format, _) ← coreM.toIO coreContext coreState
|
|
||||||
return format.pretty
|
|
||||||
|
|
||||||
|
|
||||||
end Pantograph.IO
|
|
|
@ -0,0 +1,169 @@
|
||||||
|
import Lean
|
||||||
|
|
||||||
|
import Pantograph.Symbols
|
||||||
|
|
||||||
|
|
||||||
|
/-
|
||||||
|
The proof state manipulation system
|
||||||
|
|
||||||
|
A proof state is launched by providing
|
||||||
|
1. Environment: `Lean.Environment`
|
||||||
|
2. Expression: `Lean.Expr`
|
||||||
|
The expression becomes the first meta variable in the saved tactic state
|
||||||
|
`Lean.Elab.Tactic.SavedState`.
|
||||||
|
From this point on, any proof which extends
|
||||||
|
`Lean.Elab.Term.Context` and
|
||||||
|
-/
|
||||||
|
|
||||||
|
def Lean.MessageLog.getErrorMessages (log : Lean.MessageLog) : Lean.MessageLog :=
|
||||||
|
{ msgs := log.msgs.filter fun m => match m.severity with | Lean.MessageSeverity.error => true | _ => false }
|
||||||
|
|
||||||
|
|
||||||
|
namespace Pantograph.Meta
|
||||||
|
|
||||||
|
structure ProofState where
|
||||||
|
savedState : Lean.Elab.Tactic.SavedState
|
||||||
|
parent : Option Nat := none
|
||||||
|
parentGoalId : Nat := 0
|
||||||
|
structure ProofTree where
|
||||||
|
-- All parameters needed to run a `TermElabM` monad
|
||||||
|
env: Lean.Environment
|
||||||
|
name: Lean.Name
|
||||||
|
coreContext : Lean.Core.Context
|
||||||
|
elabContext : Lean.Elab.Term.Context
|
||||||
|
|
||||||
|
-- Set of proof states
|
||||||
|
states : Array ProofState := #[]
|
||||||
|
|
||||||
|
abbrev ProofM := StateRefT ProofTree IO
|
||||||
|
|
||||||
|
def createProofTree (name: Lean.Name) (env: Lean.Environment) (coreContext: Lean.Core.Context): ProofTree :=
|
||||||
|
{
|
||||||
|
env := env,
|
||||||
|
name := name,
|
||||||
|
coreContext := coreContext,
|
||||||
|
elabContext := {
|
||||||
|
declName? := some (name ++ "_pantograph"),
|
||||||
|
errToSorry := false
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
-- Executing a `TermElabM`
|
||||||
|
def ProofM.runTermElabM (termElabM: Lean.Elab.TermElabM α): ProofM (α × Lean.Core.State) := do
|
||||||
|
let context ← get
|
||||||
|
let metaM : Lean.MetaM α := termElabM.run' (ctx := context.elabContext)
|
||||||
|
let coreM : Lean.CoreM α := metaM.run'
|
||||||
|
let coreState : Lean.Core.State := { env := context.env }
|
||||||
|
coreM.toIO context.coreContext coreState
|
||||||
|
def ProofM.runTermElabM' (termElabM: Lean.Elab.TermElabM α): ProofM α := do
|
||||||
|
return Prod.fst <| ← ProofM.runTermElabM termElabM
|
||||||
|
|
||||||
|
-- Parsing syntax under the environment
|
||||||
|
def ProofM.syntax_to_expr (syn: Lean.Syntax): ProofM (Except String Lean.Expr) := do
|
||||||
|
let termElabM : Lean.Elab.TermElabM (Except String Lean.Expr) :=
|
||||||
|
try
|
||||||
|
--let expr ← Lean.Elab.Term.elabTerm syn
|
||||||
|
-- (expectedType? := none)
|
||||||
|
-- (catchExPostpone := false)
|
||||||
|
-- (implicitLambda := true)
|
||||||
|
let expr ← Lean.Elab.Term.elabType syn
|
||||||
|
|
||||||
|
-- Immediately synthesise all metavariables since we need to leave the elaboration context.
|
||||||
|
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
|
||||||
|
Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing
|
||||||
|
let expr ← Lean.instantiateMVars expr
|
||||||
|
|
||||||
|
return .ok expr
|
||||||
|
|
||||||
|
catch ex => return .error (← ex.toMessageData.toString)
|
||||||
|
ProofM.runTermElabM' <| termElabM
|
||||||
|
|
||||||
|
def start_tactic_state (expr: Lean.Expr): Lean.Elab.TermElabM Lean.Elab.Tactic.SavedState := do
|
||||||
|
let mvar ← Lean.Meta.mkFreshExprMVar (some expr) (kind := Lean.MetavarKind.synthetic)
|
||||||
|
let termState : Lean.Elab.Term.SavedState ← Lean.Elab.Term.saveState
|
||||||
|
let tacticState : Lean.Elab.Tactic.SavedState := { term := termState, tactic := { goals := [mvar.mvarId!] }}
|
||||||
|
return tacticState
|
||||||
|
/-- Create the initial proof state of the proof tree -/
|
||||||
|
def ProofM.start (expr: Lean.Expr): ProofM Unit := do
|
||||||
|
let state: ProofState := {
|
||||||
|
savedState := (← ProofM.runTermElabM' <| start_tactic_state expr),
|
||||||
|
parent := none
|
||||||
|
}
|
||||||
|
let tree ← get
|
||||||
|
set { tree with states := #[state] }
|
||||||
|
|
||||||
|
|
||||||
|
def execute_tactic (env: Lean.Environment) (state: Lean.Elab.Tactic.SavedState) (goalId: Nat) (tactic: String) :
|
||||||
|
Lean.Elab.TermElabM (Except (Array String) Lean.Elab.Tactic.SavedState):= do
|
||||||
|
-- Factor this one out to allow for direct syntactic communication
|
||||||
|
match Lean.Parser.runParserCategory
|
||||||
|
(env := env)
|
||||||
|
(catName := `tactic)
|
||||||
|
(input := tactic)
|
||||||
|
(fileName := "<stdin>") with
|
||||||
|
| Except.error err => return .error #[err]
|
||||||
|
| Except.ok stx => do
|
||||||
|
state.term.restore
|
||||||
|
let tac : Lean.Elab.Tactic.TacticM Unit := set state.tactic *> Lean.Elab.Tactic.evalTactic stx
|
||||||
|
match state.tactic.goals.get? goalId with
|
||||||
|
| .none => return .error #[s!"Invalid goalId {goalId}"]
|
||||||
|
| .some mvarId =>
|
||||||
|
try
|
||||||
|
let unsolvedGoals ← Lean.Elab.Tactic.run mvarId tac
|
||||||
|
if (← getThe Lean.Core.State).messages.hasErrors then
|
||||||
|
let messages := (← getThe Lean.Core.State).messages.getErrorMessages |>.toList.toArray
|
||||||
|
let errors ← (messages.map Lean.Message.data).mapM fun md => md.toString
|
||||||
|
return .error errors
|
||||||
|
else
|
||||||
|
let nextState : Lean.Elab.Tactic.SavedState := {
|
||||||
|
term := (← Lean.Elab.Term.saveState),
|
||||||
|
tactic := { goals := unsolvedGoals}
|
||||||
|
}
|
||||||
|
return .ok nextState
|
||||||
|
catch ex =>
|
||||||
|
return .error #[← ex.toMessageData.toString]
|
||||||
|
|
||||||
|
def extract_goals (state: Lean.Elab.Tactic.SavedState): Lean.Elab.TermElabM (Array String) := do
|
||||||
|
state.term.restore
|
||||||
|
let goals ← state.tactic.goals.mapM fun g => do pure $ toString (← Lean.Meta.ppGoal g)
|
||||||
|
pure goals.toArray
|
||||||
|
|
||||||
|
|
||||||
|
/-- Response for executing a tactic -/
|
||||||
|
inductive TacticResult where
|
||||||
|
-- Invalid id
|
||||||
|
| invalid (message: String): TacticResult
|
||||||
|
-- Goes to next state
|
||||||
|
| success (nextId: Nat) (goals: Array String)
|
||||||
|
-- Fails with messages
|
||||||
|
| failure (messages: Array String)
|
||||||
|
|
||||||
|
/-- Execute tactic on given state -/
|
||||||
|
def ProofM.execute (stateId: Nat) (goalId: Nat) (tactic: String): ProofM TacticResult := do
|
||||||
|
let context ← get
|
||||||
|
match context.states.get? stateId with
|
||||||
|
| .none => return .invalid s!"Invalid state id {stateId}"
|
||||||
|
| .some state =>
|
||||||
|
match (← ProofM.runTermElabM' <| execute_tactic (env := context.env) (state := state.savedState) (goalId := goalId) (tactic := tactic)) with
|
||||||
|
| .error errors =>
|
||||||
|
return .failure errors
|
||||||
|
| .ok nextState =>
|
||||||
|
let nextId := context.states.size
|
||||||
|
-- Return goals
|
||||||
|
let goals ← ProofM.runTermElabM' <| extract_goals nextState
|
||||||
|
|
||||||
|
if goals.size = 0 then
|
||||||
|
return .success 0 #[]
|
||||||
|
else
|
||||||
|
-- Create next proof state node
|
||||||
|
let proofState: ProofState := {
|
||||||
|
savedState := nextState,
|
||||||
|
parent := stateId,
|
||||||
|
parentGoalId := goalId
|
||||||
|
}
|
||||||
|
modify fun s => { s with states := s.states.push proofState }
|
||||||
|
|
||||||
|
return .success nextId goals
|
||||||
|
|
||||||
|
|
||||||
|
end Pantograph.Meta
|
|
@ -1,105 +0,0 @@
|
||||||
import Lean
|
|
||||||
import Pantograph.Symbols
|
|
||||||
|
|
||||||
|
|
||||||
/-
|
|
||||||
The proof state manipulation system
|
|
||||||
|
|
||||||
A proof state is launched by providing
|
|
||||||
1. Environment: `Lean.Environment`
|
|
||||||
2. Expression: `Lean.Expr`
|
|
||||||
The expression becomes the first meta variable in the saved tactic state
|
|
||||||
`Lean.Elab.Tactic.SavedState`.
|
|
||||||
From this point on, any proof which extends
|
|
||||||
`Lean.Elab.Term.Context` and
|
|
||||||
-/
|
|
||||||
|
|
||||||
def Lean.MessageLog.getErrorMessages (log : Lean.MessageLog) : Lean.MessageLog :=
|
|
||||||
{ msgs := log.msgs.filter fun m => match m.severity with | Lean.MessageSeverity.error => true | _ => false }
|
|
||||||
|
|
||||||
namespace Pantograph
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- All parameters needed to run a `TermElabM` monad
|
|
||||||
structure Context where
|
|
||||||
env: Lean.Environment
|
|
||||||
name: Lean.Name
|
|
||||||
coreContext : Lean.Core.Context
|
|
||||||
elabContext: Lean.Elab.Term.Context
|
|
||||||
|
|
||||||
-- Tactic execution response
|
|
||||||
structure Response : Type where
|
|
||||||
goals : Array String := #[]
|
|
||||||
errors : Array String := #[]
|
|
||||||
|
|
||||||
|
|
||||||
def createContext (name: Lean.Name) (env: Lean.Environment): Context :=
|
|
||||||
{
|
|
||||||
env := env,
|
|
||||||
name := name,
|
|
||||||
coreContext := {
|
|
||||||
currNamespace := strToName "Aniva",
|
|
||||||
openDecls := [], -- No 'open' directives needed
|
|
||||||
fileName := "<Gym>",
|
|
||||||
fileMap := { source := "", positions := #[0], lines := #[1] }
|
|
||||||
},
|
|
||||||
elabContext := {
|
|
||||||
declName? := some (name ++ "_pantograph"),
|
|
||||||
errToSorry := false
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
def Context.runTermElabM (termElabM: Lean.Elab.TermElabM α): ReaderT Context IO (α × Lean.Core.State) := do
|
|
||||||
let context ← read
|
|
||||||
let metaM : Lean.MetaM α := termElabM.run' (ctx := context.elabContext)
|
|
||||||
let coreM : Lean.CoreM α := metaM.run'
|
|
||||||
let coreState : Lean.Core.State := { env := context.env }
|
|
||||||
coreM.toIO context.coreContext coreState
|
|
||||||
def Context.runTermElabM' (termElabM: Lean.Elab.TermElabM α): ReaderT Context IO α := do
|
|
||||||
let context ← read
|
|
||||||
let (result, _) ← context.runTermElabM termElabM
|
|
||||||
return result
|
|
||||||
|
|
||||||
|
|
||||||
def start_proof_state: ReaderT Context IO Lean.Elab.Tactic.SavedState := do
|
|
||||||
let context ← read
|
|
||||||
let name := context.name
|
|
||||||
let termElabM : Lean.Elab.TermElabM Lean.Elab.Tactic.SavedState := do
|
|
||||||
match context.env.find? name with
|
|
||||||
| none => throwError "decl {name} not found"
|
|
||||||
| some cInfo =>
|
|
||||||
if ¬ (← Lean.Meta.isProp cInfo.type) then throwError "decl {name} not a theorem"
|
|
||||||
let mvar ← Lean.Meta.mkFreshExprMVar (some cInfo.type) (kind := Lean.MetavarKind.synthetic)
|
|
||||||
let termState : Lean.Elab.Term.SavedState ← Lean.Elab.Term.saveState
|
|
||||||
let tacticState : Lean.Elab.Tactic.SavedState := { term := termState, tactic := { goals := [mvar.mvarId!] }}
|
|
||||||
return tacticState
|
|
||||||
Context.runTermElabM' termElabM
|
|
||||||
|
|
||||||
def execute_tactic (state: Lean.Elab.Tactic.SavedState) (tacticString : String) : ReaderT Context IO (Lean.Elab.Tactic.SavedState × Response) := do
|
|
||||||
let context ← read
|
|
||||||
match Lean.Parser.runParserCategory
|
|
||||||
(env := context.env)
|
|
||||||
(catName := `tactic)
|
|
||||||
(input := tacticString)
|
|
||||||
(fileName := "<stdin>") with
|
|
||||||
| Except.error err => pure (state, { errors := #[err] })
|
|
||||||
| Except.ok stx => Context.runTermElabM' <| do
|
|
||||||
state.term.restore
|
|
||||||
let tac : Lean.Elab.Tactic.TacticM Unit := set state.tactic *> Lean.Elab.Tactic.evalTactic stx
|
|
||||||
let mvarId : Lean.MVarId := state.tactic.goals.head!
|
|
||||||
try
|
|
||||||
let unsolvedGoals ← Lean.Elab.Tactic.run mvarId tac
|
|
||||||
if (← getThe Lean.Core.State).messages.hasErrors then
|
|
||||||
let messages := (← getThe Lean.Core.State).messages.getErrorMessages |>.toList.toArray
|
|
||||||
pure (state, { errors := ← (messages.map Lean.Message.data).mapM fun md => md.toString })
|
|
||||||
else
|
|
||||||
let nextState : Lean.Elab.Tactic.SavedState := { term := (← Lean.Elab.Term.saveState), tactic := { goals := unsolvedGoals}}
|
|
||||||
let goals ← nextState.tactic.goals.mapM fun g => do pure $ toString (← Lean.Meta.ppGoal g)
|
|
||||||
pure (nextState, { goals := goals.toArray })
|
|
||||||
catch ex =>
|
|
||||||
pure (state, { errors := #[← ex.toMessageData.toString] })
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
end Pantograph
|
|
|
@ -0,0 +1,31 @@
|
||||||
|
import Lean
|
||||||
|
|
||||||
|
/-
|
||||||
|
Expression IO
|
||||||
|
-/
|
||||||
|
|
||||||
|
|
||||||
|
namespace Pantograph.Serial
|
||||||
|
|
||||||
|
|
||||||
|
/-- Read a theorem from the environment -/
|
||||||
|
def expr_from_const (env: Lean.Environment) (name: Lean.Name): Except String Lean.Expr :=
|
||||||
|
match env.find? name with
|
||||||
|
| none => throw s!"Symbol not found: {name}"
|
||||||
|
| some cInfo => return cInfo.type
|
||||||
|
def syntax_from_str (env: Lean.Environment) (s: String): Except String Lean.Syntax :=
|
||||||
|
Lean.Parser.runParserCategory
|
||||||
|
(env := env)
|
||||||
|
(catName := `term)
|
||||||
|
(input := s)
|
||||||
|
(fileName := "<stdin>")
|
||||||
|
|
||||||
|
def expr_to_str (env: Lean.Environment) (coreContext: Lean.Core.Context) (expr: Lean.Expr): IO String := do
|
||||||
|
let metaM := Lean.Meta.ppExpr expr
|
||||||
|
let coreM : Lean.CoreM Lean.Format := metaM.run'
|
||||||
|
let coreState : Lean.Core.State := { env := env }
|
||||||
|
let (format, _) ← coreM.toIO coreContext coreState
|
||||||
|
return format.pretty
|
||||||
|
|
||||||
|
|
||||||
|
end Pantograph.Serial
|
|
@ -5,7 +5,7 @@ import Lean.Declaration
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
|
||||||
def strToName (s: String): Lean.Name :=
|
def str_to_name (s: String): Lean.Name :=
|
||||||
(s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous
|
(s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous
|
||||||
|
|
||||||
def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
|
def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
|
||||||
|
|
21
README.md
21
README.md
|
@ -20,9 +20,10 @@ lake build mathlib
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
The binary must be run inside a `lake env` environment. i.e. `lake env
|
The binary must be run inside a `lake env` environment. i.e. `lake env
|
||||||
build/bin/pantograph`. The REPL loop accepts commands and outputs either an
|
build/bin/pantograph`. The REPL loop accepts commands as single-line JSON inputs
|
||||||
`Error:` (indicating malformed command) or a json return value indicating the
|
and outputs either an `Error:` (indicating malformed command) or a json return
|
||||||
result of a command execution. The command can be passed in one of two formats
|
value indicating the result of a command execution. The command can be passed in
|
||||||
|
one of two formats
|
||||||
```
|
```
|
||||||
command { ... }
|
command { ... }
|
||||||
{ "cmd": command, "payload": ... }
|
{ "cmd": command, "payload": ... }
|
||||||
|
@ -43,7 +44,18 @@ $ lake env build/bin/Pantograph
|
||||||
create {"imports": ["Mathlib.Analysis.Seminorm"]}
|
create {"imports": ["Mathlib.Analysis.Seminorm"]}
|
||||||
catalog {"id": 0}
|
catalog {"id": 0}
|
||||||
```
|
```
|
||||||
|
Example proving a theorem: (alternatively use `proof.start {"id": 0, "name": "aa", "copyFrom": "Nat.add_comm", "expr": ""}`) to prime the proof
|
||||||
|
```
|
||||||
|
$ lake env build/bin/Pantograph
|
||||||
|
create {"imports": ["Init"]}
|
||||||
|
proof.start {"id": 0, "name": "aa", "copyFrom": "", "expr": "∀ (n m : Nat), n + m = m + n"}
|
||||||
|
proof.tactic {"treeId": 0, "stateId": 0, "goalId": 0, "tactic": "intro n m"}
|
||||||
|
proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "assumption"}
|
||||||
|
proof.printTree {"treeId": 0}
|
||||||
|
proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "rw [Nat.add_comm]"}
|
||||||
|
proof.printTree {"treeId": 0}
|
||||||
|
```
|
||||||
|
where the application of `assumption` should lead to a failure.
|
||||||
|
|
||||||
## Troubleshooting
|
## Troubleshooting
|
||||||
|
|
||||||
|
@ -51,3 +63,4 @@ If lean encounters stack overflow problems when printing catalog, execute this b
|
||||||
```sh
|
```sh
|
||||||
ulimit -s unlimited
|
ulimit -s unlimited
|
||||||
```
|
```
|
||||||
|
Due to a current bug in Lean (which existed in Lean 3), [the default value of structures are not honoured when parsing Json's](https://github.com/leanprover/lean4/issues/2225).
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
import Lake
|
import Lake
|
||||||
open Lake DSL
|
open Lake DSL
|
||||||
|
|
||||||
|
|
||||||
package pantograph
|
package pantograph
|
||||||
|
|
||||||
require mathlib from git
|
require mathlib from git
|
||||||
|
@ -23,9 +22,3 @@ lean_exe examples_proof {
|
||||||
-- Somehow solves the native symbol not found problem
|
-- Somehow solves the native symbol not found problem
|
||||||
supportInterpreter := true
|
supportInterpreter := true
|
||||||
}
|
}
|
||||||
|
|
||||||
lean_exe examples_expr_io {
|
|
||||||
root := `Examples.ExprIO
|
|
||||||
-- Somehow solves the native symbol not found problem
|
|
||||||
supportInterpreter := true
|
|
||||||
}
|
|
||||||
|
|
Loading…
Reference in New Issue