Remove ExceptT from main monad

Allow pretty printing of expr
This commit is contained in:
Leni Aniva 2023-05-20 15:58:38 -07:00
parent c4a1ccad13
commit ed70875837
4 changed files with 104 additions and 61 deletions

119
Main.lean
View File

@ -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' {}

View File

@ -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

View File

@ -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

View File

@ -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)
``` ```