Remove ExceptT from main monad
Allow pretty printing of expr
This commit is contained in:
parent
c4a1ccad13
commit
ed70875837
119
Main.lean
119
Main.lean
|
@ -7,13 +7,16 @@ import Pantograph.Symbols
|
||||||
|
|
||||||
namespace Pantograph
|
namespace Pantograph
|
||||||
|
|
||||||
|
|
||||||
|
structure Context where
|
||||||
|
coreContext: Lean.Core.Context
|
||||||
|
|
||||||
/-- Stores state of the REPL -/
|
/-- Stores state of the REPL -/
|
||||||
structure State where
|
structure State where
|
||||||
environments: Array Lean.Environment
|
environments: Array Lean.Environment := #[]
|
||||||
|
|
||||||
-- State monad
|
-- State monad
|
||||||
abbrev T (m: Type → Type) := StateT State m
|
abbrev Subroutine := ReaderT Context (StateT State IO)
|
||||||
abbrev Subroutine α := ExceptT String (T IO) α
|
|
||||||
|
|
||||||
def nextId (s: State): Nat := s.environments.size
|
def nextId (s: State): Nat := s.environments.size
|
||||||
|
|
||||||
|
@ -29,10 +32,8 @@ def option_expect (o: Option α) (error: String): Except String α :=
|
||||||
| .some value => return value
|
| .some value => return value
|
||||||
| .none => throw error
|
| .none => throw error
|
||||||
|
|
||||||
structure Command where
|
|
||||||
cmd: String
|
open Commands
|
||||||
payload: Lean.Json
|
|
||||||
deriving Lean.FromJson
|
|
||||||
|
|
||||||
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
|
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
|
||||||
def parse_command (s: String): Except String Command := do
|
def parse_command (s: String): Except String Command := do
|
||||||
|
@ -51,34 +52,35 @@ def parse_command (s: String): Except String Command := do
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
open Commands
|
unsafe def execute (command: Command): Subroutine Lean.Json := do
|
||||||
|
|
||||||
unsafe def execute (command: String): ExceptT String (T IO) Lean.Json := do
|
|
||||||
let command: Command ← parse_command command
|
|
||||||
match command.cmd with
|
match command.cmd with
|
||||||
| "create" =>
|
| "create" =>
|
||||||
let args: Commands.Create ← Lean.fromJson? command.payload
|
match Lean.fromJson? command.payload with
|
||||||
let ret ← create args
|
| .ok args => create args
|
||||||
return Lean.toJson ret
|
| .error x => return errorJson x
|
||||||
| "catalog" =>
|
| "catalog" =>
|
||||||
let args: Commands.Catalog ← Lean.fromJson? command.payload
|
match Lean.fromJson? command.payload with
|
||||||
let ret ← catalog args
|
| .ok args => catalog args
|
||||||
return Lean.toJson ret
|
| .error x => return errorJson x
|
||||||
| "clear" =>
|
| "clear" =>
|
||||||
-- Delete all the environments
|
-- Delete all the environments
|
||||||
let ret ← clear
|
let ret ← clear
|
||||||
return Lean.toJson ret
|
return Lean.toJson ret
|
||||||
| "inspect" =>
|
| "inspect" =>
|
||||||
let args: Commands.Inspect ← Lean.fromJson? command.payload
|
match Lean.fromJson? command.payload with
|
||||||
let ret ← inspect args
|
| .ok args => inspect args
|
||||||
return Lean.toJson ret
|
| .error x => return errorJson x
|
||||||
| "proof.trace" =>
|
| "proof.trace" =>
|
||||||
let args: Commands.ProofTrace ← Lean.fromJson? command.payload
|
match Lean.fromJson? command.payload with
|
||||||
let ret ← proof_trace args
|
| .ok args => proof_trace args
|
||||||
return Lean.toJson ret
|
| .error x => return errorJson x
|
||||||
| cmd => throw s!"Unknown verb: {cmd}"
|
| cmd =>
|
||||||
|
let error: InteractionError := { error := "unknown", desc := s!"Unknown command {cmd}" }
|
||||||
|
return Lean.toJson error
|
||||||
where
|
where
|
||||||
create (args: Create): Subroutine CreateResult := do
|
errorJson (s: String) := Lean.toJson ({ error := "json", desc := s }: InteractionError)
|
||||||
|
errorIndex (s: String) := Lean.toJson ({ error := "index", desc := s }: InteractionError)
|
||||||
|
create (args: Create): 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
|
||||||
|
@ -88,38 +90,47 @@ unsafe def execute (command: String): ExceptT String (T IO) Lean.Json := do
|
||||||
modify fun s => { environments := s.environments.push env }
|
modify fun s => { environments := s.environments.push env }
|
||||||
let num_filtered_symbols := env.constants.fold (init := 0) (λ acc name info =>
|
let num_filtered_symbols := env.constants.fold (init := 0) (λ acc name info =>
|
||||||
acc + if is_symbol_unsafe_or_internal name info then 0 else 1)
|
acc + if is_symbol_unsafe_or_internal name info then 0 else 1)
|
||||||
return {
|
return Lean.toJson ({
|
||||||
id := id,
|
id := id,
|
||||||
symbols := env.constants.size,
|
symbols := env.constants.size,
|
||||||
filtered_symbols := num_filtered_symbols }
|
filtered_symbols := num_filtered_symbols }: CreateResult)
|
||||||
catalog (args: Catalog): Subroutine CatalogResult := do
|
catalog (args: Catalog): Subroutine Lean.Json := do
|
||||||
let state ← get
|
let state ← get
|
||||||
let env ← state.getEnv args.id
|
match state.getEnv args.id with
|
||||||
|
| .error error => return Lean.toJson <| errorIndex error
|
||||||
|
| .ok env =>
|
||||||
let names := env.constants.fold (init := []) (λ es name info =>
|
let names := env.constants.fold (init := []) (λ es name info =>
|
||||||
match to_filtered_symbol name info with
|
match to_filtered_symbol name info with
|
||||||
| .some x => x::es
|
| .some x => x::es
|
||||||
| .none => es)
|
| .none => es)
|
||||||
return { theorems := names }
|
return Lean.toJson <| ({ theorems := names }: CatalogResult)
|
||||||
clear: Subroutine ClearResult := do
|
clear: Subroutine Lean.Json := do
|
||||||
let state ← get
|
let state ← get
|
||||||
|
let nEnv := state.environments.size
|
||||||
for env in state.environments do
|
for env in state.environments do
|
||||||
env.freeRegions
|
env.freeRegions
|
||||||
return { n := state.environments.size }
|
set { state with environments := #[] }
|
||||||
inspect (args: Inspect): Subroutine InspectResult := do
|
return Lean.toJson ({ nEnv := nEnv }: ClearResult)
|
||||||
|
inspect (args: Inspect): Subroutine Lean.Json := do
|
||||||
|
let context ← read
|
||||||
let state ← get
|
let state ← get
|
||||||
let env ← state.getEnv args.id
|
match state.getEnv args.id with
|
||||||
|
| .error error => return Lean.toJson <| errorIndex error
|
||||||
|
| .ok env =>
|
||||||
let info? := env.find? <| strToName args.symbol
|
let info? := env.find? <| strToName args.symbol
|
||||||
let info ← match info? with
|
match info? with
|
||||||
| none => throw s!"Symbol not found: {args.symbol}"
|
| none => return Lean.toJson <| errorIndex s!"Symbol not found {args.symbol}"
|
||||||
| some info => pure info.toConstantVal
|
| some info =>
|
||||||
-- Now print the type expression
|
let format ← IO.exprToStr
|
||||||
let format := IO.exprToStr env info.type
|
(env := env)
|
||||||
return { type := format }
|
(coreContext := context.coreContext)
|
||||||
proof_trace (args: ProofTrace): Subroutine ProofTraceResult := do
|
(expr := info.toConstantVal.type)
|
||||||
|
return Lean.toJson ({ type := format }: InspectResult)
|
||||||
|
proof_trace (args: ProofTrace): Subroutine Lean.Json := do
|
||||||
-- Step 1: Create tactic state
|
-- Step 1: Create tactic state
|
||||||
-- Step 2: Execute tactic
|
-- Step 2: Execute tactic
|
||||||
-- Step 3: ??
|
-- Step 3: ??
|
||||||
return { expr := "test" }
|
return Lean.toJson ({ expr := "test" }: ProofTraceResult)
|
||||||
|
|
||||||
|
|
||||||
end Pantograph
|
end Pantograph
|
||||||
|
@ -136,16 +147,26 @@ unsafe def getLines : IO String := do
|
||||||
| "\n" => pure "\n"
|
| "\n" => pure "\n"
|
||||||
| line => pure <| line ++ (← getLines)
|
| line => pure <| line ++ (← getLines)
|
||||||
|
|
||||||
unsafe def loop : T IO Unit := do
|
unsafe def loop : Subroutine Unit := do
|
||||||
let command ← getLines
|
let command ← (← IO.getStdin).getLine
|
||||||
if command == "" then return ()
|
match parse_command command with
|
||||||
|
| .error _ =>
|
||||||
|
-- Halt execution if command is empty
|
||||||
|
return ()
|
||||||
|
| .ok command =>
|
||||||
let ret ← execute command
|
let ret ← execute command
|
||||||
match ret with
|
IO.println <| toString <| ret
|
||||||
| .error e => IO.println s!"Error: {e}"
|
|
||||||
| .ok obj => IO.println <| toString <| obj
|
|
||||||
loop
|
loop
|
||||||
|
|
||||||
unsafe def main : IO Unit := do
|
unsafe def main : IO Unit := do
|
||||||
Lean.enableInitializersExecution
|
Lean.enableInitializersExecution
|
||||||
Lean.initSearchPath (← Lean.findSysroot)
|
Lean.initSearchPath (← Lean.findSysroot)
|
||||||
StateT.run' loop ⟨#[]⟩
|
let context: Context := {
|
||||||
|
coreContext := {
|
||||||
|
currNamespace := strToName "Aniva",
|
||||||
|
openDecls := [], -- No 'open' directives needed
|
||||||
|
fileName := "<Pantograph>",
|
||||||
|
fileMap := { source := "", positions := #[0], lines := #[1] }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
loop.run context |>.run' {}
|
||||||
|
|
|
@ -3,6 +3,20 @@ import Lean.Data.Json
|
||||||
|
|
||||||
namespace Pantograph.Commands
|
namespace Pantograph.Commands
|
||||||
|
|
||||||
|
structure Command where
|
||||||
|
cmd: String
|
||||||
|
payload: Lean.Json
|
||||||
|
deriving Lean.FromJson
|
||||||
|
|
||||||
|
structure InteractionError where
|
||||||
|
error: String
|
||||||
|
desc: String
|
||||||
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
|
||||||
|
-- Individual command and return types
|
||||||
|
|
||||||
|
-- Create a new environment using the given imports
|
||||||
structure Create where
|
structure Create where
|
||||||
imports : List String := []
|
imports : List String := []
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
|
@ -12,6 +26,7 @@ structure CreateResult where
|
||||||
filtered_symbols: Nat
|
filtered_symbols: Nat
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
-- Print all symbols in environment
|
||||||
structure Catalog where
|
structure Catalog where
|
||||||
id: Nat
|
id: Nat
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
|
@ -19,16 +34,18 @@ structure CatalogResult where
|
||||||
theorems: List String
|
theorems: List String
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
-- Reset the state of REPL
|
||||||
structure ClearResult where
|
structure ClearResult where
|
||||||
n: Nat -- Number of environments reset
|
nEnv: Nat -- Number of environments reset
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
|
-- Print the type of a symbol
|
||||||
structure Inspect where
|
structure Inspect where
|
||||||
id: Nat -- Environment id
|
id: Nat -- Environment id
|
||||||
symbol: String
|
symbol: String
|
||||||
deriving Lean.FromJson
|
deriving Lean.FromJson
|
||||||
structure InspectResult where
|
structure InspectResult where
|
||||||
type: String
|
type: String := ""
|
||||||
deriving Lean.ToJson
|
deriving Lean.ToJson
|
||||||
|
|
||||||
structure ProofTrace where
|
structure ProofTrace where
|
||||||
|
|
|
@ -8,9 +8,12 @@ Expression IO
|
||||||
namespace Pantograph.IO
|
namespace Pantograph.IO
|
||||||
|
|
||||||
|
|
||||||
def exprToStr (env: Lean.Environment) (e: Lean.Expr): String :=
|
def exprToStr (env: Lean.Environment) (coreContext: Lean.Core.Context) (expr: Lean.Expr): IO String := do
|
||||||
let format := Lean.Meta.ppExpr e
|
let metaM := Lean.Meta.ppExpr expr
|
||||||
"stub"
|
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
|
end Pantograph.IO
|
||||||
|
|
|
@ -27,13 +27,15 @@ result of a command execution. The command can be passed in one of two formats
|
||||||
command { ... }
|
command { ... }
|
||||||
{ "cmd": command, "payload": ... }
|
{ "cmd": command, "payload": ... }
|
||||||
```
|
```
|
||||||
The list of available commands can be found in `Pantograph/Commands.lean`
|
The list of available commands can be found in `Pantograph/Commands.lean`. An
|
||||||
|
empty command aborts the REPL.
|
||||||
|
|
||||||
Example: (~5k symbols)
|
Example: (~5k symbols)
|
||||||
```
|
```
|
||||||
$ lake env build/bin/Pantograph
|
$ lake env build/bin/Pantograph
|
||||||
create {"imports": ["Init"]}
|
create {"imports": ["Init"]}
|
||||||
catalog {"id": 0}
|
catalog {"id": 0}
|
||||||
|
inspect {"id": 0, "symbol": "Nat.le_add_left"}
|
||||||
```
|
```
|
||||||
Example with `mathlib` (~90k symbols)
|
Example with `mathlib` (~90k symbols)
|
||||||
```
|
```
|
||||||
|
|
Loading…
Reference in New Issue