test: env.add
This commit is contained in:
parent
85eb42207c
commit
a540dd4540
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue