test: env.add

This commit is contained in:
Leni Aniva 2023-12-14 11:11:24 -08:00
parent 2f3a91562a
commit 6c25cca46a
Signed by: aniva
GPG Key ID: 4D9B1C8D10EA4C50
2 changed files with 46 additions and 17 deletions

View File

@ -103,18 +103,25 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
} }
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv let env ← Lean.MonadEnv.getEnv
let tv?: Except String (Lean.Expr × Lean.Expr) ← runTermElabM (do
let type ← match syntax_from_str env args.type with let type ← match syntax_from_str env args.type with
| .ok syn => do | .ok syn => do
match ← (syntax_to_expr syn |> runTermElabM) with match ← syntax_to_expr syn with
| .error e => return .error $ errorExpr e | .error e => return .error e
| .ok expr => pure expr | .ok expr => pure expr
| .error e => return .error $ errorExpr e | .error e => return .error e
let value ← match syntax_from_str env args.value with let value ← match syntax_from_str env args.value with
| .ok syn => do | .ok syn => do
try try
let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type) |> runTermElabM let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
let expr ← Lean.instantiateMVars expr
pure $ expr pure $ expr
catch ex => return .error $ errorExpr (← ex.toMessageData.toString) catch ex => return .error (← ex.toMessageData.toString)
| .error e => return .error e
pure $ .ok (type, value)
)
let (type, value) ← match tv? with
| .ok t => pure t
| .error e => return .error $ errorExpr e | .error e => return .error $ errorExpr e
let constant := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx let constant := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
(name := args.name.toName) (name := args.name.toName)
@ -135,9 +142,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get let state ← get
let env ← Lean.MonadEnv.getEnv let env ← Lean.MonadEnv.getEnv
match syntax_from_str env args.expr with let syn ← match syntax_from_str env args.expr with
| .error str => return .error $ errorI "parsing" str | .error str => return .error $ errorI "parsing" str
| .ok syn => runTermElabM do | .ok syn => pure syn
runTermElabM (do
match ← syntax_to_expr syn with match ← syntax_to_expr syn with
| .error str => return .error $ errorI "elab" str | .error str => return .error $ errorI "elab" str
| .ok expr => do | .ok expr => do
@ -148,7 +156,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
expr := (← serialize_expression (options := state.options) expr) expr := (← serialize_expression (options := state.options) expr)
} }
catch exception => 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 options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get let state ← get
let options := state.options let options := state.options

View File

@ -112,12 +112,33 @@ def test_tactic : IO LSpec.TestSeq :=
Protocol.GoalTacticResult)) Protocol.GoalTacticResult))
] ]
def test_env : IO LSpec.TestSeq :=
let name := "Pantograph.Mystery"
subroutine_runner [
subroutine_step "env.add"
[
("name", .str name),
("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 name)]
(Lean.toJson ({
value? := .some { pp? := .some "fun a b => a b" },
type := { pp? := .some "Prop → Prop → Prop" },
}:
Protocol.EnvInspectResult))
]
def suite: IO LSpec.TestSeq := do def suite: IO LSpec.TestSeq := do
return LSpec.group "Integration" $ return LSpec.group "Integration" $
(LSpec.group "Option modify" (← test_option_modify)) ++ (LSpec.group "Option modify" (← test_option_modify)) ++
(LSpec.group "Malformed command" (← test_malformed_command)) ++ (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 end Pantograph.Test.Integration