diff --git a/Pantograph.lean b/Pantograph.lean index 1e3dbe3..9d9399d 100644 --- a/Pantograph.lean +++ b/Pantograph.lean @@ -1,7 +1,7 @@ import Pantograph.Goal import Pantograph.Protocol import Pantograph.Serial -import Pantograph.Symbol +import Pantograph.Environment import Lean.Data.HashMap namespace Pantograph @@ -41,8 +41,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do | "reset" => run reset | "stat" => run stat | "expr.echo" => run expr_echo - | "lib.catalog" => run lib_catalog - | "lib.inspect" => run lib_inspect + | "env.catalog" => run env_catalog + | "env.inspect" => run env_inspect + | "env.add" => run env_add | "options.set" => run options_set | "options.print" => run options_print | "goal.start" => run goal_start @@ -68,43 +69,20 @@ def execute (command: Protocol.Command): MainM Lean.Json := do let state ← get let nGoals := state.goalStates.size return .ok { nGoals } - lib_catalog (_: Protocol.LibCatalog): MainM (CR Protocol.LibCatalogResult) := do - let env ← Lean.MonadEnv.getEnv - let names := env.constants.fold (init := #[]) (λ acc name info => - match to_filtered_symbol name info with - | .some x => acc.push x - | .none => acc) - return .ok { symbols := names } - lib_inspect (args: Protocol.LibInspect): MainM (CR Protocol.LibInspectResult) := do + env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do + Environment.catalog args + env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do let state ← get - let env ← Lean.MonadEnv.getEnv - let name := args.name.toName - let info? := env.find? name - match info? with - | none => return .error $ errorIndex s!"Symbol not found {args.name}" - | some info => - let module? := env.getModuleIdxFor? name >>= - (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString - let value? := match args.value?, info with - | .some true, _ => info.value? - | .some false, _ => .none - | .none, .defnInfo _ => info.value? - | .none, _ => .none - return .ok { - type := ← (serialize_expression state.options info.type).run', - value? := ← value?.mapM (λ v => serialize_expression state.options v |>.run'), - publicName? := Lean.privateToUserName? name |>.map (·.toString), - -- BUG: Warning: getUsedConstants here will not include projections. This is a known bug. - typeDependency? := if args.dependency?.getD false then .some <| info.type.getUsedConstants.map (λ n => name_to_ast n) else .none, - valueDependency? := if args.dependency?.getD false then info.value?.map (·.getUsedConstants.map (λ n => name_to_ast n)) else .none, - module? := module? - } + Environment.inspect args state.options + env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do + Environment.addDecl args expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do let state ← get let env ← Lean.MonadEnv.getEnv - match syntax_from_str env args.expr with - | .error str => return .error $ errorI "parsing" str - | .ok syn => runTermElabM do + let syn ← match syntax_from_str env args.expr with + | .error str => return .error $ errorI "parsing" str + | .ok syn => pure syn + runTermElabM (do match ← syntax_to_expr syn with | .error str => return .error $ errorI "elab" str | .ok expr => do @@ -115,7 +93,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do expr := (← serialize_expression (options := state.options) expr) } catch exception => - return .error $ errorI "typing" (← exception.toMessageData.toString) + return .error $ errorI "typing" (← exception.toMessageData.toString)) options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do let state ← get let options := state.options diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean new file mode 100644 index 0000000..ab4513f --- /dev/null +++ b/Pantograph/Environment.lean @@ -0,0 +1,104 @@ +import Pantograph.Protocol +import Pantograph.Serial +import Lean + +open Lean +open Pantograph + +namespace Pantograph.Environment + +abbrev CR α := Except Protocol.InteractionError α + +def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool := + isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ info.isUnsafe + where + isLeanSymbol (name: Lean.Name): Bool := match name.getRoot with + | .str _ name => name == "Lean" + | _ => true + +def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String := + let pref := match info with + | .axiomInfo _ => "a" + | .defnInfo _ => "d" + | .thmInfo _ => "t" + | .opaqueInfo _ => "o" + | .quotInfo _ => "q" + | .inductInfo _ => "i" + | .ctorInfo _ => "c" + | .recInfo _ => "r" + s!"{pref}{toString n}" + +def to_filtered_symbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String := + if is_symbol_unsafe_or_internal n info + then Option.none + else Option.some <| to_compact_symbol_name n info +def catalog (_: Protocol.EnvCatalog): CoreM (CR Protocol.EnvCatalogResult) := do + let env ← Lean.MonadEnv.getEnv + let names := env.constants.fold (init := #[]) (λ acc name info => + match to_filtered_symbol name info with + | .some x => acc.push x + | .none => acc) + return .ok { symbols := names } +def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR Protocol.EnvInspectResult) := do + let env ← Lean.MonadEnv.getEnv + let name := args.name.toName + let info? := env.find? name + match info? with + | none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}" + | some info => + let module? := env.getModuleIdxFor? name >>= + (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString + let value? := match args.value?, info with + | .some true, _ => info.value? + | .some false, _ => .none + | .none, .defnInfo _ => info.value? + | .none, _ => .none + return .ok { + type := ← (serialize_expression options info.type).run', + value? := ← value?.mapM (λ v => serialize_expression options v |>.run'), + publicName? := Lean.privateToUserName? name |>.map (·.toString), + -- BUG: Warning: getUsedConstants here will not include projections. This is a known bug. + typeDependency? := if args.dependency?.getD false then .some <| info.type.getUsedConstants.map (λ n => name_to_ast n) else .none, + valueDependency? := if args.dependency?.getD false then info.value?.map (·.getUsedConstants.map (λ n => name_to_ast n)) else .none, + module? := module? + } +def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do + let env ← Lean.MonadEnv.getEnv + let tvM: Elab.TermElabM (Except String (Expr × Expr)) := do + let type ← match syntax_from_str env args.type with + | .ok syn => do + match ← syntax_to_expr syn with + | .error e => return .error e + | .ok expr => pure expr + | .error e => return .error e + let value ← match syntax_from_str env args.value with + | .ok syn => do + try + let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .some type) + Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing + let expr ← instantiateMVars expr + pure $ expr + catch ex => return .error (← ex.toMessageData.toString) + | .error e => return .error e + pure $ .ok (type, value) + let (type, value) ← match ← tvM.run' (ctx := {}) |>.run' with + | .ok t => pure t + | .error e => return .error $ Protocol.errorExpr e + let constant := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx + (name := args.name.toName) + (levelParams := []) + (type := type) + (value := value) + (hints := Lean.mkReducibilityHintsRegularEx 1) + (safety := Lean.DefinitionSafety.safe) + (all := []) + let env' ← match env.addDecl constant with + | .error e => do + let options ← Lean.MonadOptions.getOptions + let desc ← (e.toMessageData options).toString + return .error $ { error := "kernel", desc } + | .ok env' => pure env' + Lean.MonadEnv.modifyEnv (λ _ => env') + return .ok {} + +end Pantograph.Environment diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean index 1589408..9b68319 100644 --- a/Pantograph/Goal.lean +++ b/Pantograph/Goal.lean @@ -1,7 +1,5 @@ import Lean -import Pantograph.Symbol - def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog := { msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean index a88a54a..c0204d0 100644 --- a/Pantograph/Protocol.lean +++ b/Pantograph/Protocol.lean @@ -79,6 +79,9 @@ structure InteractionError where desc: String deriving Lean.ToJson +def errorIndex (desc: String): InteractionError := { error := "index", desc } +def errorExpr (desc: String): InteractionError := { error := "expr", desc } + --- Individual command and return types --- @@ -102,13 +105,13 @@ structure ExprEchoResult where deriving Lean.ToJson -- Print all symbols in environment -structure LibCatalog where +structure EnvCatalog where deriving Lean.FromJson -structure LibCatalogResult where +structure EnvCatalogResult where symbols: Array String deriving Lean.ToJson -- Print the type of a symbol -structure LibInspect where +structure EnvInspect where name: String -- If true/false, show/hide the value expressions; By default definitions -- values are shown and theorem values are hidden. @@ -116,7 +119,7 @@ structure LibInspect where -- If true, show the type and value dependencies dependency?: Option Bool := .some false deriving Lean.FromJson -structure LibInspectResult where +structure EnvInspectResult where type: Expression value?: Option Expression := .none module?: Option String := .none @@ -125,6 +128,14 @@ structure LibInspectResult where typeDependency?: Option (Array String) := .none valueDependency?: Option (Array String) := .none deriving Lean.ToJson +structure EnvAdd where + name: String + type: String + value: String + isTheorem?: Bool + deriving Lean.FromJson +structure EnvAddResult where + deriving Lean.ToJson /-- Set options; See `Options` struct above for meanings -/ structure OptionsSet where diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean deleted file mode 100644 index ba80877..0000000 --- a/Pantograph/Symbol.lean +++ /dev/null @@ -1,29 +0,0 @@ -import Lean - -namespace Pantograph - -def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool := - isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ info.isUnsafe - where - isLeanSymbol (name: Lean.Name): Bool := match name.getRoot with - | .str _ name => name == "Lean" - | _ => true - -def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String := - let pref := match info with - | .axiomInfo _ => "a" - | .defnInfo _ => "d" - | .thmInfo _ => "t" - | .opaqueInfo _ => "o" - | .quotInfo _ => "q" - | .inductInfo _ => "i" - | .ctorInfo _ => "c" - | .recInfo _ => "r" - s!"{pref}{toString n}" - -def to_filtered_symbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String := - if is_symbol_unsafe_or_internal n info - then Option.none - else Option.some <| to_compact_symbol_name n info - -end Pantograph diff --git a/README.md b/README.md index 2b8425c..1ca4d7b 100644 --- a/README.md +++ b/README.md @@ -42,13 +42,13 @@ also accept lean options of the form `--key=value` e.g. `--pp.raw=true`. Example: (~5k symbols) ``` $ pantograph Init -lib.catalog -lib.inspect {"name": "Nat.le_add_left"} +env.catalog +env.inspect {"name": "Nat.le_add_left"} ``` Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting) ``` $ pantograph Mathlib.Analysis.Seminorm -lib.catalog +env.catalog ``` Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_comm"}`) to prime the proof ``` @@ -68,8 +68,8 @@ where the application of `assumption` should lead to a failure. See `Pantograph/Protocol.lean` for a description of the parameters and return values in JSON. - `reset`: Delete all cached expressions and proof trees - `expr.echo {"expr": }`: Determine the type of an expression and round-trip it -- `lib.catalog`: Display a list of all safe Lean symbols in the current context -- `lib.inspect {"name": , "value": }`: Show the type and package of a +- `env.catalog`: Display a list of all safe Lean symbols in the current environment +- `env.inspect {"name": , "value": }`: Show the type and package of a given symbol; If value flag is set, the value is printed or hidden. By default only the values of definitions are printed. - `options.set { key: value, ... }`: Set one or more options (not Lean options; those diff --git a/Test/Catalog.lean b/Test/Environment.lean similarity index 73% rename from Test/Catalog.lean rename to Test/Environment.lean index 44c2bf7..3bd8448 100644 --- a/Test/Catalog.lean +++ b/Test/Environment.lean @@ -1,8 +1,8 @@ import LSpec import Pantograph.Serial -import Pantograph.Symbol +import Pantograph.Environment -namespace Pantograph.Test.Catalog +namespace Pantograph.Test.Environment open Pantograph open Lean @@ -14,7 +14,7 @@ def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do ] let suite := entries.foldl (λ suites (symbol, target) => let constant := env.constants.find! symbol - let test := LSpec.check symbol.toString ((is_symbol_unsafe_or_internal symbol constant) == target) + let test := LSpec.check symbol.toString ((Environment.is_symbol_unsafe_or_internal symbol constant) == target) LSpec.TestSeq.append suites test) LSpec.TestSeq.done return suite @@ -24,7 +24,7 @@ def suite: IO LSpec.TestSeq := do (opts := {}) (trustLevel := 1) - return LSpec.group "Catalog" $ + return LSpec.group "Environment" $ (LSpec.group "Symbol visibility" (← test_symbol_visibility env)) -end Pantograph.Test.Catalog +end Pantograph.Test.Environment diff --git a/Test/Integration.lean b/Test/Integration.lean index 5aad1e7..0a6c210 100644 --- a/Test/Integration.lean +++ b/Test/Integration.lean @@ -44,20 +44,20 @@ def test_option_modify : IO LSpec.TestSeq := let module? := Option.some "Init.Data.Nat.Basic" let options: Protocol.Options := {} subroutine_runner [ - subroutine_step "lib.inspect" + subroutine_step "env.inspect" [("name", .str "Nat.add_one")] (Lean.toJson ({ type := { pp? }, module? }: - Protocol.LibInspectResult)), + Protocol.EnvInspectResult)), subroutine_step "options.set" [("printExprAST", .bool true)] (Lean.toJson ({ }: Protocol.OptionsSetResult)), - subroutine_step "lib.inspect" + subroutine_step "env.inspect" [("name", .str "Nat.add_one")] (Lean.toJson ({ type := { pp?, sexp? }, module? }: - Protocol.LibInspectResult)), + Protocol.EnvInspectResult)), subroutine_step "options.print" [] (Lean.toJson ({ options with printExprAST := true }: @@ -112,12 +112,49 @@ def test_tactic : IO LSpec.TestSeq := Protocol.GoalTacticResult)) ] +def test_env : IO LSpec.TestSeq := + let name1 := "Pantograph.mystery" + let name2 := "Pantograph.mystery2" + subroutine_runner [ + subroutine_step "env.add" + [ + ("name", .str name1), + ("type", .str "Prop → Prop → Prop"), + ("value", .str "λ (a b: Prop) => Or a b"), + ("isTheorem", .bool false) + ] + (Lean.toJson ({}: Protocol.EnvAddResult)), + subroutine_step "env.inspect" + [("name", .str name1)] + (Lean.toJson ({ + value? := .some { pp? := .some "fun a b => a ∨ b" }, + type := { pp? := .some "Prop → Prop → Prop" }, + }: + Protocol.EnvInspectResult)), + subroutine_step "env.add" + [ + ("name", .str name2), + ("type", .str "Nat → Int"), + ("value", .str "λ (a: Nat) => a + 1"), + ("isTheorem", .bool false) + ] + (Lean.toJson ({}: Protocol.EnvAddResult)), + subroutine_step "env.inspect" + [("name", .str name2)] + (Lean.toJson ({ + value? := .some { pp? := .some "fun a => Int.ofNat a + 1" }, + type := { pp? := .some "Nat → Int" }, + }: + Protocol.EnvInspectResult)) + ] + def suite: IO LSpec.TestSeq := do return LSpec.group "Integration" $ (LSpec.group "Option modify" (← test_option_modify)) ++ (LSpec.group "Malformed command" (← test_malformed_command)) ++ - (LSpec.group "Tactic" (← test_tactic)) + (LSpec.group "Tactic" (← test_tactic)) ++ + (LSpec.group "Env" (← test_env)) end Pantograph.Test.Integration diff --git a/Test/Main.lean b/Test/Main.lean index 5178e85..4a8ab1f 100644 --- a/Test/Main.lean +++ b/Test/Main.lean @@ -1,5 +1,5 @@ import LSpec -import Test.Catalog +import Test.Environment import Test.Holes import Test.Integration import Test.Proofs @@ -15,7 +15,7 @@ def main := do Integration.suite, Proofs.suite, Serial.suite, - Catalog.suite + Environment.suite ] let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done LSpec.lspecIO $ all diff --git a/Test/Serial.lean b/Test/Serial.lean index 0730bad..e502fa8 100644 --- a/Test/Serial.lean +++ b/Test/Serial.lean @@ -1,6 +1,5 @@ import LSpec import Pantograph.Serial -import Pantograph.Symbol namespace Pantograph.Test.Serial