From 5cedb9d88c477b5d307bafc22b62315e30eb83cf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 13 Aug 2023 21:19:06 -0700
Subject: [PATCH 001/465] version bump, restructure
---
Main.lean | 213 +++------------------------------------
Pantograph.lean | 207 +++++++++++++++++++++++++++++++++++++
Pantograph/Commands.lean | 13 ++-
Pantograph/Serial.lean | 60 +++++++++++
Pantograph/Version.lean | 5 +
README.md | 4 +-
Test/Main.lean | 3 +-
lean-toolchain | 2 +-
8 files changed, 304 insertions(+), 203 deletions(-)
create mode 100644 Pantograph/Version.lean
diff --git a/Main.lean b/Main.lean
index c08014d..012ee4b 100644
--- a/Main.lean
+++ b/Main.lean
@@ -1,173 +1,8 @@
import Lean.Data.Json
import Lean.Environment
-import Pantograph.Commands
-import Pantograph.Serial
-import Pantograph.Meta
-import Pantograph.Symbols
-
-namespace Pantograph
-
-
-structure Context where
-
-/-- Stores state of the REPL -/
-structure State where
- --environments: Array Lean.Environment := #[]
- proofTrees: Array ProofTree := #[]
-
--- State monad
-abbrev Subroutine := ReaderT Context (StateT State Lean.Elab.TermElabM)
-
-open Commands
-
-/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
-def parse_command (s: String): Except String Command := do
- let s := s.trim
- match s.get? 0 with
- | .some '{' => -- Parse in Json mode
- Lean.fromJson? (← Lean.Json.parse s)
- | .some _ => -- Parse in line mode
- let offset := s.posOf ' ' |> s.offsetOfPos
- if offset = s.length then
- return { cmd := s.take offset, payload := Lean.Json.null }
- else
- let payload ← s.drop offset |> Lean.Json.parse
- return { cmd := s.take offset, payload := payload }
- | .none => throw "Command is empty"
-
-def execute (command: Command): Subroutine Lean.Json := do
- match command.cmd with
- | "catalog" =>
- match Lean.fromJson? command.payload with
- | .ok args => catalog args
- | .error x => return errorJson x
- | "inspect" =>
- match Lean.fromJson? command.payload with
- | .ok args => inspect args
- | .error x => return errorJson x
- | "clear" => clear
- | "expr.type" =>
- match Lean.fromJson? command.payload with
- | .ok args => expr_type args
- | .error x => return errorJson x
- | "proof.start" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_start args
- | .error x => return errorJson x
- | "proof.tactic" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_tactic args
- | .error x => return errorJson x
- | "proof.printTree" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_print_tree args
- | .error x => return errorJson x
- | cmd =>
- let error: InteractionError := { error := "unknown", desc := s!"Unknown command {cmd}" }
- return Lean.toJson error
- where
- errorI (type desc: String) := Lean.toJson ({ error := type, desc := desc }: InteractionError)
- errorJson := errorI "json"
- errorIndex := errorI "index"
- catalog (_: Catalog): Subroutine Lean.Json := 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 Lean.toJson <| ({ symbols := names }: CatalogResult)
- inspect (args: Inspect): Subroutine Lean.Json := do
- let env ← Lean.MonadEnv.getEnv
- let name := str_to_name args.name
- let info? := env.find? name
- match info? with
- | none => return errorIndex s!"Symbol not found {args.name}"
- | some info =>
- let format ← Lean.Meta.ppExpr info.toConstantVal.type
- let module? := env.getModuleIdxFor? name >>=
- (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
- let boundExpr? ← (match info.toConstantVal.type with
- | .forallE _ _ _ _ => return .some (← type_expr_to_bound info.toConstantVal.type)
- | _ => return Option.none)
- return Lean.toJson ({
- type := toString format,
- boundExpr? := boundExpr?,
- module? := module?
- }: InspectResult)
- clear : Subroutine Lean.Json := do
- let state ← get
- let nTrees := state.proofTrees.size
- set { state with proofTrees := #[] }
- return Lean.toJson ({ nTrees := nTrees }: ClearResult)
- expr_type (args: ExprType): Subroutine Lean.Json := do
- let env ← Lean.MonadEnv.getEnv
- match syntax_from_str env args.expr with
- | .error str => return errorI "parsing" str
- | .ok syn => do
- match (← syntax_to_expr syn) with
- | .error str => return errorI "elab" str
- | .ok expr => do
- try
- let format ← Lean.Meta.ppExpr (← Lean.Meta.inferType expr)
- return Lean.toJson <| ({
- type := toString format,
- roundTrip := toString <| (← Lean.Meta.ppExpr expr)
- }: ExprTypeResult)
- catch exception =>
- return errorI "typing" (← exception.toMessageData.toString)
- proof_start (args: ProofStart): Subroutine Lean.Json := do
- let state ← get
- let env ← Lean.MonadEnv.getEnv
- let expr?: Except Lean.Json Lean.Expr ← (match args.expr, args.copyFrom with
- | .some expr, .none =>
- (match syntax_from_str env expr with
- | .error str => return .error <| errorI "parsing" str
- | .ok syn => do
- (match (← syntax_to_expr syn) with
- | .error str => return .error <| errorI "elab" str
- | .ok expr => return .ok expr))
- | .none, .some copyFrom =>
- (match env.find? <| str_to_name copyFrom with
- | .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
- | .some cInfo => return .ok cInfo.type)
- | .none, .none =>
- return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
- | _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
- match expr? with
- | .error error => return error
- | .ok expr =>
- let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
- -- Put the new tree in the environment
- let nextTreeId := state.proofTrees.size
- set { state with proofTrees := state.proofTrees.push tree }
- return Lean.toJson ({ treeId := nextTreeId }: ProofStartResult)
- proof_tactic (args: ProofTactic): Subroutine Lean.Json := do
- let state ← get
- match state.proofTrees.get? args.treeId with
- | .none => return errorIndex "Invalid tree index {args.treeId}"
- | .some tree =>
- let (result, nextTree) ← ProofTree.execute
- (stateId := args.stateId)
- (goalId := args.goalId.getD 0)
- (tactic := args.tactic) |>.run tree
- match result with
- | .invalid message => return Lean.toJson <| errorIndex message
- | .success nextId? goals =>
- set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
- return Lean.toJson ({ nextId? := nextId?, goals := goals }: ProofTacticResultSuccess)
- | .failure messages =>
- return Lean.toJson ({ tacticErrors := messages }: ProofTacticResultFailure)
- proof_print_tree (args: ProofPrintTree): Subroutine Lean.Json := do
- let state ← get
- match state.proofTrees.get? args.treeId with
- | .none => return errorIndex "Invalid tree index {args.treeId}"
- | .some tree =>
- return Lean.toJson ({parents := tree.structure_array}: ProofPrintTreeResult)
-
-
-end Pantograph
-
+import Pantograph.Version
+import Pantograph
-- Main IO functions
open Pantograph
@@ -184,38 +19,22 @@ unsafe def loop : Subroutine Unit := do
IO.println <| toString <| ret
loop
-namespace Lean
--- This is better than the default version since it handles `.`
-def setOptionFromString' (opts : Options) (entry : String) : IO Options := do
- let ps := (entry.splitOn "=").map String.trim
- let [key, val] ← pure ps | throw $ IO.userError "invalid configuration option entry, it must be of the form '<key> = <value>'"
- let key := str_to_name key
- let defValue ← getOptionDefaultValue key
- match defValue with
- | DataValue.ofString _ => pure $ opts.setString key val
- | DataValue.ofBool _ =>
- match val with
- | "true" => pure $ opts.setBool key true
- | "false" => pure $ opts.setBool key false
- | _ => throw $ IO.userError s!"invalid Bool option value '{val}'"
- | DataValue.ofName _ => pure $ opts.setName key val.toName
- | DataValue.ofNat _ =>
- match val.toNat? with
- | none => throw (IO.userError s!"invalid Nat option value '{val}'")
- | some v => pure $ opts.setNat key v
- | DataValue.ofInt _ =>
- match val.toInt? with
- | none => throw (IO.userError s!"invalid Int option value '{val}'")
- | some v => pure $ opts.setInt key v
- | DataValue.ofSyntax _ => throw (IO.userError s!"invalid Syntax option value")
-end Lean
-
unsafe def main (args: List String): IO Unit := do
+ -- NOTE: A more sophisticated scheme of command line argument handling is needed.
+ -- Separate imports and options
+ if args == ["--version"] then do
+ println! s!"{version}"
+ return
+
Lean.enableInitializersExecution
Lean.initSearchPath (← Lean.findSysroot)
- -- Separate imports and options
- let options := args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
+ let options? ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
+ |>.foldlM Lean.setOptionFromString'' Lean.Options.empty
+ |>.run
+ let options ← match options? with
+ | .ok options => pure options
+ | .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
let env ← Lean.importModules
@@ -225,11 +44,11 @@ unsafe def main (args: List String): IO Unit := do
let context: Context := {
}
let coreContext: Lean.Core.Context := {
- currNamespace := str_to_name "Aniva",
+ currNamespace := Lean.Name.str .anonymous "Aniva"
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0], lines := #[1] },
- options := ← options.foldlM Lean.setOptionFromString' Lean.Options.empty
+ options := options
}
try
let termElabM := loop.run context |>.run' {}
diff --git a/Pantograph.lean b/Pantograph.lean
index cd13b6f..045d28a 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,2 +1,209 @@
import Pantograph.Commands
+import Pantograph.Serial
+import Pantograph.Meta
import Pantograph.Symbols
+
+namespace Lean
+-- This is better than the default version since it handles `.` and doesn't
+-- crash the program when it fails.
+def setOptionFromString'' (opts : Options) (entry : String) : ExceptT String IO Options := do
+ let ps := (entry.splitOn "=").map String.trim
+ let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
+ let key := Pantograph.str_to_name key
+ let defValue ← getOptionDefaultValue key
+ match defValue with
+ | DataValue.ofString _ => pure $ opts.setString key val
+ | DataValue.ofBool _ =>
+ match val with
+ | "true" => pure $ opts.setBool key true
+ | "false" => pure $ opts.setBool key false
+ | _ => throw s!"invalid Bool option value '{val}'"
+ | DataValue.ofName _ => pure $ opts.setName key val.toName
+ | DataValue.ofNat _ =>
+ match val.toNat? with
+ | none => throw s!"invalid Nat option value '{val}'"
+ | some v => pure $ opts.setNat key v
+ | DataValue.ofInt _ =>
+ match val.toInt? with
+ | none => throw s!"invalid Int option value '{val}'"
+ | some v => pure $ opts.setInt key v
+ | DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
+end Lean
+
+namespace Pantograph
+
+structure Context where
+
+/-- Stores state of the REPL -/
+structure State where
+ --environments: Array Lean.Environment := #[]
+ proofTrees: Array ProofTree := #[]
+
+-- State monad
+abbrev Subroutine := ReaderT Context (StateT State Lean.Elab.TermElabM)
+
+/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
+def parse_command (s: String): Except String Commands.Command := do
+ let s := s.trim
+ match s.get? 0 with
+ | .some '{' => -- Parse in Json mode
+ Lean.fromJson? (← Lean.Json.parse s)
+ | .some _ => -- Parse in line mode
+ let offset := s.posOf ' ' |> s.offsetOfPos
+ if offset = s.length then
+ return { cmd := s.take offset, payload := Lean.Json.null }
+ else
+ let payload ← s.drop offset |> Lean.Json.parse
+ return { cmd := s.take offset, payload := payload }
+ | .none => throw "Command is empty"
+
+def execute (command: Commands.Command): Subroutine Lean.Json := do
+ match command.cmd with
+ | "option.set" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => option_set args
+ | .error x => return errorJson x
+ | "catalog" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => catalog args
+ | .error x => return errorJson x
+ | "inspect" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => inspect args
+ | .error x => return errorJson x
+ | "clear" => clear
+ | "expr.type" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => expr_type args
+ | .error x => return errorJson x
+ | "proof.start" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => proof_start args
+ | .error x => return errorJson x
+ | "proof.tactic" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => proof_tactic args
+ | .error x => return errorJson x
+ | "proof.printTree" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => proof_print_tree args
+ | .error x => return errorJson x
+ | cmd =>
+ let error: Commands.InteractionError :=
+ { error := "unknown", desc := s!"Unknown command {cmd}" }
+ return Lean.toJson error
+ where
+ errorI (type desc: String) := Lean.toJson (
+ { error := type, desc := desc }: Commands.InteractionError)
+ errorJson := errorI "json"
+ errorIndex := errorI "index"
+ option_set (args: Commands.OptionSet): Subroutine Lean.Json := do
+ let options? ← args.options.foldlM Lean.setOptionFromString'' Lean.Options.empty
+ |>.run
+ match options? with
+ | .ok options =>
+ withTheReader Lean.Core.Context
+ (λ coreContext => { coreContext with options })
+ (pure $ Lean.toJson <| ({ }: Commands.OptionSetResult))
+ | .error e =>
+ return errorI "parsing" e
+ catalog (_: Commands.Catalog): Subroutine Lean.Json := 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 Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
+ inspect (args: Commands.Inspect): Subroutine Lean.Json := do
+ let env ← Lean.MonadEnv.getEnv
+ let name := str_to_name args.name
+ let info? := env.find? name
+ match info? with
+ | none => return errorIndex s!"Symbol not found {args.name}"
+ | some info =>
+ let format ← Lean.Meta.ppExpr info.toConstantVal.type
+ let module? := env.getModuleIdxFor? name >>=
+ (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
+ let boundExpr? ← (match info.toConstantVal.type with
+ | .forallE _ _ _ _ => return Option.none -- TODO: Temporary override, enable expression dissection in options.
+ -- return .some (← type_expr_to_bound info.toConstantVal.type)
+ | _ => return Option.none)
+ return Lean.toJson ({
+ type := toString format,
+ boundExpr? := boundExpr?,
+ module? := module?
+ }: Commands.InspectResult)
+ clear : Subroutine Lean.Json := do
+ let state ← get
+ let nTrees := state.proofTrees.size
+ set { state with proofTrees := #[] }
+ return Lean.toJson ({ nTrees := nTrees }: Commands.ClearResult)
+ expr_type (args: Commands.ExprType): Subroutine Lean.Json := do
+ let env ← Lean.MonadEnv.getEnv
+ match syntax_from_str env args.expr with
+ | .error str => return errorI "parsing" str
+ | .ok syn => do
+ match (← syntax_to_expr syn) with
+ | .error str => return errorI "elab" str
+ | .ok expr => do
+ try
+ let format ← Lean.Meta.ppExpr (← Lean.Meta.inferType expr)
+ return Lean.toJson <| ({
+ type := toString format,
+ roundTrip := toString <| (← Lean.Meta.ppExpr expr)
+ }: Commands.ExprTypeResult)
+ catch exception =>
+ return errorI "typing" (← exception.toMessageData.toString)
+ proof_start (args: Commands.ProofStart): Subroutine Lean.Json := do
+ let state ← get
+ let env ← Lean.MonadEnv.getEnv
+ let expr?: Except Lean.Json Lean.Expr ← (match args.expr, args.copyFrom with
+ | .some expr, .none =>
+ (match syntax_from_str env expr with
+ | .error str => return .error <| errorI "parsing" str
+ | .ok syn => do
+ (match (← syntax_to_expr syn) with
+ | .error str => return .error <| errorI "elab" str
+ | .ok expr => return .ok expr))
+ | .none, .some copyFrom =>
+ (match env.find? <| str_to_name copyFrom with
+ | .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
+ | .some cInfo => return .ok cInfo.type)
+ | .none, .none =>
+ return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
+ | _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
+ match expr? with
+ | .error error => return error
+ | .ok expr =>
+ let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
+ -- Put the new tree in the environment
+ let nextTreeId := state.proofTrees.size
+ set { state with proofTrees := state.proofTrees.push tree }
+ return Lean.toJson ({ treeId := nextTreeId }: Commands.ProofStartResult)
+ proof_tactic (args: Commands.ProofTactic): Subroutine Lean.Json := do
+ let state ← get
+ match state.proofTrees.get? args.treeId with
+ | .none => return errorIndex "Invalid tree index {args.treeId}"
+ | .some tree =>
+ let (result, nextTree) ← ProofTree.execute
+ (stateId := args.stateId)
+ (goalId := args.goalId.getD 0)
+ (tactic := args.tactic) |>.run tree
+ match result with
+ | .invalid message => return Lean.toJson <| errorIndex message
+ | .success nextId? goals =>
+ set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
+ return Lean.toJson (
+ { nextId? := nextId?, goals := goals }: Commands.ProofTacticResultSuccess)
+ | .failure messages =>
+ return Lean.toJson (
+ { tacticErrors := messages }: Commands.ProofTacticResultFailure)
+ proof_print_tree (args: Commands.ProofPrintTree): Subroutine Lean.Json := do
+ let state ← get
+ match state.proofTrees.get? args.treeId with
+ | .none => return errorIndex "Invalid tree index {args.treeId}"
+ | .some tree =>
+ return Lean.toJson ({parents := tree.structure_array}: Commands.ProofPrintTreeResult)
+
+
+end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 4ad79b5..0b08303 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -21,7 +21,16 @@ structure InteractionError where
deriving Lean.ToJson
--- Individual command and return types
+--- Individual command and return types ---
+
+-- Set Lean options supplied in the form of
+--
+-- option=value
+structure OptionSet where
+ options: Array String
+ deriving Lean.FromJson
+structure OptionSetResult where
+ deriving Lean.ToJson
-- Print all symbols in environment
@@ -38,7 +47,7 @@ structure Inspect where
structure InspectResult where
type: String
-- Decompose the bound expression when the type is forall.
- boundExpr?: Option BoundExpression
+ boundExpr?: Option BoundExpression := Option.none
module?: Option String
deriving Lean.ToJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 0d1c2d6..0851c4c 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -117,4 +117,64 @@ def serialize_goal (mvarDecl: MetavarDecl) : MetaM Goal := do
vars := vars.reverse.toArray
}
+/-- Completely serialises an expression tree. Json not used due to compactness -/
+def serialize_expression_ast (expr: Expr): MetaM String := do
+ match expr with
+ | .bvar deBruijnIndex => return s!"(:bv {deBruijnIndex})"
+ | .fvar fvarId =>
+ let name := (← fvarId.getDecl).userName
+ return s!"(:fv {name})"
+ | .mvar _ =>
+ -- mvarId is ignored.
+ return s!":mv"
+ | .sort u => return s!"(:sort {u.depth})"
+ | .const declName _ =>
+ -- The universe level of the const expression is elided since it should be
+ -- inferrable from surrounding expression
+ return s!"(:const {declName})"
+ | .app fn arg =>
+ let fn' ← serialize_expression_ast fn
+ let arg' ← serialize_expression_ast arg
+ return s!"(:app {fn'} {arg'})"
+ | .lam binderName binderType body binderInfo =>
+ let binderType' ← serialize_expression_ast binderType
+ let body' ← serialize_expression_ast body
+ let binderInfo' := binderInfoToAst binderInfo
+ return s!"(:lam {binderName} {binderType'} {body'} :{binderInfo'})"
+ | .forallE binderName binderType body binderInfo =>
+ let binderType' ← serialize_expression_ast binderType
+ let body' ← serialize_expression_ast body
+ let binderInfo' := binderInfoToAst binderInfo
+ return s!"(:forall {binderName} {binderType'} {body'} :{binderInfo'})"
+ | .letE name type value body _ =>
+ -- Dependent boolean flag diacarded
+ let type' ← serialize_expression_ast type
+ let value' ← serialize_expression_ast value
+ let body' ← serialize_expression_ast body
+ return s!"(:let {name} {type'} {value'} {body'})"
+ | .lit v =>
+ return (match v with
+ | .natVal val => toString val
+ | .strVal val => s!"\"{val}\"")
+ | .mdata _ expr =>
+ -- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
+ return (← serialize_expression_ast expr)
+ | .proj typeName idx struct =>
+ let struct' ← serialize_expression_ast struct
+ return s!"(:proj {typeName} {idx} {struct'})"
+
+ where
+ binderInfoToAst : Lean.BinderInfo → String
+ | .default => "default"
+ | .implicit => "implicit"
+ | .strictImplicit => "strictImplicit"
+ | .instImplicit => "instImplicit"
+
+/-- Serialised expression object --/
+structure Expression where
+ prettyprinted?: Option String := .none
+ bound?: Option BoundExpression := .none
+ sexp?: Option String := .none
+ deriving ToJson
+
end Pantograph
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
new file mode 100644
index 0000000..d667eb3
--- /dev/null
+++ b/Pantograph/Version.lean
@@ -0,0 +1,5 @@
+namespace Pantograph
+
+def version := "0.2"
+
+end Pantograph
diff --git a/README.md b/README.md
index 68ea647..1bb7f32 100644
--- a/README.md
+++ b/README.md
@@ -23,7 +23,7 @@ Note that `lean-toolchain` must be present in the `$PWD` in order to run Pantogr
## Usage
``` sh
-build/bin/pantograph OPTIONS|MODULES
+build/bin/pantograph MODULES|LEAN_OPTIONS
```
The REPL loop accepts commands as single-line JSON inputs and outputs either an
@@ -37,7 +37,7 @@ The list of available commands can be found in `Pantograph/Commands.lean`. An
empty command aborts the REPL.
The `Pantograph` executable must be run with a list of modules to import. It can
-also accept options of the form `--key=value` e.g. `--pp.raw=true`.
+also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
Example: (~5k symbols)
```
diff --git a/Test/Main.lean b/Test/Main.lean
index 22d8984..54b2cb9 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,5 +1,5 @@
import LSpec
-import Pantograph.Symbols
+import Test.Integration
import Test.Proofs
import Test.Serial
@@ -12,6 +12,7 @@ unsafe def main := do
let suites := [
test_serial,
test_proofs
+ --test_integration
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all
diff --git a/lean-toolchain b/lean-toolchain
index a7041bc..1acfb77 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:nightly-2023-05-06
+leanprover/lean4:nightly-2023-08-12
From 9eadd1d4d4a75e66e539fd76bb4c10903d693de2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 14 Aug 2023 17:07:53 -0700
Subject: [PATCH 002/465] Add expression sexp printing (1/2, tests pending)
---
Main.lean | 33 +++++++-
Pantograph.lean | 75 +++++++------------
Pantograph/Commands.lean | 73 +++++++++++++++---
Pantograph/Meta.lean | 10 ++-
Pantograph/Serial.lean | 158 +++++++++++++++++++--------------------
README.md | 10 ++-
Test/Main.lean | 1 +
7 files changed, 214 insertions(+), 146 deletions(-)
diff --git a/Main.lean b/Main.lean
index 012ee4b..9b8bedb 100644
--- a/Main.lean
+++ b/Main.lean
@@ -19,6 +19,36 @@ unsafe def loop : Subroutine Unit := do
IO.println <| toString <| ret
loop
+namespace Lean
+
+/-- This is better than the default version since it handles `.` and doesn't
+ crash the program when it fails. -/
+def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
+ let ps := (entry.splitOn "=").map String.trim
+ let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
+ let key := Pantograph.str_to_name key
+ let defValue ← getOptionDefaultValue key
+ match defValue with
+ | DataValue.ofString _ => pure $ opts.setString key val
+ | DataValue.ofBool _ =>
+ match val with
+ | "true" => pure $ opts.setBool key true
+ | "false" => pure $ opts.setBool key false
+ | _ => throw s!"invalid Bool option value '{val}'"
+ | DataValue.ofName _ => pure $ opts.setName key val.toName
+ | DataValue.ofNat _ =>
+ match val.toNat? with
+ | none => throw s!"invalid Nat option value '{val}'"
+ | some v => pure $ opts.setNat key v
+ | DataValue.ofInt _ =>
+ match val.toInt? with
+ | none => throw s!"invalid Int option value '{val}'"
+ | some v => pure $ opts.setInt key v
+ | DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
+
+end Lean
+
+
unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
-- Separate imports and options
@@ -30,7 +60,7 @@ unsafe def main (args: List String): IO Unit := do
Lean.initSearchPath (← Lean.findSysroot)
let options? ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
- |>.foldlM Lean.setOptionFromString'' Lean.Options.empty
+ |>.foldlM Lean.setOptionFromString' Lean.Options.empty
|>.run
let options ← match options? with
| .ok options => pure options
@@ -42,6 +72,7 @@ unsafe def main (args: List String): IO Unit := do
(opts := {})
(trustLevel := 1)
let context: Context := {
+ imports
}
let coreContext: Lean.Core.Context := {
currNamespace := Lean.Name.str .anonymous "Aniva"
diff --git a/Pantograph.lean b/Pantograph.lean
index 045d28a..086651f 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -3,39 +3,14 @@ import Pantograph.Serial
import Pantograph.Meta
import Pantograph.Symbols
-namespace Lean
--- This is better than the default version since it handles `.` and doesn't
--- crash the program when it fails.
-def setOptionFromString'' (opts : Options) (entry : String) : ExceptT String IO Options := do
- let ps := (entry.splitOn "=").map String.trim
- let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
- let key := Pantograph.str_to_name key
- let defValue ← getOptionDefaultValue key
- match defValue with
- | DataValue.ofString _ => pure $ opts.setString key val
- | DataValue.ofBool _ =>
- match val with
- | "true" => pure $ opts.setBool key true
- | "false" => pure $ opts.setBool key false
- | _ => throw s!"invalid Bool option value '{val}'"
- | DataValue.ofName _ => pure $ opts.setName key val.toName
- | DataValue.ofNat _ =>
- match val.toNat? with
- | none => throw s!"invalid Nat option value '{val}'"
- | some v => pure $ opts.setNat key v
- | DataValue.ofInt _ =>
- match val.toInt? with
- | none => throw s!"invalid Int option value '{val}'"
- | some v => pure $ opts.setInt key v
- | DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
-end Lean
-
namespace Pantograph
structure Context where
+ imports: List String
/-- Stores state of the REPL -/
structure State where
+ options: Commands.Options := {}
--environments: Array Lean.Environment := #[]
proofTrees: Array ProofTree := #[]
@@ -59,9 +34,13 @@ def parse_command (s: String): Except String Commands.Command := do
def execute (command: Commands.Command): Subroutine Lean.Json := do
match command.cmd with
- | "option.set" =>
+ | "options.set" =>
match Lean.fromJson? command.payload with
- | .ok args => option_set args
+ | .ok args => options_set args
+ | .error x => return errorJson x
+ | "options.print" =>
+ match Lean.fromJson? command.payload with
+ | .ok args => options_print args
| .error x => return errorJson x
| "catalog" =>
match Lean.fromJson? command.payload with
@@ -97,16 +76,19 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
{ error := type, desc := desc }: Commands.InteractionError)
errorJson := errorI "json"
errorIndex := errorI "index"
- option_set (args: Commands.OptionSet): Subroutine Lean.Json := do
- let options? ← args.options.foldlM Lean.setOptionFromString'' Lean.Options.empty
- |>.run
- match options? with
- | .ok options =>
- withTheReader Lean.Core.Context
- (λ coreContext => { coreContext with options })
- (pure $ Lean.toJson <| ({ }: Commands.OptionSetResult))
- | .error e =>
- return errorI "parsing" e
+ -- Command Functions
+ options_set (args: Commands.OptionsSet): Subroutine Lean.Json := do
+ let state ← get
+ set { state with
+ options := {
+ printExprPretty := args.printExprPretty?.getD true,
+ printExprAST := args.printExprAST?.getD true,
+ proofVariableDelta := args.proofVariableDelta?.getD false
+ }
+ }
+ return Lean.toJson ({ }: Commands.OptionsSetResult)
+ options_print (_: Commands.OptionsPrint): Subroutine Lean.Json := do
+ return Lean.toJson (← get).options
catalog (_: Commands.Catalog): Subroutine Lean.Json := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
@@ -115,22 +97,23 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
| .none => acc)
return Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
inspect (args: Commands.Inspect): Subroutine Lean.Json := do
+ let state ← get
let env ← Lean.MonadEnv.getEnv
let name := str_to_name args.name
let info? := env.find? name
match info? with
| none => return errorIndex s!"Symbol not found {args.name}"
| some info =>
- let format ← Lean.Meta.ppExpr info.toConstantVal.type
let module? := env.getModuleIdxFor? name >>=
(λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
- let boundExpr? ← (match info.toConstantVal.type with
- | .forallE _ _ _ _ => return Option.none -- TODO: Temporary override, enable expression dissection in options.
- -- return .some (← type_expr_to_bound info.toConstantVal.type)
- | _ => return Option.none)
+ let value? := match args.value?, info with
+ | .some true, _ => info.value?
+ | .some false, _ => .none
+ | .none, .defnInfo _ => info.value?
+ | .none, _ => .none
return Lean.toJson ({
- type := toString format,
- boundExpr? := boundExpr?,
+ type := ← serialize_expression state.options info.type,
+ value? := ← value?.mapM (λ v => serialize_expression state.options v),
module? := module?
}: Commands.InspectResult)
clear : Subroutine Lean.Json := do
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 0b08303..2212f96 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -6,10 +6,55 @@ its field names to avoid confusion with error messages generated by the REPL.
-/
import Lean.Data.Json
-import Pantograph.Serial
-
namespace Pantograph.Commands
+
+/-- Main Option structure, placed here to avoid name collision -/
+structure Options where
+ -- When enabled, pretty print every expression
+ printExprPretty: Bool := true
+ -- When enabled, print the raw AST of expressions
+ printExprAST: Bool := false
+ -- When enabled, the types and values of persistent variables in a proof goal
+ -- are not shown unless they are new to the proof step. Reduces overhead
+ proofVariableDelta: Bool := false
+ deriving Lean.ToJson
+
+--- Expression Objects ---
+
+structure BoundExpression where
+ binders: Array (String × String)
+ target: String
+ deriving Lean.ToJson
+structure Expression where
+ -- Pretty printed expression
+ pp?: Option String := .none
+ -- AST structure
+ sexp?: Option String := .none
+ deriving Lean.ToJson
+
+structure Variable where
+ name: String
+ /-- Does the name contain a dagger -/
+ isInaccessible: Bool := false
+ type: Expression
+ value?: Option Expression := .none
+ deriving Lean.ToJson
+structure Goal where
+ /-- String case id -/
+ caseName?: Option String := .none
+ /-- Is the goal in conversion mode -/
+ isConversion: Bool := false
+ /-- target expression type -/
+ target: Expression
+ /-- Variables -/
+ vars: Array Variable := #[]
+ deriving Lean.ToJson
+
+
+
+--- Individual Commands and return types ---
+
structure Command where
cmd: String
payload: Lean.Json
@@ -23,15 +68,19 @@ structure InteractionError where
--- Individual command and return types ---
--- Set Lean options supplied in the form of
---
--- option=value
-structure OptionSet where
- options: Array String
+/-- Set options; See `Options` struct above for meanings -/
+structure OptionsSet where
+ printExprPretty?: Option Bool
+ printExprAST?: Option Bool
+ proofVariableDelta?: Option Bool
deriving Lean.FromJson
-structure OptionSetResult where
+structure OptionsSetResult where
deriving Lean.ToJson
+structure OptionsPrint where
+ deriving Lean.FromJson
+abbrev OptionsPrintResult := Options
+
-- Print all symbols in environment
structure Catalog where
@@ -43,11 +92,13 @@ structure CatalogResult where
-- Print the type of a symbol
structure Inspect where
name: String
+ -- If true/false, show/hide the value expressions; By default definitions
+ -- values are shown and theorem values are hidden.
+ value?: Option Bool := .some false
deriving Lean.FromJson
structure InspectResult where
- type: String
- -- Decompose the bound expression when the type is forall.
- boundExpr?: Option BoundExpression := Option.none
+ type: Expression
+ value?: Option Expression := .none
module?: Option String
deriving Lean.ToJson
diff --git a/Pantograph/Meta.lean b/Pantograph/Meta.lean
index 3426628..09f6d93 100644
--- a/Pantograph/Meta.lean
+++ b/Pantograph/Meta.lean
@@ -16,7 +16,9 @@ From this point on, any proof which extends
-/
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
-{ msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false }
+ {
+ msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false
+ }
namespace Pantograph
@@ -83,12 +85,14 @@ inductive TacticResult where
-- Invalid id
| invalid (message: String): TacticResult
-- Goes to next state
- | success (nextId?: Option Nat) (goals: Array Goal)
+ | success (nextId?: Option Nat) (goals: Array Commands.Goal)
-- Fails with messages
| failure (messages: Array String)
/-- Execute tactic on given state -/
def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT ProofTree M TacticResult := do
+ -- TODO: Replace with actual options
+ let options: Commands.Options := {}
let tree ← get
match tree.states.get? stateId with
| .none => return .invalid s!"Invalid state id {stateId}"
@@ -113,7 +117,7 @@ def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT P
modify fun s => { s with states := s.states.push proofState }
let goals ← nextGoals.mapM fun mvarId => do
match (← MonadMCtx.getMCtx).findDecl? mvarId with
- | .some mvarDecl => serialize_goal mvarDecl
+ | .some mvarDecl => serialize_goal options mvarDecl
| .none => throwError mvarId
return .success (.some nextId) goals.toArray
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 0851c4c..3daf93a 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -3,15 +3,20 @@ All serialisation functions
-/
import Lean
+import Pantograph.Commands
+
namespace Pantograph
open Lean
+--- Input Functions ---
+
/-- Read a theorem from the environment -/
def expr_from_const (env: Environment) (name: Name): Except String Lean.Expr :=
match env.find? name with
| none => throw s!"Symbol not found: {name}"
| some cInfo => return cInfo.type
+/-- Read syntax object from string -/
def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
Parser.runParserCategory
(env := env)
@@ -39,84 +44,15 @@ def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
-structure BoundExpression where
- binders: Array (String × String)
- target: String
- deriving ToJson
-def type_expr_to_bound (expr: Expr): MetaM BoundExpression := do
+
+--- Output Functions ---
+
+def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
Meta.forallTelescope expr fun arr body => do
let binders ← arr.mapM fun fvar => do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-
-structure Variable where
- name: String
- /-- Does the name contain a dagger -/
- isInaccessible: Bool := false
- type: String
- value?: Option String := .none
- deriving ToJson
-structure Goal where
- /-- String case id -/
- caseName?: Option String := .none
- /-- Is the goal in conversion mode -/
- isConversion: Bool := false
- /-- target expression type -/
- target: String
- /-- Variables -/
- vars: Array Variable := #[]
- deriving ToJson
-
-/-- Adapted from ppGoal -/
-def serialize_goal (mvarDecl: MetavarDecl) : MetaM Goal := do
- -- Options for printing; See Meta.ppGoal for details
- let showLetValues := True
- let ppAuxDecls := false
- let ppImplDetailHyps := false
- let lctx := mvarDecl.lctx
- let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
- Meta.withLCtx lctx mvarDecl.localInstances do
- let rec ppVars (localDecl : LocalDecl) : MetaM Variable := do
- match localDecl with
- | .cdecl _ _ varName type _ _ =>
- let varName := varName.simpMacroScopes
- let type ← instantiateMVars type
- return {
- name := toString varName,
- isInaccessible := varName.isInaccessibleUserName,
- type := toString <| ← Meta.ppExpr type
- }
- | .ldecl _ _ varName type val _ _ => do
- let varName := varName.simpMacroScopes
- let type ← instantiateMVars type
- let value? ← if showLetValues then
- let val ← instantiateMVars val
- pure $ .some <| toString <| (← Meta.ppExpr val)
- else
- pure $ .none
- return {
- name := toString varName,
- isInaccessible := varName.isInaccessibleUserName,
- type := toString <| ← Meta.ppExpr type
- value? := value?
- }
- let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
- let skip := !ppAuxDecls && localDecl.isAuxDecl || !ppImplDetailHyps && localDecl.isImplementationDetail
- if skip then
- return acc
- else
- let var ← ppVars localDecl
- return var::acc
- return {
- caseName? := match mvarDecl.userName with
- | Name.anonymous => .none
- | name => .some <| toString name,
- isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
- target := toString <| (← Meta.ppExpr (← instantiateMVars mvarDecl.type)),
- vars := vars.reverse.toArray
- }
-
/-- Completely serialises an expression tree. Json not used due to compactness -/
def serialize_expression_ast (expr: Expr): MetaM String := do
match expr with
@@ -131,16 +67,16 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
- return s!"(:const {declName})"
+ return s!"(:c {declName})"
| .app fn arg =>
let fn' ← serialize_expression_ast fn
let arg' ← serialize_expression_ast arg
- return s!"(:app {fn'} {arg'})"
+ return s!"({fn'} {arg'})"
| .lam binderName binderType body binderInfo =>
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
let binderInfo' := binderInfoToAst binderInfo
- return s!"(:lam {binderName} {binderType'} {body'} :{binderInfo'})"
+ return s!"(:lambda {binderName} {binderType'} {body'} :{binderInfo'})"
| .forallE binderName binderType body binderInfo =>
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
@@ -170,11 +106,69 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
| .strictImplicit => "strictImplicit"
| .instImplicit => "instImplicit"
-/-- Serialised expression object --/
-structure Expression where
- prettyprinted?: Option String := .none
- bound?: Option BoundExpression := .none
- sexp?: Option String := .none
- deriving ToJson
+def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.Expression := do
+ let pp := toString (← Meta.ppExpr e)
+ let pp?: Option String := match options.printExprPretty with
+ | true => .some pp
+ | false => .none
+ let sexp: String := (← serialize_expression_ast e)
+ let sexp?: Option String := match options.printExprAST with
+ | true => .some sexp
+ | false => .none
+ return {
+ pp?,
+ sexp?
+ }
+
+/-- Adapted from ppGoal -/
+def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) : MetaM Commands.Goal := do
+ -- Options for printing; See Meta.ppGoal for details
+ let showLetValues := True
+ let ppAuxDecls := false
+ let ppImplDetailHyps := false
+ let lctx := mvarDecl.lctx
+ let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
+ Meta.withLCtx lctx mvarDecl.localInstances do
+ let rec ppVars (localDecl : LocalDecl) : MetaM Commands.Variable := do
+ match localDecl with
+ | .cdecl _ _ varName type _ _ =>
+ let varName := varName.simpMacroScopes
+ let type ← instantiateMVars type
+ return {
+ name := toString varName,
+ isInaccessible := varName.isInaccessibleUserName,
+ type := (← serialize_expression options type)
+ }
+ | .ldecl _ _ varName type val _ _ => do
+ let varName := varName.simpMacroScopes
+ let type ← instantiateMVars type
+ let value? ← if showLetValues then
+ let val ← instantiateMVars val
+ pure $ .some (← serialize_expression options val)
+ else
+ pure $ .none
+ return {
+ name := toString varName,
+ isInaccessible := varName.isInaccessibleUserName,
+ type := (← serialize_expression options type)
+ value? := value?
+ }
+ let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
+ let skip := !ppAuxDecls && localDecl.isAuxDecl || !ppImplDetailHyps && localDecl.isImplementationDetail
+ if skip then
+ return acc
+ else
+ let var ← ppVars localDecl
+ return var::acc
+ return {
+ caseName? := match mvarDecl.userName with
+ | Name.anonymous => .none
+ | name => .some <| toString name,
+ isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
+ target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
+ vars := vars.reverse.toArray
+ }
+
+
end Pantograph
diff --git a/README.md b/README.md
index 1bb7f32..46d818d 100644
--- a/README.md
+++ b/README.md
@@ -33,7 +33,7 @@ result of a command execution. The command can be passed in one of two formats
command { ... }
{ "cmd": command, "payload": ... }
```
-The list of available commands can be found in `Pantograph/Commands.lean`. An
+The list of available commands can be found in `Pantograph/Commands.lean` and below. An
empty command aborts the REPL.
The `Pantograph` executable must be run with a list of modules to import. It can
@@ -65,8 +65,13 @@ where the application of `assumption` should lead to a failure.
## Commands
See `Pantograph/Commands.lean` for a description of the parameters and return values in Json.
+- `options.set { key: value, ... }`: Set one or more options (not Lean options; those
+ have to be set via command line arguments.)
+- `options.print`: Display the current set of options
- `catalog`: Display a list of all safe Lean symbols in the current context
-- `inspect {"name": <name>}`: Show the type and package of a given symbol
+- `inspect {"name": <name>, "value": <bool>}`: 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.
- `clear`: Delete all cached expressions and proof trees
- `expr.type {"expr": <expr>}`: Determine the type of an expression and round-trip it
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
@@ -86,4 +91,3 @@ The tests are based on `LSpec`. To run tests,
``` sh
test/all.sh
```
-
diff --git a/Test/Main.lean b/Test/Main.lean
index 54b2cb9..9bf8e8a 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -9,6 +9,7 @@ unsafe def main := do
Lean.enableInitializersExecution
Lean.initSearchPath (← Lean.findSysroot)
+ -- TODO: Add proper testing
let suites := [
test_serial,
test_proofs
From 7771408de1ea48cf57f6fa44ccbdbee39dc6dfd1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 14 Aug 2023 21:43:40 -0700
Subject: [PATCH 003/465] Add expression sexp printing (2/2)
---
Pantograph.lean | 19 +++----
Pantograph/Commands.lean | 13 +++--
Pantograph/Serial.lean | 38 ++++++++++----
Pantograph/{Meta.lean => Tactic.lean} | 6 +--
README.md | 2 +-
Test/Integration.lean | 75 +++++++++++++++++++++++++++
Test/Main.lean | 7 ++-
Test/Proofs.lean | 36 +++++++------
Test/Serial.lean | 42 ++++++++++++---
9 files changed, 182 insertions(+), 56 deletions(-)
rename Pantograph/{Meta.lean => Tactic.lean} (97%)
create mode 100644 Test/Integration.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 086651f..e7c2c59 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,7 +1,7 @@
import Pantograph.Commands
import Pantograph.Serial
-import Pantograph.Meta
import Pantograph.Symbols
+import Pantograph.Tactic
namespace Pantograph
@@ -51,9 +51,9 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
| .ok args => inspect args
| .error x => return errorJson x
| "clear" => clear
- | "expr.type" =>
+ | "expr.echo" =>
match Lean.fromJson? command.payload with
- | .ok args => expr_type args
+ | .ok args => expr_echo args
| .error x => return errorJson x
| "proof.start" =>
match Lean.fromJson? command.payload with
@@ -121,7 +121,8 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
let nTrees := state.proofTrees.size
set { state with proofTrees := #[] }
return Lean.toJson ({ nTrees := nTrees }: Commands.ClearResult)
- expr_type (args: Commands.ExprType): Subroutine Lean.Json := do
+ expr_echo (args: Commands.ExprEcho): Subroutine Lean.Json := do
+ let state ← get
let env ← Lean.MonadEnv.getEnv
match syntax_from_str env args.expr with
| .error str => return errorI "parsing" str
@@ -130,11 +131,11 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
| .error str => return errorI "elab" str
| .ok expr => do
try
- let format ← Lean.Meta.ppExpr (← Lean.Meta.inferType expr)
+ let type ← Lean.Meta.inferType expr
return Lean.toJson <| ({
- type := toString format,
- roundTrip := toString <| (← Lean.Meta.ppExpr expr)
- }: Commands.ExprTypeResult)
+ type := (← serialize_expression (options := state.options) type),
+ expr := (← serialize_expression (options := state.options) expr)
+ }: Commands.ExprEchoResult)
catch exception =>
return errorI "typing" (← exception.toMessageData.toString)
proof_start (args: Commands.ProofStart): Subroutine Lean.Json := do
@@ -171,7 +172,7 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
let (result, nextTree) ← ProofTree.execute
(stateId := args.stateId)
(goalId := args.goalId.getD 0)
- (tactic := args.tactic) |>.run tree
+ (tactic := args.tactic) |>.run state.options |>.run tree
match result with
| .invalid message => return Lean.toJson <| errorIndex message
| .success nextId? goals =>
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 2212f96..45eca35 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -17,9 +17,12 @@ structure Options where
printExprAST: Bool := false
-- When enabled, the types and values of persistent variables in a proof goal
-- are not shown unless they are new to the proof step. Reduces overhead
+ -- TODO: Not implemented yet.
proofVariableDelta: Bool := false
deriving Lean.ToJson
+abbrev OptionsT := ReaderT Options
+
--- Expression Objects ---
structure BoundExpression where
@@ -106,13 +109,13 @@ structure ClearResult where
nTrees: Nat
deriving Lean.ToJson
--- Get the type of an expression
-structure ExprType where
+-- Return the type of an expression
+structure ExprEcho where
expr: String
deriving Lean.FromJson
-structure ExprTypeResult where
- type: String
- roundTrip: String
+structure ExprEchoResult where
+ expr: Expression
+ type: Expression
deriving Lean.ToJson
structure ProofStart where
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 3daf93a..67fb107 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -53,10 +53,14 @@ def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-/-- Completely serialises an expression tree. Json not used due to compactness -/
+/--
+ Completely serialises an expression tree. Json not used due to compactness
+-/
def serialize_expression_ast (expr: Expr): MetaM String := do
match expr with
- | .bvar deBruijnIndex => return s!"(:bv {deBruijnIndex})"
+ | .bvar deBruijnIndex =>
+ -- This is very common so the index alone is shown. Literals are handled below.
+ return s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := (← fvarId.getDecl).userName
return s!"(:fv {name})"
@@ -73,38 +77,50 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
let arg' ← serialize_expression_ast arg
return s!"({fn'} {arg'})"
| .lam binderName binderType body binderInfo =>
+ let binderName' := nameToAst binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
let binderInfo' := binderInfoToAst binderInfo
- return s!"(:lambda {binderName} {binderType'} {body'} :{binderInfo'})"
+ return s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo =>
+ let binderName' := nameToAst binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
let binderInfo' := binderInfoToAst binderInfo
- return s!"(:forall {binderName} {binderType'} {body'} :{binderInfo'})"
+ return s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ =>
-- Dependent boolean flag diacarded
+ let name' := nameToAst name
let type' ← serialize_expression_ast type
let value' ← serialize_expression_ast value
let body' ← serialize_expression_ast body
- return s!"(:let {name} {type'} {value'} {body'})"
+ return s!"(:let {name'} {type'} {value'} {body'})"
| .lit v =>
- return (match v with
+ -- To not burden the downstream parser who needs to handle this, the literal
+ -- is wrapped in a :lit sexp.
+ let v' := match v with
| .natVal val => toString val
- | .strVal val => s!"\"{val}\"")
+ | .strVal val => s!"\"{val}\""
+ return s!"(:lit {v'})"
| .mdata _ expr =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
+ -- It may become necessary to incorporate the metadata.
return (← serialize_expression_ast expr)
| .proj typeName idx struct =>
let struct' ← serialize_expression_ast struct
return s!"(:proj {typeName} {idx} {struct'})"
where
+ -- Elides all unhygenic names
+ nameToAst: Lean.Name → String
+ | .anonymous
+ | .num _ _ => ":anon"
+ | n@(.str _ _) => toString n
binderInfoToAst : Lean.BinderInfo → String
- | .default => "default"
- | .implicit => "implicit"
- | .strictImplicit => "strictImplicit"
- | .instImplicit => "instImplicit"
+ | .default => ""
+ | .implicit => " :implicit"
+ | .strictImplicit => " :strictImplicit"
+ | .instImplicit => " :instImplicit"
def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.Expression := do
let pp := toString (← Meta.ppExpr e)
diff --git a/Pantograph/Meta.lean b/Pantograph/Tactic.lean
similarity index 97%
rename from Pantograph/Meta.lean
rename to Pantograph/Tactic.lean
index 09f6d93..c051f3c 100644
--- a/Pantograph/Meta.lean
+++ b/Pantograph/Tactic.lean
@@ -90,9 +90,9 @@ inductive TacticResult where
| failure (messages: Array String)
/-- Execute tactic on given state -/
-def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String): StateRefT ProofTree M TacticResult := do
- -- TODO: Replace with actual options
- let options: Commands.Options := {}
+def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String):
+ Commands.OptionsT StateRefT ProofTree M TacticResult := do
+ let options ← read
let tree ← get
match tree.states.get? stateId with
| .none => return .invalid s!"Invalid state id {stateId}"
diff --git a/README.md b/README.md
index 46d818d..309303b 100644
--- a/README.md
+++ b/README.md
@@ -73,7 +73,7 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
given symbol; If value flag is set, the value is printed or hidden. By default
only the values of definitions are printed.
- `clear`: Delete all cached expressions and proof trees
-- `expr.type {"expr": <expr>}`: Determine the type of an expression and round-trip it
+- `expr.echo {"expr": <expr>}`: Determine the type of an expression and round-trip it
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
- `proof.tactic {"treeId": <id>, "stateId": <id>, "goalId": <id>, "tactic": string}`: Execute a tactic on a given proof state
- `proof.printTree {"treeId": <id>}`: Print the topological structure of a proof tree
diff --git a/Test/Integration.lean b/Test/Integration.lean
new file mode 100644
index 0000000..d22eadf
--- /dev/null
+++ b/Test/Integration.lean
@@ -0,0 +1,75 @@
+/- Integration test for the REPL
+ -/
+import LSpec
+import Pantograph
+namespace Pantograph.Test
+open Pantograph
+
+def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
+ (expected: Lean.Json): Subroutine LSpec.TestSeq := do
+ let result ← execute { cmd := cmd, payload := Lean.Json.mkObj payload }
+ return LSpec.test s!"{cmd}" (toString result = toString expected)
+
+def subroutine_runner (steps: List (Subroutine LSpec.TestSeq)): IO LSpec.TestSeq := do
+ -- Setup the environment for execution
+ let env ← Lean.importModules
+ (imports := [{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
+ (opts := {})
+ (trustLevel := 1)
+ let context: Context := {
+ imports := ["Init"]
+ }
+ let coreContext: Lean.Core.Context := {
+ currNamespace := Lean.Name.str .anonymous "Aniva"
+ openDecls := [],
+ fileName := "<Test>",
+ fileMap := { source := "", positions := #[0], lines := #[1] },
+ options := Lean.Options.empty
+ }
+ let commands: Subroutine LSpec.TestSeq :=
+ steps.foldlM (λ suite step => do
+ let result ← step
+ return suite ++ result) LSpec.TestSeq.done
+ try
+ let termElabM := commands.run context |>.run' {}
+ let metaM := termElabM.run' (ctx := {
+ declName? := some "_pantograph",
+ errToSorry := false
+ })
+ let coreM := metaM.run'
+ return Prod.fst $ (← coreM.toIO coreContext { env := env })
+ catch ex =>
+ return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
+
+def test_option_print : IO LSpec.TestSeq :=
+ let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
+ let sexp? := Option.some "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"
+ let module? := Option.some "Init.Data.Nat.Basic"
+ subroutine_runner [
+ subroutine_step "inspect"
+ [("name", .str "Nat.add_one")]
+ (Lean.toJson ({
+ type := { pp? }, module? }:
+ Commands.InspectResult)),
+ subroutine_step "options.set"
+ [("printExprAST", .bool true)]
+ (Lean.toJson ({ }:
+ Commands.OptionsSetResult)),
+ subroutine_step "inspect"
+ [("name", .str "Nat.add_one")]
+ (Lean.toJson ({
+ type := { pp?, sexp? }, module? }:
+ Commands.InspectResult)),
+ subroutine_step "options.print"
+ []
+ (Lean.toJson ({ printExprAST := true }:
+ Commands.OptionsPrintResult))
+ ]
+
+def test_integration: IO LSpec.TestSeq := do
+
+ return LSpec.group "Integration" $
+ (LSpec.group "Option modify" (← test_option_print))
+
+
+end Pantograph.Test
diff --git a/Test/Main.lean b/Test/Main.lean
index 9bf8e8a..84d686d 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -9,11 +9,10 @@ unsafe def main := do
Lean.enableInitializersExecution
Lean.initSearchPath (← Lean.findSysroot)
- -- TODO: Add proper testing
let suites := [
- test_serial,
- test_proofs
- --test_integration
+ test_integration,
+ test_proofs,
+ test_serial
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 52854d4..9df7c84 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -1,5 +1,5 @@
import LSpec
-import Pantograph.Meta
+import Pantograph.Tactic
import Pantograph.Serial
namespace Pantograph.Test
@@ -47,13 +47,15 @@ def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
(expr := expr)
return (testSeq, Option.some state)
-deriving instance DecidableEq, Repr for Variable
-deriving instance DecidableEq, Repr for Goal
+deriving instance DecidableEq, Repr for Commands.Expression
+deriving instance DecidableEq, Repr for Commands.Variable
+deriving instance DecidableEq, Repr for Commands.Goal
deriving instance DecidableEq, Repr for TacticResult
+/-- Check the output of each proof step -/
def proof_step (stateId: Nat) (goalId: Nat) (tactic: String)
(expected: TacticResult) : TestM LSpec.TestSeq := do
- let result: TacticResult ← ProofTree.execute stateId goalId tactic
+ let result: TacticResult ← ProofTree.execute stateId goalId tactic |>.run {}
match expected, result with
| .success (.some i) #[], .success (.some _) goals =>
-- If the goals are omitted but the next state is specified, we imply that
@@ -63,6 +65,7 @@ def proof_step (stateId: Nat) (goalId: Nat) (tactic: String)
| _, _ =>
return LSpec.test s!"{stateId}.{goalId} {tactic}" (result = expected)
+/-- Check that the tree structure is correct -/
def proof_inspect (expected: Array String) : TestM LSpec.TestSeq := do
let result := (← get).structure_array
return LSpec.test s!"tree structure" (result = expected)
@@ -90,20 +93,18 @@ def proof_runner (env: Lean.Environment) (start: Start) (steps: List (TestM LSpe
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
| .ok a => return a
-def build_goal (nameType: List (String × String)) (target: String): Goal :=
+def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
{
- target := target,
- vars := (nameType.map fun x => ({ name := x.fst, type := x.snd }: Variable)).toArray
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ name := x.fst, type := { pp? := .some x.snd } })).toArray
}
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
rw [Nat.add_comm]
def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
- let goal1: Goal := {
- target := "n + m = m + n",
- vars := #[{ name := "n", type := "Nat" }, { name := "m", type := "Nat" }]
- }
+ let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
proof_runner env (.copy "Nat.add_comm") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
@@ -113,7 +114,7 @@ def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
(.success .none #[])
]
def proof_nat_add_comm_manual (env: Lean.Environment): IO LSpec.TestSeq := do
- let goal1: Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
+ let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
proof_runner env (.expr "∀ (a b: Nat), a + b = b + a") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
@@ -139,13 +140,14 @@ example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
. apply Or.inl
assumption
def proof_or_comm (env: Lean.Environment): IO LSpec.TestSeq := do
- let branchGoal (caseName name: String): Goal := {
+ let typeProp: Commands.Expression := { pp? := .some "Prop" }
+ let branchGoal (caseName name: String): Commands.Goal := {
caseName? := .some caseName,
- target := "q ∨ p",
+ target := { pp? := .some "q ∨ p" },
vars := #[
- { name := "p", type := "Prop" },
- { name := "q", type := "Prop" },
- { name := "h✝", type := name, isInaccessible := true }
+ { name := "p", type := typeProp },
+ { name := "q", type := typeProp },
+ { name := "h✝", type := { pp? := .some name }, isInaccessible := true }
]
}
proof_runner env (.expr "∀ (p q: Prop), p ∨ q → q ∨ p") [
diff --git a/Test/Serial.lean b/Test/Serial.lean
index febf489..f84e3e4 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -7,22 +7,25 @@ namespace Pantograph.Test
open Pantograph
open Lean
-deriving instance Repr, DecidableEq for BoundExpression
+deriving instance Repr, DecidableEq for Commands.BoundExpression
+
+def test_str_to_name: LSpec.TestSeq :=
+ LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
- let cases: List (String × BoundExpression) := [
+ let entries: List (String × Commands.BoundExpression) := [
("Nat.add_comm", { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
("Nat.le_of_succ_le", { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
]
- let coreM := cases.foldlM (λ suites (symbol, target) => do
+ let coreM := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := str_to_name symbol |> env.find? |>.get! |>.type
let test := LSpec.check symbol ((← type_expr_to_bound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
let coreContext: Core.Context := {
- currNamespace := str_to_name "Aniva",
+ currNamespace := Lean.Name.str .anonymous "Aniva"
openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph>",
+ fileName := "<Pantograph/Test>",
fileMap := { source := "", positions := #[0], lines := #[1] }
}
match ← (coreM.run' coreContext { env := env }).toBaseIO with
@@ -30,6 +33,32 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
| .ok a => return a
+def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
+ let entries: List (String × String) := [
+ -- This one contains unhygienic variable names which must be suppressed
+ ("Nat.add", "(:forall :anon (:c Nat) (:forall :anon (:c Nat) (:c Nat)))"),
+ -- These ones are normal and easy
+ ("Nat.add_one", "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"),
+ ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h (((((:c LE.le) (:c Nat)) (:c instLENat)) ((:c Nat.succ) 1)) 0) (((((:c LE.le) (:c Nat)) (:c instLENat)) 2) 1)) :implicit) :implicit)")
+ ]
+ let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
+ let env ← MonadEnv.getEnv
+ let expr := str_to_name symbol |> env.find? |>.get! |>.type
+ let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
+ return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
+ let coreM := metaM.run'
+ let coreContext: Core.Context := {
+ currNamespace := Lean.Name.str .anonymous "Aniva"
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph/Test>",
+ fileMap := { source := "", positions := #[0], lines := #[1] }
+ }
+ match ← (coreM.run' coreContext { env := env }).toBaseIO with
+ | .error exception =>
+ return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+ | .ok a => return a
+
+
def test_serial: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
@@ -37,7 +66,8 @@ def test_serial: IO LSpec.TestSeq := do
(trustLevel := 1)
return LSpec.group "Serialisation" $
+ (LSpec.group "str_to_name" test_str_to_name) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
- LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
+ (LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
end Pantograph.Test
From b2ba26528d6cf8934c8a9edf825d6bbe2114a738 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 15 Aug 2023 15:40:54 -0700
Subject: [PATCH 004/465] Add proof variable delta; Bump version to 0.2.1
---
Main.lean | 2 +-
Pantograph.lean | 133 +++++++++++++++++----------------------
Pantograph/Commands.lean | 26 +++++---
Pantograph/Serial.lean | 47 +++++++++-----
Pantograph/Tactic.lean | 3 +-
Pantograph/Version.lean | 2 +-
Test/Integration.lean | 9 +--
Test/Proofs.lean | 50 +++++++++++----
8 files changed, 154 insertions(+), 118 deletions(-)
diff --git a/Main.lean b/Main.lean
index 9b8bedb..70f2494 100644
--- a/Main.lean
+++ b/Main.lean
@@ -7,7 +7,7 @@ import Pantograph
-- Main IO functions
open Pantograph
-unsafe def loop : Subroutine Unit := do
+unsafe def loop : MainM Unit := do
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
match parse_command command with
diff --git a/Pantograph.lean b/Pantograph.lean
index e7c2c59..e40a3e7 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -15,7 +15,10 @@ structure State where
proofTrees: Array ProofTree := #[]
-- State monad
-abbrev Subroutine := ReaderT Context (StateT State Lean.Elab.TermElabM)
+abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
+-- For some reason writing `CommandM α := MainM (Except ... α)` disables certain
+-- monadic features in `MainM`
+abbrev CR α := Except Commands.InteractionError α
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
def parse_command (s: String): Except String Commands.Command := do
@@ -32,77 +35,62 @@ def parse_command (s: String): Except String Commands.Command := do
return { cmd := s.take offset, payload := payload }
| .none => throw "Command is empty"
-def execute (command: Commands.Command): Subroutine Lean.Json := do
+def execute (command: Commands.Command): MainM Lean.Json := do
+ let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
+ match Lean.fromJson? command.payload with
+ | .ok args => do
+ match (← comm args) with
+ | .ok result => return Lean.toJson result
+ | .error ierror => return Lean.toJson ierror
+ | .error error => pure $ error
match command.cmd with
- | "options.set" =>
- match Lean.fromJson? command.payload with
- | .ok args => options_set args
- | .error x => return errorJson x
- | "options.print" =>
- match Lean.fromJson? command.payload with
- | .ok args => options_print args
- | .error x => return errorJson x
- | "catalog" =>
- match Lean.fromJson? command.payload with
- | .ok args => catalog args
- | .error x => return errorJson x
- | "inspect" =>
- match Lean.fromJson? command.payload with
- | .ok args => inspect args
- | .error x => return errorJson x
- | "clear" => clear
- | "expr.echo" =>
- match Lean.fromJson? command.payload with
- | .ok args => expr_echo args
- | .error x => return errorJson x
- | "proof.start" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_start args
- | .error x => return errorJson x
- | "proof.tactic" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_tactic args
- | .error x => return errorJson x
- | "proof.printTree" =>
- match Lean.fromJson? command.payload with
- | .ok args => proof_print_tree args
- | .error x => return errorJson x
+ | "options.set" => run options_set
+ | "options.print" => run options_print
+ | "catalog" => run catalog
+ | "inspect" => run inspect
+ | "clear" => run clear
+ | "expr.echo" => run expr_echo
+ | "proof.start" => run proof_start
+ | "proof.tactic" => run proof_tactic
+ | "proof.printTree" => run proof_print_tree
| cmd =>
let error: Commands.InteractionError :=
{ error := "unknown", desc := s!"Unknown command {cmd}" }
return Lean.toJson error
where
- errorI (type desc: String) := Lean.toJson (
- { error := type, desc := desc }: Commands.InteractionError)
- errorJson := errorI "json"
+ errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
errorIndex := errorI "index"
-- Command Functions
- options_set (args: Commands.OptionsSet): Subroutine Lean.Json := do
+ options_set (args: Commands.OptionsSet): MainM (CR Commands.OptionsSetResult) := do
let state ← get
+ let options := state.options
set { state with
options := {
- printExprPretty := args.printExprPretty?.getD true,
- printExprAST := args.printExprAST?.getD true,
- proofVariableDelta := args.proofVariableDelta?.getD false
+ -- FIXME: This should be replaced with something more elegant
+ printExprPretty := args.printExprPretty?.getD options.printExprPretty,
+ printExprAST := args.printExprAST?.getD options.printExprAST,
+ proofVariableDelta := args.proofVariableDelta?.getD options.proofVariableDelta,
+ printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
+ printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
}
}
- return Lean.toJson ({ }: Commands.OptionsSetResult)
- options_print (_: Commands.OptionsPrint): Subroutine Lean.Json := do
- return Lean.toJson (← get).options
- catalog (_: Commands.Catalog): Subroutine Lean.Json := do
+ return .ok { }
+ options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
+ return .ok (← get).options
+ catalog (_: Commands.Catalog): MainM (CR Commands.CatalogResult) := 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 Lean.toJson <| ({ symbols := names }: Commands.CatalogResult)
- inspect (args: Commands.Inspect): Subroutine Lean.Json := do
+ return .ok { symbols := names }
+ inspect (args: Commands.Inspect): MainM (CR Commands.InspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let name := str_to_name args.name
let info? := env.find? name
match info? with
- | none => return errorIndex s!"Symbol not found {args.name}"
+ | 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
@@ -111,37 +99,37 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
| .some false, _ => .none
| .none, .defnInfo _ => info.value?
| .none, _ => .none
- return Lean.toJson ({
+ return .ok {
type := ← serialize_expression state.options info.type,
value? := ← value?.mapM (λ v => serialize_expression state.options v),
module? := module?
- }: Commands.InspectResult)
- clear : Subroutine Lean.Json := do
+ }
+ clear (_: Commands.Clear): MainM (CR Commands.ClearResult) := do
let state ← get
let nTrees := state.proofTrees.size
set { state with proofTrees := #[] }
- return Lean.toJson ({ nTrees := nTrees }: Commands.ClearResult)
- expr_echo (args: Commands.ExprEcho): Subroutine Lean.Json := do
+ return .ok { nTrees := nTrees }
+ expr_echo (args: Commands.ExprEcho): MainM (CR Commands.ExprEchoResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
match syntax_from_str env args.expr with
- | .error str => return errorI "parsing" str
+ | .error str => return .error $ errorI "parsing" str
| .ok syn => do
match (← syntax_to_expr syn) with
- | .error str => return errorI "elab" str
+ | .error str => return .error $ errorI "elab" str
| .ok expr => do
try
let type ← Lean.Meta.inferType expr
- return Lean.toJson <| ({
+ return .ok {
type := (← serialize_expression (options := state.options) type),
expr := (← serialize_expression (options := state.options) expr)
- }: Commands.ExprEchoResult)
+ }
catch exception =>
- return errorI "typing" (← exception.toMessageData.toString)
- proof_start (args: Commands.ProofStart): Subroutine Lean.Json := do
+ return .error $ errorI "typing" (← exception.toMessageData.toString)
+ proof_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let expr?: Except Lean.Json Lean.Expr ← (match args.expr, args.copyFrom with
+ let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
| .some expr, .none =>
(match syntax_from_str env expr with
| .error str => return .error <| errorI "parsing" str
@@ -157,37 +145,34 @@ def execute (command: Commands.Command): Subroutine Lean.Json := do
return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
| _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
match expr? with
- | .error error => return error
+ | .error error => return .error error
| .ok expr =>
let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
-- Put the new tree in the environment
let nextTreeId := state.proofTrees.size
set { state with proofTrees := state.proofTrees.push tree }
- return Lean.toJson ({ treeId := nextTreeId }: Commands.ProofStartResult)
- proof_tactic (args: Commands.ProofTactic): Subroutine Lean.Json := do
+ return .ok { treeId := nextTreeId }
+ proof_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
let state ← get
match state.proofTrees.get? args.treeId with
- | .none => return errorIndex "Invalid tree index {args.treeId}"
+ | .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
| .some tree =>
let (result, nextTree) ← ProofTree.execute
(stateId := args.stateId)
(goalId := args.goalId.getD 0)
(tactic := args.tactic) |>.run state.options |>.run tree
match result with
- | .invalid message => return Lean.toJson <| errorIndex message
+ | .invalid message => return .error $ errorIndex message
| .success nextId? goals =>
set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
- return Lean.toJson (
- { nextId? := nextId?, goals := goals }: Commands.ProofTacticResultSuccess)
+ return .ok { nextId? := nextId?, goals? := .some goals }
| .failure messages =>
- return Lean.toJson (
- { tacticErrors := messages }: Commands.ProofTacticResultFailure)
- proof_print_tree (args: Commands.ProofPrintTree): Subroutine Lean.Json := do
+ return .ok { tacticErrors? := .some messages }
+ proof_print_tree (args: Commands.ProofPrintTree): MainM (CR Commands.ProofPrintTreeResult) := do
let state ← get
match state.proofTrees.get? args.treeId with
- | .none => return errorIndex "Invalid tree index {args.treeId}"
+ | .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
| .some tree =>
- return Lean.toJson ({parents := tree.structure_array}: Commands.ProofPrintTreeResult)
-
+ return .ok { parents := tree.structure_array }
end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 45eca35..57c5ddc 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -17,8 +17,11 @@ structure Options where
printExprAST: Bool := false
-- When enabled, the types and values of persistent variables in a proof goal
-- are not shown unless they are new to the proof step. Reduces overhead
- -- TODO: Not implemented yet.
proofVariableDelta: Bool := false
+ -- See `pp.auxDecls`
+ printAuxDecls: Bool := false
+ -- See `pp.implementationDetailHyps`
+ printImplementationDetailHyps: Bool := false
deriving Lean.ToJson
abbrev OptionsT := ReaderT Options
@@ -39,8 +42,8 @@ structure Expression where
structure Variable where
name: String
/-- Does the name contain a dagger -/
- isInaccessible: Bool := false
- type: Expression
+ isInaccessible?: Option Bool := .none
+ type?: Option Expression := .none
value?: Option Expression := .none
deriving Lean.ToJson
structure Goal where
@@ -76,6 +79,8 @@ structure OptionsSet where
printExprPretty?: Option Bool
printExprAST?: Option Bool
proofVariableDelta?: Option Bool
+ printAuxDecls?: Option Bool
+ printImplementationDetailHyps?: Option Bool
deriving Lean.FromJson
structure OptionsSetResult where
deriving Lean.ToJson
@@ -105,6 +110,8 @@ structure InspectResult where
module?: Option String
deriving Lean.ToJson
+structure Clear where
+ deriving Lean.FromJson
structure ClearResult where
nTrees: Nat
deriving Lean.ToJson
@@ -135,12 +142,13 @@ structure ProofTactic where
goalId: Option Nat
tactic: String
deriving Lean.FromJson
-structure ProofTacticResultSuccess where
- goals: Array Goal
- nextId?: Option Nat -- Next proof state id
- deriving Lean.ToJson
-structure ProofTacticResultFailure where
- tacticErrors: Array String -- Error messages generated by tactic
+structure ProofTacticResult where
+ -- Existence of this field shows success
+ goals?: Option (Array Goal) := .none
+ -- Next proof state id, if successful
+ nextId?: Option Nat := .none
+ -- Existence of this field shows failure
+ tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
structure ProofPrintTree where
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 67fb107..67a6963 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -137,23 +137,35 @@ def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.E
}
/-- Adapted from ppGoal -/
-def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) : MetaM Commands.Goal := do
+def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+ : MetaM Commands.Goal := do
-- Options for printing; See Meta.ppGoal for details
- let showLetValues := True
- let ppAuxDecls := false
- let ppImplDetailHyps := false
+ let showLetValues := true
+ let ppAuxDecls := options.printAuxDecls
+ let ppImplDetailHyps := options.printImplementationDetailHyps
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
Meta.withLCtx lctx mvarDecl.localInstances do
- let rec ppVars (localDecl : LocalDecl) : MetaM Commands.Variable := do
+ let ppVarNameOnly (localDecl: LocalDecl): MetaM Commands.Variable := do
+ match localDecl with
+ | .cdecl _ _ varName _ _ _ =>
+ let varName := varName.simpMacroScopes
+ return {
+ name := toString varName,
+ }
+ | .ldecl _ _ varName _ _ _ _ => do
+ return {
+ name := toString varName,
+ }
+ let ppVar (localDecl : LocalDecl) : MetaM Commands.Variable := do
match localDecl with
| .cdecl _ _ varName type _ _ =>
let varName := varName.simpMacroScopes
let type ← instantiateMVars type
return {
name := toString varName,
- isInaccessible := varName.isInaccessibleUserName,
- type := (← serialize_expression options type)
+ isInaccessible? := .some varName.isInaccessibleUserName
+ type? := .some (← serialize_expression options type)
}
| .ldecl _ _ varName type val _ _ => do
let varName := varName.simpMacroScopes
@@ -165,17 +177,22 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) : MetaM C
pure $ .none
return {
name := toString varName,
- isInaccessible := varName.isInaccessibleUserName,
- type := (← serialize_expression options type)
+ isInaccessible? := .some varName.isInaccessibleUserName
+ type? := .some (← serialize_expression options type)
value? := value?
}
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
- let skip := !ppAuxDecls && localDecl.isAuxDecl || !ppImplDetailHyps && localDecl.isImplementationDetail
- if skip then
- return acc
- else
- let var ← ppVars localDecl
- return var::acc
+ let skip := !ppAuxDecls && localDecl.isAuxDecl ||
+ !ppImplDetailHyps && localDecl.isImplementationDetail
+ if skip then
+ return acc
+ else
+ let nameOnly := options.proofVariableDelta && (parentDecl?.map
+ (λ decl => decl.lctx.find? localDecl.fvarId |>.isSome) |>.getD false)
+ let var ← match nameOnly with
+ | true => ppVarNameOnly localDecl
+ | false => ppVar localDecl
+ return var::acc
return {
caseName? := match mvarDecl.userName with
| Name.anonymous => .none
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index c051f3c..f661be5 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -115,9 +115,10 @@ def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String):
parentGoalId := goalId
}
modify fun s => { s with states := s.states.push proofState }
+ let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal
let goals ← nextGoals.mapM fun mvarId => do
match (← MonadMCtx.getMCtx).findDecl? mvarId with
- | .some mvarDecl => serialize_goal options mvarDecl
+ | .some mvarDecl => serialize_goal options mvarDecl (parentDecl? := parentDecl?)
| .none => throwError mvarId
return .success (.some nextId) goals.toArray
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index d667eb3..a9c55b5 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2"
+def version := "0.2.1"
end Pantograph
diff --git a/Test/Integration.lean b/Test/Integration.lean
index d22eadf..cfcf557 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -6,11 +6,11 @@ namespace Pantograph.Test
open Pantograph
def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
- (expected: Lean.Json): Subroutine LSpec.TestSeq := do
+ (expected: Lean.Json): MainM LSpec.TestSeq := do
let result ← execute { cmd := cmd, payload := Lean.Json.mkObj payload }
return LSpec.test s!"{cmd}" (toString result = toString expected)
-def subroutine_runner (steps: List (Subroutine LSpec.TestSeq)): IO LSpec.TestSeq := do
+def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := do
-- Setup the environment for execution
let env ← Lean.importModules
(imports := [{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
@@ -26,7 +26,7 @@ def subroutine_runner (steps: List (Subroutine LSpec.TestSeq)): IO LSpec.TestSeq
fileMap := { source := "", positions := #[0], lines := #[1] },
options := Lean.Options.empty
}
- let commands: Subroutine LSpec.TestSeq :=
+ let commands: MainM LSpec.TestSeq :=
steps.foldlM (λ suite step => do
let result ← step
return suite ++ result) LSpec.TestSeq.done
@@ -45,6 +45,7 @@ def test_option_print : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
let sexp? := Option.some "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
+ let options: Commands.Options := {}
subroutine_runner [
subroutine_step "inspect"
[("name", .str "Nat.add_one")]
@@ -62,7 +63,7 @@ def test_option_print : IO LSpec.TestSeq :=
Commands.InspectResult)),
subroutine_step "options.print"
[]
- (Lean.toJson ({ printExprAST := true }:
+ (Lean.toJson ({ options with printExprAST := true }:
Commands.OptionsPrintResult))
]
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9df7c84..52a2c69 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -10,7 +10,7 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
-abbrev TestM := StateRefT ProofTree M
+abbrev TestM := ReaderT Commands.Options StateRefT ProofTree M
def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
let env ← Lean.MonadEnv.getEnv
@@ -55,7 +55,8 @@ deriving instance DecidableEq, Repr for TacticResult
/-- Check the output of each proof step -/
def proof_step (stateId: Nat) (goalId: Nat) (tactic: String)
(expected: TacticResult) : TestM LSpec.TestSeq := do
- let result: TacticResult ← ProofTree.execute stateId goalId tactic |>.run {}
+ let options ← read
+ let result: TacticResult ← ProofTree.execute stateId goalId tactic |>.run options
match expected, result with
| .success (.some i) #[], .success (.some _) goals =>
-- If the goals are omitted but the next state is specified, we imply that
@@ -70,12 +71,12 @@ def proof_inspect (expected: Array String) : TestM LSpec.TestSeq := do
let result := (← get).structure_array
return LSpec.test s!"tree structure" (result = expected)
-def proof_runner (env: Lean.Environment) (start: Start) (steps: List (TestM LSpec.TestSeq)): IO LSpec.TestSeq := do
+def proof_runner (env: Lean.Environment) (options: Commands.Options) (start: Start) (steps: List (TestM LSpec.TestSeq)): IO LSpec.TestSeq := do
let termElabM := do
let (testSeq, state?) ← start_proof start
match state? with
| .none => return testSeq
- | .some state => steps.foldlM (fun tests m => do pure $ tests ++ (← m)) testSeq |>.run' state
+ | .some state => steps.foldlM (fun tests m => do pure $ tests ++ (← m)) testSeq |>.run options |>.run' state
let coreContext: Lean.Core.Context := {
currNamespace := str_to_name "Aniva",
@@ -97,7 +98,10 @@ def build_goal (nameType: List (String × String)) (target: String): Commands.Go
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
- name := x.fst, type := { pp? := .some x.snd } })).toArray
+ name := x.fst,
+ type? := .some { pp? := .some x.snd },
+ isInaccessible? := .some false
+ })).toArray
}
example: ∀ (a b: Nat), a + b = b + a := by
@@ -105,7 +109,7 @@ example: ∀ (a b: Nat), a + b = b + a := by
rw [Nat.add_comm]
def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- proof_runner env (.copy "Nat.add_comm") [
+ proof_runner env {} (.copy "Nat.add_comm") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
proof_step 1 0 "assumption"
@@ -115,7 +119,7 @@ def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
]
def proof_nat_add_comm_manual (env: Lean.Environment): IO LSpec.TestSeq := do
let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- proof_runner env (.expr "∀ (a b: Nat), a + b = b + a") [
+ proof_runner env {} (.expr "∀ (a b: Nat), a + b = b + a") [
proof_step 0 0 "intro n m"
(.success (.some 1) #[goal1]),
proof_step 1 0 "assumption"
@@ -145,12 +149,12 @@ def proof_or_comm (env: Lean.Environment): IO LSpec.TestSeq := do
caseName? := .some caseName,
target := { pp? := .some "q ∨ p" },
vars := #[
- { name := "p", type := typeProp },
- { name := "q", type := typeProp },
- { name := "h✝", type := { pp? := .some name }, isInaccessible := true }
+ { name := "p", type? := .some typeProp, isInaccessible? := .some false },
+ { name := "q", type? := .some typeProp, isInaccessible? := .some false },
+ { name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
]
}
- proof_runner env (.expr "∀ (p q: Prop), p ∨ q → q ∨ p") [
+ proof_runner env {} (.expr "∀ (p q: Prop), p ∨ q → q ∨ p") [
proof_step 0 0 "intro p q h"
(.success (.some 1) #[build_goal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"]),
proof_step 1 0 "cases h"
@@ -173,7 +177,7 @@ example (w x y z : Nat) (p : Nat → Prop)
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
def proof_arith_1 (env: Lean.Environment): IO LSpec.TestSeq := do
- proof_runner env (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)") [
+ proof_runner env {} (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)") [
proof_step 0 0 "intros"
(.success (.some 1) #[]),
proof_step 1 0 "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *"
@@ -182,6 +186,25 @@ def proof_arith_1 (env: Lean.Environment): IO LSpec.TestSeq := do
(.success .none #[])
]
+def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
+ {
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ name := x.fst,
+ type? := x.snd.map (λ type => { pp? := type }),
+ isInaccessible? := x.snd.map (λ _ => false)
+ })).toArray
+ }
+def proof_delta_variable (env: Lean.Environment): IO LSpec.TestSeq := do
+ let goal1: Commands.Goal := build_goal_selective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
+ let goal2: Commands.Goal := build_goal_selective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
+ proof_runner env { proofVariableDelta := true } (.expr "∀ (a b: Nat), a + b = b + a") [
+ proof_step 0 0 "intro n"
+ (.success (.some 1) #[goal1]),
+ proof_step 1 0 "intro m"
+ (.success (.some 2) #[goal2])
+ ]
+
def test_proofs : IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
@@ -192,7 +215,8 @@ def test_proofs : IO LSpec.TestSeq := do
(LSpec.group "Nat.add_comm" $ (← proof_nat_add_comm env)) ++
(LSpec.group "Nat.add_comm manual" $ (← proof_nat_add_comm_manual env)) ++
(LSpec.group "Or.comm" $ (← proof_or_comm env)) ++
- (LSpec.group "Arithmetic 1" $ (← proof_arith_1 env))
+ (LSpec.group "Arithmetic 1" $ (← proof_arith_1 env)) ++
+ (LSpec.group "Delta variable" $ (← proof_delta_variable env))
end Pantograph.Test
From 96cbbf25510bd75e455c79a4f085900a9344c671 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 16 Aug 2023 19:25:32 -0700
Subject: [PATCH 005/465] Add compressed json print option; Rearrange commands
into hierarchy
---
Main.lean | 9 +++--
Pantograph.lean | 53 +++++++++++++--------------
Pantograph/Commands.lean | 78 ++++++++++++++++++++--------------------
Pantograph/Version.lean | 2 +-
README.md | 20 +++++------
Test/Integration.lean | 8 ++---
6 files changed, 88 insertions(+), 82 deletions(-)
diff --git a/Main.lean b/Main.lean
index 70f2494..10fc6b0 100644
--- a/Main.lean
+++ b/Main.lean
@@ -8,15 +8,20 @@ import Pantograph
open Pantograph
unsafe def loop : MainM Unit := do
+ let state ← get
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
match parse_command command with
| .error error =>
let error := Lean.toJson ({ error := "json", desc := error }: Commands.InteractionError)
- IO.println (toString error)
+ -- Using `Lean.Json.compress` here to prevent newline
+ IO.println error.compress
| .ok command =>
let ret ← execute command
- IO.println <| toString <| ret
+ let str := match state.options.printJsonPretty with
+ | true => ret.pretty
+ | false => ret.compress
+ IO.println str
loop
namespace Lean
diff --git a/Pantograph.lean b/Pantograph.lean
index e40a3e7..e3501aa 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -44,12 +44,12 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| .error ierror => return Lean.toJson ierror
| .error error => pure $ error
match command.cmd with
+ | "reset" => run reset
+ | "expr.echo" => run expr_echo
+ | "lib.catalog" => run lib_catalog
+ | "lib.inspect" => run lib_inspect
| "options.set" => run options_set
| "options.print" => run options_print
- | "catalog" => run catalog
- | "inspect" => run inspect
- | "clear" => run clear
- | "expr.echo" => run expr_echo
| "proof.start" => run proof_start
| "proof.tactic" => run proof_tactic
| "proof.printTree" => run proof_print_tree
@@ -61,30 +61,19 @@ def execute (command: Commands.Command): MainM Lean.Json := do
errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
errorIndex := errorI "index"
-- Command Functions
- options_set (args: Commands.OptionsSet): MainM (CR Commands.OptionsSetResult) := do
+ reset (_: Commands.Reset): MainM (CR Commands.ResetResult) := do
let state ← get
- let options := state.options
- set { state with
- options := {
- -- FIXME: This should be replaced with something more elegant
- printExprPretty := args.printExprPretty?.getD options.printExprPretty,
- printExprAST := args.printExprAST?.getD options.printExprAST,
- proofVariableDelta := args.proofVariableDelta?.getD options.proofVariableDelta,
- printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
- printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
- }
- }
- return .ok { }
- options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
- return .ok (← get).options
- catalog (_: Commands.Catalog): MainM (CR Commands.CatalogResult) := do
+ let nTrees := state.proofTrees.size
+ set { state with proofTrees := #[] }
+ return .ok { nTrees := nTrees }
+ lib_catalog (_: Commands.LibCatalog): MainM (CR Commands.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 }
- inspect (args: Commands.Inspect): MainM (CR Commands.InspectResult) := do
+ lib_inspect (args: Commands.LibInspect): MainM (CR Commands.LibInspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let name := str_to_name args.name
@@ -104,11 +93,6 @@ def execute (command: Commands.Command): MainM Lean.Json := do
value? := ← value?.mapM (λ v => serialize_expression state.options v),
module? := module?
}
- clear (_: Commands.Clear): MainM (CR Commands.ClearResult) := do
- let state ← get
- let nTrees := state.proofTrees.size
- set { state with proofTrees := #[] }
- return .ok { nTrees := nTrees }
expr_echo (args: Commands.ExprEcho): MainM (CR Commands.ExprEchoResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
@@ -126,6 +110,23 @@ def execute (command: Commands.Command): MainM Lean.Json := do
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
+ options_set (args: Commands.OptionsSet): MainM (CR Commands.OptionsSetResult) := do
+ let state ← get
+ let options := state.options
+ set { state with
+ options := {
+ -- FIXME: This should be replaced with something more elegant
+ printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
+ printExprPretty := args.printExprPretty?.getD options.printExprPretty,
+ printExprAST := args.printExprAST?.getD options.printExprAST,
+ proofVariableDelta := args.proofVariableDelta?.getD options.proofVariableDelta,
+ printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
+ printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
+ }
+ }
+ return .ok { }
+ options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
+ return .ok (← get).options
proof_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 57c5ddc..8d17b0e 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -11,6 +11,9 @@ namespace Pantograph.Commands
/-- Main Option structure, placed here to avoid name collision -/
structure Options where
+ -- When false, suppress newlines in Json objects. Useful for machine-to-machine interaction.
+ -- This should be false` by default to avoid any surprises with parsing.
+ printJsonPretty: Bool := false
-- When enabled, pretty print every expression
printExprPretty: Bool := true
-- When enabled, print the raw AST of expressions
@@ -74,45 +77,10 @@ structure InteractionError where
--- Individual command and return types ---
-/-- Set options; See `Options` struct above for meanings -/
-structure OptionsSet where
- printExprPretty?: Option Bool
- printExprAST?: Option Bool
- proofVariableDelta?: Option Bool
- printAuxDecls?: Option Bool
- printImplementationDetailHyps?: Option Bool
- deriving Lean.FromJson
-structure OptionsSetResult where
- deriving Lean.ToJson
-structure OptionsPrint where
+structure Reset where
deriving Lean.FromJson
-abbrev OptionsPrintResult := Options
-
-
--- Print all symbols in environment
-structure Catalog where
- deriving Lean.FromJson
-structure CatalogResult where
- symbols: Array String
- deriving Lean.ToJson
-
--- Print the type of a symbol
-structure Inspect where
- name: String
- -- If true/false, show/hide the value expressions; By default definitions
- -- values are shown and theorem values are hidden.
- value?: Option Bool := .some false
- deriving Lean.FromJson
-structure InspectResult where
- type: Expression
- value?: Option Expression := .none
- module?: Option String
- deriving Lean.ToJson
-
-structure Clear where
- deriving Lean.FromJson
-structure ClearResult where
+structure ResetResult where
nTrees: Nat
deriving Lean.ToJson
@@ -125,6 +93,40 @@ structure ExprEchoResult where
type: Expression
deriving Lean.ToJson
+-- Print all symbols in environment
+structure LibCatalog where
+ deriving Lean.FromJson
+structure LibCatalogResult where
+ symbols: Array String
+ deriving Lean.ToJson
+-- Print the type of a symbol
+structure LibInspect where
+ name: String
+ -- If true/false, show/hide the value expressions; By default definitions
+ -- values are shown and theorem values are hidden.
+ value?: Option Bool := .some false
+ deriving Lean.FromJson
+structure LibInspectResult where
+ type: Expression
+ value?: Option Expression := .none
+ module?: Option String
+ deriving Lean.ToJson
+
+/-- Set options; See `Options` struct above for meanings -/
+structure OptionsSet where
+ printJsonPretty?: Option Bool
+ printExprPretty?: Option Bool
+ printExprAST?: Option Bool
+ proofVariableDelta?: Option Bool
+ printAuxDecls?: Option Bool
+ printImplementationDetailHyps?: Option Bool
+ deriving Lean.FromJson
+structure OptionsSetResult where
+ deriving Lean.ToJson
+structure OptionsPrint where
+ deriving Lean.FromJson
+abbrev OptionsPrintResult := Options
+
structure ProofStart where
name: Option String -- Identifier of the proof
-- Only one of the fields below may be populated.
@@ -134,7 +136,6 @@ structure ProofStart where
structure ProofStartResult where
treeId: Nat := 0 -- Proof tree id
deriving Lean.ToJson
-
structure ProofTactic where
-- Identifiers for tree, state, and goal
treeId: Nat
@@ -150,7 +151,6 @@ structure ProofTacticResult where
-- Existence of this field shows failure
tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
-
structure ProofPrintTree where
treeId: Nat
deriving Lean.FromJson
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index a9c55b5..9cf39ff 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.1"
+def version := "0.2.2"
end Pantograph
diff --git a/README.md b/README.md
index 309303b..f413d31 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)
```
$ build/bin/Pantograph Init
-catalog
-inspect {"name": "Nat.le_add_left"}
+lib.catalog
+lib.inspect {"name": "Nat.le_add_left"}
```
Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting)
```
$ lake env build/bin/Pantograph Mathlib.Analysis.Seminorm
-catalog
+lib.catalog
```
Example proving a theorem: (alternatively use `proof.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
```
@@ -65,15 +65,15 @@ where the application of `assumption` should lead to a failure.
## Commands
See `Pantograph/Commands.lean` for a description of the parameters and return values in Json.
-- `options.set { key: value, ... }`: Set one or more options (not Lean options; those
- have to be set via command line arguments.)
-- `options.print`: Display the current set of options
-- `catalog`: Display a list of all safe Lean symbols in the current context
-- `inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
+- `reset`: Delete all cached expressions and proof trees
+- `expr.echo {"expr": <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": <name>, "value": <bool>}`: 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.
-- `clear`: Delete all cached expressions and proof trees
-- `expr.echo {"expr": <expr>}`: Determine the type of an expression and round-trip it
+- `options.set { key: value, ... }`: Set one or more options (not Lean options; those
+ have to be set via command line arguments.), for options, see `Pantograph/Commands.lean`
+- `options.print`: Display the current set of options
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
- `proof.tactic {"treeId": <id>, "stateId": <id>, "goalId": <id>, "tactic": string}`: Execute a tactic on a given proof state
- `proof.printTree {"treeId": <id>}`: Print the topological structure of a proof tree
diff --git a/Test/Integration.lean b/Test/Integration.lean
index cfcf557..ae73d82 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -47,20 +47,20 @@ def test_option_print : IO LSpec.TestSeq :=
let module? := Option.some "Init.Data.Nat.Basic"
let options: Commands.Options := {}
subroutine_runner [
- subroutine_step "inspect"
+ subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp? }, module? }:
- Commands.InspectResult)),
+ Commands.LibInspectResult)),
subroutine_step "options.set"
[("printExprAST", .bool true)]
(Lean.toJson ({ }:
Commands.OptionsSetResult)),
- subroutine_step "inspect"
+ subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp?, sexp? }, module? }:
- Commands.InspectResult)),
+ Commands.LibInspectResult)),
subroutine_step "options.print"
[]
(Lean.toJson ({ options with printExprAST := true }:
From a8cbb3be4f768484289d66911fc17f93d8e28aa9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 22 Aug 2023 09:54:37 -0700
Subject: [PATCH 006/465] Move all json-string functions to Main.lean
---
Main.lean | 15 +++++++++++++++
Pantograph.lean | 15 ---------------
2 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/Main.lean b/Main.lean
index 10fc6b0..ff57890 100644
--- a/Main.lean
+++ b/Main.lean
@@ -7,6 +7,21 @@ import Pantograph
-- Main IO functions
open Pantograph
+/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
+def parse_command (s: String): Except String Commands.Command := do
+ let s := s.trim
+ match s.get? 0 with
+ | .some '{' => -- Parse in Json mode
+ Lean.fromJson? (← Lean.Json.parse s)
+ | .some _ => -- Parse in line mode
+ let offset := s.posOf ' ' |> s.offsetOfPos
+ if offset = s.length then
+ return { cmd := s.take offset, payload := Lean.Json.null }
+ else
+ let payload ← s.drop offset |> Lean.Json.parse
+ return { cmd := s.take offset, payload := payload }
+ | .none => throw "Command is empty"
+
unsafe def loop : MainM Unit := do
let state ← get
let command ← (← IO.getStdin).getLine
diff --git a/Pantograph.lean b/Pantograph.lean
index e3501aa..3c5de42 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -20,21 +20,6 @@ abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
-- monadic features in `MainM`
abbrev CR α := Except Commands.InteractionError α
-/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
-def parse_command (s: String): Except String Commands.Command := do
- let s := s.trim
- match s.get? 0 with
- | .some '{' => -- Parse in Json mode
- Lean.fromJson? (← Lean.Json.parse s)
- | .some _ => -- Parse in line mode
- let offset := s.posOf ' ' |> s.offsetOfPos
- if offset = s.length then
- return { cmd := s.take offset, payload := Lean.Json.null }
- else
- let payload ← s.drop offset |> Lean.Json.parse
- return { cmd := s.take offset, payload := payload }
- | .none => throw "Command is empty"
-
def execute (command: Commands.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
From 59c046efc6fe8911c840e7850c9f4a2effc3cad5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 23 Aug 2023 12:51:06 -0700
Subject: [PATCH 007/465] Add proper printing of sorts
---
Pantograph/Serial.lean | 78 +++++++++++++++++++++++++++++++++--------
Pantograph/Version.lean | 2 +-
Test/Serial.lean | 5 ++-
3 files changed, 68 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 67a6963..6dd9a9f 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -53,21 +53,73 @@ def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
+private def name_to_ast: Lean.Name → String
+ | .anonymous
+ | .num _ _ => ":anon"
+ | n@(.str _ _) => toString n
+
+private def level_depth: Level → Nat
+ | .zero => 0
+ | .succ l => 1 + (level_depth l)
+ | .max u v | .imax u v => 1 + max (level_depth u) (level_depth v)
+ | .param _ | .mvar _ => 0
+
+theorem level_depth_max_imax (u v: Level): (level_depth (Level.max u v) = level_depth (Level.imax u v)) := by
+ constructor
+theorem level_max_depth_decrease (u v: Level): (level_depth u < level_depth (Level.max u v)) := by
+ have h1: level_depth (Level.max u v) = 1 + Nat.max (level_depth u) (level_depth v) := by constructor
+ rewrite [h1]
+ simp_arith
+ conv =>
+ rhs
+ apply Nat.max_def
+ sorry
+theorem level_offset_decrease (u v: Level): (level_depth u ≤ level_depth (Level.max u v).getLevelOffset) := sorry
+
+/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
+def serialize_sort_level_ast (level: Level): String :=
+ let k := level.getOffset
+ let u := level.getLevelOffset
+ let u_str := match u with
+ | .zero => "0"
+ | .succ _ => panic! "getLevelOffset should not return .succ"
+ | .max v w | .imax v w =>
+ let v := serialize_sort_level_ast v
+ let w := serialize_sort_level_ast w
+ s!"(max {v} {w})"
+ | .param name =>
+ let name := name_to_ast name
+ s!"{name}"
+ | .mvar id =>
+ let name := name_to_ast id.name
+ s!"(:mvar {name})"
+ match k, u with
+ | 0, _ => u_str
+ | _, .zero => s!"{k}"
+ | _, _ => s!"(+ {u_str} {k})"
+ termination_by serialize_sort_level_ast level => level_depth level
+ decreasing_by
+ . sorry
+
/--
- Completely serialises an expression tree. Json not used due to compactness
+ Completely serializes an expression tree. Json not used due to compactness
-/
def serialize_expression_ast (expr: Expr): MetaM String := do
match expr with
| .bvar deBruijnIndex =>
-- This is very common so the index alone is shown. Literals are handled below.
+ -- The raw de Bruijn index should never appear in an unbound setting. In
+ -- Lean these are handled using a `#` prefix.
return s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := (← fvarId.getDecl).userName
return s!"(:fv {name})"
- | .mvar _ =>
- -- mvarId is ignored.
- return s!":mv"
- | .sort u => return s!"(:sort {u.depth})"
+ | .mvar mvarId =>
+ let name := name_to_ast mvarId.name
+ return s!"(:mv {name})"
+ | .sort level =>
+ let level := serialize_sort_level_ast level
+ return s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
@@ -77,20 +129,20 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
let arg' ← serialize_expression_ast arg
return s!"({fn'} {arg'})"
| .lam binderName binderType body binderInfo =>
- let binderName' := nameToAst binderName
+ let binderName' := name_to_ast binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
- let binderInfo' := binderInfoToAst binderInfo
+ let binderInfo' := binder_info_to_ast binderInfo
return s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo =>
- let binderName' := nameToAst binderName
+ let binderName' := name_to_ast binderName
let binderType' ← serialize_expression_ast binderType
let body' ← serialize_expression_ast body
- let binderInfo' := binderInfoToAst binderInfo
+ let binderInfo' := binder_info_to_ast binderInfo
return s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ =>
-- Dependent boolean flag diacarded
- let name' := nameToAst name
+ let name' := name_to_ast name
let type' ← serialize_expression_ast type
let value' ← serialize_expression_ast value
let body' ← serialize_expression_ast body
@@ -112,11 +164,7 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
where
-- Elides all unhygenic names
- nameToAst: Lean.Name → String
- | .anonymous
- | .num _ _ => ":anon"
- | n@(.str _ _) => toString n
- binderInfoToAst : Lean.BinderInfo → String
+ binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 9cf39ff..e4ebd2c 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.2"
+def version := "0.2.3"
end Pantograph
diff --git a/Test/Serial.lean b/Test/Serial.lean
index f84e3e4..e300492 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -39,7 +39,10 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
("Nat.add", "(:forall :anon (:c Nat) (:forall :anon (:c Nat) (:c Nat)))"),
-- These ones are normal and easy
("Nat.add_one", "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"),
- ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h (((((:c LE.le) (:c Nat)) (:c instLENat)) ((:c Nat.succ) 1)) 0) (((((:c LE.le) (:c Nat)) (:c instLENat)) 2) 1)) :implicit) :implicit)")
+ ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h (((((:c LE.le) (:c Nat)) (:c instLENat)) ((:c Nat.succ) 1)) 0) (((((:c LE.le) (:c Nat)) (:c instLENat)) 2) 1)) :implicit) :implicit)"),
+ -- Handling of higher order types
+ ("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
+ ("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
]
let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
From 0c330c87784c89a8e59b66fa61b59000e7405642 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 23 Aug 2023 13:00:11 -0700
Subject: [PATCH 008/465] Unify json and unknown error into command error
---
Main.lean | 2 +-
Pantograph.lean | 2 +-
Test/Integration.lean | 14 ++++++++++++--
3 files changed, 14 insertions(+), 4 deletions(-)
diff --git a/Main.lean b/Main.lean
index 10fc6b0..99ec70b 100644
--- a/Main.lean
+++ b/Main.lean
@@ -13,7 +13,7 @@ unsafe def loop : MainM Unit := do
if command.trim.length = 0 then return ()
match parse_command command with
| .error error =>
- let error := Lean.toJson ({ error := "json", desc := error }: Commands.InteractionError)
+ let error := Lean.toJson ({ error := "command", desc := error }: Commands.InteractionError)
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
diff --git a/Pantograph.lean b/Pantograph.lean
index e3501aa..d37f7ef 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -55,7 +55,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| "proof.printTree" => run proof_print_tree
| cmd =>
let error: Commands.InteractionError :=
- { error := "unknown", desc := s!"Unknown command {cmd}" }
+ { error := "command", desc := s!"Unknown command {cmd}" }
return Lean.toJson error
where
errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
diff --git a/Test/Integration.lean b/Test/Integration.lean
index ae73d82..83cdb70 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -41,7 +41,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
catch ex =>
return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
-def test_option_print : IO LSpec.TestSeq :=
+def test_option_modify : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
let sexp? := Option.some "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
@@ -66,11 +66,21 @@ def test_option_print : IO LSpec.TestSeq :=
(Lean.toJson ({ options with printExprAST := true }:
Commands.OptionsPrintResult))
]
+def test_malformed_command : IO LSpec.TestSeq :=
+ let invalid := "invalid"
+ subroutine_runner [
+ subroutine_step invalid
+ [("name", .str "Nat.add_one")]
+ (Lean.toJson ({
+ error := "command", desc := s!"Unknown command {invalid}"}:
+ Commands.InteractionError))
+ ]
def test_integration: IO LSpec.TestSeq := do
return LSpec.group "Integration" $
- (LSpec.group "Option modify" (← test_option_print))
+ (LSpec.group "Option modify" (← test_option_modify)) ++
+ (LSpec.group "Malformed command" (← test_malformed_command))
end Pantograph.Test
From ff8fed8741c88f0f4828bf9f09ae64bd43d9c755 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 24 Aug 2023 22:51:40 -0700
Subject: [PATCH 009/465] Classify JSON error as command error
Also add documentation for this
---
Pantograph.lean | 5 +++--
README.md | 19 +++++++++++++++++--
2 files changed, 20 insertions(+), 4 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 8a8e91a..18ead6b 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -27,7 +27,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
match (← comm args) with
| .ok result => return Lean.toJson result
| .error ierror => return Lean.toJson ierror
- | .error error => pure $ error
+ | .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
match command.cmd with
| "reset" => run reset
| "expr.echo" => run expr_echo
@@ -40,10 +40,11 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| "proof.printTree" => run proof_print_tree
| cmd =>
let error: Commands.InteractionError :=
- { error := "command", desc := s!"Unknown command {cmd}" }
+ errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
+ errorCommand := errorI "command"
errorIndex := errorI "index"
-- Command Functions
reset (_: Commands.Reset): MainM (CR Commands.ResetResult) := do
diff --git a/README.md b/README.md
index f413d31..82d3db3 100644
--- a/README.md
+++ b/README.md
@@ -27,7 +27,7 @@ build/bin/pantograph MODULES|LEAN_OPTIONS
```
The REPL loop accepts commands as single-line JSON inputs and outputs either an
-`Error:` (indicating malformed command) or a json return value indicating the
+`Error:` (indicating malformed command) or a JSON return value indicating the
result of a command execution. The command can be passed in one of two formats
```
command { ... }
@@ -64,7 +64,7 @@ where the application of `assumption` should lead to a failure.
## Commands
-See `Pantograph/Commands.lean` for a description of the parameters and return values in Json.
+See `Pantograph/Commands.lean` for a description of the parameters and return values in JSON.
- `reset`: Delete all cached expressions and proof trees
- `expr.echo {"expr": <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
@@ -78,6 +78,21 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
- `proof.tactic {"treeId": <id>, "stateId": <id>, "goalId": <id>, "tactic": string}`: Execute a tactic on a given proof state
- `proof.printTree {"treeId": <id>}`: Print the topological structure of a proof tree
+## Errors
+
+When an error pertaining to the execution of a command happens, the returning JSON structure is
+
+``` json
+{ error: "type", desc: "description" }
+```
+Common error forms:
+* `command`: Indicates malformed command structure which results from either
+ invalid command or a malformed JSON structure that cannot be fed to an
+ individual command.
+* `index`: Indicates an invariant maintained by the output of one command and
+ input of another is broken. For example, attempting to query a symbol not
+ existing in the library or indexing into a non-existent proof state.
+
## Troubleshooting
If lean encounters stack overflow problems when printing catalog, execute this before running lean:
From bd4fbcc369840237cb107765a153849eb9088aae Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 24 Aug 2023 23:12:18 -0700
Subject: [PATCH 010/465] Add test cases for command error categories
---
Test/Integration.lean | 13 ++++++++++---
1 file changed, 10 insertions(+), 3 deletions(-)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 83cdb70..ab31110 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -5,10 +5,12 @@ import Pantograph
namespace Pantograph.Test
open Pantograph
-def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
+def subroutine_named_step (name cmd: String) (payload: List (String × Lean.Json))
(expected: Lean.Json): MainM LSpec.TestSeq := do
let result ← execute { cmd := cmd, payload := Lean.Json.mkObj payload }
- return LSpec.test s!"{cmd}" (toString result = toString expected)
+ return LSpec.test name (toString result = toString expected)
+def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
+ (expected: Lean.Json): MainM LSpec.TestSeq := subroutine_named_step cmd cmd payload expected
def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := do
-- Setup the environment for execution
@@ -69,10 +71,15 @@ def test_option_modify : IO LSpec.TestSeq :=
def test_malformed_command : IO LSpec.TestSeq :=
let invalid := "invalid"
subroutine_runner [
- subroutine_step invalid
+ subroutine_named_step "Invalid command" invalid
[("name", .str "Nat.add_one")]
(Lean.toJson ({
error := "command", desc := s!"Unknown command {invalid}"}:
+ Commands.InteractionError)),
+ subroutine_named_step "JSON Deserialization" "expr.echo"
+ [(invalid, .str "Random garbage data")]
+ (Lean.toJson ({
+ error := "command", desc := s!"Unable to parse json: Pantograph.Commands.ExprEcho.expr: String expected"}:
Commands.InteractionError))
]
From 9c4c43a9f1118d2501c836479008b4a5dffe8927 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 23 Aug 2023 13:19:38 -0700
Subject: [PATCH 011/465] Remove the obsolete name field from proof tree
structure
---
Pantograph.lean | 2 +-
Pantograph/Commands.lean | 3 +--
Pantograph/Tactic.lean | 6 +-----
Test/Proofs.lean | 2 --
4 files changed, 3 insertions(+), 10 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 18ead6b..525b834 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -134,7 +134,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
match expr? with
| .error error => return .error error
| .ok expr =>
- let tree ← ProofTree.create (str_to_name <| args.name.getD "Untitled") expr
+ let tree ← ProofTree.create expr
-- Put the new tree in the environment
let nextTreeId := state.proofTrees.size
set { state with proofTrees := state.proofTrees.push tree }
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 8d17b0e..6e28af8 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -128,7 +128,6 @@ structure OptionsPrint where
abbrev OptionsPrintResult := Options
structure ProofStart where
- name: Option String -- Identifier of the proof
-- Only one of the fields below may be populated.
expr: Option String -- Proof expression
copyFrom: Option String -- Theorem name
@@ -140,7 +139,7 @@ structure ProofTactic where
-- Identifiers for tree, state, and goal
treeId: Nat
stateId: Nat
- goalId: Option Nat
+ goalId: Option Nat -- Defaults to 0
tactic: String
deriving Lean.FromJson
structure ProofTacticResult where
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index f661be5..50ddf3a 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -30,21 +30,17 @@ structure ProofState where
parent : Option Nat := none
parentGoalId : Nat := 0
structure ProofTree where
- -- All parameters needed to run a `TermElabM` monad
- name: Name
-
-- Set of proof states
states : Array ProofState := #[]
abbrev M := Elab.TermElabM
-def ProofTree.create (name: Name) (expr: Expr): M ProofTree := do
+def ProofTree.create (expr: Expr): M ProofTree := do
let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
return {
- name := name,
states := #[{
savedState := savedState,
goals := [goal.mvarId!]
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 52a2c69..505eec9 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -22,7 +22,6 @@ def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
match cInfo? with
| .some cInfo =>
let state ← ProofTree.create
- (name := str_to_name "TestExample")
(expr := cInfo.type)
return (testSeq, Option.some state)
| .none =>
@@ -43,7 +42,6 @@ def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
return (testSeq, Option.none)
| .ok expr =>
let state ← ProofTree.create
- (name := str_to_name "TestExample")
(expr := expr)
return (testSeq, Option.some state)
From a86af1bc57bf00360e8df6a58b302159e64d9495 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 27 Aug 2023 19:53:09 -0700
Subject: [PATCH 012/465] Add SemihashMap structure for goal bookkeeping
---
Pantograph.lean | 54 +++---
Pantograph/Commands.lean | 16 +-
Pantograph/SemihashMap.lean | 89 ++++++++++
Pantograph/Tactic.lean | 83 ++++------
README.md | 14 +-
Test/Proofs.lean | 320 ++++++++++++++++++++----------------
6 files changed, 339 insertions(+), 237 deletions(-)
create mode 100644 Pantograph/SemihashMap.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 525b834..543c49e 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -2,6 +2,7 @@ import Pantograph.Commands
import Pantograph.Serial
import Pantograph.Symbols
import Pantograph.Tactic
+import Pantograph.SemihashMap
namespace Pantograph
@@ -11,8 +12,7 @@ structure Context where
/-- Stores state of the REPL -/
structure State where
options: Commands.Options := {}
- --environments: Array Lean.Environment := #[]
- proofTrees: Array ProofTree := #[]
+ goalStates: SemihashMap GoalState := SemihashMap.empty
-- State monad
abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
@@ -49,9 +49,9 @@ def execute (command: Commands.Command): MainM Lean.Json := do
-- Command Functions
reset (_: Commands.Reset): MainM (CR Commands.ResetResult) := do
let state ← get
- let nTrees := state.proofTrees.size
- set { state with proofTrees := #[] }
- return .ok { nTrees := nTrees }
+ let nStates := state.goalStates.size
+ set { state with goalStates := SemihashMap.empty }
+ return .ok { nStates := nStates }
lib_catalog (_: Commands.LibCatalog): MainM (CR Commands.LibCatalogResult) := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
@@ -134,32 +134,34 @@ def execute (command: Commands.Command): MainM Lean.Json := do
match expr? with
| .error error => return .error error
| .ok expr =>
- let tree ← ProofTree.create expr
- -- Put the new tree in the environment
- let nextTreeId := state.proofTrees.size
- set { state with proofTrees := state.proofTrees.push tree }
- return .ok { treeId := nextTreeId }
+ let goalState ← GoalState.create expr
+ let (goalStates, goalId) := state.goalStates.insert goalState
+ set { state with goalStates }
+ return .ok { goalId }
proof_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
let state ← get
- match state.proofTrees.get? args.treeId with
- | .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
- | .some tree =>
- let (result, nextTree) ← ProofTree.execute
- (stateId := args.stateId)
- (goalId := args.goalId.getD 0)
- (tactic := args.tactic) |>.run state.options |>.run tree
+ match state.goalStates.get? args.goalId with
+ | .none => return .error $ errorIndex "Invalid goal index {args.goalId}"
+ | .some goalState =>
+ let result ← GoalState.execute goalState args.tactic |>.run state.options
match result with
- | .invalid message => return .error $ errorIndex message
- | .success nextId? goals =>
- set { state with proofTrees := state.proofTrees.set! args.treeId nextTree }
- return .ok { nextId? := nextId?, goals? := .some goals }
+ | .success goals =>
+ if goals.isEmpty then
+ return .ok {}
+ else
+ -- Append all goals
+ let (goalStates, goalIds, sGoals) := Array.foldl (λ acc itr =>
+ let (map, indices, serializedGoals) := acc
+ let (goalState, sGoal) := itr
+ let (map, index) := map.insert goalState
+ (map, index :: indices, sGoal :: serializedGoals)
+ ) (state.goalStates, [], []) goals
+ set { state with goalStates }
+ return .ok { goals? := .some sGoals.reverse.toArray, goalIds? := .some goalIds.reverse.toArray }
| .failure messages =>
return .ok { tacticErrors? := .some messages }
- proof_print_tree (args: Commands.ProofPrintTree): MainM (CR Commands.ProofPrintTreeResult) := do
+ proof_print_tree (_: Commands.ProofPrintTree): MainM (CR Commands.ProofPrintTreeResult) := do
let state ← get
- match state.proofTrees.get? args.treeId with
- | .none => return .error $ errorIndex "Invalid tree index {args.treeId}"
- | .some tree =>
- return .ok { parents := tree.structure_array }
+ return .ok { nGoals := state.goalStates.size }
end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 6e28af8..8c8b509 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -81,7 +81,7 @@ structure InteractionError where
structure Reset where
deriving Lean.FromJson
structure ResetResult where
- nTrees: Nat
+ nStates: Nat
deriving Lean.ToJson
-- Return the type of an expression
@@ -133,29 +133,27 @@ structure ProofStart where
copyFrom: Option String -- Theorem name
deriving Lean.FromJson
structure ProofStartResult where
- treeId: Nat := 0 -- Proof tree id
+ goalId: Nat := 0 -- Proof tree id
deriving Lean.ToJson
structure ProofTactic where
-- Identifiers for tree, state, and goal
- treeId: Nat
- stateId: Nat
- goalId: Option Nat -- Defaults to 0
+ goalId: Nat
tactic: String
deriving Lean.FromJson
structure ProofTacticResult where
-- Existence of this field shows success
goals?: Option (Array Goal) := .none
-- Next proof state id, if successful
- nextId?: Option Nat := .none
+ goalIds?: Option (Array Nat) := .none
-- Existence of this field shows failure
tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
+
structure ProofPrintTree where
- treeId: Nat
deriving Lean.FromJson
structure ProofPrintTreeResult where
- -- "" if no parents, otherwise "parentId.goalId"
- parents: Array String
+ -- Total number of goals
+ nGoals: Nat
deriving Lean.ToJson
end Pantograph.Commands
diff --git a/Pantograph/SemihashMap.lean b/Pantograph/SemihashMap.lean
new file mode 100644
index 0000000..362be94
--- /dev/null
+++ b/Pantograph/SemihashMap.lean
@@ -0,0 +1,89 @@
+
+namespace Pantograph.SemihashMap
+
+structure Imp (β: Type u) where
+ data: Array (Option β)
+
+ -- Number of elements currently in use
+ size: Nat
+
+ -- Next index that has never been touched
+ allocFront: Nat
+
+ -- Deallocated indices
+ deallocs: Array Nat
+
+ -- Number of valid entries in `deallocs` array
+ lastDealloc: Nat
+
+namespace Imp
+
+
+@[inline] def insert (map: Imp β) (v: β): (Imp β × Nat) :=
+ match map.lastDealloc with
+ | 0 => -- Capacity is full, buffer expansion is required
+ if map.size == map.data.size then
+ let nextIndex := map.data.size
+ let extendCapacity := map.size
+ let result: Imp β := {
+ data := (map.data.append #[Option.some v]).append (mkArray extendCapacity .none),
+ size := map.size + 1,
+ allocFront := map.size + 1,
+ deallocs := mkArray (map.data.size + 1 + extendCapacity) 0,
+ lastDealloc := 0,
+ }
+ (result, nextIndex)
+ else
+ let nextIndex := map.size
+ let result: Imp β := {
+ map
+ with
+ data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
+ size := map.size + 1,
+ allocFront := map.allocFront + 1,
+ }
+ (result, nextIndex)
+ | (.succ k) => -- Allocation list has space
+ let nextIndex := map.deallocs.get! k
+ let result: Imp β := {
+ map with
+ data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
+ size := map.size + 1,
+ lastDealloc := map.lastDealloc - 1
+ }
+ (result, nextIndex)
+
+@[inline] def remove (map: Imp β) (index: Nat): Imp β :=
+ match map.data.getD index .none with
+ | .none => map
+ | .some _ =>
+ {
+ map with
+ data := map.data.set ⟨index, sorry⟩ .none,
+ size := map.size - 1,
+ deallocs := map.deallocs.set ⟨map.lastDealloc, sorry⟩ index,
+ lastDealloc := map.lastDealloc + 1,
+ }
+
+/-- Retrieval is efficient -/
+@[inline] def get? (map: Imp β) (index: Nat): Option β :=
+ map.data.getD index .none
+@[inline] def capacity (map: Imp β): Nat := map.data.size
+
+end Imp
+
+def empty (capacity := 16): Imp β :=
+ {
+ data := mkArray capacity .none,
+ size := 0,
+ allocFront := 0,
+ deallocs := mkArray capacity 0,
+ lastDealloc := 0,
+ }
+
+/--
+This is like a hashmap but you cannot control the keys.
+-/
+def _root_.Pantograph.SemihashMap β := Imp β
+
+end Pantograph.SemihashMap
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 50ddf3a..a736064 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -24,35 +24,22 @@ def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
namespace Pantograph
open Lean
-structure ProofState where
- goals : List MVarId
+structure GoalState where
+ mvarId: MVarId
savedState : Elab.Tactic.SavedState
- parent : Option Nat := none
- parentGoalId : Nat := 0
-structure ProofTree where
- -- Set of proof states
- states : Array ProofState := #[]
abbrev M := Elab.TermElabM
-def ProofTree.create (expr: Expr): M ProofTree := do
+def GoalState.create (expr: Expr): M GoalState := do
let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
return {
- states := #[{
- savedState := savedState,
- goals := [goal.mvarId!]
- }]
+ savedState := savedState,
+ mvarId := goal.mvarId!
}
--- Print the tree structures in readable form
-def ProofTree.structure_array (tree: ProofTree): Array String :=
- tree.states.map λ state => match state.parent with
- | .none => ""
- | .some parent => s!"{parent}.{state.parentGoalId}"
-
def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: String) :
M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
@@ -78,44 +65,38 @@ def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Strin
/-- Response for executing a tactic -/
inductive TacticResult where
- -- Invalid id
- | invalid (message: String): TacticResult
-- Goes to next state
- | success (nextId?: Option Nat) (goals: Array Commands.Goal)
+ | success (goals: Array (GoalState × Commands.Goal))
-- Fails with messages
| failure (messages: Array String)
+namespace TacticResult
+
+def is_success: TacticResult → Bool
+ | .success _ => true
+ | .failure _ => false
+
+end TacticResult
+
/-- Execute tactic on given state -/
-def ProofTree.execute (stateId: Nat) (goalId: Nat) (tactic: String):
- Commands.OptionsT StateRefT ProofTree M TacticResult := do
+def GoalState.execute (goal: GoalState) (tactic: String):
+ Commands.OptionsT M TacticResult := do
let options ← read
- let tree ← get
- match tree.states.get? stateId with
- | .none => return .invalid s!"Invalid state id {stateId}"
- | .some state =>
- match state.goals.get? goalId with
- | .none => return .invalid s!"Invalid goal id {goalId}"
- | .some goal =>
- match (← execute_tactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
- | .error errors =>
- return .failure errors
- | .ok (nextState, nextGoals) =>
- let nextId := tree.states.size
- if nextGoals.isEmpty then
- return .success .none #[]
- else
- let proofState: ProofState := {
- savedState := nextState,
- goals := nextGoals,
- parent := stateId,
- parentGoalId := goalId
- }
- modify fun s => { s with states := s.states.push proofState }
- let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal
- let goals ← nextGoals.mapM fun mvarId => do
- match (← MonadMCtx.getMCtx).findDecl? mvarId with
- | .some mvarDecl => serialize_goal options mvarDecl (parentDecl? := parentDecl?)
- | .none => throwError mvarId
- return .success (.some nextId) goals.toArray
+ match (← execute_tactic (state := goal.savedState) (goal := goal.mvarId) (tactic := tactic)) with
+ | .error errors =>
+ return .failure errors
+ | .ok (nextState, nextGoals) =>
+ if nextGoals.isEmpty then
+ return .success #[]
+ else
+ let nextGoals: List GoalState := nextGoals.map fun mvarId => { mvarId, savedState := nextState }
+ let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal.mvarId
+ let goals ← nextGoals.mapM fun nextGoal => do
+ match (← MonadMCtx.getMCtx).findDecl? nextGoal.mvarId with
+ | .some mvarDecl =>
+ let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
+ return (nextGoal, serializedGoal)
+ | .none => throwError nextGoal.mvarId
+ return .success goals.toArray
end Pantograph
diff --git a/README.md b/README.md
index 82d3db3..8407d49 100644
--- a/README.md
+++ b/README.md
@@ -54,11 +54,11 @@ Example proving a theorem: (alternatively use `proof.start {"copyFrom": "Nat.add
```
$ env build/bin/Pantograph Init
proof.start {"expr": "∀ (n m : Nat), n + m = m + n"}
-proof.tactic {"treeId": 0, "stateId": 0, "goalId": 0, "tactic": "intro n m"}
-proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "assumption"}
-proof.printTree {"treeId": 0}
-proof.tactic {"treeId": 0, "stateId": 1, "goalId": 0, "tactic": "rw [Nat.add_comm]"}
-proof.printTree {"treeId": 0}
+proof.tactic {"goalId": 0, "tactic": "intro n m"}
+proof.tactic {"goalId": 1, "tactic": "assumption"}
+proof.printTree {}
+proof.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
+proof.printTree
```
where the application of `assumption` should lead to a failure.
@@ -75,8 +75,8 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
have to be set via command line arguments.), for options, see `Pantograph/Commands.lean`
- `options.print`: Display the current set of options
- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
-- `proof.tactic {"treeId": <id>, "stateId": <id>, "goalId": <id>, "tactic": string}`: Execute a tactic on a given proof state
-- `proof.printTree {"treeId": <id>}`: Print the topological structure of a proof tree
+- `proof.tactic {"goalId": <id>, "tactic": <tactic>}`: Execute a tactic string on a given proof state
+- `proof.printTree`: Print the number of goals
## Errors
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 505eec9..ccf7b01 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -10,87 +10,46 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
-abbrev TestM := ReaderT Commands.Options StateRefT ProofTree M
-
-def start_proof (start: Start): M (LSpec.TestSeq × Option ProofTree) := do
- let env ← Lean.MonadEnv.getEnv
- let mut testSeq := LSpec.TestSeq.done
- match start with
- | .copy name =>
- let cInfo? := str_to_name name |> env.find?
- testSeq := testSeq ++ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
- match cInfo? with
- | .some cInfo =>
- let state ← ProofTree.create
- (expr := cInfo.type)
- return (testSeq, Option.some state)
- | .none =>
- return (testSeq, Option.none)
- | .expr expr =>
- let syn? := syntax_from_str env expr
- testSeq := testSeq ++ LSpec.check s!"Parsing {expr}" (syn?.isOk)
- match syn? with
- | .error error =>
- IO.println error
- return (testSeq, Option.none)
- | .ok syn =>
- let expr? ← syntax_to_expr syn
- testSeq := testSeq ++ LSpec.check s!"Elaborating" expr?.isOk
- match expr? with
- | .error error =>
- IO.println error
- return (testSeq, Option.none)
- | .ok expr =>
- let state ← ProofTree.create
- (expr := expr)
- return (testSeq, Option.some state)
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
deriving instance DecidableEq, Repr for Commands.Expression
deriving instance DecidableEq, Repr for Commands.Variable
deriving instance DecidableEq, Repr for Commands.Goal
-deriving instance DecidableEq, Repr for TacticResult
-/-- Check the output of each proof step -/
-def proof_step (stateId: Nat) (goalId: Nat) (tactic: String)
- (expected: TacticResult) : TestM LSpec.TestSeq := do
- let options ← read
- let result: TacticResult ← ProofTree.execute stateId goalId tactic |>.run options
- match expected, result with
- | .success (.some i) #[], .success (.some _) goals =>
- -- If the goals are omitted but the next state is specified, we imply that
- -- the tactic succeeded.
- let expected := .success (.some i) goals
- return LSpec.test s!"{stateId}.{goalId} {tactic}" (result = expected)
- | _, _ =>
- return LSpec.test s!"{stateId}.{goalId} {tactic}" (result = expected)
+def add_test (test: LSpec.TestSeq): TestM Unit := do
+ set $ (← get) ++ test
-/-- Check that the tree structure is correct -/
-def proof_inspect (expected: Array String) : TestM LSpec.TestSeq := do
- let result := (← get).structure_array
- return LSpec.test s!"tree structure" (result = expected)
+def start_proof (start: Start): TestM (Option GoalState) := do
+ let env ← Lean.MonadEnv.getEnv
+ match start with
+ | .copy name =>
+ let cInfo? := str_to_name name |> env.find?
+ add_test $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
+ match cInfo? with
+ | .some cInfo =>
+ let goal ← GoalState.create (expr := cInfo.type)
+ return Option.some goal
+ | .none =>
+ return Option.none
+ | .expr expr =>
+ let syn? := syntax_from_str env expr
+ add_test $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
+ match syn? with
+ | .error error =>
+ IO.println error
+ return Option.none
+ | .ok syn =>
+ let expr? ← syntax_to_expr syn
+ add_test $ LSpec.check s!"Elaborating" expr?.isOk
+ match expr? with
+ | .error error =>
+ IO.println error
+ return Option.none
+ | .ok expr =>
+ let goal ← GoalState.create (expr := expr)
+ return Option.some goal
-def proof_runner (env: Lean.Environment) (options: Commands.Options) (start: Start) (steps: List (TestM LSpec.TestSeq)): IO LSpec.TestSeq := do
- let termElabM := do
- let (testSeq, state?) ← start_proof start
- match state? with
- | .none => return testSeq
- | .some state => steps.foldlM (fun tests m => do pure $ tests ++ (← m)) testSeq |>.run options |>.run' state
-
- let coreContext: Lean.Core.Context := {
- currNamespace := str_to_name "Aniva",
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
- let coreM := metaM.run'
- match ← (coreM.run' coreContext { env := env }).toBaseIO with
- | .error exception =>
- return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
- | .ok a => return a
+def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
{
@@ -101,30 +60,61 @@ def build_goal (nameType: List (String × String)) (target: String): Commands.Go
isInaccessible? := .some false
})).toArray
}
+-- Like `build_goal` but allow certain variables to be elided.
+def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
+ {
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ name := x.fst,
+ type? := x.snd.map (λ type => { pp? := type }),
+ isInaccessible? := x.snd.map (λ _ => false)
+ })).toArray
+ }
+
+-- Individual test cases
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
rw [Nat.add_comm]
-def proof_nat_add_comm (env: Lean.Environment): IO LSpec.TestSeq := do
- let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- proof_runner env {} (.copy "Nat.add_comm") [
- proof_step 0 0 "intro n m"
- (.success (.some 1) #[goal1]),
- proof_step 1 0 "assumption"
- (.failure #[s!"tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n"]),
- proof_step 1 0 "rw [Nat.add_comm]"
- (.success .none #[])
- ]
-def proof_nat_add_comm_manual (env: Lean.Environment): IO LSpec.TestSeq := do
- let goal1: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- proof_runner env {} (.expr "∀ (a b: Nat), a + b = b + a") [
- proof_step 0 0 "intro n m"
- (.success (.some 1) #[goal1]),
- proof_step 1 0 "assumption"
- (.failure #[s!"tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n"]),
- proof_step 1 0 "rw [Nat.add_comm]"
- (.success .none #[])
- ]
+def proof_nat_add_comm: TestM Unit := do
+ let goal? ← start_proof (.copy "Nat.add_comm")
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ if let .success #[(goal, sGoal)] ← goal.execute "intro n m" then
+ let sGoal1e: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
+ add_test $ LSpec.check "intro n m" (sGoal = sGoal1e)
+
+ if let .failure #[message] ← goal.execute "assumption" then
+ add_test $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
+ else
+ add_test $ assert_unreachable "assumption"
+
+ if let .success #[] ← goal.execute "rw [Nat.add_comm]" then
+ return ()
+ else
+ add_test $ assert_unreachable "rw [Nat.add_comm]"
+ else
+ add_test $ assert_unreachable "intro n m"
+def proof_nat_add_comm_manual: TestM Unit := do
+ let goal? ← start_proof (.expr "∀ (a b: Nat), a + b = b + a")
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ if let .success #[(goal, sGoal)] ← goal.execute "intro n m" then
+ let sGoal1e: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
+ add_test $ LSpec.check "intro n m" (sGoal = sGoal1e)
+
+ if let .failure #[message] ← goal.execute "assumption" then
+ add_test $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
+ else
+ add_test $ assert_unreachable "assumption"
+
+ if let .success #[] ← goal.execute "rw [Nat.add_comm]" then
+ return ()
+ else
+ add_test $ assert_unreachable "rw [Nat.add_comm]"
+ else
+ add_test $ assert_unreachable "intro n m"
+
-- Two ways to write the same theorem
example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
@@ -141,7 +131,7 @@ example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
assumption
. apply Or.inl
assumption
-def proof_or_comm (env: Lean.Environment): IO LSpec.TestSeq := do
+def proof_or_comm: TestM Unit := do
let typeProp: Commands.Expression := { pp? := .some "Prop" }
let branchGoal (caseName name: String): Commands.Goal := {
caseName? := .some caseName,
@@ -152,69 +142,111 @@ def proof_or_comm (env: Lean.Environment): IO LSpec.TestSeq := do
{ name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
]
}
- proof_runner env {} (.expr "∀ (p q: Prop), p ∨ q → q ∨ p") [
- proof_step 0 0 "intro p q h"
- (.success (.some 1) #[build_goal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"]),
- proof_step 1 0 "cases h"
- (.success (.some 2) #[branchGoal "inl" "p", branchGoal "inr" "q"]),
- proof_inspect #["", "0.0", "1.0"],
- proof_step 2 0 "apply Or.inr"
- (.success (.some 3) #[]),
- proof_inspect #["", "0.0", "1.0", "2.0"],
- proof_step 3 0 "assumption"
- (.success .none #[]),
- proof_step 2 1 "apply Or.inl"
- (.success (.some 4) #[]),
- proof_step 4 0 "assumption"
- (.success .none #[]),
- proof_inspect #["", "0.0", "1.0", "2.0", "2.1"]
- ]
+ let goal? ← start_proof (.expr "∀ (p q: Prop), p ∨ q → q ∨ p")
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ if let .success #[(goal, sGoal)] ← goal.execute "intro p q h" then
+ let sGoal1e := build_goal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"
+ add_test $ LSpec.check "intro p q h" (sGoal = sGoal1e)
+
+ if let .success #[(goal1, sGoal1), (goal2, sGoal2)] ← goal.execute "cases h" then
+ add_test $ LSpec.check "cases h/1" (sGoal1 = branchGoal "inl" "p")
+ if let .success #[(goal, _)] ← goal1.execute "apply Or.inr" then
+ if let .success #[] ← goal.execute "assumption" then
+ return ()
+ else
+ add_test $ assert_unreachable "assumption"
+ else
+ add_test $ assert_unreachable "apply Or.inr"
+
+
+ add_test $ LSpec.check "cases h/2" (sGoal2 = branchGoal "inr" "q")
+ if let .success #[(goal, _)] ← goal2.execute "apply Or.inl" then
+ if let .success #[] ← goal.execute "assumption" then
+ return ()
+ else
+ add_test $ assert_unreachable "assumption"
+ else
+ add_test $ assert_unreachable "apply Or.inl"
+
+ else
+ add_test $ assert_unreachable "cases h"
+ else
+ add_test $ assert_unreachable "intro p q h"
example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
-def proof_arith_1 (env: Lean.Environment): IO LSpec.TestSeq := do
- proof_runner env {} (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)") [
- proof_step 0 0 "intros"
- (.success (.some 1) #[]),
- proof_step 1 0 "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *"
- (.success (.some 2) #[]),
- proof_step 2 0 "assumption"
- (.success .none #[])
- ]
+def proof_arith_1: TestM Unit := do
+ let goal? ← start_proof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ if let .success #[(goal, _)] ← goal.execute "intros" then
+ if let .success #[(goal, _)] ← goal.execute "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *" then
+ if let .success #[] ← goal.execute "assumption" then
+ return ()
+ else
+ add_test $ assert_unreachable "assumption"
+ else
+ add_test $ assert_unreachable "simp ..."
+ else
+ add_test $ assert_unreachable "intros"
-def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
- {
- target := { pp? := .some target},
- vars := (nameType.map fun x => ({
- name := x.fst,
- type? := x.snd.map (λ type => { pp? := type }),
- isInaccessible? := x.snd.map (λ _ => false)
- })).toArray
+def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
+ let goal? ← start_proof (.expr "∀ (a b: Nat), a + b = b + a")
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ if let .success #[(goal, sGoal)] ← goal.execute "intro n" then
+ let sGoal1e: Commands.Goal := build_goal_selective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
+ add_test $ LSpec.check "intro n" (sGoal = sGoal1e)
+
+ if let .success #[(_, sGoal)] ← goal.execute "intro m" then
+ let sGoal2e: Commands.Goal := build_goal_selective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
+ add_test $ LSpec.check "intro m" (sGoal = sGoal2e)
+ else
+ add_test $ assert_unreachable "intro m"
+ else
+ add_test $ assert_unreachable "intro n"
+
+def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
+ let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
+
+ let coreContext: Lean.Core.Context := {
+ currNamespace := str_to_name "Aniva",
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph>",
+ fileMap := { source := "", positions := #[0], lines := #[1] }
}
-def proof_delta_variable (env: Lean.Environment): IO LSpec.TestSeq := do
- let goal1: Commands.Goal := build_goal_selective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
- let goal2: Commands.Goal := build_goal_selective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
- proof_runner env { proofVariableDelta := true } (.expr "∀ (a b: Nat), a + b = b + a") [
- proof_step 0 0 "intro n"
- (.success (.some 1) #[goal1]),
- proof_step 1 0 "intro m"
- (.success (.some 2) #[goal2])
- ]
+ let metaM := termElabM.run' (ctx := {
+ declName? := some "_pantograph",
+ errToSorry := false
+ })
+ let coreM := metaM.run'
+ match ← (coreM.run' coreContext { env := env }).toBaseIO with
+ | .error exception =>
+ return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+ | .ok (_, a) =>
+ return a
def test_proofs : IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
+ let tests := [
+ ("Nat.add_comm", proof_nat_add_comm),
+ ("nat.add_comm manual", proof_nat_add_comm_manual),
+ ("Or.comm", proof_or_comm),
+ ("arithmetic 1", proof_arith_1),
+ ("delta variable", proof_delta_variable)
+ ]
+ let tests ← tests.foldlM (fun acc tests => do
+ let (name, tests) := tests
+ let tests ← proof_runner env tests
+ return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
- return LSpec.group "Proofs" $
- (LSpec.group "Nat.add_comm" $ (← proof_nat_add_comm env)) ++
- (LSpec.group "Nat.add_comm manual" $ (← proof_nat_add_comm_manual env)) ++
- (LSpec.group "Or.comm" $ (← proof_or_comm env)) ++
- (LSpec.group "Arithmetic 1" $ (← proof_arith_1 env)) ++
- (LSpec.group "Delta variable" $ (← proof_delta_variable env))
+ return LSpec.group "Proofs" tests
end Pantograph.Test
From a6e337a89e516e4f36d8a40f352a3adfe7b2e504 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 27 Aug 2023 19:58:52 -0700
Subject: [PATCH 013/465] Rename proof commands to goal commands
---
Pantograph.lean | 35 ++++++++++++++++++-----------------
Pantograph/Commands.lean | 13 +++++--------
README.md | 20 ++++++++++----------
3 files changed, 33 insertions(+), 35 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 543c49e..bb2635e 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -29,15 +29,15 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| .error ierror => return Lean.toJson ierror
| .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
match command.cmd with
- | "reset" => run reset
- | "expr.echo" => run expr_echo
- | "lib.catalog" => run lib_catalog
- | "lib.inspect" => run lib_inspect
- | "options.set" => run options_set
- | "options.print" => run options_print
- | "proof.start" => run proof_start
- | "proof.tactic" => run proof_tactic
- | "proof.printTree" => run proof_print_tree
+ | "reset" => run reset
+ | "stat" => run stat
+ | "expr.echo" => run expr_echo
+ | "lib.catalog" => run lib_catalog
+ | "lib.inspect" => run lib_inspect
+ | "options.set" => run options_set
+ | "options.print" => run options_print
+ | "goal.start" => run goal_start
+ | "goal.tactic" => run goal_tactic
| cmd =>
let error: Commands.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -47,11 +47,15 @@ def execute (command: Commands.Command): MainM Lean.Json := do
errorCommand := errorI "command"
errorIndex := errorI "index"
-- Command Functions
- reset (_: Commands.Reset): MainM (CR Commands.ResetResult) := do
+ reset (_: Commands.Reset): MainM (CR Commands.StatResult) := do
let state ← get
- let nStates := state.goalStates.size
+ let nGoals := state.goalStates.size
set { state with goalStates := SemihashMap.empty }
- return .ok { nStates := nStates }
+ return .ok { nGoals }
+ stat (_: Commands.Stat): MainM (CR Commands.StatResult) := do
+ let state ← get
+ let nGoals := state.goalStates.size
+ return .ok { nGoals }
lib_catalog (_: Commands.LibCatalog): MainM (CR Commands.LibCatalogResult) := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
@@ -113,7 +117,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
return .ok { }
options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
return .ok (← get).options
- proof_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
+ goal_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
@@ -138,7 +142,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
let (goalStates, goalId) := state.goalStates.insert goalState
set { state with goalStates }
return .ok { goalId }
- proof_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
+ goal_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
let state ← get
match state.goalStates.get? args.goalId with
| .none => return .error $ errorIndex "Invalid goal index {args.goalId}"
@@ -160,8 +164,5 @@ def execute (command: Commands.Command): MainM Lean.Json := do
return .ok { goals? := .some sGoals.reverse.toArray, goalIds? := .some goalIds.reverse.toArray }
| .failure messages =>
return .ok { tacticErrors? := .some messages }
- proof_print_tree (_: Commands.ProofPrintTree): MainM (CR Commands.ProofPrintTreeResult) := do
- let state ← get
- return .ok { nGoals := state.goalStates.size }
end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index 8c8b509..f9abf9d 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -80,8 +80,11 @@ structure InteractionError where
structure Reset where
deriving Lean.FromJson
-structure ResetResult where
- nStates: Nat
+structure Stat where
+ deriving Lean.FromJson
+structure StatResult where
+ -- Number of goals states
+ nGoals: Nat
deriving Lean.ToJson
-- Return the type of an expression
@@ -149,11 +152,5 @@ structure ProofTacticResult where
tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
-structure ProofPrintTree where
- deriving Lean.FromJson
-structure ProofPrintTreeResult where
- -- Total number of goals
- nGoals: Nat
- deriving Lean.ToJson
end Pantograph.Commands
diff --git a/README.md b/README.md
index 8407d49..9a2ec5b 100644
--- a/README.md
+++ b/README.md
@@ -50,15 +50,15 @@ Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting)
$ lake env build/bin/Pantograph Mathlib.Analysis.Seminorm
lib.catalog
```
-Example proving a theorem: (alternatively use `proof.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
+Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
```
$ env build/bin/Pantograph Init
-proof.start {"expr": "∀ (n m : Nat), n + m = m + n"}
-proof.tactic {"goalId": 0, "tactic": "intro n m"}
-proof.tactic {"goalId": 1, "tactic": "assumption"}
-proof.printTree {}
-proof.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
-proof.printTree
+goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
+goal.tactic {"goalId": 0, "tactic": "intro n m"}
+goal.tactic {"goalId": 1, "tactic": "assumption"}
+stat {}
+goal.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
+stat
```
where the application of `assumption` should lead to a failure.
@@ -74,9 +74,9 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
- `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Commands.lean`
- `options.print`: Display the current set of options
-- `proof.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new proof state from a given expression or symbol
-- `proof.tactic {"goalId": <id>, "tactic": <tactic>}`: Execute a tactic string on a given proof state
-- `proof.printTree`: Print the number of goals
+- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
+- `goal.tactic {"goalId": <id>, "tactic": <tactic>}`: Execute a tactic string on a given goal
+- `stat`: Display resource usage
## Errors
From b98304f78ad7c508a7c21f8c9f9c8db4f8b5d224 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 27 Aug 2023 19:59:31 -0700
Subject: [PATCH 014/465] Version bump to 0.2.4 due to breaking change
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index e4ebd2c..f179705 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.3"
+def version := "0.2.4"
end Pantograph
From 6b96f7893fa1b5f7f68c383e0221745281aef93a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 27 Aug 2023 22:50:18 -0700
Subject: [PATCH 015/465] Separate max and imax in sort level
---
Pantograph/Serial.lean | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 6dd9a9f..924c77b 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -83,16 +83,20 @@ def serialize_sort_level_ast (level: Level): String :=
let u_str := match u with
| .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ"
- | .max v w | .imax v w =>
+ | .max v w =>
let v := serialize_sort_level_ast v
let w := serialize_sort_level_ast w
- s!"(max {v} {w})"
+ s!"(:max {v} {w})"
+ | .imax v w =>
+ let v := serialize_sort_level_ast v
+ let w := serialize_sort_level_ast w
+ s!"(:imax {v} {w})"
| .param name =>
let name := name_to_ast name
s!"{name}"
| .mvar id =>
let name := name_to_ast id.name
- s!"(:mvar {name})"
+ s!"(:mv {name})"
match k, u with
| 0, _ => u_str
| _, .zero => s!"{k}"
From f1f1c20ff9a9d93d318e96795da684d55d6911b2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 30 Aug 2023 19:16:33 -0700
Subject: [PATCH 016/465] Add SemihashMap interface, rename proof commands to
goal commands, allow deletion
---
Pantograph.lean | 12 ++++--
Pantograph/Commands.lean | 15 +++++--
Pantograph/SemihashMap.lean | 86 +++++++++++++++++++++++++++++++------
README.md | 2 +
4 files changed, 95 insertions(+), 20 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index bb2635e..3e53859 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -38,6 +38,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| "options.print" => run options_print
| "goal.start" => run goal_start
| "goal.tactic" => run goal_tactic
+ | "goal.delete" => run goal_delete
| cmd =>
let error: Commands.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -117,7 +118,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
return .ok { }
options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
return .ok (← get).options
- goal_start (args: Commands.ProofStart): MainM (CR Commands.ProofStartResult) := do
+ goal_start (args: Commands.GoalStart): MainM (CR Commands.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
@@ -142,10 +143,10 @@ def execute (command: Commands.Command): MainM Lean.Json := do
let (goalStates, goalId) := state.goalStates.insert goalState
set { state with goalStates }
return .ok { goalId }
- goal_tactic (args: Commands.ProofTactic): MainM (CR Commands.ProofTacticResult) := do
+ goal_tactic (args: Commands.GoalTactic): MainM (CR Commands.GoalTacticResult) := do
let state ← get
match state.goalStates.get? args.goalId with
- | .none => return .error $ errorIndex "Invalid goal index {args.goalId}"
+ | .none => return .error $ errorIndex s!"Invalid goal index {args.goalId}"
| .some goalState =>
let result ← GoalState.execute goalState args.tactic |>.run state.options
match result with
@@ -164,5 +165,10 @@ def execute (command: Commands.Command): MainM Lean.Json := do
return .ok { goals? := .some sGoals.reverse.toArray, goalIds? := .some goalIds.reverse.toArray }
| .failure messages =>
return .ok { tacticErrors? := .some messages }
+ goal_delete (args: Commands.GoalDelete): MainM (CR Commands.GoalDeleteResult) := do
+ let state ← get
+ let goalStates := args.goalIds.foldl (λ map id => map.remove id) state.goalStates
+ set { state with goalStates }
+ return .ok {}
end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Commands.lean
index f9abf9d..72194b0 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Commands.lean
@@ -130,20 +130,20 @@ structure OptionsPrint where
deriving Lean.FromJson
abbrev OptionsPrintResult := Options
-structure ProofStart where
+structure GoalStart where
-- Only one of the fields below may be populated.
expr: Option String -- Proof expression
copyFrom: Option String -- Theorem name
deriving Lean.FromJson
-structure ProofStartResult where
+structure GoalStartResult where
goalId: Nat := 0 -- Proof tree id
deriving Lean.ToJson
-structure ProofTactic where
+structure GoalTactic where
-- Identifiers for tree, state, and goal
goalId: Nat
tactic: String
deriving Lean.FromJson
-structure ProofTacticResult where
+structure GoalTacticResult where
-- Existence of this field shows success
goals?: Option (Array Goal) := .none
-- Next proof state id, if successful
@@ -152,5 +152,12 @@ structure ProofTacticResult where
tacticErrors?: Option (Array String) := .none
deriving Lean.ToJson
+-- Remove a bunch of goals.
+structure GoalDelete where
+ goalIds: List Nat
+ deriving Lean.FromJson
+structure GoalDeleteResult where
+ deriving Lean.ToJson
+
end Pantograph.Commands
diff --git a/Pantograph/SemihashMap.lean b/Pantograph/SemihashMap.lean
index 362be94..1d9ebae 100644
--- a/Pantograph/SemihashMap.lean
+++ b/Pantograph/SemihashMap.lean
@@ -18,7 +18,56 @@ structure Imp (β: Type u) where
namespace Imp
+structure WF (m: Imp β): Prop where
+ capacity: m.data.size = m.deallocs.size
+ front_dealloc: ∀ i: Fin m.deallocs.size, (i < m.allocFront) → (m.deallocs.get i) < m.allocFront
+ front_data: ∀ i: Fin m.data.size, (i ≥ m.allocFront) → (m.data.get i).isNone
+def empty (capacity := 16): Imp β :=
+ {
+ data := mkArray capacity .none,
+ size := 0,
+ allocFront := 0,
+ deallocs := mkArray capacity 0,
+ lastDealloc := 0,
+ }
+
+private theorem list_get_replicate (x: α) (i: Fin (List.replicate n x).length):
+ List.get (List.replicate n x) i = x := by
+ sorry
+
+theorem empty_wf : WF (empty n: Imp β) := by
+ unfold empty
+ apply WF.mk
+ case capacity =>
+ conv =>
+ lhs
+ congr
+ simp
+ conv =>
+ rhs
+ congr
+ simp
+ simp
+ case front_dealloc =>
+ simp_all
+ intro i
+ intro a
+ contradiction
+ case front_data =>
+ simp_all
+ intro i
+ unfold Imp.data at i
+ simp at i
+ conv =>
+ lhs
+ unfold Array.get
+ unfold mkArray
+ simp [List.replicate]
+ rewrite [list_get_replicate]
+
+-- FIXME: Merge this with the well-formed versions below so proof and code can
+-- mesh seamlessly.
@[inline] def insert (map: Imp β) (v: β): (Imp β × Nat) :=
match map.lastDealloc with
| 0 => -- Capacity is full, buffer expansion is required
@@ -53,8 +102,9 @@ namespace Imp
}
(result, nextIndex)
-@[inline] def remove (map: Imp β) (index: Nat): Imp β :=
- match map.data.getD index .none with
+@[inline] def remove (map: Imp β) (index: Fin (map.size)): Imp β :=
+ have h: index.val < map.data.size := by sorry
+ match map.data.get ⟨index.val, h⟩ with
| .none => map
| .some _ =>
{
@@ -66,24 +116,34 @@ namespace Imp
}
/-- Retrieval is efficient -/
-@[inline] def get? (map: Imp β) (index: Nat): Option β :=
- map.data.getD index .none
+@[inline] def get? (map: Imp β) (index: Fin (map.size)): Option β :=
+ have h: index.val < map.data.size := by sorry
+ map.data.get ⟨index.val, h⟩
@[inline] def capacity (map: Imp β): Nat := map.data.size
end Imp
-def empty (capacity := 16): Imp β :=
- {
- data := mkArray capacity .none,
- size := 0,
- allocFront := 0,
- deallocs := mkArray capacity 0,
- lastDealloc := 0,
- }
/--
This is like a hashmap but you cannot control the keys.
-/
-def _root_.Pantograph.SemihashMap β := Imp β
+def _root_.Pantograph.SemihashMap β := {m: Imp β // m.WF}
+
+@[inline] def empty (capacity := 16): SemihashMap β :=
+ ⟨ Imp.empty capacity, Imp.empty_wf ⟩
+@[inline] def insert (map: SemihashMap β) (v: β): (SemihashMap β × Nat) :=
+ let ⟨imp, pre⟩ := map
+ let ⟨result, id⟩ := imp.insert v
+ ( ⟨ result, sorry ⟩, id)
+@[inline] def remove (map: SemihashMap β) (index: Nat): SemihashMap β :=
+ let ⟨imp, pre⟩ := map
+ let result := imp.remove ⟨index, sorry⟩
+ ⟨ result, sorry ⟩
+@[inline] def get? (map: SemihashMap β) (index: Nat): Option β :=
+ let ⟨imp, _⟩ := map
+ imp.get? ⟨index, sorry⟩
+@[inline] def size (map: SemihashMap β): Nat :=
+ let ⟨imp, _⟩ := map
+ imp.size
end Pantograph.SemihashMap
diff --git a/README.md b/README.md
index 9a2ec5b..273e865 100644
--- a/README.md
+++ b/README.md
@@ -56,6 +56,7 @@ $ env build/bin/Pantograph Init
goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
goal.tactic {"goalId": 0, "tactic": "intro n m"}
goal.tactic {"goalId": 1, "tactic": "assumption"}
+goal.delete {"goalIds": [0]}
stat {}
goal.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
stat
@@ -76,6 +77,7 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
- `options.print`: Display the current set of options
- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
- `goal.tactic {"goalId": <id>, "tactic": <tactic>}`: Execute a tactic string on a given goal
+- `goal.remove {"goalIds": [<id>]}"`: Remove a bunch of stored goals.
- `stat`: Display resource usage
## Errors
From d7077ce854ee51f6fe148bd069fc133373c0d42f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 13 Sep 2023 21:02:26 -0700
Subject: [PATCH 017/465] Bump lean version to 4.0.0
---
lake-manifest.json | 30 ++++--------------------------
lean-toolchain | 2 +-
2 files changed, 5 insertions(+), 27 deletions(-)
diff --git a/lake-manifest.json b/lake-manifest.json
index 6a4ca4f..5a13649 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,33 +1,11 @@
-{"version": 4,
+{"version": 5,
"packagesDir": "lake-packages",
"packages":
[{"git":
{"url": "https://github.com/lurk-lab/LSpec.git",
"subDir?": null,
"rev": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
+ "opts": {},
"name": "LSpec",
- "inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41"}},
- {"git":
- {"url": "https://github.com/leanprover-community/mathlib4.git",
- "subDir?": null,
- "rev": "8e5a00a8afc8913c0584cb85f37951995275fd87",
- "name": "mathlib",
- "inputRev?": "8e5a00a8afc8913c0584cb85f37951995275fd87"}},
- {"git":
- {"url": "https://github.com/gebner/quote4",
- "subDir?": null,
- "rev": "c71f94e34c1cda52eef5c93dc9da409ab2727420",
- "name": "Qq",
- "inputRev?": "master"}},
- {"git":
- {"url": "https://github.com/JLimperg/aesop",
- "subDir?": null,
- "rev": "cdc00b640d0179910ebaa9c931e3b733a04b881c",
- "name": "aesop",
- "inputRev?": "master"}},
- {"git":
- {"url": "https://github.com/leanprover/std4",
- "subDir?": null,
- "rev": "6006307d2ceb8743fea7e00ba0036af8654d0347",
- "name": "std",
- "inputRev?": "main"}}]}
+ "inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
+ "inherited": false}}]}
diff --git a/lean-toolchain b/lean-toolchain
index 1acfb77..49fd71c 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:nightly-2023-08-12
+leanprover/lean4:4.0.0
From 35b391881efe878700bfaff7e8ca347934662901 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 1 Oct 2023 21:58:58 -0700
Subject: [PATCH 018/465] Add ready message to indicate the main loop is up
---
Main.lean | 1 +
Pantograph/Version.lean | 2 +-
2 files changed, 2 insertions(+), 1 deletion(-)
diff --git a/Main.lean b/Main.lean
index a490112..dc4b14f 100644
--- a/Main.lean
+++ b/Main.lean
@@ -108,6 +108,7 @@ unsafe def main (args: List String): IO Unit := do
errToSorry := false
})
let coreM := metaM.run'
+ IO.println "ready."
discard <| coreM.toIO coreContext { env := env }
catch ex =>
IO.println "Uncaught IO exception"
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index f179705..f450292 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.4"
+def version := "0.2.5"
end Pantograph
From 6d15d1e6704849c19f8dd960b0745dfb5dd6aaab Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 2 Oct 2023 10:26:19 -0700
Subject: [PATCH 019/465] Use makefile instead of ad-hoc script
---
Makefile | 17 +++++++++++++++++
README.md | 19 +++++++++----------
Test/all.sh | 3 ---
3 files changed, 26 insertions(+), 13 deletions(-)
create mode 100644 Makefile
delete mode 100755 Test/all.sh
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..c201842
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,17 @@
+LIB := build/lib/Pantograph.olean
+EXE := build/bin/pantograph
+SOURCE := $(wildcard Pantograph/*.lean) Main.lean Pantograph.lean
+
+TEST_EXE := build/bin/test
+TEST_SOURCE := $(wildcard Test/*.lean)
+
+$(LIB) $(EXE): $(SOURCE)
+ lake build
+
+$(TEST_EXE): $(LIB) $(TEST_SOURCE)
+ lake build test
+
+test: $(TEST_EXE)
+ lake env $(TEST_EXE)
+
+.PHONY: test
diff --git a/README.md b/README.md
index 273e865..b8e0868 100644
--- a/README.md
+++ b/README.md
@@ -6,11 +6,11 @@ An interaction system for Lean 4.
## Installation
-Install `elan` and `lean4`. Then, execute
+Install `elan` and `lake`. Execute
``` sh
-lake build
+make build/bin/pantograph
```
-Then, setup the `LEAN_PATH` environment variable so it contains the library path of lean libraries. The libraries must be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
+setup the `LEAN_PATH` environment variable so it contains the library path of lean libraries. The libraries must be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
``` sh
LIB="../lib"
LIB_MATHLIB="$LIB/mathlib4/lake-packages"
@@ -18,12 +18,11 @@ export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATH
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
-Note that `lean-toolchain` must be present in the `$PWD` in order to run Pantograph! This is because Pantograph taps into Lean's internals.
## Usage
``` sh
-build/bin/pantograph MODULES|LEAN_OPTIONS
+pantograph MODULES|LEAN_OPTIONS
```
The REPL loop accepts commands as single-line JSON inputs and outputs either an
@@ -36,23 +35,23 @@ command { ... }
The list of available commands can be found in `Pantograph/Commands.lean` and below. An
empty command aborts the REPL.
-The `Pantograph` executable must be run with a list of modules to import. It can
+The `pantograph` executable must be run with a list of modules to import. It can
also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
Example: (~5k symbols)
```
-$ build/bin/Pantograph Init
+$ pantograph Init
lib.catalog
lib.inspect {"name": "Nat.le_add_left"}
```
Example with `mathlib4` (~90k symbols, may stack overflow, see troubleshooting)
```
-$ lake env build/bin/Pantograph Mathlib.Analysis.Seminorm
+$ pantograph Mathlib.Analysis.Seminorm
lib.catalog
```
Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_comm"}`) to prime the proof
```
-$ env build/bin/Pantograph Init
+$ pantograph Init
goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
goal.tactic {"goalId": 0, "tactic": "intro n m"}
goal.tactic {"goalId": 1, "tactic": "assumption"}
@@ -106,5 +105,5 @@ ulimit -s unlimited
The tests are based on `LSpec`. To run tests,
``` sh
-test/all.sh
+make test
```
diff --git a/Test/all.sh b/Test/all.sh
deleted file mode 100755
index 9d940bd..0000000
--- a/Test/all.sh
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-
-lake build test && lake env build/bin/test
From 0948e71d60df16f761337368e362ff63ba409713 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 2 Oct 2023 10:30:07 -0700
Subject: [PATCH 020/465] Add dependency for lakefile and lean-toolchain
---
Makefile | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Makefile b/Makefile
index c201842..edee774 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
LIB := build/lib/Pantograph.olean
EXE := build/bin/pantograph
-SOURCE := $(wildcard Pantograph/*.lean) Main.lean Pantograph.lean
+SOURCE := $(wildcard Pantograph/*.lean) $(wildcard *.lean) lean-toolchain
TEST_EXE := build/bin/test
TEST_SOURCE := $(wildcard Test/*.lean)
From a8cf94ccb142907c500d6f5bc0a5d33523e28526 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Oct 2023 17:49:43 -0700
Subject: [PATCH 021/465] Bump Lean version to 4.1.0
---
.gitignore | 1 +
Main.lean | 2 +-
lean-toolchain | 2 +-
3 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/.gitignore b/.gitignore
index 069f8e2..21bcd46 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,6 @@
.*
!.gitignore
+*.olean
/build
/lake-packages
diff --git a/Main.lean b/Main.lean
index dc4b14f..8fd617b 100644
--- a/Main.lean
+++ b/Main.lean
@@ -88,7 +88,7 @@ unsafe def main (args: List String): IO Unit := do
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
let env ← Lean.importModules
- (imports := imports.map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := imports.toArray.map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let context: Context := {
diff --git a/lean-toolchain b/lean-toolchain
index 49fd71c..a9bddf0 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:4.0.0
+leanprover/lean4:4.1.0
From 13f3460e9a5b5666b6d9c1a150b659da9e958e77 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Oct 2023 17:51:41 -0700
Subject: [PATCH 022/465] Fix test failures
---
Test/Integration.lean | 2 +-
Test/Proofs.lean | 2 +-
Test/Serial.lean | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index ab31110..6caaf90 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -15,7 +15,7 @@ def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := do
-- Setup the environment for execution
let env ← Lean.importModules
- (imports := [{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
+ (imports := #[{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
(opts := {})
(trustLevel := 1)
let context: Context := {
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ccf7b01..a6d08e7 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -231,7 +231,7 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
def test_proofs : IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
- (imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let tests := [
diff --git a/Test/Serial.lean b/Test/Serial.lean
index e300492..058ba04 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -64,7 +64,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
def test_serial: IO LSpec.TestSeq := do
let env: Environment ← importModules
- (imports := ["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
From 7a5fe554ba0eae2fc92b73ae6781c004268bb374 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Oct 2023 17:31:36 -0700
Subject: [PATCH 023/465] Add holes test stub
Move tests into their own namespaces
---
Test/Holes.lean | 101 ++++++++++++++++++++++++++++++++++++++++++
Test/Integration.lean | 6 +--
Test/Main.lean | 8 ++--
Test/Proofs.lean | 8 ++--
Test/Serial.lean | 8 ++--
5 files changed, 117 insertions(+), 14 deletions(-)
create mode 100644 Test/Holes.lean
diff --git a/Test/Holes.lean b/Test/Holes.lean
new file mode 100644
index 0000000..8935ea9
--- /dev/null
+++ b/Test/Holes.lean
@@ -0,0 +1,101 @@
+import LSpec
+import Pantograph.Tactic
+import Pantograph.Serial
+
+namespace Pantograph.Test.Holes
+open Pantograph
+open Lean
+
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
+
+deriving instance DecidableEq, Repr for Commands.Expression
+deriving instance DecidableEq, Repr for Commands.Variable
+deriving instance DecidableEq, Repr for Commands.Goal
+
+def add_test (test: LSpec.TestSeq): TestM Unit := do
+ set $ (← get) ++ test
+
+def start_goal (hole: String): TestM (Option GoalState) := do
+ let env ← Lean.MonadEnv.getEnv
+ let syn? := syntax_from_str env hole
+ add_test $ LSpec.check s!"Parsing {hole}" (syn?.isOk)
+ match syn? with
+ | .error error =>
+ IO.println error
+ return Option.none
+ | .ok syn =>
+ let expr? ← syntax_to_expr syn
+ add_test $ LSpec.check s!"Elaborating" expr?.isOk
+ match expr? with
+ | .error error =>
+ IO.println error
+ return Option.none
+ | .ok expr =>
+ let goal ← GoalState.create (expr := expr)
+ return Option.some goal
+
+def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
+
+def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
+ {
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ name := x.fst,
+ type? := .some { pp? := .some x.snd },
+ isInaccessible? := .some false
+ })).toArray
+ }
+-- Like `build_goal` but allow certain variables to be elided.
+def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
+ {
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ name := x.fst,
+ type? := x.snd.map (λ type => { pp? := type }),
+ isInaccessible? := x.snd.map (λ _ => false)
+ })).toArray
+ }
+
+def construct_sigma: TestM Unit := do
+ let goal? ← start_goal "∀ (n m: Nat), n + m = m + n"
+ add_test $ LSpec.check "Start goal" goal?.isSome
+ if let .some goal := goal? then
+ return ()
+
+
+def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
+ let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
+
+ let coreContext: Lean.Core.Context := {
+ currNamespace := str_to_name "Aniva",
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph>",
+ fileMap := { source := "", positions := #[0], lines := #[1] }
+ }
+ let metaM := termElabM.run' (ctx := {
+ declName? := some "_pantograph",
+ errToSorry := false
+ })
+ let coreM := metaM.run'
+ match ← (coreM.run' coreContext { env := env }).toBaseIO with
+ | .error exception =>
+ return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+ | .ok (_, a) =>
+ return a
+
+def suite: IO LSpec.TestSeq := do
+ let env: Lean.Environment ← Lean.importModules
+ (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (opts := {})
+ (trustLevel := 1)
+ let tests := [
+ ("Σ'", construct_sigma)
+ ]
+ let tests ← tests.foldlM (fun acc tests => do
+ let (name, tests) := tests
+ let tests ← proof_runner env tests
+ return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
+
+ return LSpec.group "Holes" tests
+
+end Pantograph.Test.Holes
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 6caaf90..5dbb80a 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -2,7 +2,7 @@
-/
import LSpec
import Pantograph
-namespace Pantograph.Test
+namespace Pantograph.Test.Integration
open Pantograph
def subroutine_named_step (name cmd: String) (payload: List (String × Lean.Json))
@@ -83,11 +83,11 @@ def test_malformed_command : IO LSpec.TestSeq :=
Commands.InteractionError))
]
-def test_integration: IO LSpec.TestSeq := do
+def suite: IO LSpec.TestSeq := do
return LSpec.group "Integration" $
(LSpec.group "Option modify" (← test_option_modify)) ++
(LSpec.group "Malformed command" (← test_malformed_command))
-end Pantograph.Test
+end Pantograph.Test.Integration
diff --git a/Test/Main.lean b/Test/Main.lean
index 84d686d..cb7c055 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,4 +1,5 @@
import LSpec
+import Test.Holes
import Test.Integration
import Test.Proofs
import Test.Serial
@@ -10,9 +11,10 @@ unsafe def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
- test_integration,
- test_proofs,
- test_serial
+ Holes.suite,
+ Integration.suite,
+ Proofs.suite,
+ Serial.suite
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a6d08e7..c9daf84 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -2,7 +2,7 @@ import LSpec
import Pantograph.Tactic
import Pantograph.Serial
-namespace Pantograph.Test
+namespace Pantograph.Test.Proofs
open Pantograph
open Lean
@@ -229,7 +229,8 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
| .ok (_, a) =>
return a
-def test_proofs : IO LSpec.TestSeq := do
+/-- Tests the most basic form of proofs whose goals do not relate to each other -/
+def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
@@ -248,5 +249,4 @@ def test_proofs : IO LSpec.TestSeq := do
return LSpec.group "Proofs" tests
-end Pantograph.Test
-
+end Pantograph.Test.Proofs
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 058ba04..e135c0c 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -2,7 +2,7 @@ import LSpec
import Pantograph.Serial
import Pantograph.Symbols
-namespace Pantograph.Test
+namespace Pantograph.Test.Serial
open Pantograph
open Lean
@@ -62,15 +62,15 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
| .ok a => return a
-def test_serial: IO LSpec.TestSeq := do
+def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
- return LSpec.group "Serialisation" $
+ return LSpec.group "Serialization" $
(LSpec.group "str_to_name" test_str_to_name) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
-end Pantograph.Test
+end Pantograph.Test.Serial
From 41db295ff57b85acaaa47d12b8bf184874dc1aa4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 15 Oct 2023 12:31:22 -0700
Subject: [PATCH 024/465] Rename tactic to goal and restructure
---
Makefile | 7 +++++--
Pantograph.lean | 2 +-
Pantograph/{Tactic.lean => Goal.lean} | 11 ++++++++---
Pantograph/Serial.lean | 10 +---------
Test/Holes.lean | 2 +-
Test/Proofs.lean | 8 ++++----
6 files changed, 20 insertions(+), 20 deletions(-)
rename Pantograph/{Tactic.lean => Goal.lean} (87%)
diff --git a/Makefile b/Makefile
index edee774..39350b6 100644
--- a/Makefile
+++ b/Makefile
@@ -6,7 +6,7 @@ TEST_EXE := build/bin/test
TEST_SOURCE := $(wildcard Test/*.lean)
$(LIB) $(EXE): $(SOURCE)
- lake build
+ lake build pantograph
$(TEST_EXE): $(LIB) $(TEST_SOURCE)
lake build test
@@ -14,4 +14,7 @@ $(TEST_EXE): $(LIB) $(TEST_SOURCE)
test: $(TEST_EXE)
lake env $(TEST_EXE)
-.PHONY: test
+clean:
+ lake clean
+
+.PHONY: test clean
diff --git a/Pantograph.lean b/Pantograph.lean
index 3e53859..c5d56a1 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,7 +1,7 @@
import Pantograph.Commands
import Pantograph.Serial
import Pantograph.Symbols
-import Pantograph.Tactic
+import Pantograph.Goal
import Pantograph.SemihashMap
namespace Pantograph
diff --git a/Pantograph/Tactic.lean b/Pantograph/Goal.lean
similarity index 87%
rename from Pantograph/Tactic.lean
rename to Pantograph/Goal.lean
index a736064..ea81c36 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Goal.lean
@@ -31,12 +31,15 @@ structure GoalState where
abbrev M := Elab.TermElabM
def GoalState.create (expr: Expr): M GoalState := do
+ -- Immediately synthesise all metavariables if we need to leave the elaboration context.
+ -- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
+ --Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← instantiateMVars expr
- let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic))
+ let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
return {
- savedState := savedState,
+ savedState,
mvarId := goal.mvarId!
}
@@ -52,7 +55,9 @@ def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Strin
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .error errors
else
- return .ok (← MonadBacktrack.saveState, ← Elab.Tactic.getUnsolvedGoals)
+ let unsolved ← Elab.Tactic.getUnsolvedGoals
+ -- The order of evaluation is important here
+ return .ok (← MonadBacktrack.saveState, unsolved)
catch exception =>
return .error #[← exception.toMessageData.toString]
match Parser.runParserCategory
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 924c77b..27251b6 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -28,19 +28,11 @@ def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
def syntax_to_expr_type (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabType syn
- -- Immediately synthesise all metavariables if we need to leave the elaboration context.
- -- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
- --Elab.Term.synthesizeSyntheticMVarsNoPostponing
- let expr ← instantiateMVars expr
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .none)
- -- Immediately synthesise all metavariables if we need to leave the elaboration context.
- -- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
- --Elab.Term.synthesizeSyntheticMVarsNoPostponing
- let expr ← instantiateMVars expr
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
@@ -249,7 +241,7 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
caseName? := match mvarDecl.userName with
| Name.anonymous => .none
| name => .some <| toString name,
- isConversion := "| " == (Meta.getGoalPrefix mvarDecl)
+ isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
}
diff --git a/Test/Holes.lean b/Test/Holes.lean
index 8935ea9..64f2e2c 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -1,5 +1,5 @@
import LSpec
-import Pantograph.Tactic
+import Pantograph.Goal
import Pantograph.Serial
namespace Pantograph.Test.Holes
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index c9daf84..3aaea0f 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -1,5 +1,5 @@
import LSpec
-import Pantograph.Tactic
+import Pantograph.Goal
import Pantograph.Serial
namespace Pantograph.Test.Proofs
@@ -39,7 +39,7 @@ def start_proof (start: Start): TestM (Option GoalState) := do
IO.println error
return Option.none
| .ok syn =>
- let expr? ← syntax_to_expr syn
+ let expr? ← syntax_to_expr_type syn
add_test $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
@@ -213,7 +213,7 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context := {
- currNamespace := str_to_name "Aniva",
+ currNamespace := Name.append .anonymous "Aniva",
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0], lines := #[1] }
@@ -232,7 +232,7 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
/-- Tests the most basic form of proofs whose goals do not relate to each other -/
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
- (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := #[{ module := Name.append .anonymous "Init", runtimeOnly := false}])
(opts := {})
(trustLevel := 1)
let tests := [
From 538ba6e7d7da468de75b5840757b62842bd52519 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 15 Oct 2023 17:15:23 -0700
Subject: [PATCH 025/465] Store states instead of goals
1. Rename {Commands, Protocol}, and {Symbols, Symbol}
2. Store the root mvarId in the proof state along with goal indices
3. Add diagnostics function which prints out the state
4. Bump version to 0.2.6 (breaking change)
Documentations pending
---
Main.lean | 6 +-
Pantograph.lean | 78 +++--
Pantograph/Goal.lean | 156 ++++++---
Pantograph/{Commands.lean => Protocol.lean} | 34 +-
Pantograph/Serial.lean | 16 +-
Pantograph/{Symbols.lean => Symbol.lean} | 4 +-
Pantograph/Version.lean | 2 +-
Test/Integration.lean | 16 +-
Test/Main.lean | 4 +-
Test/Proofs.lean | 347 +++++++++++---------
Test/Serial.lean | 6 +-
11 files changed, 378 insertions(+), 291 deletions(-)
rename Pantograph/{Commands.lean => Protocol.lean} (84%)
rename Pantograph/{Symbols.lean => Symbol.lean} (94%)
diff --git a/Main.lean b/Main.lean
index 8fd617b..d7f936e 100644
--- a/Main.lean
+++ b/Main.lean
@@ -8,7 +8,7 @@ import Pantograph
open Pantograph
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
-def parse_command (s: String): Except String Commands.Command := do
+def parseCommand (s: String): Except String Protocol.Command := do
let s := s.trim
match s.get? 0 with
| .some '{' => -- Parse in Json mode
@@ -26,9 +26,9 @@ unsafe def loop : MainM Unit := do
let state ← get
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
- match parse_command command with
+ match parseCommand command with
| .error error =>
- let error := Lean.toJson ({ error := "command", desc := error }: Commands.InteractionError)
+ let error := Lean.toJson ({ error := "command", desc := error }: Protocol.InteractionError)
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
diff --git a/Pantograph.lean b/Pantograph.lean
index c5d56a1..0e74e81 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,8 +1,8 @@
-import Pantograph.Commands
-import Pantograph.Serial
-import Pantograph.Symbols
import Pantograph.Goal
+import Pantograph.Protocol
import Pantograph.SemihashMap
+import Pantograph.Serial
+import Pantograph.Symbol
namespace Pantograph
@@ -11,16 +11,16 @@ structure Context where
/-- Stores state of the REPL -/
structure State where
- options: Commands.Options := {}
+ options: Protocol.Options := {}
goalStates: SemihashMap GoalState := SemihashMap.empty
--- State monad
+/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
--- For some reason writing `CommandM α := MainM (Except ... α)` disables certain
--- monadic features in `MainM`
-abbrev CR α := Except Commands.InteractionError α
+-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
+-- certain monadic features in `MainM`
+abbrev CR α := Except Protocol.InteractionError α
-def execute (command: Commands.Command): MainM Lean.Json := do
+def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
| .ok args => do
@@ -40,31 +40,31 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| "goal.tactic" => run goal_tactic
| "goal.delete" => run goal_delete
| cmd =>
- let error: Commands.InteractionError :=
+ let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
- errorI (type desc: String): Commands.InteractionError := { error := type, desc := desc }
+ errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
errorCommand := errorI "command"
errorIndex := errorI "index"
-- Command Functions
- reset (_: Commands.Reset): MainM (CR Commands.StatResult) := do
+ reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
set { state with goalStates := SemihashMap.empty }
return .ok { nGoals }
- stat (_: Commands.Stat): MainM (CR Commands.StatResult) := do
+ stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
return .ok { nGoals }
- lib_catalog (_: Commands.LibCatalog): MainM (CR Commands.LibCatalogResult) := do
+ 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: Commands.LibInspect): MainM (CR Commands.LibInspectResult) := do
+ lib_inspect (args: Protocol.LibInspect): MainM (CR Protocol.LibInspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let name := str_to_name args.name
@@ -84,7 +84,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
value? := ← value?.mapM (λ v => serialize_expression state.options v),
module? := module?
}
- expr_echo (args: Commands.ExprEcho): MainM (CR Commands.ExprEchoResult) := do
+ 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
@@ -101,7 +101,7 @@ def execute (command: Commands.Command): MainM Lean.Json := do
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
- options_set (args: Commands.OptionsSet): MainM (CR Commands.OptionsSetResult) := do
+ options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
set { state with
@@ -116,9 +116,9 @@ def execute (command: Commands.Command): MainM Lean.Json := do
}
}
return .ok { }
- options_print (_: Commands.OptionsPrint): MainM (CR Commands.OptionsPrintResult) := do
+ options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.OptionsPrintResult) := do
return .ok (← get).options
- goal_start (args: Commands.GoalStart): MainM (CR Commands.GoalStartResult) := do
+ goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
@@ -140,34 +140,32 @@ def execute (command: Commands.Command): MainM Lean.Json := do
| .error error => return .error error
| .ok expr =>
let goalState ← GoalState.create expr
- let (goalStates, goalId) := state.goalStates.insert goalState
+ let (goalStates, stateId) := state.goalStates.insert goalState
set { state with goalStates }
- return .ok { goalId }
- goal_tactic (args: Commands.GoalTactic): MainM (CR Commands.GoalTacticResult) := do
+ return .ok { stateId }
+ goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
- match state.goalStates.get? args.goalId with
- | .none => return .error $ errorIndex s!"Invalid goal index {args.goalId}"
+ match state.goalStates.get? args.stateId with
+ | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState =>
- let result ← GoalState.execute goalState args.tactic |>.run state.options
+ let result ← GoalState.execute goalState args.goalId args.tactic |>.run state.options
match result with
- | .success goals =>
- if goals.isEmpty then
- return .ok {}
- else
- -- Append all goals
- let (goalStates, goalIds, sGoals) := Array.foldl (λ acc itr =>
- let (map, indices, serializedGoals) := acc
- let (goalState, sGoal) := itr
- let (map, index) := map.insert goalState
- (map, index :: indices, sGoal :: serializedGoals)
- ) (state.goalStates, [], []) goals
- set { state with goalStates }
- return .ok { goals? := .some sGoals.reverse.toArray, goalIds? := .some goalIds.reverse.toArray }
+ | .success nextGoalState goals =>
+ let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
+ set { state with goalStates }
+ return .ok {
+ nextStateId? := .some nextStateId,
+ goals? := .some goals
+ }
+ | .parseError message =>
+ return .ok { parseError? := .some message }
+ | .indexError goalId =>
+ return .error $ errorIndex s!"Invalid goal id index {goalId}"
| .failure messages =>
return .ok { tacticErrors? := .some messages }
- goal_delete (args: Commands.GoalDelete): MainM (CR Commands.GoalDeleteResult) := do
+ goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
- let goalStates := args.goalIds.foldl (λ map id => map.remove id) state.goalStates
+ let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
set { state with goalStates }
return .ok {}
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index ea81c36..64c0a6e 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -1,19 +1,8 @@
import Lean
-import Pantograph.Symbols
+import Pantograph.Symbol
import Pantograph.Serial
-
-/-
-The proof state manipulation system
-
-A proof state is launched by providing
-1. Environment: `Environment`
-2. Expression: `Expr`
-The expression becomes the first meta variable in the saved tactic state
-`Elab.Tactic.SavedState`.
-From this point on, any proof which extends
-`Elab.Term.Context` and
--/
+import Pantograph.Protocol
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
{
@@ -25,25 +14,32 @@ namespace Pantograph
open Lean
structure GoalState where
- mvarId: MVarId
savedState : Elab.Tactic.SavedState
+ -- The root hole which is the search target
+ root: MVarId
+ -- New metavariables acquired in this state
+ newMVars: SSet MVarId
+
abbrev M := Elab.TermElabM
-def GoalState.create (expr: Expr): M GoalState := do
- -- Immediately synthesise all metavariables if we need to leave the elaboration context.
+protected def GoalState.create (expr: Expr): M GoalState := do
+ -- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
+
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
- let expr ← instantiateMVars expr
+ --let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
return {
savedState,
- mvarId := goal.mvarId!
+ root := goal.mvarId!,
+ newMVars := SSet.empty,
}
+protected def GoalState.goals (goalState: GoalState): List MVarId := goalState.savedState.tactic.goals
-def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: String) :
+def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
state.restore
@@ -56,52 +52,108 @@ def execute_tactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Strin
return .error errors
else
let unsolved ← Elab.Tactic.getUnsolvedGoals
- -- The order of evaluation is important here
+ -- The order of evaluation is important here, since `getUnsolvedGoals` prunes the goals set
return .ok (← MonadBacktrack.saveState, unsolved)
catch exception =>
return .error #[← exception.toMessageData.toString]
- match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `tactic)
- (input := tactic)
- (fileName := "<stdin>") with
- | Except.error err => return .error #[err]
- | Except.ok stx => tacticM stx { elaborator := .anonymous } |>.run' state.tactic
+ tacticM tactic { elaborator := .anonymous } |>.run' state.tactic
/-- Response for executing a tactic -/
inductive TacticResult where
-- Goes to next state
- | success (goals: Array (GoalState × Commands.Goal))
- -- Fails with messages
+ | success (state: GoalState) (goals: Array Protocol.Goal)
+ -- Tactic failed with messages
| failure (messages: Array String)
-
-namespace TacticResult
-
-def is_success: TacticResult → Bool
- | .success _ => true
- | .failure _ => false
-
-end TacticResult
+ -- Could not parse tactic
+ | parseError (message: String)
+ -- The goal index is out of bounds
+ | indexError (goalId: Nat)
/-- Execute tactic on given state -/
-def GoalState.execute (goal: GoalState) (tactic: String):
- Commands.OptionsT M TacticResult := do
+protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String):
+ Protocol.OptionsT M TacticResult := do
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure $ goal
+ | .none => return .indexError goalId
+ let tactic ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `tactic)
+ (input := tactic)
+ (fileName := "<stdin>") with
+ | .ok stx => pure $ stx
+ | .error error => return .parseError error
let options ← read
- match (← execute_tactic (state := goal.savedState) (goal := goal.mvarId) (tactic := tactic)) with
+ match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
| .error errors =>
return .failure errors
- | .ok (nextState, nextGoals) =>
- if nextGoals.isEmpty then
- return .success #[]
+ | .ok (nextSavedState, nextGoals) =>
+ assert! nextSavedState.tactic.goals.length == nextGoals.length
+ -- Assert that the definition of metavariables are the same
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars := (← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ return acc
+ else
+ return mvarId :: acc
+ ) []).toSSet
+ let nextState: GoalState := {
+ savedState := nextSavedState
+ root := state.root,
+ newMVars,
+ }
+ nextSavedState.term.restore
+ let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal
+ let goals ← nextGoals.mapM fun nextGoal => do
+ match (← MonadMCtx.getMCtx).findDecl? nextGoal with
+ | .some mvarDecl =>
+ let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
+ return serializedGoal
+ | .none => throwError s!"Parent mvar id does not exist {nextGoal.name}"
+ return .success nextState goals.toArray
+
+-- Diagnostics functions
+
+/-- Print the metavariables in a readable format -/
+protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): Elab.TermElabM Unit := do
+ let savedState := goalState.savedState
+ savedState.term.restore
+ let goals := savedState.tactic.goals
+ let mctx ← getMCtx
+ goals.forM (fun mvarId => do
+ let pref := "⊢"
+ match mctx.decls.find? mvarId with
+ | .some decl => printMVar pref mvarId decl
+ | .none => IO.println s!"{pref}{mvarId.name}: ??"
+ )
+ let goals := goals.toSSet
+ mctx.decls.forM (fun mvarId decl => do
+ if goals.contains mvarId then
+ pure ()
+ else if mvarId == goalState.root then
+ printMVar (pref := ">") mvarId decl
+ else if ¬(goalState.newMVars.contains mvarId) then
+ printMVar (pref := " ") mvarId decl
+ else if options.printNonVisible then
+ printMVar (pref := "~") mvarId decl
else
- let nextGoals: List GoalState := nextGoals.map fun mvarId => { mvarId, savedState := nextState }
- let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal.mvarId
- let goals ← nextGoals.mapM fun nextGoal => do
- match (← MonadMCtx.getMCtx).findDecl? nextGoal.mvarId with
- | .some mvarDecl =>
- let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
- return (nextGoal, serializedGoal)
- | .none => throwError nextGoal.mvarId
- return .success goals.toArray
+ IO.println s!" {mvarId.name}{userNameToString decl.userName}"
+ )
+ where
+ printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): Elab.TermElabM Unit := do
+ if options.printContext then
+ decl.lctx.fvarIdToDecl.forM printFVar
+ IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {← serialize_expression_ast decl.type}"
+ if options.printValue then
+ if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
+ IO.println s!" = {← Meta.ppExpr value}"
+ printFVar (fvarId: FVarId) (decl: LocalDecl): Elab.TermElabM Unit := do
+ IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
+ userNameToString : Name → String
+ | .anonymous => ""
+ | other => s!"[{other}]"
end Pantograph
diff --git a/Pantograph/Commands.lean b/Pantograph/Protocol.lean
similarity index 84%
rename from Pantograph/Commands.lean
rename to Pantograph/Protocol.lean
index 72194b0..390c49f 100644
--- a/Pantograph/Commands.lean
+++ b/Pantograph/Protocol.lean
@@ -6,7 +6,7 @@ its field names to avoid confusion with error messages generated by the REPL.
-/
import Lean.Data.Json
-namespace Pantograph.Commands
+namespace Pantograph.Protocol
/-- Main Option structure, placed here to avoid name collision -/
@@ -132,32 +132,42 @@ abbrev OptionsPrintResult := Options
structure GoalStart where
-- Only one of the fields below may be populated.
- expr: Option String -- Proof expression
- copyFrom: Option String -- Theorem name
+ expr: Option String -- Directly parse in an expression
+ copyFrom: Option String -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure GoalStartResult where
- goalId: Nat := 0 -- Proof tree id
+ stateId: Nat := 0
deriving Lean.ToJson
structure GoalTactic where
-- Identifiers for tree, state, and goal
- goalId: Nat
+ stateId: Nat
+ goalId: Nat := 0
tactic: String
deriving Lean.FromJson
structure GoalTacticResult where
- -- Existence of this field shows success
+ -- The next goal state id. Existence of this field shows success
+ nextStateId?: Option Nat := .none
+ -- If the array is empty, it shows the goals have been fully resolved.
goals?: Option (Array Goal) := .none
- -- Next proof state id, if successful
- goalIds?: Option (Array Nat) := .none
- -- Existence of this field shows failure
+
+ -- Existence of this field shows tactic execution failure
tacticErrors?: Option (Array String) := .none
+
+ -- Existence of this field shows the tactic parsing has failed
+ parseError?: Option String := .none
deriving Lean.ToJson
--- Remove a bunch of goals.
+-- Remove goal states
structure GoalDelete where
- goalIds: List Nat
+ stateIds: List Nat
deriving Lean.FromJson
structure GoalDeleteResult where
deriving Lean.ToJson
+structure GoalPrint where
+ printContext: Bool := true
+ printValue: Bool := true
+ printNonVisible: Bool := true
-end Pantograph.Commands
+
+end Pantograph.Protocol
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 27251b6..46f1262 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -3,7 +3,7 @@ All serialisation functions
-/
import Lean
-import Pantograph.Commands
+import Pantograph.Protocol
namespace Pantograph
open Lean
@@ -39,7 +39,7 @@ def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
--- Output Functions ---
-def type_expr_to_bound (expr: Expr): MetaM Commands.BoundExpression := do
+def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
Meta.forallTelescope expr fun arr body => do
let binders ← arr.mapM fun fvar => do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
@@ -108,7 +108,7 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
-- Lean these are handled using a `#` prefix.
return s!"{deBruijnIndex}"
| .fvar fvarId =>
- let name := (← fvarId.getDecl).userName
+ let name := name_to_ast fvarId.name
return s!"(:fv {name})"
| .mvar mvarId =>
let name := name_to_ast mvarId.name
@@ -166,7 +166,7 @@ def serialize_expression_ast (expr: Expr): MetaM String := do
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
-def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.Expression := do
+def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp := toString (← Meta.ppExpr e)
let pp?: Option String := match options.printExprPretty with
| true => .some pp
@@ -181,8 +181,8 @@ def serialize_expression (options: Commands.Options) (e: Expr): MetaM Commands.E
}
/-- Adapted from ppGoal -/
-def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
- : MetaM Commands.Goal := do
+def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+ : MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
let ppAuxDecls := options.printAuxDecls
@@ -190,7 +190,7 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
Meta.withLCtx lctx mvarDecl.localInstances do
- let ppVarNameOnly (localDecl: LocalDecl): MetaM Commands.Variable := do
+ let ppVarNameOnly (localDecl: LocalDecl): MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ _ varName _ _ _ =>
let varName := varName.simpMacroScopes
@@ -201,7 +201,7 @@ def serialize_goal (options: Commands.Options) (mvarDecl: MetavarDecl) (parentDe
return {
name := toString varName,
}
- let ppVar (localDecl : LocalDecl) : MetaM Commands.Variable := do
+ let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ _ varName type _ _ =>
let varName := varName.simpMacroScopes
diff --git a/Pantograph/Symbols.lean b/Pantograph/Symbol.lean
similarity index 94%
rename from Pantograph/Symbols.lean
rename to Pantograph/Symbol.lean
index 641a276..81d7deb 100644
--- a/Pantograph/Symbols.lean
+++ b/Pantograph/Symbol.lean
@@ -1,10 +1,8 @@
-/-
- - Manages the visibility status of symbols
- -/
import Lean.Declaration
namespace Pantograph
+/-- Converts a symbol of the form `aa.bb.cc` to a name -/
def str_to_name (s: String): Lean.Name :=
(s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index f450292..ec93fa9 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.5"
+def version := "0.2.6"
end Pantograph
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 5dbb80a..b7a5e62 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -47,26 +47,26 @@ def test_option_modify : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
let sexp? := Option.some "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
- let options: Commands.Options := {}
+ let options: Protocol.Options := {}
subroutine_runner [
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp? }, module? }:
- Commands.LibInspectResult)),
+ Protocol.LibInspectResult)),
subroutine_step "options.set"
[("printExprAST", .bool true)]
(Lean.toJson ({ }:
- Commands.OptionsSetResult)),
+ Protocol.OptionsSetResult)),
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
type := { pp?, sexp? }, module? }:
- Commands.LibInspectResult)),
+ Protocol.LibInspectResult)),
subroutine_step "options.print"
[]
(Lean.toJson ({ options with printExprAST := true }:
- Commands.OptionsPrintResult))
+ Protocol.OptionsPrintResult))
]
def test_malformed_command : IO LSpec.TestSeq :=
let invalid := "invalid"
@@ -75,12 +75,12 @@ def test_malformed_command : IO LSpec.TestSeq :=
[("name", .str "Nat.add_one")]
(Lean.toJson ({
error := "command", desc := s!"Unknown command {invalid}"}:
- Commands.InteractionError)),
+ Protocol.InteractionError)),
subroutine_named_step "JSON Deserialization" "expr.echo"
[(invalid, .str "Random garbage data")]
(Lean.toJson ({
- error := "command", desc := s!"Unable to parse json: Pantograph.Commands.ExprEcho.expr: String expected"}:
- Commands.InteractionError))
+ error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected"}:
+ Protocol.InteractionError))
]
def suite: IO LSpec.TestSeq := do
diff --git a/Test/Main.lean b/Test/Main.lean
index cb7c055..5b9a24a 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,5 +1,5 @@
import LSpec
-import Test.Holes
+--import Test.Holes
import Test.Integration
import Test.Proofs
import Test.Serial
@@ -11,7 +11,7 @@ unsafe def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
- Holes.suite,
+ --Holes.suite,
Integration.suite,
Proofs.suite,
Serial.suite
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 3aaea0f..05331ed 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -1,7 +1,21 @@
+/-
+Tests pertaining to goals with no interdependencies
+-/
import LSpec
import Pantograph.Goal
import Pantograph.Serial
+namespace Pantograph
+
+def TacticResult.toString : TacticResult → String
+ | .success _ goals => s!".success ({goals.size} goals)"
+ | .failure messages =>
+ let messages := "\n".intercalate messages.toList
+ s!".failure {messages}"
+ | .parseError error => s!".parseError {error}"
+ | .indexError index => s!".indexError {index}"
+end Pantograph
+
namespace Pantograph.Test.Proofs
open Pantograph
open Lean
@@ -10,21 +24,21 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
-deriving instance DecidableEq, Repr for Commands.Expression
-deriving instance DecidableEq, Repr for Commands.Variable
-deriving instance DecidableEq, Repr for Commands.Goal
+deriving instance DecidableEq, Repr for Protocol.Expression
+deriving instance DecidableEq, Repr for Protocol.Variable
+deriving instance DecidableEq, Repr for Protocol.Goal
-def add_test (test: LSpec.TestSeq): TestM Unit := do
+def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
-def start_proof (start: Start): TestM (Option GoalState) := do
+def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
match start with
| .copy name =>
let cInfo? := str_to_name name |> env.find?
- add_test $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
+ addTest $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
match cInfo? with
| .some cInfo =>
let goal ← GoalState.create (expr := cInfo.type)
@@ -33,14 +47,14 @@ def start_proof (start: Start): TestM (Option GoalState) := do
return Option.none
| .expr expr =>
let syn? := syntax_from_str env expr
- add_test $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
+ addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
let expr? ← syntax_to_expr_type syn
- add_test $ LSpec.check s!"Elaborating" expr?.isOk
+ addTest $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
IO.println error
@@ -49,9 +63,9 @@ def start_proof (start: Start): TestM (Option GoalState) := do
let goal ← GoalState.create (expr := expr)
return Option.some goal
-def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
+def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
-def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
+def buildGoal (nameType: List (String × String)) (target: String): Protocol.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
@@ -60,8 +74,8 @@ def build_goal (nameType: List (String × String)) (target: String): Commands.Go
isInaccessible? := .some false
})).toArray
}
--- Like `build_goal` but allow certain variables to be elided.
-def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
+-- Like `buildGoal` but allow certain variables to be elided.
+def buildGoalSelective (nameType: List (String × Option String)) (target: String): Protocol.Goal :=
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
@@ -70,146 +84,7 @@ def build_goal_selective (nameType: List (String × Option String)) (target: Str
isInaccessible? := x.snd.map (λ _ => false)
})).toArray
}
-
-
--- Individual test cases
-example: ∀ (a b: Nat), a + b = b + a := by
- intro n m
- rw [Nat.add_comm]
-def proof_nat_add_comm: TestM Unit := do
- let goal? ← start_proof (.copy "Nat.add_comm")
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- if let .success #[(goal, sGoal)] ← goal.execute "intro n m" then
- let sGoal1e: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- add_test $ LSpec.check "intro n m" (sGoal = sGoal1e)
-
- if let .failure #[message] ← goal.execute "assumption" then
- add_test $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
- else
- add_test $ assert_unreachable "assumption"
-
- if let .success #[] ← goal.execute "rw [Nat.add_comm]" then
- return ()
- else
- add_test $ assert_unreachable "rw [Nat.add_comm]"
- else
- add_test $ assert_unreachable "intro n m"
-def proof_nat_add_comm_manual: TestM Unit := do
- let goal? ← start_proof (.expr "∀ (a b: Nat), a + b = b + a")
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- if let .success #[(goal, sGoal)] ← goal.execute "intro n m" then
- let sGoal1e: Commands.Goal := build_goal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"
- add_test $ LSpec.check "intro n m" (sGoal = sGoal1e)
-
- if let .failure #[message] ← goal.execute "assumption" then
- add_test $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
- else
- add_test $ assert_unreachable "assumption"
-
- if let .success #[] ← goal.execute "rw [Nat.add_comm]" then
- return ()
- else
- add_test $ assert_unreachable "rw [Nat.add_comm]"
- else
- add_test $ assert_unreachable "intro n m"
-
-
--- Two ways to write the same theorem
-example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
- intro p q h
- cases h
- apply Or.inr
- assumption
- apply Or.inl
- assumption
-example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
- intro p q h
- cases h
- . apply Or.inr
- assumption
- . apply Or.inl
- assumption
-def proof_or_comm: TestM Unit := do
- let typeProp: Commands.Expression := { pp? := .some "Prop" }
- let branchGoal (caseName name: String): Commands.Goal := {
- caseName? := .some caseName,
- target := { pp? := .some "q ∨ p" },
- vars := #[
- { name := "p", type? := .some typeProp, isInaccessible? := .some false },
- { name := "q", type? := .some typeProp, isInaccessible? := .some false },
- { name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
- ]
- }
- let goal? ← start_proof (.expr "∀ (p q: Prop), p ∨ q → q ∨ p")
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- if let .success #[(goal, sGoal)] ← goal.execute "intro p q h" then
- let sGoal1e := build_goal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"
- add_test $ LSpec.check "intro p q h" (sGoal = sGoal1e)
-
- if let .success #[(goal1, sGoal1), (goal2, sGoal2)] ← goal.execute "cases h" then
- add_test $ LSpec.check "cases h/1" (sGoal1 = branchGoal "inl" "p")
- if let .success #[(goal, _)] ← goal1.execute "apply Or.inr" then
- if let .success #[] ← goal.execute "assumption" then
- return ()
- else
- add_test $ assert_unreachable "assumption"
- else
- add_test $ assert_unreachable "apply Or.inr"
-
-
- add_test $ LSpec.check "cases h/2" (sGoal2 = branchGoal "inr" "q")
- if let .success #[(goal, _)] ← goal2.execute "apply Or.inl" then
- if let .success #[] ← goal.execute "assumption" then
- return ()
- else
- add_test $ assert_unreachable "assumption"
- else
- add_test $ assert_unreachable "apply Or.inl"
-
- else
- add_test $ assert_unreachable "cases h"
- else
- add_test $ assert_unreachable "intro p q h"
-
-example (w x y z : Nat) (p : Nat → Prop)
- (h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
- simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
- assumption
-def proof_arith_1: TestM Unit := do
- let goal? ← start_proof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- if let .success #[(goal, _)] ← goal.execute "intros" then
- if let .success #[(goal, _)] ← goal.execute "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *" then
- if let .success #[] ← goal.execute "assumption" then
- return ()
- else
- add_test $ assert_unreachable "assumption"
- else
- add_test $ assert_unreachable "simp ..."
- else
- add_test $ assert_unreachable "intros"
-
-def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
- let goal? ← start_proof (.expr "∀ (a b: Nat), a + b = b + a")
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- if let .success #[(goal, sGoal)] ← goal.execute "intro n" then
- let sGoal1e: Commands.Goal := build_goal_selective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
- add_test $ LSpec.check "intro n" (sGoal = sGoal1e)
-
- if let .success #[(_, sGoal)] ← goal.execute "intro m" then
- let sGoal2e: Commands.Goal := build_goal_selective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
- add_test $ LSpec.check "intro m" (sGoal = sGoal2e)
- else
- add_test $ assert_unreachable "intro m"
- else
- add_test $ assert_unreachable "intro n"
-
-def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
+def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context := {
@@ -229,6 +104,160 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
| .ok (_, a) =>
return a
+
+-- Individual test cases
+example: ∀ (a b: Nat), a + b = b + a := by
+ intro n m
+ rw [Nat.add_comm]
+def proof_nat_add_comm (manual: Bool): TestM Unit := do
+ let state? ← startProof <| match manual with
+ | false => .copy "Nat.add_comm"
+ | true => .expr "∀ (a b: Nat), a + b = b + a"
+ addTest $ LSpec.check "Start goal" state?.isSome
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let (state1, goal1) ← match ← state0.execute (goalId := 0) (tactic := "intro n m") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "intro n m" (goal1 = buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n")
+
+ match ← state1.execute (goalId := 0) (tactic := "assumption") with
+ | .failure #[message] =>
+ addTest $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+
+ let state2 ← match ← state1.execute (goalId := 0) (tactic := "rw [Nat.add_comm]") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ return ()
+
+
+-- Two ways to write the same theorem
+example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
+ intro p q h
+ cases h
+ apply Or.inr
+ assumption
+ apply Or.inl
+ assumption
+example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
+ intro p q h
+ cases h
+ . apply Or.inr
+ assumption
+ . apply Or.inl
+ assumption
+def proof_or_comm: TestM Unit := do
+ let state? ← startProof (.expr "∀ (p q: Prop), p ∨ q → q ∨ p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let (state1, goal1) ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "p q h" (goal1 = buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p")
+ let (state2, goal1, goal2) ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
+ | .success state #[goal1, goal2] => pure (state, goal1, goal2)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "cases h/1" (goal1 = branchGoal "inl" "p")
+ addTest $ LSpec.check "cases h/2" (goal2 = branchGoal "inr" "q")
+
+ let (state3_1, _goal) ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ IO.println "===== 1 ====="
+ state1.print
+ IO.println "===== 2 ====="
+ state2.print
+ IO.println "===== 4_1 ====="
+ state4_1.print
+ let (state3_2, _goal) ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ IO.println "===== 3_2 ====="
+ state3_2.print
+ let state4_2 ← match ← state3_2.execute (goalId := 0) (tactic := "assumption") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ IO.println "===== 4_2 ====="
+ state4_2.print
+
+ return ()
+ where
+ typeProp: Protocol.Expression := { pp? := .some "Prop" }
+ branchGoal (caseName name: String): Protocol.Goal := {
+ caseName? := .some caseName,
+ target := { pp? := .some "q ∨ p" },
+ vars := #[
+ { name := "p", type? := .some typeProp, isInaccessible? := .some false },
+ { name := "q", type? := .some typeProp, isInaccessible? := .some false },
+ { name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
+ ]
+ }
+
+--example (w x y z : Nat) (p : Nat → Prop)
+-- (h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
+-- simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
+-- assumption
+--def proof_arith_1: TestM Unit := do
+-- let goal? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
+-- addTest $ LSpec.check "Start goal" goal?.isSome
+-- if let .some goal := goal? then
+-- if let .success #[(goal, _)] ← goal.execute "intros" then
+-- if let .success #[(goal, _)] ← goal.execute "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *" then
+-- if let .success #[] ← goal.execute "assumption" then
+-- return ()
+-- else
+-- addTest $ assertUnreachable "assumption"
+-- else
+-- addTest $ assertUnreachable "simp ..."
+-- else
+-- addTest $ assertUnreachable "intros"
+--
+--def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
+-- let goal? ← startProof (.expr "∀ (a b: Nat), a + b = b + a")
+-- addTest $ LSpec.check "Start goal" goal?.isSome
+-- if let .some goal := goal? then
+-- if let .success #[(goal, sGoal)] ← goal.execute "intro n" then
+-- let sGoal1e: Protocol.Goal :=buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
+-- addTest $ LSpec.check "intro n" (sGoal = sGoal1e)
+--
+-- if let .success #[(_, sGoal)] ← goal.execute "intro m" then
+-- let sGoal2e: Protocol.Goal :=buildGoalSelective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
+-- addTest $ LSpec.check "intro m" (sGoal = sGoal2e)
+-- else
+-- addTest $ assertUnreachable "intro m"
+-- else
+-- addTest $ assertUnreachable "intro n"
+
/-- Tests the most basic form of proofs whose goals do not relate to each other -/
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
@@ -236,15 +265,15 @@ def suite: IO LSpec.TestSeq := do
(opts := {})
(trustLevel := 1)
let tests := [
- ("Nat.add_comm", proof_nat_add_comm),
- ("nat.add_comm manual", proof_nat_add_comm_manual),
- ("Or.comm", proof_or_comm),
- ("arithmetic 1", proof_arith_1),
- ("delta variable", proof_delta_variable)
+ ("Nat.add_comm", proof_nat_add_comm false),
+ ("Nat.add_comm manual", proof_nat_add_comm true),
+ ("Or.comm", proof_or_comm)
+ --("arithmetic 1", proof_arith_1),
+ --("delta variable", proof_delta_variable)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
- let tests ← proof_runner env tests
+ let tests ← proofRunner env tests
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
return LSpec.group "Proofs" tests
diff --git a/Test/Serial.lean b/Test/Serial.lean
index e135c0c..30d6f60 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -1,19 +1,19 @@
import LSpec
import Pantograph.Serial
-import Pantograph.Symbols
+import Pantograph.Symbol
namespace Pantograph.Test.Serial
open Pantograph
open Lean
-deriving instance Repr, DecidableEq for Commands.BoundExpression
+deriving instance Repr, DecidableEq for Protocol.BoundExpression
def test_str_to_name: LSpec.TestSeq :=
LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
- let entries: List (String × Commands.BoundExpression) := [
+ let entries: List (String × Protocol.BoundExpression) := [
("Nat.add_comm", { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
("Nat.le_of_succ_le", { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
]
From 3d7d5d6b4dce481cf8f5dcf0f68514f0af3fbbb1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 20 Oct 2023 11:52:09 -0700
Subject: [PATCH 026/465] feat: Add nix flake
---
flake.lock | 202 +++++++++++++++++++++++++++++++++++++++++++++++++++++
flake.nix | 38 ++++++++++
2 files changed, 240 insertions(+)
create mode 100644 flake.lock
create mode 100644 flake.nix
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..67246b6
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,202 @@
+{
+ "nodes": {
+ "flake-parts": {
+ "inputs": {
+ "nixpkgs-lib": "nixpkgs-lib"
+ },
+ "locked": {
+ "lastModified": 1696343447,
+ "narHash": "sha256-B2xAZKLkkeRFG5XcHHSXXcP7To9Xzr59KXeZiRf4vdQ=",
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "rev": "c9afaba3dfa4085dbd2ccb38dfade5141e33d9d4",
+ "type": "github"
+ },
+ "original": {
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "type": "github"
+ }
+ },
+ "flake-utils": {
+ "locked": {
+ "lastModified": 1656928814,
+ "narHash": "sha256-RIFfgBuKz6Hp89yRr7+NR5tzIAbn52h8vT6vXkYjZoM=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "7e2a3b3dfd9af950a856d66b0a7d01e3c18aa249",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "lean": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "lean4-mode": "lean4-mode",
+ "nix": "nix",
+ "nixpkgs": "nixpkgs_2"
+ },
+ "locked": {
+ "lastModified": 1695693562,
+ "narHash": "sha256-6qbCafG0bL5KxQt2gL6hV4PFDsEMM0UXfldeOOqxsaE=",
+ "owner": "leanprover",
+ "repo": "lean4",
+ "rev": "a832f398b80a5ebb820d27b9e55ec949759043ff",
+ "type": "github"
+ },
+ "original": {
+ "owner": "leanprover",
+ "ref": "v4.1.0",
+ "repo": "lean4",
+ "type": "github"
+ }
+ },
+ "lean4-mode": {
+ "flake": false,
+ "locked": {
+ "lastModified": 1676498134,
+ "narHash": "sha256-u3WvyKxOViZG53hkb8wd2/Og6muTecbh+NdflIgVeyk=",
+ "owner": "leanprover",
+ "repo": "lean4-mode",
+ "rev": "2c6ef33f476fdf5eb5e4fa4fa023ba8b11372440",
+ "type": "github"
+ },
+ "original": {
+ "owner": "leanprover",
+ "repo": "lean4-mode",
+ "type": "github"
+ }
+ },
+ "lowdown-src": {
+ "flake": false,
+ "locked": {
+ "lastModified": 1633514407,
+ "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
+ "owner": "kristapsdz",
+ "repo": "lowdown",
+ "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
+ "type": "github"
+ },
+ "original": {
+ "owner": "kristapsdz",
+ "repo": "lowdown",
+ "type": "github"
+ }
+ },
+ "nix": {
+ "inputs": {
+ "lowdown-src": "lowdown-src",
+ "nixpkgs": "nixpkgs",
+ "nixpkgs-regression": "nixpkgs-regression"
+ },
+ "locked": {
+ "lastModified": 1657097207,
+ "narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
+ "owner": "NixOS",
+ "repo": "nix",
+ "rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "repo": "nix",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1653988320,
+ "narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixos-22.05-small",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs-lib": {
+ "locked": {
+ "dir": "lib",
+ "lastModified": 1696019113,
+ "narHash": "sha256-X3+DKYWJm93DRSdC5M6K5hLqzSya9BjibtBsuARoPco=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "f5892ddac112a1e9b3612c39af1b72987ee5783a",
+ "type": "github"
+ },
+ "original": {
+ "dir": "lib",
+ "owner": "NixOS",
+ "ref": "nixos-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs-regression": {
+ "locked": {
+ "lastModified": 1643052045,
+ "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
+ "type": "github"
+ }
+ },
+ "nixpkgs_2": {
+ "locked": {
+ "lastModified": 1686089707,
+ "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs_3": {
+ "locked": {
+ "lastModified": 1697456312,
+ "narHash": "sha256-roiSnrqb5r+ehnKCauPLugoU8S36KgmWraHgRqVYndo=",
+ "owner": "nixos",
+ "repo": "nixpkgs",
+ "rev": "ca012a02bf8327be9e488546faecae5e05d7d749",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nixos",
+ "ref": "nixos-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-parts": "flake-parts",
+ "lean": "lean",
+ "nixpkgs": "nixpkgs_3"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..356323f
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,38 @@
+{
+ description = "Pantograph";
+
+ inputs = {
+ nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
+ flake-parts.url = "github:hercules-ci/flake-parts";
+ lean.url = "github:leanprover/lean4?ref=v4.1.0";
+ };
+
+ outputs = inputs @ {
+ self,
+ nixpkgs,
+ flake-parts,
+ lean,
+ ...
+ } : flake-parts.lib.mkFlake { inherit inputs; } {
+ flake = {
+ };
+ systems = [
+ "x86_64-linux"
+ "x86_64-darwin"
+ ];
+ perSystem = { system, pkgs, ... }: let
+ leanPkgs = lean.packages.${system};
+ project = leanPkgs.buildLeanPackage {
+ name = "Pantograph";
+ roots = [ "Main" "Pantograph" ];
+ src = ./.;
+ };
+ in rec {
+ packages = project // {
+ inherit (leanPkgs) lean;
+ default = packages.executable;
+ };
+ devShells.default = project.devShell;
+ };
+ };
+}
From a9294e0338c3e32e5d649ea562b32349a249f958 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 20 Oct 2023 12:54:35 -0700
Subject: [PATCH 027/465] Add documentation about flake
---
README.md | 1 +
1 file changed, 1 insertion(+)
diff --git a/README.md b/README.md
index b8e0868..442b57d 100644
--- a/README.md
+++ b/README.md
@@ -18,6 +18,7 @@ export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATH
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
+The provided `flake.nix` has a develop environment with Lean already setup.
## Usage
From d991533170c0643093e224a6f7cfef9f888731ef Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 25 Oct 2023 16:03:45 -0700
Subject: [PATCH 028/465] feat: Add proof continue and root extraction
---
Pantograph/Goal.lean | 72 ++++++++++++++++------
Pantograph/Protocol.lean | 3 +-
Pantograph/Serial.lean | 126 ++++++++++++++++++++-------------------
Test/Proofs.lean | 30 ++++++----
4 files changed, 142 insertions(+), 89 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 64c0a6e..3f42abe 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -31,14 +31,20 @@ protected def GoalState.create (expr: Expr): M GoalState := do
--let expr ← instantiateMVars expr
let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous))
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
- let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [goal.mvarId!]}
+ let root := goal.mvarId!
+ let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
return {
savedState,
- root := goal.mvarId!,
- newMVars := SSet.empty,
+ root,
+ newMVars := SSet.insert .empty root,
}
protected def GoalState.goals (goalState: GoalState): List MVarId := goalState.savedState.tactic.goals
+private def GoalState.mctx (state: GoalState): MetavarContext :=
+ state.savedState.term.meta.meta.mctx
+private def GoalState.mvars (state: GoalState): SSet MVarId :=
+ state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
+
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
@@ -93,13 +99,13 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
let prevMCtx := state.savedState.term.meta.meta.mctx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
- let newMVars := (← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
assert! prevMVarDecl.type == mvarDecl.type
return acc
else
- return mvarId :: acc
- ) []).toSSet
+ return acc.insert mvarId
+ ) SSet.empty
let nextState: GoalState := {
savedState := nextSavedState
root := state.root,
@@ -115,38 +121,70 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
| .none => throwError s!"Parent mvar id does not exist {nextGoal.name}"
return .success nextState goals.toArray
+/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
+protected def GoalState.continue (target: GoalState) (graftee: GoalState): Except String GoalState :=
+ if target.root != graftee.root then
+ .error s!"Roots of two continued goal states do not match: {target.root.name} != {graftee.root.name}"
+ -- Ensure goals are not dangling
+ else if ¬ (target.goals.all (λ goal => graftee.mvars.contains goal)) then
+ .error s!"Some goals in target are not present in the graftee"
+ else
+ -- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
+ let unassigned := target.goals.filter (λ goal =>
+ let mctx := graftee.mctx
+ ¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
+ .ok {
+ savedState := {
+ term := graftee.savedState.term,
+ tactic := { goals := unassigned },
+ },
+ root := target.root,
+ newMVars := graftee.newMVars,
+ }
+
+protected def GoalState.rootExpr (goalState: GoalState): Option Expr :=
+ goalState.mctx.eAssignment.find? goalState.root |>.filter (λ e => ¬ e.hasMVar)
+
-- Diagnostics functions
/-- Print the metavariables in a readable format -/
-protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): Elab.TermElabM Unit := do
+protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): M Unit := do
let savedState := goalState.savedState
savedState.term.restore
let goals := savedState.tactic.goals
let mctx ← getMCtx
+ let root := goalState.root
+ -- Print the root
+ match mctx.decls.find? root with
+ | .some decl => printMVar ">" root decl
+ | .none => IO.println s!">{root.name}: ??"
goals.forM (fun mvarId => do
- let pref := "⊢"
- match mctx.decls.find? mvarId with
- | .some decl => printMVar pref mvarId decl
- | .none => IO.println s!"{pref}{mvarId.name}: ??"
+ if mvarId != root then
+ match mctx.decls.find? mvarId with
+ | .some decl => printMVar "⊢" mvarId decl
+ | .none => IO.println s!"⊢{mvarId.name}: ??"
)
let goals := goals.toSSet
mctx.decls.forM (fun mvarId decl => do
- if goals.contains mvarId then
+ if goals.contains mvarId || mvarId == root then
pure ()
+ -- Always print the root goal
else if mvarId == goalState.root then
printMVar (pref := ">") mvarId decl
- else if ¬(goalState.newMVars.contains mvarId) then
- printMVar (pref := " ") mvarId decl
+ -- Print the remainig ones that users don't see in Lean
else if options.printNonVisible then
- printMVar (pref := "~") mvarId decl
+ let pref := if goalState.newMVars.contains mvarId then "~" else " "
+ printMVar pref mvarId decl
else
- IO.println s!" {mvarId.name}{userNameToString decl.userName}"
+ pure ()
+ --IO.println s!" {mvarId.name}{userNameToString decl.userName}"
)
where
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): Elab.TermElabM Unit := do
if options.printContext then
decl.lctx.fvarIdToDecl.forM printFVar
- IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {← serialize_expression_ast decl.type}"
+ let type_sexp ← serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
+ IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
IO.println s!" = {← Meta.ppExpr value}"
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 390c49f..49103d7 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -167,7 +167,8 @@ structure GoalDeleteResult where
structure GoalPrint where
printContext: Bool := true
printValue: Bool := true
- printNonVisible: Bool := true
+ printNewMVars: Bool := false
+ printNonVisible: Bool := false
end Pantograph.Protocol
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 46f1262..a5acd7f 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -45,9 +45,11 @@ def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-private def name_to_ast: Lean.Name → String
- | .anonymous
- | .num _ _ => ":anon"
+private def name_to_ast (name: Lean.Name) (sanitize: Bool := true): String := match name with
+ | .anonymous => ":anon"
+ | .num n i => match sanitize with
+ | false => s!"{toString n} {i}"
+ | true => ":anon"
| n@(.str _ _) => toString n
private def level_depth: Level → Nat
@@ -100,71 +102,73 @@ def serialize_sort_level_ast (level: Level): String :=
/--
Completely serializes an expression tree. Json not used due to compactness
-/
-def serialize_expression_ast (expr: Expr): MetaM String := do
- match expr with
- | .bvar deBruijnIndex =>
- -- This is very common so the index alone is shown. Literals are handled below.
- -- The raw de Bruijn index should never appear in an unbound setting. In
- -- Lean these are handled using a `#` prefix.
- return s!"{deBruijnIndex}"
- | .fvar fvarId =>
- let name := name_to_ast fvarId.name
- return s!"(:fv {name})"
- | .mvar mvarId =>
- let name := name_to_ast mvarId.name
- return s!"(:mv {name})"
- | .sort level =>
- let level := serialize_sort_level_ast level
- return s!"(:sort {level})"
- | .const declName _ =>
- -- The universe level of the const expression is elided since it should be
- -- inferrable from surrounding expression
- return s!"(:c {declName})"
- | .app fn arg =>
- let fn' ← serialize_expression_ast fn
- let arg' ← serialize_expression_ast arg
- return s!"({fn'} {arg'})"
- | .lam binderName binderType body binderInfo =>
- let binderName' := name_to_ast binderName
- let binderType' ← serialize_expression_ast binderType
- let body' ← serialize_expression_ast body
- let binderInfo' := binder_info_to_ast binderInfo
- return s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
- | .forallE binderName binderType body binderInfo =>
- let binderName' := name_to_ast binderName
- let binderType' ← serialize_expression_ast binderType
- let body' ← serialize_expression_ast body
- let binderInfo' := binder_info_to_ast binderInfo
- return s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
- | .letE name type value body _ =>
- -- Dependent boolean flag diacarded
- let name' := name_to_ast name
- let type' ← serialize_expression_ast type
- let value' ← serialize_expression_ast value
- let body' ← serialize_expression_ast body
- return s!"(:let {name'} {type'} {value'} {body'})"
- | .lit v =>
- -- To not burden the downstream parser who needs to handle this, the literal
- -- is wrapped in a :lit sexp.
- let v' := match v with
- | .natVal val => toString val
- | .strVal val => s!"\"{val}\""
- return s!"(:lit {v'})"
- | .mdata _ expr =>
- -- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
- -- It may become necessary to incorporate the metadata.
- return (← serialize_expression_ast expr)
- | .proj typeName idx struct =>
- let struct' ← serialize_expression_ast struct
- return s!"(:proj {typeName} {idx} {struct'})"
-
+def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): MetaM String := do
+ return self expr
where
+ self (e: Expr): String :=
+ match e with
+ | .bvar deBruijnIndex =>
+ -- This is very common so the index alone is shown. Literals are handled below.
+ -- The raw de Bruijn index should never appear in an unbound setting. In
+ -- Lean these are handled using a `#` prefix.
+ s!"{deBruijnIndex}"
+ | .fvar fvarId =>
+ let name := of_name fvarId.name
+ s!"(:fv {name})"
+ | .mvar mvarId =>
+ let name := of_name mvarId.name
+ s!"(:mv {name})"
+ | .sort level =>
+ let level := serialize_sort_level_ast level
+ s!"(:sort {level})"
+ | .const declName _ =>
+ -- The universe level of the const expression is elided since it should be
+ -- inferrable from surrounding expression
+ s!"(:c {declName})"
+ | .app fn arg =>
+ let fn' := self fn
+ let arg' := self arg
+ s!"({fn'} {arg'})"
+ | .lam binderName binderType body binderInfo =>
+ let binderName' := of_name binderName
+ let binderType' := self binderType
+ let body' := self body
+ let binderInfo' := binder_info_to_ast binderInfo
+ s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
+ | .forallE binderName binderType body binderInfo =>
+ let binderName' := of_name binderName
+ let binderType' := self binderType
+ let body' := self body
+ let binderInfo' := binder_info_to_ast binderInfo
+ s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
+ | .letE name type value body _ =>
+ -- Dependent boolean flag diacarded
+ let name' := name_to_ast name
+ let type' := self type
+ let value' := self value
+ let body' := self body
+ s!"(:let {name'} {type'} {value'} {body'})"
+ | .lit v =>
+ -- To not burden the downstream parser who needs to handle this, the literal
+ -- is wrapped in a :lit sexp.
+ let v' := match v with
+ | .natVal val => toString val
+ | .strVal val => s!"\"{val}\""
+ s!"(:lit {v'})"
+ | .mdata _ inner =>
+ -- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
+ -- It may become necessary to incorporate the metadata.
+ self inner
+ | .proj typeName idx struct =>
+ let struct' := self struct
+ s!"(:proj {typeName} {idx} {struct'})"
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
+ of_name (name: Name) := name_to_ast name sanitize
def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp := toString (← Meta.ppExpr e)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 05331ed..ac9c78c 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -189,26 +189,36 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- IO.println "===== 1 ====="
- state1.print
- IO.println "===== 2 ====="
- state2.print
- IO.println "===== 4_1 ====="
- state4_1.print
let (state3_2, _goal) ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state #[goal] => pure (state, goal)
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- IO.println "===== 3_2 ====="
- state3_2.print
let state4_2 ← match ← state3_2.execute (goalId := 0) (tactic := "assumption") with
| .success state #[] => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- IO.println "===== 4_2 ====="
- state4_2.print
+
+ -- Ensure the proof can continue from `state4_2`.
+ let state2b ← match state2.continue state4_2 with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.test "state2b" (state2b.goals == [state2.goals.get! 0])
+ let (state3_1, _goal) ← match ← state2b.execute (goalId := 0) (tactic := "apply Or.inr") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ IO.println "===== 4_1 ====="
+ state4_1.print ({ printNonVisible := false })
return ()
where
From 8029298db7b253cf8d81436a623e2f9e007dc782 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 25 Oct 2023 22:18:59 -0700
Subject: [PATCH 029/465] feat: Display user name in Goal structure
1. Modify `serialize_expression_ast` so its no longer a monad
2. Test existence of root expression
---
Pantograph/Goal.lean | 9 +++++++--
Pantograph/Protocol.lean | 5 ++++-
Pantograph/Serial.lean | 42 ++++++++++++++++++++++------------------
Test/Common.lean | 19 ++++++++++++++++++
Test/Proofs.lean | 25 ++++++++++++------------
Test/Serial.lean | 4 ++--
6 files changed, 68 insertions(+), 36 deletions(-)
create mode 100644 Test/Common.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 3f42abe..4e57134 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -143,7 +143,12 @@ protected def GoalState.continue (target: GoalState) (graftee: GoalState): Excep
}
protected def GoalState.rootExpr (goalState: GoalState): Option Expr :=
- goalState.mctx.eAssignment.find? goalState.root |>.filter (λ e => ¬ e.hasMVar)
+ let expr := goalState.mctx.eAssignment.find! goalState.root
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ if expr.hasMVar then
+ .none
+ else
+ .some expr
-- Diagnostics functions
@@ -183,7 +188,7 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrin
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): Elab.TermElabM Unit := do
if options.printContext then
decl.lctx.fvarIdToDecl.forM printFVar
- let type_sexp ← serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
+ let type_sexp := serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 49103d7..a6bae29 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -43,7 +43,10 @@ structure Expression where
deriving Lean.ToJson
structure Variable where
- name: String
+ /-- The internal name used in raw expressions -/
+ name: String := ""
+ /-- The name displayed to the user -/
+ userName: String
/-- Does the name contain a dagger -/
isInaccessible?: Option Bool := .none
type?: Option Expression := .none
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index a5acd7f..99f95ef 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -102,8 +102,8 @@ def serialize_sort_level_ast (level: Level): String :=
/--
Completely serializes an expression tree. Json not used due to compactness
-/
-def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): MetaM String := do
- return self expr
+def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
+ self expr
where
self (e: Expr): String :=
match e with
@@ -175,7 +175,7 @@ def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.E
let pp?: Option String := match options.printExprPretty with
| true => .some pp
| false => .none
- let sexp: String := (← serialize_expression_ast e)
+ let sexp: String := serialize_expression_ast e
let sexp?: Option String := match options.printExprAST with
| true => .some sexp
| false => .none
@@ -196,27 +196,30 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
Meta.withLCtx lctx mvarDecl.localInstances do
let ppVarNameOnly (localDecl: LocalDecl): MetaM Protocol.Variable := do
match localDecl with
- | .cdecl _ _ varName _ _ _ =>
- let varName := varName.simpMacroScopes
+ | .cdecl _ fvarId userName _ _ _ =>
+ let userName := userName.simpMacroScopes
return {
- name := toString varName,
+ name := of_name fvarId.name,
+ userName:= of_name userName.simpMacroScopes,
}
- | .ldecl _ _ varName _ _ _ _ => do
+ | .ldecl _ fvarId userName _ _ _ _ => do
return {
- name := toString varName,
+ name := of_name fvarId.name,
+ userName := toString userName.simpMacroScopes,
}
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
- | .cdecl _ _ varName type _ _ =>
- let varName := varName.simpMacroScopes
+ | .cdecl _ fvarId userName type _ _ =>
+ let userName := userName.simpMacroScopes
let type ← instantiateMVars type
return {
- name := toString varName,
- isInaccessible? := .some varName.isInaccessibleUserName
+ name := of_name fvarId.name,
+ userName:= of_name userName,
+ isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serialize_expression options type)
}
- | .ldecl _ _ varName type val _ _ => do
- let varName := varName.simpMacroScopes
+ | .ldecl _ fvarId userName type val _ _ => do
+ let userName := userName.simpMacroScopes
let type ← instantiateMVars type
let value? ← if showLetValues then
let val ← instantiateMVars val
@@ -224,8 +227,9 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
else
pure $ .none
return {
- name := toString varName,
- isInaccessible? := .some varName.isInaccessibleUserName
+ name := of_name fvarId.name,
+ userName:= of_name userName,
+ isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serialize_expression options type)
value? := value?
}
@@ -242,13 +246,13 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
| false => ppVar localDecl
return var::acc
return {
- caseName? := match mvarDecl.userName with
- | Name.anonymous => .none
- | name => .some <| toString name,
+ caseName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
}
+ where
+ of_name (n: Name) := name_to_ast n (sanitize := false)
diff --git a/Test/Common.lean b/Test/Common.lean
new file mode 100644
index 0000000..3e52932
--- /dev/null
+++ b/Test/Common.lean
@@ -0,0 +1,19 @@
+import Pantograph.Protocol
+
+namespace Pantograph
+
+namespace Protocol
+/-- Set internal names to "" -/
+def Goal.devolatilize (goal: Goal): Goal :=
+ {
+ goal with
+ vars := goal.vars.map removeInternalAux,
+ }
+ where removeInternalAux (v: Variable): Variable :=
+ {
+ v with
+ name := ""
+ }
+end Protocol
+
+end Pantograph
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ac9c78c..d609dd4 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -4,6 +4,7 @@ Tests pertaining to goals with no interdependencies
import LSpec
import Pantograph.Goal
import Pantograph.Serial
+import Test.Common
namespace Pantograph
@@ -69,7 +70,7 @@ def buildGoal (nameType: List (String × String)) (target: String): Protocol.Goa
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
- name := x.fst,
+ userName := x.fst,
type? := .some { pp? := .some x.snd },
isInaccessible? := .some false
})).toArray
@@ -79,7 +80,7 @@ def buildGoalSelective (nameType: List (String × Option String)) (target: Strin
{
target := { pp? := .some target},
vars := (nameType.map fun x => ({
- name := x.fst,
+ userName := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
isInaccessible? := x.snd.map (λ _ => false)
})).toArray
@@ -104,7 +105,6 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
| .ok (_, a) =>
return a
-
-- Individual test cases
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
@@ -125,7 +125,7 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intro n m" (goal1 = buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n")
+ addTest $ LSpec.check "intro n m" (goal1.devolatilize = buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n")
match ← state1.execute (goalId := 0) (tactic := "assumption") with
| .failure #[message] =>
@@ -170,14 +170,14 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "p q h" (goal1 = buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p")
+ addTest $ LSpec.check "p q h" (goal1.devolatilize = buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p")
let (state2, goal1, goal2) ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
| .success state #[goal1, goal2] => pure (state, goal1, goal2)
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "cases h/1" (goal1 = branchGoal "inl" "p")
- addTest $ LSpec.check "cases h/2" (goal2 = branchGoal "inr" "q")
+ addTest $ LSpec.check "cases h/1" (goal1.devolatilize = branchGoal "inl" "p")
+ addTest $ LSpec.check "cases h/2" (goal2.devolatilize = branchGoal "inr" "q")
let (state3_1, _goal) ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state #[goal] => pure (state, goal)
@@ -200,6 +200,7 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "4_2 root" state4_2.rootExpr.isNone
-- Ensure the proof can continue from `state4_2`.
let state2b ← match state2.continue state4_2 with
| .error msg => do
@@ -217,8 +218,8 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- IO.println "===== 4_1 ====="
- state4_1.print ({ printNonVisible := false })
+ state4_1.print
+ addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome
return ()
where
@@ -227,9 +228,9 @@ def proof_or_comm: TestM Unit := do
caseName? := .some caseName,
target := { pp? := .some "q ∨ p" },
vars := #[
- { name := "p", type? := .some typeProp, isInaccessible? := .some false },
- { name := "q", type? := .some typeProp, isInaccessible? := .some false },
- { name := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
+ { userName := "p", type? := .some typeProp, isInaccessible? := .some false },
+ { userName := "q", type? := .some typeProp, isInaccessible? := .some false },
+ { userName := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
]
}
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 30d6f60..9a42992 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -47,8 +47,8 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := str_to_name symbol |> env.find? |>.get! |>.type
- let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
- return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
+ let test := LSpec.check symbol ((serialize_expression_ast expr) = target)
+ return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let coreM := metaM.run'
let coreContext: Core.Context := {
currNamespace := Lean.Name.str .anonymous "Aniva"
From c852db2f46f6e28efb2b63cc72d8e77ef651fbba Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 26 Oct 2023 11:22:02 -0700
Subject: [PATCH 030/465] test: m-coupled goals
---
Pantograph/Goal.lean | 8 +++--
Test/Proofs.lean | 85 ++++++++++++++++++++++++++++++++------------
2 files changed, 69 insertions(+), 24 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 4e57134..884b8a0 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -38,9 +38,13 @@ protected def GoalState.create (expr: Expr): M GoalState := do
root,
newMVars := SSet.insert .empty root,
}
-protected def GoalState.goals (goalState: GoalState): List MVarId := goalState.savedState.tactic.goals
+protected def GoalState.goals (state: GoalState): List MVarId := state.savedState.tactic.goals
-private def GoalState.mctx (state: GoalState): MetavarContext :=
+protected def GoalState.runM {α: Type} (state: GoalState) (m: Elab.TermElabM α) : M α := do
+ state.savedState.term.restore
+ m
+
+protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index d609dd4..a3d26fe 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -141,6 +141,37 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
return ()
+example (w x y z : Nat) (p : Nat → Prop)
+ (h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
+ simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
+ assumption
+def proof_arith: TestM Unit := do
+ let state? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let (state1, goal) ← match ← state0.execute (goalId := 0) (tactic := "intros") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "1 root" state1.rootExpr.isNone
+ let (state2, goal) ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
+ | .success state #[goal] => pure (state, goal)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "2 root" state2.rootExpr.isNone
+ let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "3 root" state3.rootExpr.isSome
+ return ()
-- Two ways to write the same theorem
example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
@@ -218,7 +249,6 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- state4_1.print
addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome
return ()
@@ -234,25 +264,35 @@ def proof_or_comm: TestM Unit := do
]
}
---example (w x y z : Nat) (p : Nat → Prop)
--- (h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
--- simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
--- assumption
---def proof_arith_1: TestM Unit := do
--- let goal? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
--- addTest $ LSpec.check "Start goal" goal?.isSome
--- if let .some goal := goal? then
--- if let .success #[(goal, _)] ← goal.execute "intros" then
--- if let .success #[(goal, _)] ← goal.execute "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *" then
--- if let .success #[] ← goal.execute "assumption" then
--- return ()
--- else
--- addTest $ assertUnreachable "assumption"
--- else
--- addTest $ assertUnreachable "simp ..."
--- else
--- addTest $ assertUnreachable "intros"
---
+/-- M-coupled goals -/
+def proof_m_couple: TestM Unit := do
+ let state? ← startProof (.expr "(2: Nat) ≤ 5")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let (state1, goalL, goalR, goalM) ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ | .success state #[goalL, goalR, goalM] => pure (state, goalL, goalR, goalM)
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "2 ≤ ?m" (goalL.target.pp? = .some "2 ≤ ?m")
+ addTest $ LSpec.test "?m ≤ 5" (goalR.target.pp? = .some "?m ≤ 5")
+ addTest $ LSpec.test "Nat" (goalM.target.pp? = .some "Nat")
+ -- Set m to 3
+ let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
+ | .success state #[] => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state1b ← match state1.continue state2 with
+ | .ok state => pure state
+ | .error error => do
+ addTest $ assertUnreachable $ error
+ return ()
+ state1b.print
--def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
-- let goal? ← startProof (.expr "∀ (a b: Nat), a + b = b + a")
-- addTest $ LSpec.check "Start goal" goal?.isSome
@@ -278,8 +318,9 @@ def suite: IO LSpec.TestSeq := do
let tests := [
("Nat.add_comm", proof_nat_add_comm false),
("Nat.add_comm manual", proof_nat_add_comm true),
- ("Or.comm", proof_or_comm)
- --("arithmetic 1", proof_arith_1),
+ ("arithmetic", proof_arith),
+ ("Or.comm", proof_or_comm),
+ ("2 < 5", proof_m_couple)
--("delta variable", proof_delta_variable)
]
let tests ← tests.foldlM (fun acc tests => do
From 269e5c707c7bb182562d45cd6b57ccc2d6703b8d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 26 Oct 2023 22:47:42 -0700
Subject: [PATCH 031/465] refactor: Separate goal printing and processing
Added a test for delta proof variables
---
Pantograph.lean | 10 +--
Pantograph/Goal.lean | 75 +++----------------
Pantograph/Protocol.lean | 9 ++-
Pantograph/Serial.lean | 72 ++++++++++++++++--
Test/Proofs.lean | 158 +++++++++++++++++++++++----------------
5 files changed, 181 insertions(+), 143 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 0e74e81..29f9bd5 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -110,7 +110,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
printExprPretty := args.printExprPretty?.getD options.printExprPretty,
printExprAST := args.printExprAST?.getD options.printExprAST,
- proofVariableDelta := args.proofVariableDelta?.getD options.proofVariableDelta,
+ noRepeat := args.noRepeat?.getD options.noRepeat,
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
}
@@ -148,14 +148,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match state.goalStates.get? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState =>
- let result ← GoalState.execute goalState args.goalId args.tactic |>.run state.options
- match result with
- | .success nextGoalState goals =>
+ match ← GoalState.execute goalState args.goalId args.tactic with
+ | .success nextGoalState =>
let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
set { state with goalStates }
+ let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
- goals? := .some goals
+ goals? := .some goals,
}
| .parseError message =>
return .ok { parseError? := .some message }
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 884b8a0..1f3f71a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -1,8 +1,6 @@
import Lean
import Pantograph.Symbol
-import Pantograph.Serial
-import Pantograph.Protocol
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
{
@@ -21,6 +19,9 @@ structure GoalState where
-- New metavariables acquired in this state
newMVars: SSet MVarId
+ -- The id of the goal in the parent
+ parentGoalId: Nat := 0
+
abbrev M := Elab.TermElabM
protected def GoalState.create (expr: Expr): M GoalState := do
@@ -49,6 +50,7 @@ protected def GoalState.mctx (state: GoalState): MetavarContext :=
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
+/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
@@ -71,7 +73,7 @@ def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax
/-- Response for executing a tactic -/
inductive TacticResult where
-- Goes to next state
- | success (state: GoalState) (goals: Array Protocol.Goal)
+ | success (state: GoalState)
-- Tactic failed with messages
| failure (messages: Array String)
-- Could not parse tactic
@@ -81,7 +83,7 @@ inductive TacticResult where
/-- Execute tactic on given state -/
protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String):
- Protocol.OptionsT M TacticResult := do
+ M TacticResult := do
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
@@ -92,7 +94,6 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
(fileName := "<stdin>") with
| .ok stx => pure $ stx
| .error error => return .parseError error
- let options ← read
match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
| .error errors =>
return .failure errors
@@ -110,20 +111,12 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
else
return acc.insert mvarId
) SSet.empty
- let nextState: GoalState := {
+ return .success {
savedState := nextSavedState
root := state.root,
newMVars,
+ parentGoalId := goalId,
}
- nextSavedState.term.restore
- let parentDecl? := (← MonadMCtx.getMCtx).findDecl? goal
- let goals ← nextGoals.mapM fun nextGoal => do
- match (← MonadMCtx.getMCtx).findDecl? nextGoal with
- | .some mvarDecl =>
- let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
- return serializedGoal
- | .none => throwError s!"Parent mvar id does not exist {nextGoal.name}"
- return .success nextState goals.toArray
/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
protected def GoalState.continue (target: GoalState) (graftee: GoalState): Except String GoalState :=
@@ -150,57 +143,11 @@ protected def GoalState.rootExpr (goalState: GoalState): Option Expr :=
let expr := goalState.mctx.eAssignment.find! goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasMVar then
+ -- Must not assert that the goal state is empty here. We could be in a branch goal.
+ --assert! ¬goalState.goals.isEmpty
.none
else
+ assert! goalState.goals.isEmpty
.some expr
--- Diagnostics functions
-
-/-- Print the metavariables in a readable format -/
-protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): M Unit := do
- let savedState := goalState.savedState
- savedState.term.restore
- let goals := savedState.tactic.goals
- let mctx ← getMCtx
- let root := goalState.root
- -- Print the root
- match mctx.decls.find? root with
- | .some decl => printMVar ">" root decl
- | .none => IO.println s!">{root.name}: ??"
- goals.forM (fun mvarId => do
- if mvarId != root then
- match mctx.decls.find? mvarId with
- | .some decl => printMVar "⊢" mvarId decl
- | .none => IO.println s!"⊢{mvarId.name}: ??"
- )
- let goals := goals.toSSet
- mctx.decls.forM (fun mvarId decl => do
- if goals.contains mvarId || mvarId == root then
- pure ()
- -- Always print the root goal
- else if mvarId == goalState.root then
- printMVar (pref := ">") mvarId decl
- -- Print the remainig ones that users don't see in Lean
- else if options.printNonVisible then
- let pref := if goalState.newMVars.contains mvarId then "~" else " "
- printMVar pref mvarId decl
- else
- pure ()
- --IO.println s!" {mvarId.name}{userNameToString decl.userName}"
- )
- where
- printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): Elab.TermElabM Unit := do
- if options.printContext then
- decl.lctx.fvarIdToDecl.forM printFVar
- let type_sexp := serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
- IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
- if options.printValue then
- if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
- IO.println s!" = {← Meta.ppExpr value}"
- printFVar (fvarId: FVarId) (decl: LocalDecl): Elab.TermElabM Unit := do
- IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
- userNameToString : Name → String
- | .anonymous => ""
- | other => s!"[{other}]"
-
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index a6bae29..1c05227 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -18,9 +18,10 @@ structure Options where
printExprPretty: Bool := true
-- When enabled, print the raw AST of expressions
printExprAST: Bool := false
- -- When enabled, the types and values of persistent variables in a proof goal
- -- are not shown unless they are new to the proof step. Reduces overhead
- proofVariableDelta: Bool := false
+ -- When enabled, the types and values of persistent variables in a goal
+ -- are not shown unless they are new to the proof step. Reduces overhead.
+ -- NOTE: that this assumes the type and assignment of variables can never change.
+ noRepeat: Bool := false
-- See `pp.auxDecls`
printAuxDecls: Bool := false
-- See `pp.implementationDetailHyps`
@@ -123,7 +124,7 @@ structure OptionsSet where
printJsonPretty?: Option Bool
printExprPretty?: Option Bool
printExprAST?: Option Bool
- proofVariableDelta?: Option Bool
+ noRepeat?: Option Bool
printAuxDecls?: Option Bool
printImplementationDetailHyps?: Option Bool
deriving Lean.FromJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 99f95ef..87552eb 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -4,6 +4,7 @@ All serialisation functions
import Lean
import Pantograph.Protocol
+import Pantograph.Goal
namespace Pantograph
open Lean
@@ -173,12 +174,12 @@ def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp := toString (← Meta.ppExpr e)
let pp?: Option String := match options.printExprPretty with
- | true => .some pp
- | false => .none
+ | true => .some pp
+ | false => .none
let sexp: String := serialize_expression_ast e
let sexp?: Option String := match options.printExprAST with
- | true => .some sexp
- | false => .none
+ | true => .some sexp
+ | false => .none
return {
pp?,
sexp?
@@ -239,7 +240,7 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
if skip then
return acc
else
- let nameOnly := options.proofVariableDelta && (parentDecl?.map
+ let nameOnly := options.noRepeat && (parentDecl?.map
(λ decl => decl.lctx.find? localDecl.fvarId |>.isSome) |>.getD false)
let var ← match nameOnly with
| true => ppVarNameOnly localDecl
@@ -254,6 +255,67 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
where
of_name (n: Name) := name_to_ast n (sanitize := false)
+protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalState := .none) (options: Protocol.Options := {}): MetaM (Array Protocol.Goal):= do
+ let goals := state.goals.toArray
+ state.savedState.term.meta.restore
+ let parentDecl? := parent.bind (λ parentState =>
+ let parentGoal := parentState.goals.get! state.parentGoalId
+ parentState.mctx.findDecl? parentGoal)
+ goals.mapM fun goal => do
+ if options.noRepeat then
+ let key := if parentDecl?.isSome then "is some" else "is none"
+ IO.println s!"goal: {goal.name}, {key}"
+ match state.mctx.findDecl? goal with
+ | .some mvarDecl =>
+ let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
+ pure serializedGoal
+ | .none => throwError s!"Metavariable does not exist in context {goal.name}"
+/-- Print the metavariables in a readable format -/
+protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): MetaM Unit := do
+ let savedState := goalState.savedState
+ savedState.term.meta.restore
+ let goals := savedState.tactic.goals
+ let mctx ← getMCtx
+ let root := goalState.root
+ -- Print the root
+ match mctx.decls.find? root with
+ | .some decl => printMVar ">" root decl
+ | .none => IO.println s!">{root.name}: ??"
+ goals.forM (fun mvarId => do
+ if mvarId != root then
+ match mctx.decls.find? mvarId with
+ | .some decl => printMVar "⊢" mvarId decl
+ | .none => IO.println s!"⊢{mvarId.name}: ??"
+ )
+ let goals := goals.toSSet
+ mctx.decls.forM (fun mvarId decl => do
+ if goals.contains mvarId || mvarId == root then
+ pure ()
+ -- Always print the root goal
+ else if mvarId == goalState.root then
+ printMVar (pref := ">") mvarId decl
+ -- Print the remainig ones that users don't see in Lean
+ else if options.printNonVisible then
+ let pref := if goalState.newMVars.contains mvarId then "~" else " "
+ printMVar pref mvarId decl
+ else
+ pure ()
+ --IO.println s!" {mvarId.name}{userNameToString decl.userName}"
+ )
+ where
+ printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
+ if options.printContext then
+ decl.lctx.fvarIdToDecl.forM printFVar
+ let type_sexp := serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
+ IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
+ if options.printValue then
+ if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
+ IO.println s!" = {← Meta.ppExpr value}"
+ printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM Unit := do
+ IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
+ userNameToString : Name → String
+ | .anonymous => ""
+ | other => s!"[{other}]"
end Pantograph
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a3d26fe..79f0f38 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -9,7 +9,7 @@ import Test.Common
namespace Pantograph
def TacticResult.toString : TacticResult → String
- | .success _ goals => s!".success ({goals.size} goals)"
+ | .success state => s!".success ({state.goals.length} goals)"
| .failure messages =>
let messages := "\n".intercalate messages.toList
s!".failure {messages}"
@@ -75,16 +75,6 @@ def buildGoal (nameType: List (String × String)) (target: String): Protocol.Goa
isInaccessible? := .some false
})).toArray
}
--- Like `buildGoal` but allow certain variables to be elided.
-def buildGoalSelective (nameType: List (String × Option String)) (target: String): Protocol.Goal :=
- {
- target := { pp? := .some target},
- vars := (nameType.map fun x => ({
- userName := x.fst,
- type? := x.snd.map (λ type => { pp? := type }),
- isInaccessible? := x.snd.map (λ _ => false)
- })).toArray
- }
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
@@ -120,12 +110,13 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let (state1, goal1) ← match ← state0.execute (goalId := 0) (tactic := "intro n m") with
- | .success state #[goal] => pure (state, goal)
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n m") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intro n m" (goal1.devolatilize = buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n")
+ addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"])
match ← state1.execute (goalId := 0) (tactic := "assumption") with
| .failure #[message] =>
@@ -134,12 +125,49 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ assertUnreachable $ other.toString
let state2 ← match ← state1.execute (goalId := 0) (tactic := "rw [Nat.add_comm]") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.test "rw [Nat.add_comm]" state2.goals.isEmpty
return ()
+def proof_delta_variable: TestM Unit := do
+ let options: Protocol.Options := { noRepeat := true }
+ let state? ← startProof <| .expr "∀ (a b: Nat), a + b = b + a"
+ addTest $ LSpec.check "Start goal" state?.isSome
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "intro n" ((← state1.serializeGoals (parent := state0) options).map (·.devolatilize) =
+ #[buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"])
+ let state2 ← match ← state1.execute (goalId := 0) (tactic := "intro m") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "intro m" ((← state2.serializeGoals (parent := state1) options).map (·.devolatilize) =
+ #[buildGoalSelective [("n", .none), ("m", .some "Nat")] "n + m = m + n"])
+ return ()
+ where
+-- Like `buildGoal` but allow certain variables to be elided.
+ buildGoalSelective (nameType: List (String × Option String)) (target: String): Protocol.Goal :=
+ {
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ userName := x.fst,
+ type? := x.snd.map (λ type => { pp? := type }),
+ isInaccessible? := x.snd.map (λ _ => false)
+ })).toArray
+ }
example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
@@ -153,23 +181,26 @@ def proof_arith: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let (state1, goal) ← match ← state0.execute (goalId := 0) (tactic := "intros") with
- | .success state #[goal] => pure (state, goal)
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "intros") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "1 root" state1.rootExpr.isNone
- let (state2, goal) ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
- | .success state #[goal] => pure (state, goal)
+ addTest $ LSpec.check "intros" (state1.goals.length = 1)
+ addTest $ LSpec.test "1 root" state1.rootExpr.isNone
+ let state2 ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
addTest $ LSpec.check "2 root" state2.rootExpr.isNone
let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.test "assumption" state3.goals.isEmpty
addTest $ LSpec.check "3 root" state3.rootExpr.isSome
return ()
@@ -196,59 +227,66 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let (state1, goal1) ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
- | .success state #[goal] => pure (state, goal)
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "p q h" (goal1.devolatilize = buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p")
- let (state2, goal1, goal2) ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
- | .success state #[goal1, goal2] => pure (state, goal1, goal2)
+ addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"])
+ let state2 ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "cases h/1" (goal1.devolatilize = branchGoal "inl" "p")
- addTest $ LSpec.check "cases h/2" (goal2.devolatilize = branchGoal "inr" "q")
+ addTest $ LSpec.check "cases h" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[branchGoal "inl" "p", branchGoal "inr" "q"])
- let (state3_1, _goal) ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
- | .success state #[goal] => pure (state, goal)
+ let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let (state3_2, _goal) ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
- | .success state #[goal] => pure (state, goal)
+ addTest $ LSpec.check "· assumption" state4_1.goals.isEmpty
+ addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr.isNone
+ let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "· apply Or.inl" (state3_2.goals.length = 1)
let state4_2 ← match ← state3_2.execute (goalId := 0) (tactic := "assumption") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
-
- addTest $ LSpec.check "4_2 root" state4_2.rootExpr.isNone
+ addTest $ LSpec.check "· assumption" state4_2.goals.isEmpty
+ addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr.isNone
-- Ensure the proof can continue from `state4_2`.
let state2b ← match state2.continue state4_2 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
- addTest $ LSpec.test "state2b" (state2b.goals == [state2.goals.get! 0])
- let (state3_1, _goal) ← match ← state2b.execute (goalId := 0) (tactic := "apply Or.inr") with
- | .success state #[goal] => pure (state, goal)
+ addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals.get! 0])
+ let state3_1 ← match ← state2b.execute (goalId := 0) (tactic := "apply Or.inr") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.check "· assumption" state4_1.goals.isEmpty
addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome
return ()
@@ -273,41 +311,30 @@ def proof_m_couple: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let (state1, goalL, goalR, goalM) ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
- | .success state #[goalL, goalR, goalM] => pure (state, goalL, goalR, goalM)
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.test "2 ≤ ?m" (goalL.target.pp? = .some "2 ≤ ?m")
- addTest $ LSpec.test "?m ≤ 5" (goalR.target.pp? = .some "?m ≤ 5")
- addTest $ LSpec.test "Nat" (goalM.target.pp? = .some "Nat")
+ addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
+ addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
-- Set m to 3
let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
- | .success state #[] => pure state
+ | .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ addTest $ LSpec.test "(1b root)" state2.rootExpr.isNone
let state1b ← match state1.continue state2 with
- | .ok state => pure state
- | .error error => do
- addTest $ assertUnreachable $ error
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
return ()
- state1b.print
---def proof_delta_variable: TestM Unit := withReader (fun _ => {proofVariableDelta := true}) do
--- let goal? ← startProof (.expr "∀ (a b: Nat), a + b = b + a")
--- addTest $ LSpec.check "Start goal" goal?.isSome
--- if let .some goal := goal? then
--- if let .success #[(goal, sGoal)] ← goal.execute "intro n" then
--- let sGoal1e: Protocol.Goal :=buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"
--- addTest $ LSpec.check "intro n" (sGoal = sGoal1e)
---
--- if let .success #[(_, sGoal)] ← goal.execute "intro m" then
--- let sGoal2e: Protocol.Goal :=buildGoalSelective [("n", .none), ("m", .some "Nat")] "n + m = m + n"
--- addTest $ LSpec.check "intro m" (sGoal = sGoal2e)
--- else
--- addTest $ assertUnreachable "intro m"
--- else
--- addTest $ assertUnreachable "intro n"
+ | .ok state => pure state
+ addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ 3", .some "3 ≤ 5"])
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr.isNone
+ return ()
/-- Tests the most basic form of proofs whose goals do not relate to each other -/
def suite: IO LSpec.TestSeq := do
@@ -318,6 +345,7 @@ def suite: IO LSpec.TestSeq := do
let tests := [
("Nat.add_comm", proof_nat_add_comm false),
("Nat.add_comm manual", proof_nat_add_comm true),
+ ("Nat.add_comm delta", proof_delta_variable),
("arithmetic", proof_arith),
("Or.comm", proof_or_comm),
("2 < 5", proof_m_couple)
From f064bb21a41ce62e27376887e2c0faeea253a4f0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 27 Oct 2023 15:15:22 -0700
Subject: [PATCH 032/465] feat: Assigning a goal with an expression
---
Pantograph/Goal.lean | 67 +++++++++++++++++++++++++++++++++++-----
Pantograph/Protocol.lean | 3 +-
Pantograph/Serial.lean | 5 +--
Test/Proofs.lean | 61 +++++++++++++++++++++++++++++-------
4 files changed, 112 insertions(+), 24 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 1f3f71a..3be34ad 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -47,13 +47,15 @@ protected def GoalState.runM {α: Type} (state: GoalState) (m: Elab.TermElabM α
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
+protected def GoalState.env (state: GoalState): Environment :=
+ state.savedState.term.meta.core.env
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
- M (Except (Array String) (Elab.Tactic.SavedState × List MVarId)):= do
- let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) (Elab.Tactic.SavedState × List MVarId)) := do
+ M (Except (Array String) Elab.Tactic.SavedState):= do
+ let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) Elab.Tactic.SavedState) := do
state.restore
Elab.Tactic.setGoals [goal]
try
@@ -63,9 +65,7 @@ def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .error errors
else
- let unsolved ← Elab.Tactic.getUnsolvedGoals
- -- The order of evaluation is important here, since `getUnsolvedGoals` prunes the goals set
- return .ok (← MonadBacktrack.saveState, unsolved)
+ return .ok (← MonadBacktrack.saveState)
catch exception =>
return .error #[← exception.toMessageData.toString]
tacticM tactic { elaborator := .anonymous } |>.run' state.tactic
@@ -97,8 +97,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
| .error errors =>
return .failure errors
- | .ok (nextSavedState, nextGoals) =>
- assert! nextSavedState.tactic.goals.length == nextGoals.length
+ | .ok nextSavedState =>
-- Assert that the definition of metavariables are the same
let nextMCtx := nextSavedState.term.meta.meta.mctx
let prevMCtx := state.savedState.term.meta.meta.mctx
@@ -112,12 +111,64 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
return acc.insert mvarId
) SSet.empty
return .success {
+ state with
savedState := nextSavedState
- root := state.root,
newMVars,
parentGoalId := goalId,
}
+protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let expr ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := expr)
+ (fileName := "<stdin>") with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ let tacticM: Elab.Tactic.TacticM TacticResult := do
+ state.savedState.restore
+ Elab.Tactic.setGoals [goal]
+ try
+ let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
+ -- Attempt to unify the expression
+ let goalType ← goal.getType
+ let exprType ← Meta.inferType expr
+ if !(← Meta.isDefEq goalType exprType) then
+ return .failure #["Type unification failed", toString (← Meta.ppExpr goalType), toString (← Meta.ppExpr exprType)]
+ goal.checkNotAssigned `GoalState.tryAssign
+ goal.assign expr
+ if (← getThe Core.State).messages.hasErrors then
+ let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
+ let errors ← (messages.map Message.data).mapM fun md => md.toString
+ return .failure errors
+ else
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ let nextMCtx ← getMCtx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ return acc
+ else
+ return mvarId :: acc
+ ) []
+ -- The new goals are the newMVars that lack an assignment
+ Elab.Tactic.setGoals (← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned)))
+ let nextSavedState ← MonadBacktrack.saveState
+ return .success {
+ state with
+ savedState := nextSavedState,
+ newMVars := newMVars.toSSet,
+ parentGoalId := goalId,
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+ tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+
/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
protected def GoalState.continue (target: GoalState) (graftee: GoalState): Except String GoalState :=
if target.root != graftee.root then
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 1c05227..b0e7744 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -172,7 +172,8 @@ structure GoalPrint where
printContext: Bool := true
printValue: Bool := true
printNewMVars: Bool := false
- printNonVisible: Bool := false
+ -- Print all mvars
+ printAll: Bool := false
end Pantograph.Protocol
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 87552eb..1a07444 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -262,9 +262,6 @@ protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalSt
let parentGoal := parentState.goals.get! state.parentGoalId
parentState.mctx.findDecl? parentGoal)
goals.mapM fun goal => do
- if options.noRepeat then
- let key := if parentDecl?.isSome then "is some" else "is none"
- IO.println s!"goal: {goal.name}, {key}"
match state.mctx.findDecl? goal with
| .some mvarDecl =>
let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
@@ -296,7 +293,7 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrin
else if mvarId == goalState.root then
printMVar (pref := ">") mvarId decl
-- Print the remainig ones that users don't see in Lean
- else if options.printNonVisible then
+ else if options.printAll then
let pref := if goalState.newMVars.contains mvarId then "~" else " "
printMVar pref mvarId decl
else
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 79f0f38..809cf50 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -66,8 +66,9 @@ def startProof (start: Start): TestM (Option GoalState) := do
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
-def buildGoal (nameType: List (String × String)) (target: String): Protocol.Goal :=
+def buildGoal (nameType: List (String × String)) (target: String) (caseName?: Option String := .none): Protocol.Goal :=
{
+ caseName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
@@ -187,21 +188,21 @@ def proof_arith: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intros" (state1.goals.length = 1)
- addTest $ LSpec.test "1 root" state1.rootExpr.isNone
+ addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
let state2 ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
- addTest $ LSpec.check "2 root" state2.rootExpr.isNone
+ addTest $ LSpec.check "(2 root)" state2.rootExpr.isNone
let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "assumption" state3.goals.isEmpty
- addTest $ LSpec.check "3 root" state3.rootExpr.isSome
+ addTest $ LSpec.check "(3 root)" state3.rootExpr.isSome
return ()
-- Two ways to write the same theorem
@@ -253,7 +254,7 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "· assumption" state4_1.goals.isEmpty
+ addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr.isNone
let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
@@ -266,7 +267,7 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "· assumption" state4_2.goals.isEmpty
+ addTest $ LSpec.check " assumption" state4_2.goals.isEmpty
addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr.isNone
-- Ensure the proof can continue from `state4_2`.
let state2b ← match state2.continue state4_2 with
@@ -286,8 +287,8 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "· assumption" state4_1.goals.isEmpty
- addTest $ LSpec.check "4_1 root" state4_1.rootExpr.isSome
+ addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
+ addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr.isSome
return ()
where
@@ -336,7 +337,45 @@ def proof_m_couple: TestM Unit := do
addTest $ LSpec.test "(2 root)" state1b.rootExpr.isNone
return ()
-/-- Tests the most basic form of proofs whose goals do not relate to each other -/
+def proof_proposition_generation: TestM Unit := do
+ let state? ← startProof (.expr "Σ' p:Prop, p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply PSigma.mk") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply PSigma.mk" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ buildGoal [] "?fst" (caseName? := .some "snd"),
+ buildGoal [] "Prop" (caseName? := .some "fst")
+ ])
+ addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
+
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
+ addTest $ LSpec.test "(2 root)" state2.rootExpr.isNone
+
+ let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[])
+ addTest $ LSpec.test "(3 root)" state3.rootExpr.isSome
+ return ()
+
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := #[{ module := Name.append .anonymous "Init", runtimeOnly := false}])
@@ -348,8 +387,8 @@ def suite: IO LSpec.TestSeq := do
("Nat.add_comm delta", proof_delta_variable),
("arithmetic", proof_arith),
("Or.comm", proof_or_comm),
- ("2 < 5", proof_m_couple)
- --("delta variable", proof_delta_variable)
+ ("2 < 5", proof_m_couple),
+ ("Proposition Generation", proof_proposition_generation)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
From 3b1746490d0ca76cbf22ca668e8b5d0046e29328 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 27 Oct 2023 15:32:59 -0700
Subject: [PATCH 033/465] feat: Add REPL command for assigning an expression
---
Pantograph.lean | 24 +++++++++++++++---------
Pantograph/Protocol.lean | 4 +++-
Test/Integration.lean | 21 ++++++++++++++++++++-
3 files changed, 38 insertions(+), 11 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 29f9bd5..dd25e9f 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -133,9 +133,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
(match env.find? <| str_to_name copyFrom with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok cInfo.type)
- | .none, .none =>
- return .error <| errorI "arguments" "At least one of {expr, copyFrom} must be supplied"
- | _, _ => return .error <| errorI "arguments" "Cannot populate both of {expr, copyFrom}")
+ | _, _ =>
+ return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
match expr? with
| .error error => return .error error
| .ok expr =>
@@ -147,9 +146,16 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
match state.goalStates.get? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
- | .some goalState =>
- match ← GoalState.execute goalState args.goalId args.tactic with
- | .success nextGoalState =>
+ | .some goalState => do
+ let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
+ | .some tactic, .none => do
+ pure ( Except.ok (← GoalState.execute goalState args.goalId tactic))
+ | .none, .some expr => do
+ pure ( Except.ok (← GoalState.tryAssign goalState args.goalId expr))
+ | _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr} must be supplied")
+ match nextGoalState? with
+ | .error error => return .error error
+ | .ok (.success nextGoalState) =>
let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
set { state with goalStates }
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
@@ -157,11 +163,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
nextStateId? := .some nextStateId,
goals? := .some goals,
}
- | .parseError message =>
+ | .ok (.parseError message) =>
return .ok { parseError? := .some message }
- | .indexError goalId =>
+ | .ok (.indexError goalId) =>
return .error $ errorIndex s!"Invalid goal id index {goalId}"
- | .failure messages =>
+ | .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index b0e7744..62700c4 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -146,7 +146,9 @@ structure GoalTactic where
-- Identifiers for tree, state, and goal
stateId: Nat
goalId: Nat := 0
- tactic: String
+ -- One of the fields here must be filled
+ tactic?: Option String := .none
+ expr?: Option String := .none
deriving Lean.FromJson
structure GoalTacticResult where
-- The next goal state id. Existence of this field shows success
diff --git a/Test/Integration.lean b/Test/Integration.lean
index b7a5e62..39f145e 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -82,12 +82,31 @@ def test_malformed_command : IO LSpec.TestSeq :=
error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected"}:
Protocol.InteractionError))
]
+def test_tactic : IO LSpec.TestSeq :=
+ let goal: Protocol.Goal := {
+ target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
+ vars := #[{ name := "_uniq 9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
+ }
+ subroutine_runner [
+ subroutine_step "goal.start"
+ [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
+ (Lean.toJson ({stateId := 0}:
+ Protocol.GoalStartResult)),
+ subroutine_step "goal.tactic"
+ [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
+ (Lean.toJson ({
+ nextStateId? := .some 1,
+ goals? := #[goal],
+ }:
+ Protocol.GoalTacticResult))
+ ]
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 "Malformed command" (← test_malformed_command)) ++
+ (LSpec.group "Tactic" (← test_tactic))
end Pantograph.Test.Integration
From 045181356c9e906b0397b1ca0792d36663f01974 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 27 Oct 2023 15:41:12 -0700
Subject: [PATCH 034/465] feat: Add REPL function for root expression
---
Pantograph.lean | 10 ++++++++++
Pantograph/Goal.lean | 2 +-
Pantograph/Protocol.lean | 9 +++++++++
Pantograph/Serial.lean | 2 +-
README.md | 5 +++--
Test/Proofs.lean | 24 ++++++++++++------------
6 files changed, 36 insertions(+), 16 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index dd25e9f..00782d5 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -39,6 +39,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.start" => run goal_start
| "goal.tactic" => run goal_tactic
| "goal.delete" => run goal_delete
+ | "goal.print" => run goal_print
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -174,5 +175,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
set { state with goalStates }
return .ok {}
+ goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
+ let state ← get
+ match state.goalStates.get? args.stateId with
+ | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ | .some goalState => do
+ let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
+ return .ok {
+ root?,
+ }
end Pantograph
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 3be34ad..78a4194 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -190,7 +190,7 @@ protected def GoalState.continue (target: GoalState) (graftee: GoalState): Excep
newMVars := graftee.newMVars,
}
-protected def GoalState.rootExpr (goalState: GoalState): Option Expr :=
+protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
let expr := goalState.mctx.eAssignment.find! goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasMVar then
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 62700c4..e379782 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -171,6 +171,15 @@ structure GoalDeleteResult where
deriving Lean.ToJson
structure GoalPrint where
+ stateId: Nat
+ deriving Lean.FromJson
+structure GoalPrintResult where
+ -- The root expression
+ root?: Option Expression
+ deriving Lean.ToJson
+
+-- Diagnostic Options, not available in REPL
+structure GoalDiag where
printContext: Bool := true
printValue: Bool := true
printNewMVars: Bool := false
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 1a07444..62321bd 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -269,7 +269,7 @@ protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalSt
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
/-- Print the metavariables in a readable format -/
-protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalPrint := {}): MetaM Unit := do
+protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
let savedState := goalState.savedState
savedState.term.meta.restore
let goals := savedState.tactic.goals
diff --git a/README.md b/README.md
index 442b57d..0c19a3a 100644
--- a/README.md
+++ b/README.md
@@ -76,8 +76,9 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
have to be set via command line arguments.), for options, see `Pantograph/Commands.lean`
- `options.print`: Display the current set of options
- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
-- `goal.tactic {"goalId": <id>, "tactic": <tactic>}`: Execute a tactic string on a given goal
-- `goal.remove {"goalIds": [<id>]}"`: Remove a bunch of stored goals.
+- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr": <expr>]}`: Execute a tactic string on a given goal
+- `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
+- `goal.print {"stateId": <id>}"`: Print a goal state
- `stat`: Display resource usage
## Errors
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 809cf50..a726627 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -188,21 +188,21 @@ def proof_arith: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intros" (state1.goals.length = 1)
- addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
+ addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
- addTest $ LSpec.check "(2 root)" state2.rootExpr.isNone
+ addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "assumption" state3.goals.isEmpty
- addTest $ LSpec.check "(3 root)" state3.rootExpr.isSome
+ addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
return ()
-- Two ways to write the same theorem
@@ -255,7 +255,7 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
- addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr.isNone
+ addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
| other => do
@@ -268,7 +268,7 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_2.goals.isEmpty
- addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr.isNone
+ addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr?.isNone
-- Ensure the proof can continue from `state4_2`.
let state2b ← match state2.continue state4_2 with
| .error msg => do
@@ -288,7 +288,7 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
- addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr.isSome
+ addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isSome
return ()
where
@@ -319,14 +319,14 @@ def proof_m_couple: TestM Unit := do
return ()
addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
- addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
+ addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
-- Set m to 3
let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.test "(1b root)" state2.rootExpr.isNone
+ addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
let state1b ← match state1.continue state2 with
| .error msg => do
addTest $ assertUnreachable $ msg
@@ -334,7 +334,7 @@ def proof_m_couple: TestM Unit := do
| .ok state => pure state
addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 3", .some "3 ≤ 5"])
- addTest $ LSpec.test "(2 root)" state1b.rootExpr.isNone
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
return ()
def proof_proposition_generation: TestM Unit := do
@@ -355,7 +355,7 @@ def proof_proposition_generation: TestM Unit := do
buildGoal [] "?fst" (caseName? := .some "snd"),
buildGoal [] "Prop" (caseName? := .some "fst")
])
- addTest $ LSpec.test "(1 root)" state1.rootExpr.isNone
+ addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
| .success state => pure state
@@ -364,7 +364,7 @@ def proof_proposition_generation: TestM Unit := do
return ()
addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
- addTest $ LSpec.test "(2 root)" state2.rootExpr.isNone
+ addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
| .success state => pure state
@@ -373,7 +373,7 @@ def proof_proposition_generation: TestM Unit := do
return ()
addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
#[])
- addTest $ LSpec.test "(3 root)" state3.rootExpr.isSome
+ addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
return ()
def suite: IO LSpec.TestSeq := do
From c0dfa04b1896915612237fe82c8cef8df2a8f0b3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 29 Oct 2023 11:18:35 -0700
Subject: [PATCH 035/465] feat: Simplify name printing
---
Pantograph/Serial.lean | 14 ++++++++------
Test/Serial.lean | 2 +-
2 files changed, 9 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 62321bd..d109188 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -46,12 +46,14 @@ def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-private def name_to_ast (name: Lean.Name) (sanitize: Bool := true): String := match name with
- | .anonymous => ":anon"
- | .num n i => match sanitize with
- | false => s!"{toString n} {i}"
- | true => ":anon"
- | n@(.str _ _) => toString n
+private def name_to_ast (name: Name) (sanitize: Bool := true): String :=
+ if sanitize && name.isInternal then "_"
+ else name_to_ast_aux name |>.drop 1
+ where
+ name_to_ast_aux: Name → String
+ | .anonymous => ""
+ | .num n i => s!"{name_to_ast_aux n} {i}"
+ | .str init last => s!"{name_to_ast_aux init} {last}"
private def level_depth: Level → Nat
| .zero => 0
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 9a42992..162a51d 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -36,7 +36,7 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
-- This one contains unhygienic variable names which must be suppressed
- ("Nat.add", "(:forall :anon (:c Nat) (:forall :anon (:c Nat) (:c Nat)))"),
+ ("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
-- These ones are normal and easy
("Nat.add_one", "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"),
("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h (((((:c LE.le) (:c Nat)) (:c instLENat)) ((:c Nat.succ) 1)) 0) (((((:c LE.le) (:c Nat)) (:c instLENat)) 2) 1)) :implicit) :implicit)"),
From de250eafd00500677734defceb9609c9e093b4e2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 29 Oct 2023 11:56:56 -0700
Subject: [PATCH 036/465] feat: Print names in one segment separated with .
---
Pantograph/Serial.lean | 14 +++++++-------
Test/Integration.lean | 2 +-
Test/Serial.lean | 10 +++++++++-
3 files changed, 17 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index d109188..89bc076 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -46,14 +46,14 @@ def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-private def name_to_ast (name: Name) (sanitize: Bool := true): String :=
- if sanitize && name.isInternal then "_"
- else name_to_ast_aux name |>.drop 1
+def name_to_ast (name: Name) (sanitize: Bool := true): String :=
+ let internal := name.isInaccessibleUserName || name.hasMacroScopes
+ if sanitize && internal then "_"
+ else toString name |> enclose_if_escaped
where
- name_to_ast_aux: Name → String
- | .anonymous => ""
- | .num n i => s!"{name_to_ast_aux n} {i}"
- | .str init last => s!"{name_to_ast_aux init} {last}"
+ enclose_if_escaped (n: String) :=
+ let quote := "̈̈\""
+ if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
private def level_depth: Level → Nat
| .zero => 0
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 39f145e..a77cb12 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -85,7 +85,7 @@ def test_malformed_command : IO LSpec.TestSeq :=
def test_tactic : IO LSpec.TestSeq :=
let goal: Protocol.Goal := {
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
- vars := #[{ name := "_uniq 9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
+ vars := #[{ name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
subroutine_runner [
subroutine_step "goal.start"
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 162a51d..575749d 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -10,7 +10,14 @@ open Lean
deriving instance Repr, DecidableEq for Protocol.BoundExpression
def test_str_to_name: LSpec.TestSeq :=
- LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
+ LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
+
+def test_name_to_ast: LSpec.TestSeq :=
+ let quote := "̈̈\""
+ LSpec.test "a.b.1" (name_to_ast (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
+ LSpec.test "seg.«a.b»" (name_to_ast (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}")
+ -- Pathological test case
+ --LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«̈{escape}{quote}»{quote}")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × Protocol.BoundExpression) := [
@@ -70,6 +77,7 @@ def suite: IO LSpec.TestSeq := do
return LSpec.group "Serialization" $
(LSpec.group "str_to_name" test_str_to_name) ++
+ (LSpec.group "name_to_ast" test_name_to_ast) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
From e523e8bcc6b340aa8cf6edd5c9550259af47ae70 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 29 Oct 2023 11:57:24 -0700
Subject: [PATCH 037/465] chore: Version bump (breaking change)
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index ec93fa9..29b3613 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.6"
+def version := "0.2.7"
end Pantograph
From 60854525b959927fb36a3c89033d50643c0add51 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 29 Oct 2023 12:50:36 -0700
Subject: [PATCH 038/465] feat: Simplify printing of function applications
---
Pantograph/Serial.lean | 34 +++++++---------------------------
Test/Integration.lean | 2 +-
Test/Serial.lean | 4 ++--
3 files changed, 10 insertions(+), 30 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 89bc076..63f5949 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -55,26 +55,8 @@ def name_to_ast (name: Name) (sanitize: Bool := true): String :=
let quote := "̈̈\""
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
-private def level_depth: Level → Nat
- | .zero => 0
- | .succ l => 1 + (level_depth l)
- | .max u v | .imax u v => 1 + max (level_depth u) (level_depth v)
- | .param _ | .mvar _ => 0
-
-theorem level_depth_max_imax (u v: Level): (level_depth (Level.max u v) = level_depth (Level.imax u v)) := by
- constructor
-theorem level_max_depth_decrease (u v: Level): (level_depth u < level_depth (Level.max u v)) := by
- have h1: level_depth (Level.max u v) = 1 + Nat.max (level_depth u) (level_depth v) := by constructor
- rewrite [h1]
- simp_arith
- conv =>
- rhs
- apply Nat.max_def
- sorry
-theorem level_offset_decrease (u v: Level): (level_depth u ≤ level_depth (Level.max u v).getLevelOffset) := sorry
-
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
-def serialize_sort_level_ast (level: Level): String :=
+partial def serialize_sort_level_ast (level: Level): String :=
let k := level.getOffset
let u := level.getLevelOffset
let u_str := match u with
@@ -98,14 +80,11 @@ def serialize_sort_level_ast (level: Level): String :=
| 0, _ => u_str
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
- termination_by serialize_sort_level_ast level => level_depth level
- decreasing_by
- . sorry
/--
Completely serializes an expression tree. Json not used due to compactness
-/
-def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
+partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
self expr
where
self (e: Expr): String :=
@@ -128,10 +107,11 @@ def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
s!"(:c {declName})"
- | .app fn arg =>
- let fn' := self fn
- let arg' := self arg
- s!"({fn'} {arg'})"
+ | .app _ _ =>
+ let fn' := self e.getAppFn
+ let args := e.getAppArgs.map self |>.toList
+ let args := " ".intercalate args
+ s!"({fn'} {args})"
| .lam binderName binderType body binderInfo =>
let binderName' := of_name binderName
let binderType' := self binderType
diff --git a/Test/Integration.lean b/Test/Integration.lean
index a77cb12..6400cca 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -45,7 +45,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
def test_option_modify : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
- let sexp? := Option.some "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"
+ let sexp? := Option.some "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
let options: Protocol.Options := {}
subroutine_runner [
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 575749d..f1b0a9d 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -45,8 +45,8 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
-- This one contains unhygienic variable names which must be suppressed
("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
-- These ones are normal and easy
- ("Nat.add_one", "(:forall n (:c Nat) ((((:c Eq) (:c Nat)) (((((((:c HAdd.hAdd) (:c Nat)) (:c Nat)) (:c Nat)) (((:c instHAdd) (:c Nat)) (:c instAddNat))) 0) ((((:c OfNat.ofNat) (:c Nat)) (:lit 1)) ((:c instOfNatNat) (:lit 1))))) ((:c Nat.succ) 0)))"),
- ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h (((((:c LE.le) (:c Nat)) (:c instLENat)) ((:c Nat.succ) 1)) 0) (((((:c LE.le) (:c Nat)) (:c instLENat)) 2) 1)) :implicit) :implicit)"),
+ ("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
+ ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
-- Handling of higher order types
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
From 1a99a2e7b25d2d9c88d1c51211e6938eff1eca57 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 29 Oct 2023 13:03:48 -0700
Subject: [PATCH 039/465] fix: Sanitize name in universe levels
---
Pantograph/Serial.lean | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 63f5949..615d9b9 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -56,25 +56,25 @@ def name_to_ast (name: Name) (sanitize: Bool := true): String :=
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
-partial def serialize_sort_level_ast (level: Level): String :=
+partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
let k := level.getOffset
let u := level.getLevelOffset
let u_str := match u with
| .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ"
| .max v w =>
- let v := serialize_sort_level_ast v
- let w := serialize_sort_level_ast w
+ let v := serialize_sort_level_ast v sanitize
+ let w := serialize_sort_level_ast w sanitize
s!"(:max {v} {w})"
| .imax v w =>
- let v := serialize_sort_level_ast v
- let w := serialize_sort_level_ast w
+ let v := serialize_sort_level_ast v sanitize
+ let w := serialize_sort_level_ast w sanitize
s!"(:imax {v} {w})"
| .param name =>
- let name := name_to_ast name
+ let name := name_to_ast name sanitize
s!"{name}"
| .mvar id =>
- let name := name_to_ast id.name
+ let name := name_to_ast id.name sanitize
s!"(:mv {name})"
match k, u with
| 0, _ => u_str
@@ -101,7 +101,7 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Stri
let name := of_name mvarId.name
s!"(:mv {name})"
| .sort level =>
- let level := serialize_sort_level_ast level
+ let level := serialize_sort_level_ast level sanitize
s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
From d1c0dc376fce10d1abe8d7576c2673626f828706 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 30 Oct 2023 14:44:06 -0700
Subject: [PATCH 040/465] feat: Print metavariable name in goal
---
Pantograph/Protocol.lean | 5 +++--
Pantograph/Serial.lean | 7 ++++---
Test/Common.lean | 1 +
Test/Integration.lean | 1 +
Test/Proofs.lean | 16 +++++++++-------
5 files changed, 18 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index e379782..fd790bb 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -54,8 +54,9 @@ structure Variable where
value?: Option Expression := .none
deriving Lean.ToJson
structure Goal where
- /-- String case id -/
- caseName?: Option String := .none
+ name: String := ""
+ /-- Name of the metavariable -/
+ userName?: Option String := .none
/-- Is the goal in conversion mode -/
isConversion: Bool := false
/-- target expression type -/
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 615d9b9..a46c2c7 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -168,7 +168,7 @@ def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.E
}
/-- Adapted from ppGoal -/
-def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+def serialize_goal (options: Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
@@ -229,7 +229,8 @@ def serialize_goal (options: Protocol.Options) (mvarDecl: MetavarDecl) (parentDe
| false => ppVar localDecl
return var::acc
return {
- caseName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
+ name := of_name goal.name,
+ userName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
@@ -246,7 +247,7 @@ protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalSt
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
- let serializedGoal ← serialize_goal options mvarDecl (parentDecl? := parentDecl?)
+ let serializedGoal ← serialize_goal options goal mvarDecl (parentDecl? := parentDecl?)
pure serializedGoal
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
diff --git a/Test/Common.lean b/Test/Common.lean
index 3e52932..f74e6a2 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -7,6 +7,7 @@ namespace Protocol
def Goal.devolatilize (goal: Goal): Goal :=
{
goal with
+ name := "",
vars := goal.vars.map removeInternalAux,
}
where removeInternalAux (v: Variable): Variable :=
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 6400cca..0420a29 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -84,6 +84,7 @@ def test_malformed_command : IO LSpec.TestSeq :=
]
def test_tactic : IO LSpec.TestSeq :=
let goal: Protocol.Goal := {
+ name := "_uniq.10",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
vars := #[{ name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a726627..c08ecb2 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -66,9 +66,9 @@ def startProof (start: Start): TestM (Option GoalState) := do
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
-def buildGoal (nameType: List (String × String)) (target: String) (caseName?: Option String := .none): Protocol.Goal :=
+def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
{
- caseName?,
+ userName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
@@ -293,13 +293,13 @@ def proof_or_comm: TestM Unit := do
return ()
where
typeProp: Protocol.Expression := { pp? := .some "Prop" }
- branchGoal (caseName name: String): Protocol.Goal := {
- caseName? := .some caseName,
+ branchGoal (caseName varName: String): Protocol.Goal := {
+ userName? := .some caseName,
target := { pp? := .some "q ∨ p" },
vars := #[
{ userName := "p", type? := .some typeProp, isInaccessible? := .some false },
{ userName := "q", type? := .some typeProp, isInaccessible? := .some false },
- { userName := "h✝", type? := .some { pp? := .some name }, isInaccessible? := .some true }
+ { userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible? := .some true }
]
}
@@ -352,9 +352,11 @@ def proof_proposition_generation: TestM Unit := do
return ()
addTest $ LSpec.check "apply PSigma.mk" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[
- buildGoal [] "?fst" (caseName? := .some "snd"),
- buildGoal [] "Prop" (caseName? := .some "fst")
+ buildGoal [] "?fst" (userName? := .some "snd"),
+ buildGoal [] "Prop" (userName? := .some "fst")
])
+ if let #[goal1, goal2] := ← state1.serializeGoals (options := { (← read) with printExprAST := true }) then
+ addTest $ LSpec.test "(1 reference)" (goal1.target.sexp? = .some s!"(:mv {goal2.name})")
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
From 59ac83f0b702c23d2c9364b84c79b122be386dd1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 30 Oct 2023 14:45:43 -0700
Subject: [PATCH 041/465] bug: Fix quote escape problem
---
Pantograph/Serial.lean | 2 +-
Test/Serial.lean | 7 ++++---
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index a46c2c7..c89fc7f 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -52,7 +52,7 @@ def name_to_ast (name: Name) (sanitize: Bool := true): String :=
else toString name |> enclose_if_escaped
where
enclose_if_escaped (n: String) :=
- let quote := "̈̈\""
+ let quote := "\""
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
diff --git a/Test/Serial.lean b/Test/Serial.lean
index f1b0a9d..dfa3890 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -13,11 +13,12 @@ def test_str_to_name: LSpec.TestSeq :=
LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
def test_name_to_ast: LSpec.TestSeq :=
- let quote := "̈̈\""
+ let quote := "\""
+ let escape := "\\"
LSpec.test "a.b.1" (name_to_ast (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
- LSpec.test "seg.«a.b»" (name_to_ast (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}")
+ LSpec.test "seg.«a.b»" (name_to_ast (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}") ++
-- Pathological test case
- --LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«̈{escape}{quote}»{quote}")
+ LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«{escape}{quote}»{quote}")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × Protocol.BoundExpression) := [
From 4a4a33cea75fcdb604700b59333b79555275ce13 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 Nov 2023 15:00:51 -0700
Subject: [PATCH 042/465] test: Separate mvar coupling tests
---
Pantograph/Goal.lean | 9 ++-
Test/Common.lean | 15 +++++
Test/Holes.lean | 129 ++++++++++++++++++++++++++++++-------------
Test/Main.lean | 4 +-
Test/Proofs.lean | 95 +------------------------------
5 files changed, 116 insertions(+), 136 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 78a4194..eeb5a10 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -170,15 +170,18 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
-protected def GoalState.continue (target: GoalState) (graftee: GoalState): Except String GoalState :=
+protected def GoalState.continue (target: GoalState) (graftee: GoalState) (goals: Option (List MVarId) := .none): Except String GoalState :=
+ let goals := match goals with
+ | .some goals => goals
+ | .none => target.goals
if target.root != graftee.root then
.error s!"Roots of two continued goal states do not match: {target.root.name} != {graftee.root.name}"
-- Ensure goals are not dangling
- else if ¬ (target.goals.all (λ goal => graftee.mvars.contains goal)) then
+ else if ¬ (goals.all (λ goal => graftee.mvars.contains goal)) then
.error s!"Some goals in target are not present in the graftee"
else
-- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
- let unassigned := target.goals.filter (λ goal =>
+ let unassigned := goals.filter (λ goal =>
let mctx := graftee.mctx
¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
.ok {
diff --git a/Test/Common.lean b/Test/Common.lean
index f74e6a2..5b74a0f 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -1,4 +1,6 @@
import Pantograph.Protocol
+import Pantograph.Goal
+import LSpec
namespace Pantograph
@@ -15,6 +17,19 @@ def Goal.devolatilize (goal: Goal): Goal :=
v with
name := ""
}
+deriving instance DecidableEq, Repr for Expression
+deriving instance DecidableEq, Repr for Variable
+deriving instance DecidableEq, Repr for Goal
end Protocol
+def TacticResult.toString : TacticResult → String
+ | .success state => s!".success ({state.goals.length} goals)"
+ | .failure messages =>
+ let messages := "\n".intercalate messages.toList
+ s!".failure {messages}"
+ | .parseError error => s!".parseError {error}"
+ | .indexError index => s!".indexError {index}"
+
+def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
+
end Pantograph
diff --git a/Test/Holes.lean b/Test/Holes.lean
index 64f2e2c..9b38087 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -1,31 +1,28 @@
import LSpec
import Pantograph.Goal
import Pantograph.Serial
+import Test.Common
namespace Pantograph.Test.Holes
open Pantograph
open Lean
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Commands.Options M)
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
-deriving instance DecidableEq, Repr for Commands.Expression
-deriving instance DecidableEq, Repr for Commands.Variable
-deriving instance DecidableEq, Repr for Commands.Goal
-
-def add_test (test: LSpec.TestSeq): TestM Unit := do
+def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
-def start_goal (hole: String): TestM (Option GoalState) := do
+def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
- let syn? := syntax_from_str env hole
- add_test $ LSpec.check s!"Parsing {hole}" (syn?.isOk)
+ let syn? := syntax_from_str env expr
+ addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
- let expr? ← syntax_to_expr syn
- add_test $ LSpec.check s!"Elaborating" expr?.isOk
+ let expr? ← syntax_to_expr_type syn
+ addTest $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
IO.println error
@@ -34,40 +31,21 @@ def start_goal (hole: String): TestM (Option GoalState) := do
let goal ← GoalState.create (expr := expr)
return Option.some goal
-def assert_unreachable (message: String): LSpec.TestSeq := LSpec.check message false
-
-def build_goal (nameType: List (String × String)) (target: String): Commands.Goal :=
+def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
{
+ userName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
- name := x.fst,
+ userName := x.fst,
type? := .some { pp? := .some x.snd },
isInaccessible? := .some false
})).toArray
}
--- Like `build_goal` but allow certain variables to be elided.
-def build_goal_selective (nameType: List (String × Option String)) (target: String): Commands.Goal :=
- {
- target := { pp? := .some target},
- vars := (nameType.map fun x => ({
- name := x.fst,
- type? := x.snd.map (λ type => { pp? := type }),
- isInaccessible? := x.snd.map (λ _ => false)
- })).toArray
- }
-
-def construct_sigma: TestM Unit := do
- let goal? ← start_goal "∀ (n m: Nat), n + m = m + n"
- add_test $ LSpec.check "Start goal" goal?.isSome
- if let .some goal := goal? then
- return ()
-
-
-def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
+def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context := {
- currNamespace := str_to_name "Aniva",
+ currNamespace := Name.append .anonymous "Aniva",
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0], lines := #[1] }
@@ -83,17 +61,94 @@ def proof_runner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :
| .ok (_, a) =>
return a
+/-- M-coupled goals -/
+def test_m_couple: TestM Unit := do
+ let state? ← startProof "(2: Nat) ≤ 5"
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
+ addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
+ -- Set m to 3
+ let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
+ let state1b ← match state1.continue state2 with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ 3", .some "3 ≤ 5"])
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+ return ()
+
+def test_proposition_generation: TestM Unit := do
+ let state? ← startProof "Σ' p:Prop, p"
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply PSigma.mk") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply PSigma.mk" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ buildGoal [] "?fst" (userName? := .some "snd"),
+ buildGoal [] "Prop" (userName? := .some "fst")
+ ])
+ if let #[goal1, goal2] := ← state1.serializeGoals (options := { (← read) with printExprAST := true }) then
+ addTest $ LSpec.test "(1 reference)" (goal1.target.sexp? = .some s!"(:mv {goal2.name})")
+ addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
+
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
+ addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
+
+ let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[])
+ addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
+ return ()
+
+
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
(imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let tests := [
- ("Σ'", construct_sigma)
+ ("2 < 5", test_m_couple),
+ ("Proposition Generation", test_proposition_generation)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
- let tests ← proof_runner env tests
+ let tests ← proofRunner env tests
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
return LSpec.group "Holes" tests
diff --git a/Test/Main.lean b/Test/Main.lean
index 5b9a24a..cb7c055 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,5 +1,5 @@
import LSpec
---import Test.Holes
+import Test.Holes
import Test.Integration
import Test.Proofs
import Test.Serial
@@ -11,7 +11,7 @@ unsafe def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
- --Holes.suite,
+ Holes.suite,
Integration.suite,
Proofs.suite,
Serial.suite
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index c08ecb2..8ec01a7 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -6,17 +6,6 @@ import Pantograph.Goal
import Pantograph.Serial
import Test.Common
-namespace Pantograph
-
-def TacticResult.toString : TacticResult → String
- | .success state => s!".success ({state.goals.length} goals)"
- | .failure messages =>
- let messages := "\n".intercalate messages.toList
- s!".failure {messages}"
- | .parseError error => s!".parseError {error}"
- | .indexError index => s!".indexError {index}"
-end Pantograph
-
namespace Pantograph.Test.Proofs
open Pantograph
open Lean
@@ -27,10 +16,6 @@ inductive Start where
abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
-deriving instance DecidableEq, Repr for Protocol.Expression
-deriving instance DecidableEq, Repr for Protocol.Variable
-deriving instance DecidableEq, Repr for Protocol.Goal
-
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
@@ -64,8 +49,6 @@ def startProof (start: Start): TestM (Option GoalState) := do
let goal ← GoalState.create (expr := expr)
return Option.some goal
-def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
-
def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
{
userName?,
@@ -303,80 +286,6 @@ def proof_or_comm: TestM Unit := do
]
}
-/-- M-coupled goals -/
-def proof_m_couple: TestM Unit := do
- let state? ← startProof (.expr "(2: Nat) ≤ 5")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
-
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
- addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
- -- Set m to 3
- let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
- let state1b ← match state1.continue state2 with
- | .error msg => do
- addTest $ assertUnreachable $ msg
- return ()
- | .ok state => pure state
- addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ 3", .some "3 ≤ 5"])
- addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
- return ()
-
-def proof_proposition_generation: TestM Unit := do
- let state? ← startProof (.expr "Σ' p:Prop, p")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
-
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply PSigma.mk") with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check "apply PSigma.mk" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[
- buildGoal [] "?fst" (userName? := .some "snd"),
- buildGoal [] "Prop" (userName? := .some "fst")
- ])
- if let #[goal1, goal2] := ← state1.serializeGoals (options := { (← read) with printExprAST := true }) then
- addTest $ LSpec.test "(1 reference)" (goal1.target.sexp? = .some s!"(:mv {goal2.name})")
- addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
-
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
- addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
-
- let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[])
- addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
- return ()
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
@@ -388,9 +297,7 @@ def suite: IO LSpec.TestSeq := do
("Nat.add_comm manual", proof_nat_add_comm true),
("Nat.add_comm delta", proof_delta_variable),
("arithmetic", proof_arith),
- ("Or.comm", proof_or_comm),
- ("2 < 5", proof_m_couple),
- ("Proposition Generation", proof_proposition_generation)
+ ("Or.comm", proof_or_comm)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
From 333355a85ddb67bbc449f98178b4d065a6aa47af Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 Nov 2023 15:33:53 -0700
Subject: [PATCH 043/465] feat: Partial state continuation
---
Pantograph/Goal.lean | 32 ++++++++++++++++--------------
Test/Holes.lean | 46 ++++++++++++++++++++++++++++++++++++++++++--
Test/Proofs.lean | 2 +-
3 files changed, 63 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index eeb5a10..fd24232 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -169,30 +169,34 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
return .failure #[← exception.toMessageData.toString]
tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
-/-- After finishing one branch of a proof (`graftee`), pick up from the point where the proof was left off (`target`) -/
-protected def GoalState.continue (target: GoalState) (graftee: GoalState) (goals: Option (List MVarId) := .none): Except String GoalState :=
- let goals := match goals with
- | .some goals => goals
- | .none => target.goals
- if target.root != graftee.root then
- .error s!"Roots of two continued goal states do not match: {target.root.name} != {graftee.root.name}"
- -- Ensure goals are not dangling
- else if ¬ (goals.all (λ goal => graftee.mvars.contains goal)) then
- .error s!"Some goals in target are not present in the graftee"
+/--
+Brings into scope a list of goals
+-/
+protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
+ if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
+ .error s!"Goals not in scope"
else
-- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
let unassigned := goals.filter (λ goal =>
- let mctx := graftee.mctx
+ let mctx := state.mctx
¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
.ok {
+ state with
savedState := {
- term := graftee.savedState.term,
+ term := state.savedState.term,
tactic := { goals := unassigned },
},
- root := target.root,
- newMVars := graftee.newMVars,
}
+/--
+Brings into scope all goals from `branch`
+-/
+protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
+ if target.root != branch.root then
+ .error s!"Roots of two continued goal states do not match: {target.root.name} != {branch.root.name}"
+ else
+ target.resume (goals := branch.goals)
+
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
let expr := goalState.mctx.eAssignment.find! goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
diff --git a/Test/Holes.lean b/Test/Holes.lean
index 9b38087..8692c2a 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -85,7 +85,7 @@ def test_m_couple: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
- let state1b ← match state1.continue state2 with
+ let state1b ← match state2.continue state1 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
@@ -136,6 +136,47 @@ def test_proposition_generation: TestM Unit := do
addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
return ()
+def test_partial_continuation: TestM Unit := do
+ let state? ← startProof "(2: Nat) ≤ 5"
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
+
+ let state2 ← match ← state1.execute (goalId := 2) (tactic := "apply Nat.succ") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply Nat.succ" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "Nat"])
+
+ -- Execute a partial continuation
+ let coupled_goals := state1.goals ++ state2.goals
+ let state1b ← match state2.resume (goals := coupled_goals) with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+
+ -- Continuation should fail if the state does not exist:
+ match state0.resume coupled_goals with
+ | .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals not in scope")
+ | .ok _ => addTest $ assertUnreachable "(continuation failure)"
+ return ()
+
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
@@ -144,7 +185,8 @@ def suite: IO LSpec.TestSeq := do
(trustLevel := 1)
let tests := [
("2 < 5", test_m_couple),
- ("Proposition Generation", test_proposition_generation)
+ ("Proposition Generation", test_proposition_generation),
+ ("Partial Continuation", test_partial_continuation)
]
let tests ← tests.foldlM (fun acc tests => do
let (name, tests) := tests
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8ec01a7..0d5fb4e 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -253,7 +253,7 @@ def proof_or_comm: TestM Unit := do
addTest $ LSpec.check " assumption" state4_2.goals.isEmpty
addTest $ LSpec.check "(4_2 root)" state4_2.rootExpr?.isNone
-- Ensure the proof can continue from `state4_2`.
- let state2b ← match state2.continue state4_2 with
+ let state2b ← match state4_2.continue state2 with
| .error msg => do
addTest $ assertUnreachable $ msg
return ()
From 97d658cfc5bacca50d0d959375bbbc2c4ba090fa Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 Nov 2023 15:51:09 -0700
Subject: [PATCH 044/465] feat: Add goal.continue command
---
Pantograph.lean | 25 +++++++++++++++++++++++++
Pantograph/Protocol.lean | 15 +++++++++++++++
2 files changed, 40 insertions(+)
diff --git a/Pantograph.lean b/Pantograph.lean
index 00782d5..0984db8 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -38,6 +38,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "options.print" => run options_print
| "goal.start" => run goal_start
| "goal.tactic" => run goal_tactic
+ | "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
| cmd =>
@@ -170,6 +171,30 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .error $ errorIndex s!"Invalid goal id index {goalId}"
| .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
+ goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
+ let state ← get
+ match state.goalStates.get? args.target with
+ | .none => return .error $ errorIndex s!"Invalid state index {args.target}"
+ | .some target => do
+ let nextState? ← match args.branch?, args.goals? with
+ | .some branchId, .none => do
+ match state.goalStates.get? branchId with
+ | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
+ | .some branch => pure $ target.continue branch
+ | .none, .some goals =>
+ let goals := goals.map (λ name => { name := str_to_name name })
+ pure $ target.resume goals
+ | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
+ match nextState? with
+ | .error error => return .ok { error? := .some error }
+ | .ok nextGoalState =>
+ let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
+ set { state with goalStates }
+ let goals ← nextGoalState.serializeGoals (parent := .some target) (options := state.options)
+ return .ok {
+ nextStateId? := .some nextStateId,
+ goals? := .some goals,
+ }
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index fd790bb..2469a6c 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -163,6 +163,21 @@ structure GoalTacticResult where
-- Existence of this field shows the tactic parsing has failed
parseError?: Option String := .none
deriving Lean.ToJson
+structure GoalContinue where
+ -- State from which the continuation acquires the context
+ target: Nat
+
+ -- One of the following must be supplied
+ -- The state which is an ancestor of `target` where goals will be extracted from
+ branch?: Option Nat := .none
+ -- Or, the particular goals that should be brought back into scope
+ goals?: Option (List String) := .none
+ deriving Lean.FromJson
+structure GoalContinueResult where
+ error?: Option String := .none
+ nextStateId?: Option Nat := .none
+ goals?: Option (Array Goal) := .none
+ deriving Lean.ToJson
-- Remove goal states
structure GoalDelete where
From 4be9dbc84a7f07abc90cb3d99f61a11db23f3790 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 Nov 2023 15:53:57 -0700
Subject: [PATCH 045/465] feat: Goal continuation fails if target has goals
---
Pantograph/Goal.lean | 4 +++-
Test/Holes.lean | 5 +++++
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index fd24232..3645087 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -192,7 +192,9 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
Brings into scope all goals from `branch`
-/
protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
- if target.root != branch.root then
+ if !target.goals.isEmpty then
+ .error s!"Target state has unresolved goals"
+ else if target.root != branch.root then
.error s!"Roots of two continued goal states do not match: {target.root.name} != {branch.root.name}"
else
target.resume (goals := branch.goals)
diff --git a/Test/Holes.lean b/Test/Holes.lean
index 8692c2a..b6647ef 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -133,6 +133,7 @@ def test_proposition_generation: TestM Unit := do
return ()
addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
#[])
+
addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
return ()
@@ -175,6 +176,10 @@ def test_partial_continuation: TestM Unit := do
match state0.resume coupled_goals with
| .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals not in scope")
| .ok _ => addTest $ assertUnreachable "(continuation failure)"
+ -- Continuation should fail if some goals have not been solved
+ match state2.continue state1 with
+ | .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Target state has unresolved goals")
+ | .ok _ => addTest $ assertUnreachable "(continuation failure)"
return ()
From a5b5e0185828f2f1dbd5382faf06caf1f0e1e78e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 Nov 2023 15:54:28 -0700
Subject: [PATCH 046/465] chore: Version bump to 0.2.8
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 29b3613..3fb09e9 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.7"
+def version := "0.2.8"
end Pantograph
From ce1cb13e54106160e15acbeb44e645e27bafb2ff Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 Nov 2023 10:45:11 -0800
Subject: [PATCH 047/465] fix: Use Lean's built in name parser
The `str_to_name` parser cannot handle numerical names and escapes.
---
Main.lean | 4 ++--
Pantograph.lean | 6 +++---
Pantograph/Symbol.lean | 4 ----
Test/Holes.lean | 16 +++++++++++++++-
Test/Proofs.lean | 2 +-
Test/Serial.lean | 20 ++++++++------------
6 files changed, 29 insertions(+), 23 deletions(-)
diff --git a/Main.lean b/Main.lean
index d7f936e..bed33bb 100644
--- a/Main.lean
+++ b/Main.lean
@@ -46,7 +46,7 @@ namespace Lean
def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
let ps := (entry.splitOn "=").map String.trim
let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
- let key := Pantograph.str_to_name key
+ let key := key.toName
let defValue ← getOptionDefaultValue key
match defValue with
| DataValue.ofString _ => pure $ opts.setString key val
@@ -88,7 +88,7 @@ unsafe def main (args: List String): IO Unit := do
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
let env ← Lean.importModules
- (imports := imports.toArray.map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := imports.toArray.map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let context: Context := {
diff --git a/Pantograph.lean b/Pantograph.lean
index 0984db8..fb4cc41 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -69,7 +69,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
lib_inspect (args: Protocol.LibInspect): MainM (CR Protocol.LibInspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let name := str_to_name args.name
+ let name := args.name.toName
let info? := env.find? name
match info? with
| none => return .error $ errorIndex s!"Symbol not found {args.name}"
@@ -132,7 +132,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .error str => return .error <| errorI "elab" str
| .ok expr => return .ok expr))
| .none, .some copyFrom =>
- (match env.find? <| str_to_name copyFrom with
+ (match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok cInfo.type)
| _, _ =>
@@ -182,7 +182,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
- let goals := goals.map (λ name => { name := str_to_name name })
+ let goals := goals.map (λ name => { name := name.toName })
pure $ target.resume goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
match nextState? with
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index 81d7deb..fb0ea1d 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -2,10 +2,6 @@ import Lean.Declaration
namespace Pantograph
-/-- Converts a symbol of the form `aa.bb.cc` to a name -/
-def str_to_name (s: String): Lean.Name :=
- (s.splitOn ".").foldl Lean.Name.str Lean.Name.anonymous
-
def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
let nameDeduce: Bool := match n.getRoot with
| .str _ name => name.startsWith "_" ∨ name == "Lean"
diff --git a/Test/Holes.lean b/Test/Holes.lean
index b6647ef..afad4e8 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -172,6 +172,20 @@ def test_partial_continuation: TestM Unit := do
#[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+ -- Roundtrip
+ --let coupled_goals := coupled_goals.map (λ g =>
+ -- { name := str_to_name $ name_to_ast g.name (sanitize := false)})
+ let coupled_goals := coupled_goals.map (λ g => name_to_ast g.name (sanitize := false))
+ let coupled_goals := coupled_goals.map (λ g => { name := g.toName })
+ let state1b ← match state2.resume (goals := coupled_goals) with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+
-- Continuation should fail if the state does not exist:
match state0.resume coupled_goals with
| .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals not in scope")
@@ -185,7 +199,7 @@ def test_partial_continuation: TestM Unit := do
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
- (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
let tests := [
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 0d5fb4e..8992697 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -23,7 +23,7 @@ def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
match start with
| .copy name =>
- let cInfo? := str_to_name name |> env.find?
+ let cInfo? := name.toName |> env.find?
addTest $ LSpec.check s!"Symbol exists {name}" cInfo?.isSome
match cInfo? with
| .some cInfo =>
diff --git a/Test/Serial.lean b/Test/Serial.lean
index dfa3890..c057bfb 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -9,9 +9,6 @@ open Lean
deriving instance Repr, DecidableEq for Protocol.BoundExpression
-def test_str_to_name: LSpec.TestSeq :=
- LSpec.test "Symbol parsing" (Name.str (.str (.str .anonymous "Lean") "Meta") "run" = Pantograph.str_to_name "Lean.Meta.run")
-
def test_name_to_ast: LSpec.TestSeq :=
let quote := "\""
let escape := "\\"
@@ -21,14 +18,14 @@ def test_name_to_ast: LSpec.TestSeq :=
LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«{escape}{quote}»{quote}")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
- let entries: List (String × Protocol.BoundExpression) := [
- ("Nat.add_comm", { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
- ("Nat.le_of_succ_le", { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
+ let entries: List (Name × Protocol.BoundExpression) := [
+ ("Nat.add_comm".toName, { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
+ ("Nat.le_of_succ_le".toName, { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
]
- let coreM := entries.foldlM (λ suites (symbol, target) => do
+ let coreM: CoreM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
- let expr := str_to_name symbol |> env.find? |>.get! |>.type
- let test := LSpec.check symbol ((← type_expr_to_bound expr) = target)
+ let expr := env.find? symbol |>.get! |>.type
+ let test := LSpec.check symbol.toString ((← type_expr_to_bound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
let coreContext: Core.Context := {
currNamespace := Lean.Name.str .anonymous "Aniva"
@@ -54,7 +51,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
]
let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
- let expr := str_to_name symbol |> env.find? |>.get! |>.type
+ let expr := env.find? symbol.toName |>.get! |>.type
let test := LSpec.check symbol ((serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let coreM := metaM.run'
@@ -72,12 +69,11 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
- (imports := #["Init"].map (λ str => { module := str_to_name str, runtimeOnly := false }))
+ (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
return LSpec.group "Serialization" $
- (LSpec.group "str_to_name" test_str_to_name) ++
(LSpec.group "name_to_ast" test_name_to_ast) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
From c6bb4be59717f303840599026ae8eb02afc847c9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 Nov 2023 11:04:28 -0800
Subject: [PATCH 048/465] chore: Update documentation
---
README.md | 15 ++++++++-------
1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/README.md b/README.md
index 0c19a3a..2b8425c 100644
--- a/README.md
+++ b/README.md
@@ -33,7 +33,7 @@ result of a command execution. The command can be passed in one of two formats
command { ... }
{ "cmd": command, "payload": ... }
```
-The list of available commands can be found in `Pantograph/Commands.lean` and below. An
+The list of available commands can be found in `Pantograph/Protocol.lean` and below. An
empty command aborts the REPL.
The `pantograph` executable must be run with a list of modules to import. It can
@@ -54,18 +54,18 @@ Example proving a theorem: (alternatively use `goal.start {"copyFrom": "Nat.add_
```
$ pantograph Init
goal.start {"expr": "∀ (n m : Nat), n + m = m + n"}
-goal.tactic {"goalId": 0, "tactic": "intro n m"}
-goal.tactic {"goalId": 1, "tactic": "assumption"}
-goal.delete {"goalIds": [0]}
+goal.tactic {"stateId": 0, "goalId": 0, "tactic": "intro n m"}
+goal.tactic {"stateId": 1, "goalId": 0, "tactic": "assumption"}
+goal.delete {"stateIds": [0]}
stat {}
-goal.tactic {"goalId": 1, "tactic": "rw [Nat.add_comm]"}
+goal.tactic {"stateId": 1, "goalId": 0, "tactic": "rw [Nat.add_comm]"}
stat
```
where the application of `assumption` should lead to a failure.
## Commands
-See `Pantograph/Commands.lean` for a description of the parameters and return values in JSON.
+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": <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
@@ -73,10 +73,11 @@ See `Pantograph/Commands.lean` for a description of the parameters and return va
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
- have to be set via command line arguments.), for options, see `Pantograph/Commands.lean`
+ have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
- `options.print`: Display the current set of options
- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr": <expr>]}`: Execute a tactic string on a given goal
+- `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`: Continue from a proof state
- `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
- `goal.print {"stateId": <id>}"`: Print a goal state
- `stat`: Display resource usage
From 8182da436ddcdfeb3569c39aa44d7d9c53da6659 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 Nov 2023 11:43:57 -0800
Subject: [PATCH 049/465] chore: Remove unnecessary unsafe's
---
Main.lean | 2 +-
Test/Main.lean | 3 +--
2 files changed, 2 insertions(+), 3 deletions(-)
diff --git a/Main.lean b/Main.lean
index d7f936e..20caa1e 100644
--- a/Main.lean
+++ b/Main.lean
@@ -22,7 +22,7 @@ def parseCommand (s: String): Except String Protocol.Command := do
return { cmd := s.take offset, payload := payload }
| .none => throw "Command is empty"
-unsafe def loop : MainM Unit := do
+partial def loop : MainM Unit := do
let state ← get
let command ← (← IO.getStdin).getLine
if command.trim.length = 0 then return ()
diff --git a/Test/Main.lean b/Test/Main.lean
index 5b9a24a..aee361c 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -6,8 +6,7 @@ import Test.Serial
open Pantograph.Test
-unsafe def main := do
- Lean.enableInitializersExecution
+def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
From ce585f7288afc6d341f96def3c546430d52c8e57 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 Nov 2023 11:51:31 -0800
Subject: [PATCH 050/465] feat: Print the root mvar name
---
Pantograph.lean | 2 +-
Pantograph/Protocol.lean | 2 ++
Test/Integration.lean | 2 +-
3 files changed, 4 insertions(+), 2 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index fb4cc41..6ec4ac1 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -143,7 +143,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let goalState ← GoalState.create expr
let (goalStates, stateId) := state.goalStates.insert goalState
set { state with goalStates }
- return .ok { stateId }
+ return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
match state.goalStates.get? args.stateId with
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 2469a6c..ce42d9d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -142,6 +142,8 @@ structure GoalStart where
deriving Lean.FromJson
structure GoalStartResult where
stateId: Nat := 0
+ -- Name of the root metavariable
+ root: String
deriving Lean.ToJson
structure GoalTactic where
-- Identifiers for tree, state, and goal
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 0420a29..d8570b0 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -91,7 +91,7 @@ def test_tactic : IO LSpec.TestSeq :=
subroutine_runner [
subroutine_step "goal.start"
[("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
- (Lean.toJson ({stateId := 0}:
+ (Lean.toJson ({stateId := 0, root := "_uniq.8"}:
Protocol.GoalStartResult)),
subroutine_step "goal.tactic"
[("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
From 4396da3e652e9103aeb1bdb570c054d9f99f042a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 Nov 2023 12:20:08 -0800
Subject: [PATCH 051/465] chore: Code formatting
---
Pantograph.lean | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 6ec4ac1..a1f2602 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -29,17 +29,17 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .error ierror => return Lean.toJson ierror
| .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
match command.cmd with
- | "reset" => run reset
- | "stat" => run stat
- | "expr.echo" => run expr_echo
- | "lib.catalog" => run lib_catalog
- | "lib.inspect" => run lib_inspect
- | "options.set" => run options_set
- | "options.print" => run options_print
- | "goal.start" => run goal_start
- | "goal.tactic" => run goal_tactic
- | "goal.continue" => run goal_continue
- | "goal.delete" => run goal_delete
+ | "reset" => run reset
+ | "stat" => run stat
+ | "expr.echo" => run expr_echo
+ | "lib.catalog" => run lib_catalog
+ | "lib.inspect" => run lib_inspect
+ | "options.set" => run options_set
+ | "options.print" => run options_print
+ | "goal.start" => run goal_start
+ | "goal.tactic" => run goal_tactic
+ | "goal.continue" => run goal_continue
+ | "goal.delete" => run goal_delete
| "goal.print" => run goal_print
| cmd =>
let error: Protocol.InteractionError :=
From 53b63bf46c21c996d11fd1b0a3d08068be7f721f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Nov 2023 12:04:17 -0800
Subject: [PATCH 052/465] fix: Remove the error prone SemihashMap
---
Pantograph.lean | 23 +++---
Pantograph/SemihashMap.lean | 149 ------------------------------------
2 files changed, 13 insertions(+), 159 deletions(-)
delete mode 100644 Pantograph/SemihashMap.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 00782d5..b719ca9 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,8 +1,8 @@
import Pantograph.Goal
import Pantograph.Protocol
-import Pantograph.SemihashMap
import Pantograph.Serial
import Pantograph.Symbol
+import Lean.Data.HashMap
namespace Pantograph
@@ -12,7 +12,8 @@ structure Context where
/-- Stores state of the REPL -/
structure State where
options: Protocol.Options := {}
- goalStates: SemihashMap GoalState := SemihashMap.empty
+ nextId: Nat := 0
+ goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
@@ -52,7 +53,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
- set { state with goalStates := SemihashMap.empty }
+ set { state with goalStates := Lean.HashMap.empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -140,12 +141,13 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .error error => return .error error
| .ok expr =>
let goalState ← GoalState.create expr
- let (goalStates, stateId) := state.goalStates.insert goalState
- set { state with goalStates }
+ let stateId := state.nextId
+ let goalStates := state.goalStates.insert stateId goalState
+ set { state with goalStates, nextId := state.nextId + 1 }
return .ok { stateId }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
- match state.goalStates.get? args.stateId with
+ match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
@@ -157,8 +159,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
- let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
- set { state with goalStates }
+ let nextStateId := state.nextId
+ let goalStates := state.goalStates.insert state.nextId goalState
+ set { state with goalStates, nextId := state.nextId + 1 }
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
@@ -172,12 +175,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { tacticErrors? := .some messages }
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
- let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
+ let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
set { state with goalStates }
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
- match state.goalStates.get? args.stateId with
+ match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
diff --git a/Pantograph/SemihashMap.lean b/Pantograph/SemihashMap.lean
deleted file mode 100644
index 1d9ebae..0000000
--- a/Pantograph/SemihashMap.lean
+++ /dev/null
@@ -1,149 +0,0 @@
-
-namespace Pantograph.SemihashMap
-
-structure Imp (β: Type u) where
- data: Array (Option β)
-
- -- Number of elements currently in use
- size: Nat
-
- -- Next index that has never been touched
- allocFront: Nat
-
- -- Deallocated indices
- deallocs: Array Nat
-
- -- Number of valid entries in `deallocs` array
- lastDealloc: Nat
-
-namespace Imp
-
-structure WF (m: Imp β): Prop where
- capacity: m.data.size = m.deallocs.size
- front_dealloc: ∀ i: Fin m.deallocs.size, (i < m.allocFront) → (m.deallocs.get i) < m.allocFront
- front_data: ∀ i: Fin m.data.size, (i ≥ m.allocFront) → (m.data.get i).isNone
-
-def empty (capacity := 16): Imp β :=
- {
- data := mkArray capacity .none,
- size := 0,
- allocFront := 0,
- deallocs := mkArray capacity 0,
- lastDealloc := 0,
- }
-
-private theorem list_get_replicate (x: α) (i: Fin (List.replicate n x).length):
- List.get (List.replicate n x) i = x := by
- sorry
-
-theorem empty_wf : WF (empty n: Imp β) := by
- unfold empty
- apply WF.mk
- case capacity =>
- conv =>
- lhs
- congr
- simp
- conv =>
- rhs
- congr
- simp
- simp
- case front_dealloc =>
- simp_all
- intro i
- intro a
- contradiction
- case front_data =>
- simp_all
- intro i
- unfold Imp.data at i
- simp at i
- conv =>
- lhs
- unfold Array.get
- unfold mkArray
- simp [List.replicate]
- rewrite [list_get_replicate]
-
--- FIXME: Merge this with the well-formed versions below so proof and code can
--- mesh seamlessly.
-@[inline] def insert (map: Imp β) (v: β): (Imp β × Nat) :=
- match map.lastDealloc with
- | 0 => -- Capacity is full, buffer expansion is required
- if map.size == map.data.size then
- let nextIndex := map.data.size
- let extendCapacity := map.size
- let result: Imp β := {
- data := (map.data.append #[Option.some v]).append (mkArray extendCapacity .none),
- size := map.size + 1,
- allocFront := map.size + 1,
- deallocs := mkArray (map.data.size + 1 + extendCapacity) 0,
- lastDealloc := 0,
- }
- (result, nextIndex)
- else
- let nextIndex := map.size
- let result: Imp β := {
- map
- with
- data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
- size := map.size + 1,
- allocFront := map.allocFront + 1,
- }
- (result, nextIndex)
- | (.succ k) => -- Allocation list has space
- let nextIndex := map.deallocs.get! k
- let result: Imp β := {
- map with
- data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
- size := map.size + 1,
- lastDealloc := map.lastDealloc - 1
- }
- (result, nextIndex)
-
-@[inline] def remove (map: Imp β) (index: Fin (map.size)): Imp β :=
- have h: index.val < map.data.size := by sorry
- match map.data.get ⟨index.val, h⟩ with
- | .none => map
- | .some _ =>
- {
- map with
- data := map.data.set ⟨index, sorry⟩ .none,
- size := map.size - 1,
- deallocs := map.deallocs.set ⟨map.lastDealloc, sorry⟩ index,
- lastDealloc := map.lastDealloc + 1,
- }
-
-/-- Retrieval is efficient -/
-@[inline] def get? (map: Imp β) (index: Fin (map.size)): Option β :=
- have h: index.val < map.data.size := by sorry
- map.data.get ⟨index.val, h⟩
-@[inline] def capacity (map: Imp β): Nat := map.data.size
-
-end Imp
-
-
-/--
-This is like a hashmap but you cannot control the keys.
--/
-def _root_.Pantograph.SemihashMap β := {m: Imp β // m.WF}
-
-@[inline] def empty (capacity := 16): SemihashMap β :=
- ⟨ Imp.empty capacity, Imp.empty_wf ⟩
-@[inline] def insert (map: SemihashMap β) (v: β): (SemihashMap β × Nat) :=
- let ⟨imp, pre⟩ := map
- let ⟨result, id⟩ := imp.insert v
- ( ⟨ result, sorry ⟩, id)
-@[inline] def remove (map: SemihashMap β) (index: Nat): SemihashMap β :=
- let ⟨imp, pre⟩ := map
- let result := imp.remove ⟨index, sorry⟩
- ⟨ result, sorry ⟩
-@[inline] def get? (map: SemihashMap β) (index: Nat): Option β :=
- let ⟨imp, _⟩ := map
- imp.get? ⟨index, sorry⟩
-@[inline] def size (map: SemihashMap β): Nat :=
- let ⟨imp, _⟩ := map
- imp.size
-
-end Pantograph.SemihashMap
From d9745094fa2f0706a567a70cc32920a74aed494c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Nov 2023 12:09:54 -0800
Subject: [PATCH 053/465] fix: Remove the error prone SemihashMap
---
Pantograph.lean | 36 +++++----
Pantograph/SemihashMap.lean | 149 ------------------------------------
2 files changed, 22 insertions(+), 163 deletions(-)
delete mode 100644 Pantograph/SemihashMap.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index a1f2602..0ae8192 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,8 +1,8 @@
import Pantograph.Goal
import Pantograph.Protocol
-import Pantograph.SemihashMap
import Pantograph.Serial
import Pantograph.Symbol
+import Lean.Data.HashMap
namespace Pantograph
@@ -12,7 +12,8 @@ structure Context where
/-- Stores state of the REPL -/
structure State where
options: Protocol.Options := {}
- goalStates: SemihashMap GoalState := SemihashMap.empty
+ nextId: Nat := 0
+ goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
@@ -53,7 +54,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
- set { state with goalStates := SemihashMap.empty }
+ set { state with goalStates := Lean.HashMap.empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -141,12 +142,15 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .error error => return .error error
| .ok expr =>
let goalState ← GoalState.create expr
- let (goalStates, stateId) := state.goalStates.insert goalState
- set { state with goalStates }
+ let stateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert stateId goalState,
+ nextId := state.nextId + 1
+ }
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
- match state.goalStates.get? args.stateId with
+ match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
@@ -158,8 +162,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
- let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
- set { state with goalStates }
+ let nextStateId := state.nextId
+ let goalStates := state.goalStates.insert state.nextId goalState
+ set { state with goalStates, nextId := state.nextId + 1 }
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
@@ -173,12 +178,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
let state ← get
- match state.goalStates.get? args.target with
+ match state.goalStates.find? args.target with
| .none => return .error $ errorIndex s!"Invalid state index {args.target}"
| .some target => do
let nextState? ← match args.branch?, args.goals? with
| .some branchId, .none => do
- match state.goalStates.get? branchId with
+ match state.goalStates.find? branchId with
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
@@ -188,8 +193,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match nextState? with
| .error error => return .ok { error? := .some error }
| .ok nextGoalState =>
- let (goalStates, nextStateId) := state.goalStates.insert nextGoalState
- set { state with goalStates }
+ let nextStateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert nextStateId nextGoalState,
+ nextId := state.nextId + 1
+ }
let goals ← nextGoalState.serializeGoals (parent := .some target) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
@@ -197,12 +205,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
}
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
- let goalStates := args.stateIds.foldl (λ map id => map.remove id) state.goalStates
+ let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
set { state with goalStates }
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
- match state.goalStates.get? args.stateId with
+ match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
diff --git a/Pantograph/SemihashMap.lean b/Pantograph/SemihashMap.lean
deleted file mode 100644
index 1d9ebae..0000000
--- a/Pantograph/SemihashMap.lean
+++ /dev/null
@@ -1,149 +0,0 @@
-
-namespace Pantograph.SemihashMap
-
-structure Imp (β: Type u) where
- data: Array (Option β)
-
- -- Number of elements currently in use
- size: Nat
-
- -- Next index that has never been touched
- allocFront: Nat
-
- -- Deallocated indices
- deallocs: Array Nat
-
- -- Number of valid entries in `deallocs` array
- lastDealloc: Nat
-
-namespace Imp
-
-structure WF (m: Imp β): Prop where
- capacity: m.data.size = m.deallocs.size
- front_dealloc: ∀ i: Fin m.deallocs.size, (i < m.allocFront) → (m.deallocs.get i) < m.allocFront
- front_data: ∀ i: Fin m.data.size, (i ≥ m.allocFront) → (m.data.get i).isNone
-
-def empty (capacity := 16): Imp β :=
- {
- data := mkArray capacity .none,
- size := 0,
- allocFront := 0,
- deallocs := mkArray capacity 0,
- lastDealloc := 0,
- }
-
-private theorem list_get_replicate (x: α) (i: Fin (List.replicate n x).length):
- List.get (List.replicate n x) i = x := by
- sorry
-
-theorem empty_wf : WF (empty n: Imp β) := by
- unfold empty
- apply WF.mk
- case capacity =>
- conv =>
- lhs
- congr
- simp
- conv =>
- rhs
- congr
- simp
- simp
- case front_dealloc =>
- simp_all
- intro i
- intro a
- contradiction
- case front_data =>
- simp_all
- intro i
- unfold Imp.data at i
- simp at i
- conv =>
- lhs
- unfold Array.get
- unfold mkArray
- simp [List.replicate]
- rewrite [list_get_replicate]
-
--- FIXME: Merge this with the well-formed versions below so proof and code can
--- mesh seamlessly.
-@[inline] def insert (map: Imp β) (v: β): (Imp β × Nat) :=
- match map.lastDealloc with
- | 0 => -- Capacity is full, buffer expansion is required
- if map.size == map.data.size then
- let nextIndex := map.data.size
- let extendCapacity := map.size
- let result: Imp β := {
- data := (map.data.append #[Option.some v]).append (mkArray extendCapacity .none),
- size := map.size + 1,
- allocFront := map.size + 1,
- deallocs := mkArray (map.data.size + 1 + extendCapacity) 0,
- lastDealloc := 0,
- }
- (result, nextIndex)
- else
- let nextIndex := map.size
- let result: Imp β := {
- map
- with
- data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
- size := map.size + 1,
- allocFront := map.allocFront + 1,
- }
- (result, nextIndex)
- | (.succ k) => -- Allocation list has space
- let nextIndex := map.deallocs.get! k
- let result: Imp β := {
- map with
- data := map.data.set ⟨nextIndex, sorry⟩ (Option.some v),
- size := map.size + 1,
- lastDealloc := map.lastDealloc - 1
- }
- (result, nextIndex)
-
-@[inline] def remove (map: Imp β) (index: Fin (map.size)): Imp β :=
- have h: index.val < map.data.size := by sorry
- match map.data.get ⟨index.val, h⟩ with
- | .none => map
- | .some _ =>
- {
- map with
- data := map.data.set ⟨index, sorry⟩ .none,
- size := map.size - 1,
- deallocs := map.deallocs.set ⟨map.lastDealloc, sorry⟩ index,
- lastDealloc := map.lastDealloc + 1,
- }
-
-/-- Retrieval is efficient -/
-@[inline] def get? (map: Imp β) (index: Fin (map.size)): Option β :=
- have h: index.val < map.data.size := by sorry
- map.data.get ⟨index.val, h⟩
-@[inline] def capacity (map: Imp β): Nat := map.data.size
-
-end Imp
-
-
-/--
-This is like a hashmap but you cannot control the keys.
--/
-def _root_.Pantograph.SemihashMap β := {m: Imp β // m.WF}
-
-@[inline] def empty (capacity := 16): SemihashMap β :=
- ⟨ Imp.empty capacity, Imp.empty_wf ⟩
-@[inline] def insert (map: SemihashMap β) (v: β): (SemihashMap β × Nat) :=
- let ⟨imp, pre⟩ := map
- let ⟨result, id⟩ := imp.insert v
- ( ⟨ result, sorry ⟩, id)
-@[inline] def remove (map: SemihashMap β) (index: Nat): SemihashMap β :=
- let ⟨imp, pre⟩ := map
- let result := imp.remove ⟨index, sorry⟩
- ⟨ result, sorry ⟩
-@[inline] def get? (map: SemihashMap β) (index: Nat): Option β :=
- let ⟨imp, _⟩ := map
- imp.get? ⟨index, sorry⟩
-@[inline] def size (map: SemihashMap β): Nat :=
- let ⟨imp, _⟩ := map
- imp.size
-
-end Pantograph.SemihashMap
From e654613182052affcffe355c764bef60b7c3ef6c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Nov 2023 13:07:50 -0800
Subject: [PATCH 054/465] fix: New goal state not inserted correctly
---
Pantograph.lean | 8 +++++---
Test/Integration.lean | 19 +++++++++++++++++--
2 files changed, 22 insertions(+), 5 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 0ae8192..2532d75 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -54,7 +54,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
- set { state with goalStates := Lean.HashMap.empty }
+ set { state with nextId := 0, goalStates := Lean.HashMap.empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -163,8 +163,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .error error => return .error error
| .ok (.success nextGoalState) =>
let nextStateId := state.nextId
- let goalStates := state.goalStates.insert state.nextId goalState
- set { state with goalStates, nextId := state.nextId + 1 }
+ set { state with
+ goalStates := state.goalStates.insert state.nextId nextGoalState,
+ nextId := state.nextId + 1,
+ }
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
diff --git a/Test/Integration.lean b/Test/Integration.lean
index d8570b0..65c2da6 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -83,11 +83,19 @@ def test_malformed_command : IO LSpec.TestSeq :=
Protocol.InteractionError))
]
def test_tactic : IO LSpec.TestSeq :=
- let goal: Protocol.Goal := {
+ let goal1: Protocol.Goal := {
name := "_uniq.10",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
vars := #[{ name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
+ let goal2: Protocol.Goal := {
+ name := "_uniq.13",
+ target := { pp? := .some "x ∨ y → y ∨ x" },
+ vars := #[
+ { name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
+ { name := "_uniq.12", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ ],
+ }
subroutine_runner [
subroutine_step "goal.start"
[("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
@@ -97,7 +105,14 @@ def test_tactic : IO LSpec.TestSeq :=
[("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
(Lean.toJson ({
nextStateId? := .some 1,
- goals? := #[goal],
+ goals? := #[goal1],
+ }:
+ Protocol.GoalTacticResult)),
+ subroutine_step "goal.tactic"
+ [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
+ (Lean.toJson ({
+ nextStateId? := .some 2,
+ goals? := #[goal2],
}:
Protocol.GoalTacticResult))
]
From a4913165419767ff4d5fb3b03ba24a0551d24cb3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Nov 2023 13:10:14 -0800
Subject: [PATCH 055/465] fix: Do not show parent state in continue
---
Pantograph.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 2532d75..f9f8cc6 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -200,7 +200,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goalStates := state.goalStates.insert nextStateId nextGoalState,
nextId := state.nextId + 1
}
- let goals ← nextGoalState.serializeGoals (parent := .some target) (options := state.options)
+ let goals ← nextGoalState.serializeGoals (parent := .none) (options := state.options)
return .ok {
nextStateId? := .some nextStateId,
goals? := .some goals,
From a1d991f5dbe8d618214ff971534dc8fac5149076 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 9 Nov 2023 22:24:17 -0800
Subject: [PATCH 056/465] fix: Rectify error format
---
Pantograph.lean | 6 +++---
Pantograph/Protocol.lean | 5 ++---
2 files changed, 5 insertions(+), 6 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index f9f8cc6..f456e81 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -193,7 +193,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure $ target.resume goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
match nextState? with
- | .error error => return .ok { error? := .some error }
+ | .error error => return .error <| errorI "structure" error
| .ok nextGoalState =>
let nextStateId := state.nextId
set { state with
@@ -202,8 +202,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
}
let goals ← nextGoalState.serializeGoals (parent := .none) (options := state.options)
return .ok {
- nextStateId? := .some nextStateId,
- goals? := .some goals,
+ nextStateId,
+ goals,
}
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index ce42d9d..c01228d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -176,9 +176,8 @@ structure GoalContinue where
goals?: Option (List String) := .none
deriving Lean.FromJson
structure GoalContinueResult where
- error?: Option String := .none
- nextStateId?: Option Nat := .none
- goals?: Option (Array Goal) := .none
+ nextStateId: Nat
+ goals: (Array Goal)
deriving Lean.ToJson
-- Remove goal states
From aaebb6b121c218431f539be6e89c7765d94c23ea Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 25 Nov 2023 15:07:56 -0800
Subject: [PATCH 057/465] feat: Read dependencies of library symbols
---
Pantograph.lean | 2 ++
Pantograph/Protocol.lean | 4 ++++
2 files changed, 6 insertions(+)
diff --git a/Pantograph.lean b/Pantograph.lean
index f456e81..2f712e7 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -85,6 +85,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok {
type := ← serialize_expression state.options info.type,
value? := ← value?.mapM (λ v => serialize_expression state.options v),
+ 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?
}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index c01228d..95c0236 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -113,11 +113,15 @@ structure LibInspect where
-- If true/false, show/hide the value expressions; By default definitions
-- values are shown and theorem values are hidden.
value?: Option Bool := .some false
+ -- If true, show the type and value dependencies
+ dependency?: Option Bool := .some false
deriving Lean.FromJson
structure LibInspectResult where
type: Expression
value?: Option Expression := .none
module?: Option String
+ typeDependency?: Option (Array String) := .none
+ valueDependency?: Option (Array String) := .none
deriving Lean.ToJson
/-- Set options; See `Options` struct above for meanings -/
From fe850ded9868784f65d1f6c6da82cbed93e230ab Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 26 Nov 2023 22:14:58 -0800
Subject: [PATCH 058/465] feat: Shorter symbol category
---
Pantograph/Symbol.lean | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index fb0ea1d..3b781b5 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -14,14 +14,14 @@ def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool
def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String :=
let pref := match info with
- | .axiomInfo _ => "axiom"
- | .defnInfo _ => "defn"
- | .thmInfo _ => "thm"
- | .opaqueInfo _ => "opaque"
- | .quotInfo _ => "quot"
- | .inductInfo _ => "induct"
- | .ctorInfo _ => "ctor"
- | .recInfo _ => "rec"
+ | .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 :=
From e0cfdfaf166c0428260f49fb924fa4cccb4a9b29 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 26 Nov 2023 23:48:47 -0800
Subject: [PATCH 059/465] chore: Version bump to 0.2.9
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 3fb09e9..a96b83a 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.8"
+def version := "0.2.9"
end Pantograph
From 860d2e239a7c6c966a40c3d3b2b169a3576cfcb4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 27 Nov 2023 09:54:41 -0800
Subject: [PATCH 060/465] feat: Remove | in symbol output
---
Pantograph/Symbol.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index 3b781b5..5fbb0d0 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -22,7 +22,7 @@ def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String :=
| .inductInfo _ => "i"
| .ctorInfo _ => "c"
| .recInfo _ => "r"
- s!"{pref}|{toString n}"
+ s!"{pref}{toString n}"
def to_filtered_symbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String :=
if is_symbol_unsafe_or_internal n info
From 35f411041eadc946c7ea4a2b9eb1c2eca5080f35 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 4 Dec 2023 16:21:02 -0800
Subject: [PATCH 061/465] feat: Remove printing projections
---
Pantograph/Serial.lean | 63 ++++++++++++++++++++++--------------------
Test/Serial.lean | 31 +++++++++++++++++++--
2 files changed, 62 insertions(+), 32 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index c89fc7f..959cc0b 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -84,67 +84,70 @@ partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
/--
Completely serializes an expression tree. Json not used due to compactness
-/
-partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): String :=
+partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr
where
- self (e: Expr): String :=
+ self (e: Expr): MetaM String :=
match e with
| .bvar deBruijnIndex =>
-- This is very common so the index alone is shown. Literals are handled below.
-- The raw de Bruijn index should never appear in an unbound setting. In
-- Lean these are handled using a `#` prefix.
- s!"{deBruijnIndex}"
+ pure s!"{deBruijnIndex}"
| .fvar fvarId =>
let name := of_name fvarId.name
- s!"(:fv {name})"
+ pure s!"(:fv {name})"
| .mvar mvarId =>
let name := of_name mvarId.name
- s!"(:mv {name})"
+ pure s!"(:mv {name})"
| .sort level =>
let level := serialize_sort_level_ast level sanitize
- s!"(:sort {level})"
+ pure s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
- s!"(:c {declName})"
- | .app _ _ =>
- let fn' := self e.getAppFn
- let args := e.getAppArgs.map self |>.toList
+ pure s!"(:c {declName})"
+ | .app _ _ => do
+ let fn' ← self e.getAppFn
+ let args := (← e.getAppArgs.mapM self) |>.toList
let args := " ".intercalate args
- s!"({fn'} {args})"
- | .lam binderName binderType body binderInfo =>
+ pure s!"({fn'} {args})"
+ | .lam binderName binderType body binderInfo => do
let binderName' := of_name binderName
- let binderType' := self binderType
- let body' := self body
+ let binderType' ← self binderType
+ let body' ← self body
let binderInfo' := binder_info_to_ast binderInfo
- s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
- | .forallE binderName binderType body binderInfo =>
+ pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
+ | .forallE binderName binderType body binderInfo => do
let binderName' := of_name binderName
- let binderType' := self binderType
- let body' := self body
+ let binderType' ← self binderType
+ let body' ← self body
let binderInfo' := binder_info_to_ast binderInfo
- s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
- | .letE name type value body _ =>
+ pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
+ | .letE name type value body _ => do
-- Dependent boolean flag diacarded
let name' := name_to_ast name
- let type' := self type
- let value' := self value
- let body' := self body
- s!"(:let {name'} {type'} {value'} {body'})"
+ let type' ← self type
+ let value' ← self value
+ let body' ← self body
+ pure s!"(:let {name'} {type'} {value'} {body'})"
| .lit v =>
-- To not burden the downstream parser who needs to handle this, the literal
-- is wrapped in a :lit sexp.
let v' := match v with
| .natVal val => toString val
| .strVal val => s!"\"{val}\""
- s!"(:lit {v'})"
+ pure s!"(:lit {v'})"
| .mdata _ inner =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
self inner
- | .proj typeName idx struct =>
- let struct' := self struct
- s!"(:proj {typeName} {idx} {struct'})"
+ | .proj typeName idx inner => do
+ let env ← getEnv
+ let fieldName := getStructureFields env typeName |>.get! idx
+ let inner ← Meta.mkProjection inner fieldName
+ assert! !inner.isProj
+ self inner
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
@@ -158,7 +161,7 @@ def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.E
let pp?: Option String := match options.printExprPretty with
| true => .some pp
| false => .none
- let sexp: String := serialize_expression_ast e
+ let sexp: String ← serialize_expression_ast e
let sexp?: Option String := match options.printExprAST with
| true => .some sexp
| false => .none
@@ -287,7 +290,7 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
if options.printContext then
decl.lctx.fvarIdToDecl.forM printFVar
- let type_sexp := serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
+ let type_sexp ← serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
diff --git a/Test/Serial.lean b/Test/Serial.lean
index c057bfb..0730bad 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -52,7 +52,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol.toName |>.get! |>.type
- let test := LSpec.check symbol ((serialize_expression_ast expr) = target)
+ let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let coreM := metaM.run'
let coreContext: Core.Context := {
@@ -66,6 +66,32 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
| .ok a => return a
+def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
+ let entries: List (String × String) := [
+ ("λ x: Nat × Bool => x.1", "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
+ ("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))")
+ ]
+ let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (source, target) => do
+ let env ← MonadEnv.getEnv
+ let s := syntax_from_str env source |>.toOption |>.get!
+ let expr := (← syntax_to_expr s) |>.toOption |>.get!
+ let test := LSpec.check source ((← serialize_expression_ast expr) = target)
+ return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
+ let metaM := termElabM.run' (ctx := {
+ declName? := some "_pantograph",
+ errToSorry := false
+ })
+ let coreM := metaM.run'
+ let coreContext: Core.Context := {
+ currNamespace := Lean.Name.str .anonymous "Aniva"
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph/Test>",
+ fileMap := { source := "", positions := #[0], lines := #[1] }
+ }
+ match ← (coreM.run' coreContext { env := env }).toBaseIO with
+ | .error exception =>
+ return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+ | .ok a => return a
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
@@ -76,6 +102,7 @@ def suite: IO LSpec.TestSeq := do
return LSpec.group "Serialization" $
(LSpec.group "name_to_ast" test_name_to_ast) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
- (LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env))
+ (LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env)) ++
+ (LSpec.group "Sexp from expr" (← test_sexp_of_expr env))
end Pantograph.Test.Serial
From f72a82a4c91fbb96b98b1f406e660e63e887211f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 4 Dec 2023 16:40:15 -0800
Subject: [PATCH 062/465] feat: Remove stem deduce
Some private subproofs are not shown in the catalog and this breaks
dependencies
---
Pantograph/Symbol.lean | 6 +-----
1 file changed, 1 insertion(+), 5 deletions(-)
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index 5fbb0d0..a473b98 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -6,11 +6,7 @@ def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool
let nameDeduce: Bool := match n.getRoot with
| .str _ name => name.startsWith "_" ∨ name == "Lean"
| _ => true
- let stemDeduce: Bool := match n with
- | .anonymous => true
- | .str _ name => name.startsWith "_"
- | .num _ _ => true
- nameDeduce ∨ stemDeduce ∨ info.isUnsafe
+ nameDeduce ∨ info.isUnsafe
def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String :=
let pref := match info with
From c80d7567b6eea9ad4b1d692a3d2c902e153293af Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 4 Dec 2023 23:36:09 -0800
Subject: [PATCH 063/465] feat: Expose _private names
---
Pantograph/Symbol.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index a473b98..07bbc2c 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -4,7 +4,7 @@ namespace Pantograph
def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
let nameDeduce: Bool := match n.getRoot with
- | .str _ name => name.startsWith "_" ∨ name == "Lean"
+ | .str _ name => name == "Lean"
| _ => true
nameDeduce ∨ info.isUnsafe
From cdb1e8576f671e5650468e6a351c9d0cd3cbc9e7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 5 Dec 2023 19:07:00 -0800
Subject: [PATCH 064/465] feat: Display whether a symbol is private
---
Pantograph.lean | 1 +
Pantograph/Protocol.lean | 1 +
Pantograph/Symbol.lean | 11 ++++++-----
Test/Catalog.lean | 33 +++++++++++++++++++++++++++++++++
Test/Integration.lean | 4 ++--
Test/Main.lean | 4 +++-
6 files changed, 46 insertions(+), 8 deletions(-)
create mode 100644 Test/Catalog.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 2f712e7..cc4096d 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -85,6 +85,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok {
type := ← serialize_expression state.options info.type,
value? := ← value?.mapM (λ v => serialize_expression state.options v),
+ isPrivate := Lean.isPrivateName name,
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?
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 95c0236..f99acb0 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -120,6 +120,7 @@ structure LibInspectResult where
type: Expression
value?: Option Expression := .none
module?: Option String
+ isPrivate: Bool
typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none
deriving Lean.ToJson
diff --git a/Pantograph/Symbol.lean b/Pantograph/Symbol.lean
index 07bbc2c..ba80877 100644
--- a/Pantograph/Symbol.lean
+++ b/Pantograph/Symbol.lean
@@ -1,12 +1,13 @@
-import Lean.Declaration
+import Lean
namespace Pantograph
def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
- let nameDeduce: Bool := match n.getRoot with
- | .str _ name => name == "Lean"
- | _ => true
- nameDeduce ∨ info.isUnsafe
+ 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
diff --git a/Test/Catalog.lean b/Test/Catalog.lean
new file mode 100644
index 0000000..e082369
--- /dev/null
+++ b/Test/Catalog.lean
@@ -0,0 +1,33 @@
+import LSpec
+import Pantograph.Serial
+import Pantograph.Symbol
+
+namespace Pantograph.Test.Catalog
+
+open Pantograph
+open Lean
+
+def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
+ let entries: List (Name × Bool) := [
+ ("Nat.add_comm".toName, false),
+ ("Lean.Name".toName, true),
+ ("_private.Init.0.Lean.Name".toName, true)
+ ]
+ 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)
+ LSpec.TestSeq.append suites test) LSpec.TestSeq.done
+ return suite
+
+
+
+def suite: IO LSpec.TestSeq := do
+ let env: Environment ← importModules
+ (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
+ (opts := {})
+ (trustLevel := 1)
+
+ return LSpec.group "Catalog" $
+ (LSpec.group "Symbol visibility" (← test_symbol_visibility env))
+
+end Pantograph.Test.Catalog
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 65c2da6..bfe1766 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -52,7 +52,7 @@ def test_option_modify : IO LSpec.TestSeq :=
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
- type := { pp? }, module? }:
+ type := { pp? }, module?, isPrivate := false }:
Protocol.LibInspectResult)),
subroutine_step "options.set"
[("printExprAST", .bool true)]
@@ -61,7 +61,7 @@ def test_option_modify : IO LSpec.TestSeq :=
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
- type := { pp?, sexp? }, module? }:
+ type := { pp?, sexp? }, module?, isPrivate := false }:
Protocol.LibInspectResult)),
subroutine_step "options.print"
[]
diff --git a/Test/Main.lean b/Test/Main.lean
index 82d8748..5178e85 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,4 +1,5 @@
import LSpec
+import Test.Catalog
import Test.Holes
import Test.Integration
import Test.Proofs
@@ -13,7 +14,8 @@ def main := do
Holes.suite,
Integration.suite,
Proofs.suite,
- Serial.suite
+ Serial.suite,
+ Catalog.suite
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all
From dbfee00420d8ce93d152888c61c601540ec3dfb3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 5 Dec 2023 20:20:08 -0800
Subject: [PATCH 065/465] feat!: Display public name only if name is private
---
Pantograph.lean | 2 +-
Pantograph/Protocol.lean | 3 ++-
Test/Integration.lean | 4 ++--
3 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index cc4096d..958e43c 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -85,7 +85,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok {
type := ← serialize_expression state.options info.type,
value? := ← value?.mapM (λ v => serialize_expression state.options v),
- isPrivate := Lean.isPrivateName name,
+ publicName? := Lean.privateToUserName? name |>.map (·.toString),
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?
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index f99acb0..582ee1d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -120,7 +120,8 @@ structure LibInspectResult where
type: Expression
value?: Option Expression := .none
module?: Option String
- isPrivate: Bool
+ -- If the name is private, displays the public facing name
+ publicName?: Option String := .none
typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none
deriving Lean.ToJson
diff --git a/Test/Integration.lean b/Test/Integration.lean
index bfe1766..65c2da6 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -52,7 +52,7 @@ def test_option_modify : IO LSpec.TestSeq :=
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
- type := { pp? }, module?, isPrivate := false }:
+ type := { pp? }, module? }:
Protocol.LibInspectResult)),
subroutine_step "options.set"
[("printExprAST", .bool true)]
@@ -61,7 +61,7 @@ def test_option_modify : IO LSpec.TestSeq :=
subroutine_step "lib.inspect"
[("name", .str "Nat.add_one")]
(Lean.toJson ({
- type := { pp?, sexp? }, module?, isPrivate := false }:
+ type := { pp?, sexp? }, module? }:
Protocol.LibInspectResult)),
subroutine_step "options.print"
[]
From 079f12d6d3378a779a91a9e99f29f7e243dd2914 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 5 Dec 2023 20:21:07 -0800
Subject: [PATCH 066/465] chore: Version bump
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index a96b83a..d71bedb 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.9"
+def version := "0.2.10"
end Pantograph
From 8a8db545a59dc6296a9421478ccacc3e43159f0d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 5 Dec 2023 22:45:59 -0800
Subject: [PATCH 067/465] fix: Printing projection leads to crash
---
Pantograph/Protocol.lean | 2 +-
Pantograph/Serial.lean | 6 +++---
lake-manifest.json | 5 +++--
3 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 582ee1d..a88a54a 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -119,7 +119,7 @@ structure LibInspect where
structure LibInspectResult where
type: Expression
value?: Option Expression := .none
- module?: Option String
+ module?: Option String := .none
-- If the name is private, displays the public facing name
publicName?: Option String := .none
typeDependency?: Option (Array String) := .none
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 959cc0b..42fc4e2 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -145,9 +145,9 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
| .proj typeName idx inner => do
let env ← getEnv
let fieldName := getStructureFields env typeName |>.get! idx
- let inner ← Meta.mkProjection inner fieldName
- assert! !inner.isProj
- self inner
+ let projectorName := getProjFnForField? env typeName fieldName |>.get!
+ let e := Expr.app (.const projectorName []) inner
+ self e
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
diff --git a/lake-manifest.json b/lake-manifest.json
index 5a13649..6c2efa0 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,4 +1,4 @@
-{"version": 5,
+{"version": 6,
"packagesDir": "lake-packages",
"packages":
[{"git":
@@ -8,4 +8,5 @@
"opts": {},
"name": "LSpec",
"inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
- "inherited": false}}]}
+ "inherited": false}}],
+ "name": "pantograph"}
From 924a67f46daaaefd3f4bc91f815b6d465a4f7f23 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 6 Dec 2023 15:05:04 -0800
Subject: [PATCH 068/465] doc: getUsedConstants bug about projections
---
Pantograph.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph.lean b/Pantograph.lean
index 958e43c..a66db35 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -86,6 +86,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
type := ← serialize_expression state.options info.type,
value? := ← value?.mapM (λ v => serialize_expression state.options v),
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?
From d7fcc502f9e848ad4a36974dd694614f6e4c7a44 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 7 Dec 2023 12:36:43 -0800
Subject: [PATCH 069/465] chore: Version downgrade to 0.2.10-alpha
There is a currently known bug
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index d71bedb..67cbb8f 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.10"
+def version := "0.2.10-alpha"
end Pantograph
From 2fe4fa9bc46e30ba7d9089a3ecd7c58a2a75f6c3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Dec 2023 16:17:16 -0800
Subject: [PATCH 070/465] fix: Change the main interaction monad to MetaM
---
Main.lean | 6 +-----
Pantograph.lean | 18 ++++++++++++------
Test/Catalog.lean | 5 +----
Test/Integration.lean | 6 +-----
4 files changed, 15 insertions(+), 20 deletions(-)
diff --git a/Main.lean b/Main.lean
index 59a7e95..e833649 100644
--- a/Main.lean
+++ b/Main.lean
@@ -102,11 +102,7 @@ unsafe def main (args: List String): IO Unit := do
options := options
}
try
- let termElabM := loop.run context |>.run' {}
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
+ let metaM := loop.run context |>.run' {}
let coreM := metaM.run'
IO.println "ready."
discard <| coreM.toIO coreContext { env := env }
diff --git a/Pantograph.lean b/Pantograph.lean
index a66db35..ab6a7b1 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -16,11 +16,17 @@ structure State where
goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context (StateT State Lean.Elab.TermElabM)
+abbrev MainM := ReaderT Context (StateT State Lean.MetaM)
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
+def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
+ termElabM.run' (ctx := {
+ declName? := .none,
+ errToSorry := false,
+ })
+
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
@@ -97,7 +103,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match syntax_from_str env args.expr with
| .error str => return .error $ errorI "parsing" str
| .ok syn => do
- match (← syntax_to_expr syn) with
+ match ← runTermElabM <| syntax_to_expr syn with
| .error str => return .error $ errorI "elab" str
| .ok expr => do
try
@@ -133,7 +139,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
(match syntax_from_str env expr with
| .error str => return .error <| errorI "parsing" str
| .ok syn => do
- (match (← syntax_to_expr syn) with
+ (match ← runTermElabM <| syntax_to_expr syn with
| .error str => return .error <| errorI "elab" str
| .ok expr => return .ok expr))
| .none, .some copyFrom =>
@@ -145,7 +151,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match expr? with
| .error error => return .error error
| .ok expr =>
- let goalState ← GoalState.create expr
+ let goalState ← runTermElabM <| GoalState.create expr
let stateId := state.nextId
set { state with
goalStates := state.goalStates.insert stateId goalState,
@@ -159,9 +165,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .some goalState => do
let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
| .some tactic, .none => do
- pure ( Except.ok (← GoalState.execute goalState args.goalId tactic))
+ pure ( Except.ok (← runTermElabM <| GoalState.execute goalState args.goalId tactic))
| .none, .some expr => do
- pure ( Except.ok (← GoalState.tryAssign goalState args.goalId expr))
+ pure ( Except.ok (← runTermElabM <| GoalState.tryAssign goalState args.goalId expr))
| _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr} must be supplied")
match nextGoalState? with
| .error error => return .error error
diff --git a/Test/Catalog.lean b/Test/Catalog.lean
index e082369..44c2bf7 100644
--- a/Test/Catalog.lean
+++ b/Test/Catalog.lean
@@ -10,8 +10,7 @@ open Lean
def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
- ("Lean.Name".toName, true),
- ("_private.Init.0.Lean.Name".toName, true)
+ ("Lean.Name".toName, true)
]
let suite := entries.foldl (λ suites (symbol, target) =>
let constant := env.constants.find! symbol
@@ -19,8 +18,6 @@ def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite
-
-
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 65c2da6..50ee740 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -33,11 +33,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
let result ← step
return suite ++ result) LSpec.TestSeq.done
try
- let termElabM := commands.run context |>.run' {}
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
+ let metaM := commands.run context |>.run' {}
let coreM := metaM.run'
return Prod.fst $ (← coreM.toIO coreContext { env := env })
catch ex =>
From bd0c66facc42700a1efe761ea1a4c40399c24bdc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Dec 2023 17:31:25 -0800
Subject: [PATCH 071/465] fix: Consolidate TermElabM blocks
---
Pantograph.lean | 12 ++++++------
Pantograph/Goal.lean | 6 ++++++
Pantograph/Serial.lean | 4 ++--
3 files changed, 14 insertions(+), 8 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index ab6a7b1..a5a181b 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -134,24 +134,23 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let expr?: Except _ Lean.Expr ← (match args.expr, args.copyFrom with
+ let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
| .some expr, .none =>
(match syntax_from_str env expr with
| .error str => return .error <| errorI "parsing" str
| .ok syn => do
- (match ← runTermElabM <| syntax_to_expr syn with
+ (match ← syntax_to_expr syn with
| .error str => return .error <| errorI "elab" str
- | .ok expr => return .ok expr))
+ | .ok expr => return .ok (← GoalState.create expr)))
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
- | .some cInfo => return .ok cInfo.type)
+ | .some cInfo => return .ok (← GoalState.create cInfo.type))
| _, _ =>
return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
match expr? with
| .error error => return .error error
- | .ok expr =>
- let goalState ← runTermElabM <| GoalState.create expr
+ | .ok goalState =>
let stateId := state.nextId
set { state with
goalStates := state.goalStates.insert stateId goalState,
@@ -225,6 +224,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
+ goalState.restoreMetaM
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
return .ok {
root?,
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 3645087..1589408 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -51,6 +51,10 @@ protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
+private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
+ state.savedState.term.restore
+def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
+ state.savedState.term.meta.restore
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
@@ -84,6 +88,7 @@ inductive TacticResult where
/-- Execute tactic on given state -/
protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String):
M TacticResult := do
+ state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
@@ -118,6 +123,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
}
protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
+ state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 42fc4e2..3d0d945 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -242,8 +242,8 @@ def serialize_goal (options: Protocol.Options) (goal: MVarId) (mvarDecl: Metavar
of_name (n: Name) := name_to_ast n (sanitize := false)
protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalState := .none) (options: Protocol.Options := {}): MetaM (Array Protocol.Goal):= do
+ state.restoreMetaM
let goals := state.goals.toArray
- state.savedState.term.meta.restore
let parentDecl? := parent.bind (λ parentState =>
let parentGoal := parentState.goals.get! state.parentGoalId
parentState.mctx.findDecl? parentGoal)
@@ -256,8 +256,8 @@ protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalSt
/-- Print the metavariables in a readable format -/
protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
+ goalState.restoreMetaM
let savedState := goalState.savedState
- savedState.term.meta.restore
let goals := savedState.tactic.goals
let mctx ← getMCtx
let root := goalState.root
From ac9f6f810c6a332fd0622e47c7f397bcb20550bb Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Dec 2023 17:32:30 -0800
Subject: [PATCH 072/465] doc: TermElabM metavariable generation
---
Pantograph/Serial.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 3d0d945..072872b 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -26,6 +26,7 @@ def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
(fileName := "<stdin>")
+/-- Parse a syntax object. May generate additional metavariables! -/
def syntax_to_expr_type (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabType syn
From 085b12c255b2d97ec9c01dc342977689f071b604 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 12 Dec 2023 18:39:02 -0800
Subject: [PATCH 073/465] feat: Use CoreM as the main interaction monad
---
Main.lean | 3 +--
Pantograph.lean | 22 ++++++++++++----------
Test/Integration.lean | 3 +--
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/Main.lean b/Main.lean
index e833649..68d1a3e 100644
--- a/Main.lean
+++ b/Main.lean
@@ -102,8 +102,7 @@ unsafe def main (args: List String): IO Unit := do
options := options
}
try
- let metaM := loop.run context |>.run' {}
- let coreM := metaM.run'
+ let coreM := loop.run context |>.run' {}
IO.println "ready."
discard <| coreM.toIO coreContext { env := env }
catch ex =>
diff --git a/Pantograph.lean b/Pantograph.lean
index a5a181b..1e3dbe3 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -16,16 +16,18 @@ structure State where
goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context (StateT State Lean.MetaM)
+abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
-def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
+def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
+ metaM.run'
+def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
termElabM.run' (ctx := {
declName? := .none,
errToSorry := false,
- })
+ }) |>.run'
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
@@ -89,8 +91,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none, .defnInfo _ => info.value?
| .none, _ => .none
return .ok {
- type := ← serialize_expression state.options info.type,
- value? := ← value?.mapM (λ v => serialize_expression state.options v),
+ 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,
@@ -102,8 +104,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let env ← Lean.MonadEnv.getEnv
match syntax_from_str env args.expr with
| .error str => return .error $ errorI "parsing" str
- | .ok syn => do
- match ← runTermElabM <| syntax_to_expr syn with
+ | .ok syn => runTermElabM do
+ match ← syntax_to_expr syn with
| .error str => return .error $ errorI "elab" str
| .ok expr => do
try
@@ -176,7 +178,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goalStates := state.goalStates.insert state.nextId nextGoalState,
nextId := state.nextId + 1,
}
- let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options)
+ let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
return .ok {
nextStateId? := .some nextStateId,
goals? := .some goals,
@@ -209,7 +211,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goalStates := state.goalStates.insert nextStateId nextGoalState,
nextId := state.nextId + 1
}
- let goals ← nextGoalState.serializeGoals (parent := .none) (options := state.options)
+ let goals ← nextGoalState.serializeGoals (parent := .none) (options := state.options) |>.run'
return .ok {
nextStateId,
goals,
@@ -223,7 +225,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
- | .some goalState => do
+ | .some goalState => runMetaM <| do
goalState.restoreMetaM
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
return .ok {
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 50ee740..5aad1e7 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -33,8 +33,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
let result ← step
return suite ++ result) LSpec.TestSeq.done
try
- let metaM := commands.run context |>.run' {}
- let coreM := metaM.run'
+ let coreM := commands.run context |>.run' {}
return Prod.fst $ (← coreM.toIO coreContext { env := env })
catch ex =>
return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
From ff4671cdd091da66668d20cf18b3fc829ad8bb1d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 12 Dec 2023 18:56:25 -0800
Subject: [PATCH 074/465] chore: Rename lib. commands to env.
This is done to improve clarity and align with Lean's terminology
---
Pantograph.lean | 8 ++++----
Pantograph/Protocol.lean | 8 ++++----
README.md | 10 +++++-----
Test/Catalog.lean | 3 +--
Test/Integration.lean | 8 ++++----
5 files changed, 18 insertions(+), 19 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index a66db35..c376999 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -33,8 +33,8 @@ 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
| "options.set" => run options_set
| "options.print" => run options_print
| "goal.start" => run goal_start
@@ -60,14 +60,14 @@ 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
+ env_catalog (_: Protocol.EnvCatalog): MainM (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 }
- lib_inspect (args: Protocol.LibInspect): MainM (CR Protocol.LibInspectResult) := do
+ env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index a88a54a..b544881 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -102,13 +102,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 +116,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
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": <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": <name>, "value": <bool>}`: Show the type and package of a
+- `env.catalog`: Display a list of all safe Lean symbols in the current environment
+- `env.inspect {"name": <name>, "value": <bool>}`: 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/Catalog.lean
index e082369..99447e7 100644
--- a/Test/Catalog.lean
+++ b/Test/Catalog.lean
@@ -10,8 +10,7 @@ open Lean
def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
- ("Lean.Name".toName, true),
- ("_private.Init.0.Lean.Name".toName, true)
+ ("Lean.Name".toName, true)
]
let suite := entries.foldl (λ suites (symbol, target) =>
let constant := env.constants.find! symbol
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 65c2da6..44faf1b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -49,20 +49,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 }:
From 3c96a7c0ea9cb47e6fd8b74035704b521b133f68 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 13 Dec 2023 19:35:32 -0800
Subject: [PATCH 075/465] feat: env_add command
---
Pantograph.lean | 33 +++++++++++++++++++++++++++++++++
Pantograph/Protocol.lean | 8 ++++++++
2 files changed, 41 insertions(+)
diff --git a/Pantograph.lean b/Pantograph.lean
index c376999..3462ccb 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -35,6 +35,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "expr.echo" => run expr_echo
| "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
@@ -50,6 +51,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
errorCommand := errorI "command"
errorIndex := errorI "index"
+ errorExpr := errorI "expr"
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -91,6 +93,37 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
valueDependency? := if args.dependency?.getD false then info.value?.map (·.getUsedConstants.map (λ n => name_to_ast n)) else .none,
module? := module?
}
+ env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
+ let env ← Lean.MonadEnv.getEnv
+ let type ← match syntax_from_str env args.type with
+ | .ok syn => do
+ match ← syntax_to_expr syn with
+ | .error e => return .error $ errorExpr e
+ | .ok expr => pure expr
+ | .error e => return .error $ errorExpr e
+ let value ← match syntax_from_str env args.value with
+ | .ok syn => do
+ try
+ let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
+ pure $ expr
+ catch ex => return .error $ errorExpr (← ex.toMessageData.toString)
+ | .error e => return .error $ 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 errorMessage ← (e.toMessageData options).toString
+ return .error $ errorI "kernel" errorMessage
+ | .ok env' => pure env'
+ Lean.MonadEnv.modifyEnv (λ _ => env')
+ return .ok {}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index b544881..8bf754a 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -125,6 +125,14 @@ structure EnvInspectResult 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
From 85eb42207c4d234714e87e00de3e2cc35a103483 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Dec 2023 05:52:12 -0800
Subject: [PATCH 076/465] fix: env_add monads
---
Pantograph.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index bdaa57c..ad3b221 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -105,14 +105,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let env ← Lean.MonadEnv.getEnv
let type ← match syntax_from_str env args.type with
| .ok syn => do
- match ← syntax_to_expr syn with
+ match ← (syntax_to_expr syn |> runTermElabM) with
| .error e => return .error $ errorExpr e
| .ok expr => pure expr
| .error e => return .error $ errorExpr e
let value ← match syntax_from_str env args.value with
| .ok syn => do
try
- let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
+ let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type) |> runTermElabM
pure $ expr
catch ex => return .error $ errorExpr (← ex.toMessageData.toString)
| .error e => return .error $ errorExpr e
From a540dd4540badfbc4fe2b0441ef77b314023c3d9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Dec 2023 11:11:24 -0800
Subject: [PATCH 077/465] test: env.add
---
Pantograph.lean | 40 ++++++++++++++++++++++++----------------
Test/Integration.lean | 23 ++++++++++++++++++++++-
2 files changed, 46 insertions(+), 17 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index ad3b221..aeb920e 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -103,18 +103,25 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
}
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv
- let type ← match syntax_from_str env args.type with
- | .ok syn => do
- match ← (syntax_to_expr syn |> runTermElabM) with
- | .error e => return .error $ errorExpr e
- | .ok expr => pure expr
- | .error e => return .error $ errorExpr e
- let value ← match syntax_from_str env args.value with
- | .ok syn => do
- try
- let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type) |> runTermElabM
- pure $ expr
- catch ex => return .error $ errorExpr (← ex.toMessageData.toString)
+ let tv?: Except String (Lean.Expr × Lean.Expr) ← runTermElabM (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 ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
+ let expr ← Lean.instantiateMVars expr
+ pure $ expr
+ 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
let constant := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
(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
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
@@ -148,7 +156,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/Test/Integration.lean b/Test/Integration.lean
index 16eb73c..351efa3 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -112,12 +112,33 @@ def test_tactic : IO LSpec.TestSeq :=
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
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
From aef93cf5063ed5ef9a4e599728fc8dfc8bccd533 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Dec 2023 13:07:59 -0500
Subject: [PATCH 078/465] fix: Force instantiate all mvars in env.add
---
Pantograph.lean | 1 +
Test/Integration.lean | 22 +++++++++++++++++++---
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index aeb920e..2bd066e 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -114,6 +114,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .ok syn => do
try
let expr ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
+ Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← Lean.instantiateMVars expr
pure $ expr
catch ex => return .error (← ex.toMessageData.toString)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 351efa3..0a6c210 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -113,21 +113,37 @@ def test_tactic : IO LSpec.TestSeq :=
]
def test_env : IO LSpec.TestSeq :=
- let name := "Pantograph.Mystery"
+ let name1 := "Pantograph.mystery"
+ let name2 := "Pantograph.mystery2"
subroutine_runner [
subroutine_step "env.add"
[
- ("name", .str name),
+ ("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 name)]
+ [("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))
]
From da194a1165745607468e45b9bd2c0e66d95aa7ef Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Dec 2023 13:37:55 -0500
Subject: [PATCH 079/465] refactor: env. operations into its own file
---
Pantograph.lean | 73 +++------------------------------
Pantograph/Environment.lean | 82 +++++++++++++++++++++++++++++++++++++
Pantograph/Protocol.lean | 3 ++
3 files changed, 90 insertions(+), 68 deletions(-)
create mode 100644 Pantograph/Environment.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 2bd066e..30ac0c0 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -2,6 +2,7 @@ import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.Serial
import Pantograph.Symbol
+import Pantograph.Environment
import Lean.Data.HashMap
namespace Pantograph
@@ -59,7 +60,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
errorCommand := errorI "command"
errorIndex := errorI "index"
- errorExpr := errorI "expr"
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -70,76 +70,13 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let nGoals := state.goalStates.size
return .ok { nGoals }
- env_catalog (_: Protocol.EnvCatalog): MainM (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 }
+ 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
- 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
- | .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 ← Lean.Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
- Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing
- let expr ← Lean.instantiateMVars expr
- pure $ expr
- 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
- 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 errorMessage ← (e.toMessageData options).toString
- return .error $ errorI "kernel" errorMessage
- | .ok env' => pure env'
- Lean.MonadEnv.modifyEnv (λ _ => env')
- return .ok {}
+ Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
new file mode 100644
index 0000000..e9a884e
--- /dev/null
+++ b/Pantograph/Environment.lean
@@ -0,0 +1,82 @@
+import Pantograph.Protocol
+import Pantograph.Symbol
+import Pantograph.Serial
+import Lean
+
+open Lean
+open Pantograph
+
+namespace Pantograph.Environment
+
+abbrev CR α := Except Protocol.InteractionError α
+
+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/Protocol.lean b/Pantograph/Protocol.lean
index 8bf754a..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 ---
From dc90b6b73e9e016144871d9619206d9ced04f636 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Dec 2023 13:40:36 -0500
Subject: [PATCH 080/465] chore: Move environment functions to its own file
Symbol.lean is now subsumed
---
Pantograph.lean | 1 -
Pantograph/Environment.lean | 24 +++++++++++++++++++++++-
Pantograph/Goal.lean | 2 --
Pantograph/Symbol.lean | 29 -----------------------------
Test/Catalog.lean | 4 ++--
Test/Serial.lean | 1 -
6 files changed, 25 insertions(+), 36 deletions(-)
delete mode 100644 Pantograph/Symbol.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 30ac0c0..9d9399d 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,7 +1,6 @@
import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.Serial
-import Pantograph.Symbol
import Pantograph.Environment
import Lean.Data.HashMap
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index e9a884e..ab4513f 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -1,5 +1,4 @@
import Pantograph.Protocol
-import Pantograph.Symbol
import Pantograph.Serial
import Lean
@@ -10,6 +9,29 @@ 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 =>
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/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/Test/Catalog.lean b/Test/Catalog.lean
index 44c2bf7..43becdc 100644
--- a/Test/Catalog.lean
+++ b/Test/Catalog.lean
@@ -1,6 +1,6 @@
import LSpec
import Pantograph.Serial
-import Pantograph.Symbol
+import Pantograph.Environment
namespace Pantograph.Test.Catalog
@@ -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
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
From 1c370ef2ae3db85907f8870dd85532266ff513e9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 26 Dec 2023 12:22:57 -0500
Subject: [PATCH 081/465] refactor: Rename Test/{Catalog,Environment}
---
Test/{Catalog.lean => Environment.lean} | 6 +++---
Test/Main.lean | 4 ++--
2 files changed, 5 insertions(+), 5 deletions(-)
rename Test/{Catalog.lean => Environment.lean} (88%)
diff --git a/Test/Catalog.lean b/Test/Environment.lean
similarity index 88%
rename from Test/Catalog.lean
rename to Test/Environment.lean
index 43becdc..3bd8448 100644
--- a/Test/Catalog.lean
+++ b/Test/Environment.lean
@@ -2,7 +2,7 @@ import LSpec
import Pantograph.Serial
import Pantograph.Environment
-namespace Pantograph.Test.Catalog
+namespace Pantograph.Test.Environment
open Pantograph
open Lean
@@ -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/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
From 6692303da616726ff9ea0b577f1ca6c42b4ccd7c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 7 Jan 2024 14:14:20 -0800
Subject: [PATCH 082/465] test: Simplify monad execution
---
Test/Common.lean | 21 +++++++++++++++++++++
Test/Serial.lean | 49 ++++++++++++++++--------------------------------
2 files changed, 37 insertions(+), 33 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index 5b74a0f..2257c7c 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -32,4 +32,25 @@ def TacticResult.toString : TacticResult → String
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
+open Lean
+
+def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq): IO LSpec.TestSeq := do
+ let coreContext: Core.Context := {
+ currNamespace := Name.str .anonymous "Aniva"
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph/Test>",
+ fileMap := { source := "", positions := #[0], lines := #[1] }
+ }
+ match ← (coreM.run' coreContext { env := env }).toBaseIO with
+ | .error exception =>
+ return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
+ | .ok a => return a
+def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSeq :=
+ runCoreMSeq env metaM.run'
+def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
+ termElabM.run' (ctx := {
+ declName? := .none,
+ errToSorry := false,
+ })
+
end Pantograph
diff --git a/Test/Serial.lean b/Test/Serial.lean
index e502fa8..765b74e 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -1,5 +1,6 @@
import LSpec
import Pantograph.Serial
+import Test.Common
namespace Pantograph.Test.Serial
@@ -26,16 +27,7 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let expr := env.find? symbol |>.get! |>.type
let test := LSpec.check symbol.toString ((← type_expr_to_bound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
- let coreContext: Core.Context := {
- currNamespace := Lean.Name.str .anonymous "Aniva"
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph/Test>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- match ← (coreM.run' coreContext { env := env }).toBaseIO with
- | .error exception =>
- return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
- | .ok a => return a
+ runCoreMSeq env coreM
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
@@ -53,17 +45,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let expr := env.find? symbol.toName |>.get! |>.type
let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- let coreM := metaM.run'
- let coreContext: Core.Context := {
- currNamespace := Lean.Name.str .anonymous "Aniva"
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph/Test>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- match ← (coreM.run' coreContext { env := env }).toBaseIO with
- | .error exception =>
- return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
- | .ok a => return a
+ runMetaMSeq env metaM
def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
@@ -80,17 +62,17 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
declName? := some "_pantograph",
errToSorry := false
})
- let coreM := metaM.run'
- let coreContext: Core.Context := {
- currNamespace := Lean.Name.str .anonymous "Aniva"
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph/Test>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- match ← (coreM.run' coreContext { env := env }).toBaseIO with
- | .error exception =>
- return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
- | .ok a => return a
+ runMetaMSeq env metaM
+
+-- Instance parsing
+def test_instance (env: Environment): IO LSpec.TestSeq := do
+ let metaM: MetaM LSpec.TestSeq := do
+ let env ← MonadEnv.getEnv
+ let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
+ let s := syntax_from_str env source |>.toOption |>.get!
+ let expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get!
+ return LSpec.TestSeq.done
+ runMetaMSeq env metaM
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
@@ -102,6 +84,7 @@ def suite: IO LSpec.TestSeq := do
(LSpec.group "name_to_ast" test_name_to_ast) ++
(LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
(LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env)) ++
- (LSpec.group "Sexp from expr" (← test_sexp_of_expr env))
+ (LSpec.group "Sexp from expr" (← test_sexp_of_expr env)) ++
+ (LSpec.group "Instance" (← test_instance env))
end Pantograph.Test.Serial
From 6fb1b2e78716486dd5b313d2f1349840a33c4f73 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 16 Jan 2024 13:29:30 -0800
Subject: [PATCH 083/465] feat: Print inductives in env.inspect
---
Pantograph/Environment.lean | 52 +++++++++++++++++++++++--------------
Pantograph/Protocol.lean | 14 ++++++++++
Test/Environment.lean | 23 +++++++++++++++-
3 files changed, 69 insertions(+), 20 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index ab4513f..5295b6d 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -43,25 +43,39 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
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?
- }
+ let info ← match info? with
+ | none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}"
+ | some info => pure 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
+ -- Information common to all symbols
+ let core := {
+ 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?
+ }
+ let result := match info with
+ | .inductInfo induct => { core with inductInfo? := .some {
+ numParams := induct.numParams,
+ numIndices := induct.numIndices,
+ all := induct.all.map (·.toString),
+ ctors := induct.ctors.map (·.toString),
+ isRec := induct.isRec,
+ isUnsafe := induct.isUnsafe,
+ isReflexive := induct.isReflexive,
+ isNested := induct.isNested,
+ } }
+ | _ => core
+ return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv
let tvM: Elab.TermElabM (Except String (Expr × Expr)) := do
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index c0204d0..ef463b1 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -110,6 +110,7 @@ structure EnvCatalog where
structure EnvCatalogResult where
symbols: Array String
deriving Lean.ToJson
+
-- Print the type of a symbol
structure EnvInspect where
name: String
@@ -119,6 +120,17 @@ structure EnvInspect where
-- If true, show the type and value dependencies
dependency?: Option Bool := .some false
deriving Lean.FromJson
+-- See `InductiveVal`
+structure InductInfo where
+ numParams: Nat
+ numIndices: Nat
+ all: List String
+ ctors: List String
+ isRec: Bool := false
+ isUnsafe: Bool := false
+ isReflexive: Bool := false
+ isNested: Bool := false
+ deriving Lean.ToJson
structure EnvInspectResult where
type: Expression
value?: Option Expression := .none
@@ -127,7 +139,9 @@ structure EnvInspectResult where
publicName?: Option String := .none
typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none
+ inductInfo?: Option InductInfo := .none
deriving Lean.ToJson
+
structure EnvAdd where
name: String
type: String
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 3bd8448..44fb8de 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -1,12 +1,16 @@
import LSpec
import Pantograph.Serial
import Pantograph.Environment
+import Test.Common
namespace Pantograph.Test.Environment
open Pantograph
open Lean
+deriving instance DecidableEq, Repr for Protocol.InductInfo
+deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
+
def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
@@ -18,6 +22,22 @@ def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite
+def test_inspect (env: Environment): IO LSpec.TestSeq := do
+ let inner: CoreM LSpec.TestSeq := do
+ let args: Protocol.EnvInspect := { name := "Or" }
+ let result ← match ← Environment.inspect args (options := {}) with
+ | .ok result => pure $ result
+ | .error e => panic! s!"Error: {e.desc}"
+ --IO.println s!"{reprStr result.inductInfo?}"
+ let test := LSpec.check "Or" (result.inductInfo? == .some {
+ numParams := 2,
+ numIndices := 0,
+ all := ["Or"],
+ ctors := ["Or.inl", "Or.inr"],
+ })
+ return LSpec.TestSeq.append LSpec.TestSeq.done test
+ runCoreMSeq env inner
+
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
@@ -25,6 +45,7 @@ def suite: IO LSpec.TestSeq := do
(trustLevel := 1)
return LSpec.group "Environment" $
- (LSpec.group "Symbol visibility" (← test_symbol_visibility env))
+ (LSpec.group "Symbol visibility" (← test_symbol_visibility env)) ++
+ (LSpec.group "Inspect" (← test_inspect env))
end Pantograph.Test.Environment
From 50ac2fea4bb1cf258589daa595bbb8bc25d58ba2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 16 Jan 2024 14:11:52 -0800
Subject: [PATCH 084/465] feat: Print constructor and recursor info
---
Pantograph/Environment.lean | 16 +++++++++++-
Pantograph/Protocol.lean | 21 +++++++++++++--
Test/Environment.lean | 52 +++++++++++++++++++++++++++++++------
Test/Serial.lean | 2 +-
4 files changed, 79 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 5295b6d..18e4445 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -56,6 +56,7 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
-- Information common to all symbols
let core := {
type := ← (serialize_expression options info.type).run',
+ isUnsafe := info.isUnsafe,
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.
@@ -70,10 +71,23 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
all := induct.all.map (·.toString),
ctors := induct.ctors.map (·.toString),
isRec := induct.isRec,
- isUnsafe := induct.isUnsafe,
isReflexive := induct.isReflexive,
isNested := induct.isNested,
} }
+ | .ctorInfo ctor => { core with constructorInfo? := .some {
+ induct := ctor.induct.toString,
+ cidx := ctor.cidx,
+ numParams := ctor.numParams,
+ numFields := ctor.numFields,
+ } }
+ | .recInfo r => { core with recursorInfo? := .some {
+ all := r.all.map (·.toString),
+ numParams := r.numParams,
+ numIndices := r.numIndices,
+ numMotives := r.numMotives,
+ numMinors := r.numMinors,
+ k := r.k,
+ } }
| _ => core
return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index ef463b1..4277783 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -127,19 +127,36 @@ structure InductInfo where
all: List String
ctors: List String
isRec: Bool := false
- isUnsafe: Bool := false
isReflexive: Bool := false
isNested: Bool := false
deriving Lean.ToJson
+-- See `ConstructorVal`
+structure ConstructorInfo where
+ induct: String
+ cidx: Nat
+ numParams: Nat
+ numFields: Nat
+ deriving Lean.ToJson
+structure RecursorInfo where
+ all: List String
+ numParams: Nat
+ numIndices: Nat
+ numMotives: Nat
+ numMinors: Nat
+ k: Bool
+ deriving Lean.ToJson
structure EnvInspectResult where
type: Expression
+ isUnsafe: Bool := false
value?: Option Expression := .none
module?: Option String := .none
-- If the name is private, displays the public facing name
publicName?: Option String := .none
typeDependency?: Option (Array String) := .none
valueDependency?: Option (Array String) := .none
- inductInfo?: Option InductInfo := .none
+ inductInfo?: Option InductInfo := .none
+ constructorInfo?: Option ConstructorInfo := .none
+ recursorInfo?: Option RecursorInfo := .none
deriving Lean.ToJson
structure EnvAdd where
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 44fb8de..df3f3ae 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -9,6 +9,8 @@ open Pantograph
open Lean
deriving instance DecidableEq, Repr for Protocol.InductInfo
+deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
+deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
@@ -22,20 +24,54 @@ def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite
+inductive ConstantCat where
+ | induct (info: Protocol.InductInfo)
+ | ctor (info: Protocol.ConstructorInfo)
+ | recursor (info: Protocol.RecursorInfo)
+
def test_inspect (env: Environment): IO LSpec.TestSeq := do
- let inner: CoreM LSpec.TestSeq := do
- let args: Protocol.EnvInspect := { name := "Or" }
- let result ← match ← Environment.inspect args (options := {}) with
- | .ok result => pure $ result
- | .error e => panic! s!"Error: {e.desc}"
- --IO.println s!"{reprStr result.inductInfo?}"
- let test := LSpec.check "Or" (result.inductInfo? == .some {
+ let testCases: List (String × ConstantCat) := [
+ ("Or", ConstantCat.induct {
numParams := 2,
numIndices := 0,
all := ["Or"],
ctors := ["Or.inl", "Or.inr"],
+ }),
+ ("Except.ok", ConstantCat.ctor {
+ induct := "Except",
+ cidx := 1,
+ numParams := 2,
+ numFields := 1,
+ }),
+ ("Eq.rec", ConstantCat.recursor {
+ all := ["Eq"],
+ numParams := 2,
+ numIndices := 1,
+ numMotives := 1,
+ numMinors := 1,
+ k := true,
+ }),
+ ("ForM.rec", ConstantCat.recursor {
+ all := ["ForM"],
+ numParams := 3,
+ numIndices := 0,
+ numMotives := 1,
+ numMinors := 1,
+ k := false,
})
- return LSpec.TestSeq.append LSpec.TestSeq.done test
+ ]
+ let inner: CoreM LSpec.TestSeq := do
+ testCases.foldlM (λ acc (name, cat) => do
+ let args: Protocol.EnvInspect := { name := name }
+ let result ← match ← Environment.inspect args (options := {}) with
+ | .ok result => pure $ result
+ | .error e => panic! s!"Error: {e.desc}"
+ let p := match cat with
+ | .induct info => LSpec.test name (result.inductInfo? == .some info)
+ | .ctor info => LSpec.test name (result.constructorInfo? == .some info)
+ | .recursor info => LSpec.test name (result.recursorInfo? == .some info)
+ return LSpec.TestSeq.append acc p
+ ) LSpec.TestSeq.done
runCoreMSeq env inner
def suite: IO LSpec.TestSeq := do
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 765b74e..70e86e8 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -70,7 +70,7 @@ def test_instance (env: Environment): IO LSpec.TestSeq := do
let env ← MonadEnv.getEnv
let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
let s := syntax_from_str env source |>.toOption |>.get!
- let expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get!
+ let _expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get!
return LSpec.TestSeq.done
runMetaMSeq env metaM
From 6a81d83c1f824b6e975378070544054a18bf67c0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 16 Jan 2024 16:44:54 -0800
Subject: [PATCH 085/465] test: Option controlled mvar instantiation
---
Pantograph/Protocol.lean | 1 +
Pantograph/Serial.lean | 13 ++++++++-----
2 files changed, 9 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index c0204d0..8db30ad 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -219,6 +219,7 @@ structure GoalDiag where
printNewMVars: Bool := false
-- Print all mvars
printAll: Bool := false
+ instantiate: Bool := true
end Pantograph.Protocol
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 072872b..38d1f14 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -276,9 +276,6 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag
mctx.decls.forM (fun mvarId decl => do
if goals.contains mvarId || mvarId == root then
pure ()
- -- Always print the root goal
- else if mvarId == goalState.root then
- printMVar (pref := ">") mvarId decl
-- Print the remainig ones that users don't see in Lean
else if options.printAll then
let pref := if goalState.newMVars.contains mvarId then "~" else " "
@@ -291,11 +288,17 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
if options.printContext then
decl.lctx.fvarIdToDecl.forM printFVar
- let type_sexp ← serialize_expression_ast (← instantiateMVars decl.type) (sanitize := false)
+ let type ← if options.instantiate
+ then instantiateMVars decl.type
+ else pure $ decl.type
+ let type_sexp ← serialize_expression_ast type (sanitize := false)
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
- IO.println s!" = {← Meta.ppExpr value}"
+ let value ← if options.instantiate
+ then instantiateMVars value
+ else pure $ value
+ IO.println s!" := {← Meta.ppExpr value}"
printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM Unit := do
IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
userNameToString : Name → String
From 25f3a2f19d40da37bd42a79c8a5ae7288094e23a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 24 Jan 2024 18:19:04 -0800
Subject: [PATCH 086/465] feat: Print parent expression assignment
---
Pantograph.lean | 2 ++
Pantograph/Environment.lean | 8 +++-----
Pantograph/Goal.lean | 17 +++++++++++++++--
Pantograph/Protocol.lean | 5 ++++-
Test/Proofs.lean | 4 ++++
5 files changed, 28 insertions(+), 8 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 9d9399d..46729fc 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -206,8 +206,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .some goalState => runMetaM <| do
goalState.restoreMetaM
let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
+ let parent? ← goalState.parentExpr?.mapM (λ expr => serialize_expression state.options expr)
return .ok {
root?,
+ parent?,
}
end Pantograph
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 18e4445..b823e8f 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -7,8 +7,6 @@ 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
@@ -32,14 +30,14 @@ 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
+def catalog (_: Protocol.EnvCatalog): CoreM (Protocol.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
+def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
let info? := env.find? name
@@ -90,7 +88,7 @@ def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (CR P
} }
| _ => core
return .ok result
-def addDecl (args: Protocol.EnvAdd): CoreM (CR Protocol.EnvAddResult) := do
+def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.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
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 9b68319..bd28944 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -1,3 +1,4 @@
+import Pantograph.Protocol
import Lean
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
@@ -20,6 +21,9 @@ structure GoalState where
-- The id of the goal in the parent
parentGoalId: Nat := 0
+ -- Parent state metavariable source
+ parentMVar: Option MVarId
+
abbrev M := Elab.TermElabM
protected def GoalState.create (expr: Expr): M GoalState := do
@@ -36,6 +40,7 @@ protected def GoalState.create (expr: Expr): M GoalState := do
savedState,
root,
newMVars := SSet.insert .empty root,
+ parentMVar := .none,
}
protected def GoalState.goals (state: GoalState): List MVarId := state.savedState.tactic.goals
@@ -114,10 +119,11 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
return acc.insert mvarId
) SSet.empty
return .success {
- state with
+ root := state.root,
savedState := nextSavedState
newMVars,
parentGoalId := goalId,
+ parentMVar := .some goal,
}
protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
@@ -164,10 +170,11 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
Elab.Tactic.setGoals (← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned)))
let nextSavedState ← MonadBacktrack.saveState
return .success {
- state with
+ root := state.root,
savedState := nextSavedState,
newMVars := newMVars.toSSet,
parentGoalId := goalId,
+ parentMVar := .some goal,
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -213,5 +220,11 @@ protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
else
assert! goalState.goals.isEmpty
.some expr
+protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
+ let parent ← goalState.parentMVar
+ let expr := goalState.mctx.eAssignment.find! parent
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ return expr
+
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 6869bdc..fcc253f 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -240,7 +240,9 @@ structure GoalPrint where
deriving Lean.FromJson
structure GoalPrintResult where
-- The root expression
- root?: Option Expression
+ root?: Option Expression := .none
+ -- How is this goal filled in relation to its children?
+ parent?: Option Expression := .none
deriving Lean.ToJson
-- Diagnostic Options, not available in REPL
@@ -252,5 +254,6 @@ structure GoalDiag where
printAll: Bool := false
instantiate: Bool := true
+abbrev CR α := Except InteractionError α
end Pantograph.Protocol
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8992697..224bb22 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -231,6 +231,8 @@ def proof_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ let state3_1parent ← serialize_expression_ast state3_1.parentExpr?.get! (sanitize := false)
+ addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.83))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
@@ -238,6 +240,8 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
+ let state4_1parent ← serialize_expression_ast state4_1.parentExpr?.get! (sanitize := false)
+ addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.49)")
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
From 40d61fecc5dff01026a35485d87b12dc1a893354 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 30 Jan 2024 16:37:35 -0800
Subject: [PATCH 087/465] doc: Correct comment about parent filling expr
---
Pantograph/Protocol.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index fcc253f..84e0cc2 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -241,7 +241,7 @@ structure GoalPrint where
structure GoalPrintResult where
-- The root expression
root?: Option Expression := .none
- -- How is this goal filled in relation to its children?
+ -- The filling expression of the parent goal
parent?: Option Expression := .none
deriving Lean.ToJson
From fe5c1eda7d04a06b48a733f3fd11a8be5975d08a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 30 Jan 2024 17:22:20 -0800
Subject: [PATCH 088/465] feat: Prevent crash during rootExpr call
---
Pantograph/Goal.lean | 6 +++---
Test/Proofs.lean | 6 ++++++
2 files changed, 9 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index bd28944..630637d 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -210,8 +210,8 @@ protected def GoalState.continue (target: GoalState) (branch: GoalState): Except
else
target.resume (goals := branch.goals)
-protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
- let expr := goalState.mctx.eAssignment.find! goalState.root
+protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
+ let expr ← goalState.mctx.eAssignment.find? goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasMVar then
-- Must not assert that the goal state is empty here. We could be in a branch goal.
@@ -219,7 +219,7 @@ protected def GoalState.rootExpr? (goalState: GoalState): Option Expr :=
.none
else
assert! goalState.goals.isEmpty
- .some expr
+ return expr
protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
let parent ← goalState.parentMVar
let expr := goalState.mctx.eAssignment.find! parent
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 224bb22..07e4cea 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -210,6 +210,8 @@ def proof_or_comm: TestM Unit := do
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
+ addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
+ addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
| .success state => pure state
@@ -218,6 +220,8 @@ def proof_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"])
+ addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
+ addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
| .success state => pure state
| other => do
@@ -225,6 +229,8 @@ def proof_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check "cases h" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
+ addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
+ addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
From 4acd367ca7889e680d0c5d047c7f7a755442e5d4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 30 Jan 2024 17:45:32 -0800
Subject: [PATCH 089/465] chore: Version bump to 0.2.12-alpha
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 67cbb8f..7bf12f9 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,5 @@
namespace Pantograph
-def version := "0.2.10-alpha"
+def version := "0.2.12-alpha"
end Pantograph
From 5f5d06f1d8181e92bed6f8d928c01495076bee90 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 5 Feb 2024 11:49:01 -0800
Subject: [PATCH 090/465] feat: Add lake and lean to the package output
---
flake.nix | 1 +
1 file changed, 1 insertion(+)
diff --git a/flake.nix b/flake.nix
index 356323f..02de0a1 100644
--- a/flake.nix
+++ b/flake.nix
@@ -30,6 +30,7 @@
in rec {
packages = project // {
inherit (leanPkgs) lean;
+ lake = leanPkgs.Lake-Main.executable;
default = packages.executable;
};
devShells.default = project.devShell;
From df4e044e5fd655c489b9ebe9f5face088a5cee6f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 13 Feb 2024 15:30:56 -0500
Subject: [PATCH 091/465] chore: Expose `leanPkgs` in flake
---
flake.nix | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/flake.nix b/flake.nix
index 02de0a1..7610209 100644
--- a/flake.nix
+++ b/flake.nix
@@ -29,8 +29,7 @@
};
in rec {
packages = project // {
- inherit (leanPkgs) lean;
- lake = leanPkgs.Lake-Main.executable;
+ inherit leanPkgs;
default = packages.executable;
};
devShells.default = project.devShell;
From 111781816f1aa3fac4cafa0c82a260f4bec96ef0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Feb 2024 14:47:09 -0800
Subject: [PATCH 092/465] test: Delayed metavariable assignment
---
Test/Proofs.lean | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 07e4cea..85ba66d 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -232,6 +232,11 @@ def proof_or_comm: TestM Unit := do
addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
+ let state2parent ← serialize_expression_ast state2.parentExpr?.get! (sanitize := false)
+ -- This is due to delayed assignment
+ addTest $ LSpec.test "(2 parent)" (state2parent ==
+ "((:mv _uniq.45) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
+
let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
From 7e28ded23fd581e863dc718d71f7b0b78ee97a7f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 6 Mar 2024 15:14:08 -0800
Subject: [PATCH 093/465] test: More diagnostics for tests
---
Pantograph/Goal.lean | 4 ++++
Pantograph/Protocol.lean | 2 +-
Test/Integration.lean | 6 ++++++
3 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 630637d..b56c893 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -225,6 +225,10 @@ protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
let expr := goalState.mctx.eAssignment.find! parent
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
+protected def GoalState.assignedExprOf? (goalState: GoalState) (mvar: MVarId): Option Expr := do
+ let expr ← goalState.mctx.eAssignment.find? mvar
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ return expr
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 84e0cc2..a4983d9 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -242,7 +242,7 @@ structure GoalPrintResult where
-- The root expression
root?: Option Expression := .none
-- The filling expression of the parent goal
- parent?: Option Expression := .none
+ parent?: Option Expression
deriving Lean.ToJson
-- Diagnostic Options, not available in REPL
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 0a6c210..8f3f217 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -103,6 +103,12 @@ def test_tactic : IO LSpec.TestSeq :=
goals? := #[goal1],
}:
Protocol.GoalTacticResult)),
+ subroutine_step "goal.print"
+ [("stateId", .num 1)]
+ (Lean.toJson ({
+ parent? := .some { pp? := .some "fun x => ?m.11 x" },
+ }:
+ Protocol.GoalPrintResult)),
subroutine_step "goal.tactic"
[("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
(Lean.toJson ({
From 93b7d8b67da9ab439d1a5d6138513aab74e44751 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 6 Mar 2024 15:26:35 -0800
Subject: [PATCH 094/465] feat: Output shared library in flake
---
flake.nix | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/flake.nix b/flake.nix
index 7610209..9f586f6 100644
--- a/flake.nix
+++ b/flake.nix
@@ -28,9 +28,10 @@
src = ./.;
};
in rec {
- packages = project // {
- inherit leanPkgs;
- default = packages.executable;
+ packages = {
+ inherit (leanPkgs) lean lean-all;
+ inherit (project) sharedLib executable;
+ default = project.executable;
};
devShells.default = project.devShell;
};
From 267d635c056c20c5c07d7a4b06a39d34fae86f1f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 6 Mar 2024 15:27:22 -0800
Subject: [PATCH 095/465] feat(build): Add shared facet for lean_lib
---
lakefile.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/lakefile.lean b/lakefile.lean
index f0832e2..89ad70f 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -4,6 +4,7 @@ open Lake DSL
package pantograph
lean_lib Pantograph {
+ defaultFacets := #[LeanLib.sharedFacet]
}
@[default_target]
From 7bc0f826542048703aa88fe5de1311bf43aab3be Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Mar 2024 23:50:44 -0800
Subject: [PATCH 096/465] feat: Add exported version function
---
Pantograph.lean | 1 +
Pantograph/Library.lean | 8 ++++++++
2 files changed, 9 insertions(+)
create mode 100644 Pantograph/Library.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 46729fc..90ce2d2 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -2,6 +2,7 @@ import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.Serial
import Pantograph.Environment
+import Pantograph.Library
import Lean.Data.HashMap
namespace Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
new file mode 100644
index 0000000..330d84d
--- /dev/null
+++ b/Pantograph/Library.lean
@@ -0,0 +1,8 @@
+import Pantograph.Version
+
+namespace Pantograph
+
+@[export pantograph_version]
+def pantograph_version: String := version
+
+end Pantograph
From 2ad7ad8778601c90d29b8d5f4cdbc455d9372137 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 9 Mar 2024 16:50:36 -0800
Subject: [PATCH 097/465] feat(lib): Catalog command FFI
---
Main.lean | 53 +++---------------------------
Pantograph.lean | 3 +-
Pantograph/Environment.lean | 4 +--
Pantograph/Library.lean | 64 ++++++++++++++++++++++++++++++++++++-
4 files changed, 72 insertions(+), 52 deletions(-)
diff --git a/Main.lean b/Main.lean
index 68d1a3e..7c36db2 100644
--- a/Main.lean
+++ b/Main.lean
@@ -2,6 +2,7 @@ import Lean.Data.Json
import Lean.Environment
import Pantograph.Version
+import Pantograph.Library
import Pantograph
-- Main IO functions
@@ -39,35 +40,6 @@ partial def loop : MainM Unit := do
IO.println str
loop
-namespace Lean
-
-/-- This is better than the default version since it handles `.` and doesn't
- crash the program when it fails. -/
-def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
- let ps := (entry.splitOn "=").map String.trim
- let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
- let key := key.toName
- let defValue ← getOptionDefaultValue key
- match defValue with
- | DataValue.ofString _ => pure $ opts.setString key val
- | DataValue.ofBool _ =>
- match val with
- | "true" => pure $ opts.setBool key true
- | "false" => pure $ opts.setBool key false
- | _ => throw s!"invalid Bool option value '{val}'"
- | DataValue.ofName _ => pure $ opts.setName key val.toName
- | DataValue.ofNat _ =>
- match val.toNat? with
- | none => throw s!"invalid Nat option value '{val}'"
- | some v => pure $ opts.setNat key v
- | DataValue.ofInt _ =>
- match val.toInt? with
- | none => throw s!"invalid Int option value '{val}'"
- | some v => pure $ opts.setInt key v
- | DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
-
-end Lean
-
unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
@@ -79,32 +51,17 @@ unsafe def main (args: List String): IO Unit := do
Lean.enableInitializersExecution
Lean.initSearchPath (← Lean.findSysroot)
- let options? ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
- |>.foldlM Lean.setOptionFromString' Lean.Options.empty
- |>.run
- let options ← match options? with
- | .ok options => pure options
- | .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
+ let coreContext ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
+ |>.toArray |> createCoreContext
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
-
- let env ← Lean.importModules
- (imports := imports.toArray.map (λ str => { module := str.toName, runtimeOnly := false }))
- (opts := {})
- (trustLevel := 1)
+ let coreState ← createCoreState imports.toArray
let context: Context := {
imports
}
- let coreContext: Lean.Core.Context := {
- currNamespace := Lean.Name.str .anonymous "Aniva"
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph>",
- fileMap := { source := "", positions := #[0], lines := #[1] },
- options := options
- }
try
let coreM := loop.run context |>.run' {}
IO.println "ready."
- discard <| coreM.toIO coreContext { env := env }
+ discard <| coreM.toIO coreContext coreState
catch ex =>
IO.println "Uncaught IO exception"
IO.println ex.toString
diff --git a/Pantograph.lean b/Pantograph.lean
index 90ce2d2..f1f194c 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -71,7 +71,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let nGoals := state.goalStates.size
return .ok { nGoals }
env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
- Environment.catalog args
+ let result ← Environment.catalog args
+ return .ok result
env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
let state ← get
Environment.inspect args state.options
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index b823e8f..df0bc7f 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -30,13 +30,13 @@ 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 (Protocol.CR Protocol.EnvCatalogResult) := do
+def catalog (_: Protocol.EnvCatalog): CoreM 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 }
+ return { symbols := names }
def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 330d84d..5b5e954 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -1,8 +1,70 @@
import Pantograph.Version
+import Pantograph.Environment
+import Pantograph.Protocol
+import Lean
+
+
+namespace Lean
+
+/-- This is better than the default version since it handles `.` and doesn't
+ crash the program when it fails. -/
+def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO Options := do
+ let ps := (entry.splitOn "=").map String.trim
+ let [key, val] ← pure ps | throw "invalid configuration option entry, it must be of the form '<key> = <value>'"
+ let key := key.toName
+ let defValue ← getOptionDefaultValue key
+ match defValue with
+ | DataValue.ofString _ => pure $ opts.setString key val
+ | DataValue.ofBool _ =>
+ match val with
+ | "true" => pure $ opts.setBool key true
+ | "false" => pure $ opts.setBool key false
+ | _ => throw s!"invalid Bool option value '{val}'"
+ | DataValue.ofName _ => pure $ opts.setName key val.toName
+ | DataValue.ofNat _ =>
+ match val.toNat? with
+ | none => throw s!"invalid Nat option value '{val}'"
+ | some v => pure $ opts.setNat key v
+ | DataValue.ofInt _ =>
+ match val.toInt? with
+ | none => throw s!"invalid Int option value '{val}'"
+ | some v => pure $ opts.setInt key v
+ | DataValue.ofSyntax _ => throw s!"invalid Syntax option value"
+
+end Lean
namespace Pantograph
@[export pantograph_version]
-def pantograph_version: String := version
+def pantographVersion: String := version
+
+/-- Creates a Core.Context object needed to run all monads -/
+@[export pantograph_create_core_context]
+def createCoreContext (options: Array String): IO Lean.Core.Context := do
+ let options? ← options.foldlM Lean.setOptionFromString' Lean.Options.empty |>.run
+ let options ← match options? with
+ | .ok options => pure options
+ | .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
+ return {
+ currNamespace := Lean.Name.str .anonymous "Aniva"
+ openDecls := [], -- No 'open' directives needed
+ fileName := "<Pantograph>",
+ fileMap := { source := "", positions := #[0], lines := #[1] },
+ options := options
+ }
+
+@[export pantograph_create_core_state]
+def createCoreState (imports: Array String): IO Lean.Core.State := do
+ let env ← Lean.importModules
+ (imports := imports.map (λ str => { module := str.toName, runtimeOnly := false }))
+ (opts := {})
+ (trustLevel := 1)
+ return { env := env }
+
+@[export pantograph_catalog]
+def catalog (cc: Lean.Core.Context) (cs: Lean.Core.State): IO Protocol.EnvCatalogResult := do
+ let coreM: Lean.CoreM _ := Environment.catalog ({}: Protocol.EnvCatalog)
+ let (result, _) ← coreM.toIO cc cs
+ return result
end Pantograph
From eeb149a32cd9f01e33eae334beae90e4c7115e96 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 9 Mar 2024 19:36:25 -0800
Subject: [PATCH 098/465] feat(lib): Search path function
---
Main.lean | 3 +--
Pantograph/Library.lean | 6 ++++++
2 files changed, 7 insertions(+), 2 deletions(-)
diff --git a/Main.lean b/Main.lean
index 7c36db2..de73033 100644
--- a/Main.lean
+++ b/Main.lean
@@ -48,8 +48,7 @@ unsafe def main (args: List String): IO Unit := do
println! s!"{version}"
return
- Lean.enableInitializersExecution
- Lean.initSearchPath (← Lean.findSysroot)
+ initSearch ""
let coreContext ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
|>.toArray |> createCoreContext
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 5b5e954..07e4656 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -38,6 +38,12 @@ namespace Pantograph
@[export pantograph_version]
def pantographVersion: String := version
+/-- Adds the given paths to Lean package search path -/
+@[export pantograph_init_search]
+unsafe def initSearch (sp: String): IO Unit := do
+ Lean.enableInitializersExecution
+ Lean.initSearchPath (← Lean.findSysroot) (sp := System.SearchPath.parse sp)
+
/-- Creates a Core.Context object needed to run all monads -/
@[export pantograph_create_core_context]
def createCoreContext (options: Array String): IO Lean.Core.Context := do
From f18a9dd1d572038d4591e634e879ea63e1f6b888 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 9 Mar 2024 20:33:36 -0800
Subject: [PATCH 099/465] refactor: Move some functions to `Library.lean`
---
Pantograph.lean | 28 +-------------------
Pantograph/Library.lean | 57 +++++++++++++++++++++++++++++++++++++---
Pantograph/Protocol.lean | 2 +-
Pantograph/Serial.lean | 2 +-
4 files changed, 57 insertions(+), 32 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index f1f194c..f9b5dc5 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -22,14 +22,6 @@ abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
-def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
- metaM.run'
-def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
- termElabM.run' (ctx := {
- declName? := .none,
- errToSorry := false,
- }) |>.run'
-
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
@@ -57,9 +49,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
- errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
- errorCommand := errorI "command"
- errorIndex := errorI "index"
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -80,22 +69,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- let env ← Lean.MonadEnv.getEnv
- 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
- try
- let type ← Lean.Meta.inferType expr
- return .ok {
- type := (← serialize_expression (options := state.options) type),
- expr := (← serialize_expression (options := state.options) expr)
- }
- catch exception =>
- return .error $ errorI "typing" (← exception.toMessageData.toString))
+ exprEcho args state.options
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 07e4656..cdc112f 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -3,7 +3,6 @@ import Pantograph.Environment
import Pantograph.Protocol
import Lean
-
namespace Lean
/-- This is better than the default version since it handles `.` and doesn't
@@ -35,6 +34,18 @@ end Lean
namespace Pantograph
+def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
+ metaM.run'
+def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
+ termElabM.run' (ctx := {
+ declName? := .none,
+ errToSorry := false,
+ }) |>.run'
+
+def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
+def errorCommand := errorI "command"
+def errorIndex := errorI "index"
+
@[export pantograph_version]
def pantographVersion: String := version
@@ -67,10 +78,50 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
(trustLevel := 1)
return { env := env }
-@[export pantograph_catalog]
-def catalog (cc: Lean.Core.Context) (cs: Lean.Core.State): IO Protocol.EnvCatalogResult := do
+@[export pantograph_env_catalog]
+def envCatalog (cc: Lean.Core.Context) (cs: Lean.Core.State): IO Protocol.EnvCatalogResult := do
let coreM: Lean.CoreM _ := Environment.catalog ({}: Protocol.EnvCatalog)
let (result, _) ← coreM.toIO cc cs
return result
+@[export pantograph_env_inspect]
+def envInspect (cc: Lean.Core.Context) (cs: Lean.Core.State)
+ (name: String) (value: Bool) (dependency: Bool) (options: Protocol.Options): IO (Protocol.CR Protocol.EnvInspectResult) := do
+ let coreM: Lean.CoreM _ := Environment.inspect ({
+ name, value? := .some value, dependency?:= .some dependency
+ }: Protocol.EnvInspect) options
+ let (result, _) ← coreM.toIO cc cs
+ return result
+
+@[export pantograph_env_add]
+def envAdd (cc: Lean.Core.Context) (cs: Lean.Core.State)
+ (name: String) (type: String) (value: String) (isTheorem: Bool): IO (Protocol.CR Protocol.EnvAddResult) := do
+ let coreM: Lean.CoreM _ := Environment.addDecl { name, type, value, isTheorem }
+ let (result, _) ← coreM.toIO cc cs
+ return result
+
+def exprEcho (args: Protocol.ExprEcho) (options: @&Protocol.Options): Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
+ let env ← Lean.MonadEnv.getEnv
+ 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
+ try
+ let type ← Lean.Meta.inferType expr
+ return .ok {
+ type := (← serialize_expression options type),
+ expr := (← serialize_expression options expr)
+ }
+ catch exception =>
+ return .error $ errorI "typing" (← exception.toMessageData.toString))
+
+@[export pantograph_expr_echo]
+def exprEchoExport (cc: Lean.Core.Context) (cs: Lean.Core.State) (expr: String) (options: @&Protocol.Options): IO (Protocol.CR Protocol.ExprEchoResult) := do
+ let coreM: Lean.CoreM _ := exprEcho { expr } options
+ let (result, _) ← coreM.toIO cc cs
+ return result
+
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 84e0cc2..5015ad1 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -163,7 +163,7 @@ structure EnvAdd where
name: String
type: String
value: String
- isTheorem?: Bool
+ isTheorem: Bool
deriving Lean.FromJson
structure EnvAddResult where
deriving Lean.ToJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 38d1f14..547b3dc 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -157,7 +157,7 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
| .instImplicit => " :instImplicit"
of_name (name: Name) := name_to_ast name sanitize
-def serialize_expression (options: Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
+def serialize_expression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp := toString (← Meta.ppExpr e)
let pp?: Option String := match options.printExprPretty with
| true => .some pp
From 996f16bbb81b55276f25b9bba16bf1d2289769bc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 10 Mar 2024 06:41:35 -0700
Subject: [PATCH 100/465] feat(lib): CoreM execution function
---
Pantograph.lean | 5 +++-
Pantograph/Library.lean | 63 +++++++++++++++++++++++------------------
2 files changed, 40 insertions(+), 28 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index f9b5dc5..ad563f0 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -69,7 +69,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- exprEcho args state.options
+ let expr ← match ← exprParse args.expr with
+ | .ok expr => pure $ expr
+ | .error e => return .error e
+ exprPrint expr state.options
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index cdc112f..a8c0ce7 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -1,6 +1,7 @@
-import Pantograph.Version
import Pantograph.Environment
+import Pantograph.Goal
import Pantograph.Protocol
+import Pantograph.Version
import Lean
namespace Lean
@@ -70,6 +71,7 @@ def createCoreContext (options: Array String): IO Lean.Core.Context := do
options := options
}
+/-- Creates a Core.State object needed to run all monads -/
@[export pantograph_create_core_state]
def createCoreState (imports: Array String): IO Lean.Core.State := do
let env ← Lean.importModules
@@ -78,11 +80,14 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
(trustLevel := 1)
return { env := env }
+/-- Execute a `CoreM` monad -/
+@[export pantograph_exec_core]
+def execCore {α} (context: Lean.Core.Context) (state: Lean.Core.State) (coreM: Lean.CoreM α): IO (α × Lean.Core.State) :=
+ coreM.toIO context state
+
@[export pantograph_env_catalog]
-def envCatalog (cc: Lean.Core.Context) (cs: Lean.Core.State): IO Protocol.EnvCatalogResult := do
- let coreM: Lean.CoreM _ := Environment.catalog ({}: Protocol.EnvCatalog)
- let (result, _) ← coreM.toIO cc cs
- return result
+def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
+ Environment.catalog ({}: Protocol.EnvCatalog)
@[export pantograph_env_inspect]
def envInspect (cc: Lean.Core.Context) (cs: Lean.Core.State)
@@ -100,28 +105,32 @@ def envAdd (cc: Lean.Core.Context) (cs: Lean.Core.State)
let (result, _) ← coreM.toIO cc cs
return result
-def exprEcho (args: Protocol.ExprEcho) (options: @&Protocol.Options): Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
- let env ← Lean.MonadEnv.getEnv
- 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
- try
- let type ← Lean.Meta.inferType expr
- return .ok {
- type := (← serialize_expression options type),
- expr := (← serialize_expression options expr)
- }
- catch exception =>
- return .error $ errorI "typing" (← exception.toMessageData.toString))
+@[export pantograph_expr_parse]
+def exprParse (s: String): Lean.CoreM (Protocol.CR Lean.Expr) := do
+ let env ← Lean.MonadEnv.getEnv
+ let syn ← match syntax_from_str env s 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 => return .ok expr)
-@[export pantograph_expr_echo]
-def exprEchoExport (cc: Lean.Core.Context) (cs: Lean.Core.State) (expr: String) (options: @&Protocol.Options): IO (Protocol.CR Protocol.ExprEchoResult) := do
- let coreM: Lean.CoreM _ := exprEcho { expr } options
- let (result, _) ← coreM.toIO cc cs
- return result
+@[export pantograph_expr_print]
+def exprPrint (expr: Lean.Expr) (options: @&Protocol.Options): Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
+ let termElabM: Lean.Elab.TermElabM _ :=
+ try
+ let type ← Lean.Meta.inferType expr
+ return .ok {
+ type := (← serialize_expression options type),
+ expr := (← serialize_expression options expr)
+ }
+ catch exception =>
+ return .error $ errorI "typing" (← exception.toMessageData.toString)
+ runTermElabM termElabM
+
+@[export pantograph_goal_start]
+def goalStart (expr: Lean.Expr): Lean.CoreM GoalState :=
+ runTermElabM (GoalState.create expr)
end Pantograph
From a5b07214824fef185f1e9cf3484523bfb608c437 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 10 Mar 2024 08:13:10 -0700
Subject: [PATCH 101/465] feat(lib): Expose goal state interface
---
Pantograph.lean | 24 +++++++---------
Pantograph/Library.lean | 62 +++++++++++++++++++++++++---------------
Pantograph/Protocol.lean | 2 +-
Pantograph/Version.lean | 1 +
4 files changed, 52 insertions(+), 37 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index ad563f0..cc2471f 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -49,6 +49,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
errorCommand s!"Unknown command {cmd}"
return Lean.toJson error
where
+ errorCommand := errorI "command"
+ errorIndex := errorI "index"
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -93,14 +95,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none =>
- (match syntax_from_str env expr with
- | .error str => return .error <| errorI "parsing" str
- | .ok syn => do
- (match ← syntax_to_expr syn with
- | .error str => return .error <| errorI "elab" str
- | .ok expr => return .ok (← GoalState.create expr)))
+ let expr?: Except Protocol.InteractionError GoalState ← runTermElabM (match args.expr, args.copyFrom with
+ | .some expr, .none => do
+ match ← exprParse expr with
+ | .ok expr => return .ok (← GoalState.create expr)
+ | .error e => return .error e
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
@@ -123,9 +122,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .some goalState => do
let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
| .some tactic, .none => do
- pure ( Except.ok (← runTermElabM <| GoalState.execute goalState args.goalId tactic))
+ pure ( Except.ok (← goalTactic goalState args.goalId tactic))
| .none, .some expr => do
- pure ( Except.ok (← runTermElabM <| GoalState.tryAssign goalState args.goalId expr))
+ pure ( Except.ok (← goalTryAssign goalState args.goalId expr))
| _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr} must be supplied")
match nextGoalState? with
| .error error => return .error error
@@ -157,8 +156,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
- let goals := goals.map (λ name => { name := name.toName })
- pure $ target.resume goals
+ pure $ goalResume target goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
match nextState? with
| .error error => return .error <| errorI "structure" error
@@ -168,7 +166,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goalStates := state.goalStates.insert nextStateId nextGoalState,
nextId := state.nextId + 1
}
- let goals ← nextGoalState.serializeGoals (parent := .none) (options := state.options) |>.run'
+ let goals ← goalSerialize nextGoalState (options := state.options)
return .ok {
nextStateId,
goals,
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index a8c0ce7..b1a6864 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -1,6 +1,7 @@
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Protocol
+import Pantograph.Serial
import Pantograph.Version
import Lean
@@ -44,11 +45,6 @@ def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
}) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
-def errorCommand := errorI "command"
-def errorIndex := errorI "index"
-
-@[export pantograph_version]
-def pantographVersion: String := version
/-- Adds the given paths to Lean package search path -/
@[export pantograph_init_search]
@@ -82,30 +78,27 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
/-- Execute a `CoreM` monad -/
@[export pantograph_exec_core]
-def execCore {α} (context: Lean.Core.Context) (state: Lean.Core.State) (coreM: Lean.CoreM α): IO (α × Lean.Core.State) :=
+def execCore {α} (context: Lean.Core.Context) (state: Lean.Core.State) (coreM: Lean.CoreM α):
+ IO (α × Lean.Core.State) :=
coreM.toIO context state
-@[export pantograph_env_catalog]
+@[export pantograph_env_catalog_m]
def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
-@[export pantograph_env_inspect]
-def envInspect (cc: Lean.Core.Context) (cs: Lean.Core.State)
- (name: String) (value: Bool) (dependency: Bool) (options: Protocol.Options): IO (Protocol.CR Protocol.EnvInspectResult) := do
- let coreM: Lean.CoreM _ := Environment.inspect ({
+@[export pantograph_env_inspect_m]
+def envInspect (name: String) (value: Bool) (dependency: Bool) (options: Protocol.Options):
+ Lean.CoreM (Protocol.CR Protocol.EnvInspectResult) :=
+ Environment.inspect ({
name, value? := .some value, dependency?:= .some dependency
}: Protocol.EnvInspect) options
- let (result, _) ← coreM.toIO cc cs
- return result
-@[export pantograph_env_add]
-def envAdd (cc: Lean.Core.Context) (cs: Lean.Core.State)
- (name: String) (type: String) (value: String) (isTheorem: Bool): IO (Protocol.CR Protocol.EnvAddResult) := do
- let coreM: Lean.CoreM _ := Environment.addDecl { name, type, value, isTheorem }
- let (result, _) ← coreM.toIO cc cs
- return result
+@[export pantograph_env_add_m]
+def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
+ Lean.CoreM (Protocol.CR Protocol.EnvAddResult) :=
+ Environment.addDecl { name, type, value, isTheorem }
-@[export pantograph_expr_parse]
+@[export pantograph_expr_parse_m]
def exprParse (s: String): Lean.CoreM (Protocol.CR Lean.Expr) := do
let env ← Lean.MonadEnv.getEnv
let syn ← match syntax_from_str env s with
@@ -116,8 +109,9 @@ def exprParse (s: String): Lean.CoreM (Protocol.CR Lean.Expr) := do
| .error str => return .error $ errorI "elab" str
| .ok expr => return .ok expr)
-@[export pantograph_expr_print]
-def exprPrint (expr: Lean.Expr) (options: @&Protocol.Options): Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
+@[export pantograph_expr_print_m]
+def exprPrint (expr: Lean.Expr) (options: @&Protocol.Options):
+ Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
let termElabM: Lean.Elab.TermElabM _ :=
try
let type ← Lean.Meta.inferType expr
@@ -129,8 +123,30 @@ def exprPrint (expr: Lean.Expr) (options: @&Protocol.Options): Lean.CoreM (Proto
return .error $ errorI "typing" (← exception.toMessageData.toString)
runTermElabM termElabM
-@[export pantograph_goal_start]
+@[export pantograph_goal_start_m]
def goalStart (expr: Lean.Expr): Lean.CoreM GoalState :=
runTermElabM (GoalState.create expr)
+@[export pantograph_goal_tactic_m]
+def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
+ runTermElabM <| GoalState.execute state goalId tactic
+
+@[export pantograph_goal_try_assign_m]
+def goalTryAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
+ runTermElabM <| GoalState.tryAssign state goalId expr
+
+@[export pantograph_goal_continue]
+def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
+ target.continue branch
+
+@[export pantograph_goal_resume]
+def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
+ target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
+
+@[export pantograph_goal_serialize_m]
+def goalSerialize (state: GoalState) (options: Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
+ runMetaM <| state.serializeGoals (parent := .none) options
+
+
+
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 5015ad1..91c44a8 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -221,7 +221,7 @@ structure GoalContinue where
-- The state which is an ancestor of `target` where goals will be extracted from
branch?: Option Nat := .none
-- Or, the particular goals that should be brought back into scope
- goals?: Option (List String) := .none
+ goals?: Option (Array String) := .none
deriving Lean.FromJson
structure GoalContinueResult where
nextStateId: Nat
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 7bf12f9..e412ced 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,5 +1,6 @@
namespace Pantograph
+@[export pantograph_version]
def version := "0.2.12-alpha"
end Pantograph
From 0b91c41ad2334d9ce290a1db2f5069dafef7725e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 10 Mar 2024 15:09:38 -0700
Subject: [PATCH 102/465] fix: Execute expr parsing within goal.start
---
Pantograph.lean | 13 ++++++++-----
Pantograph/Library.lean | 6 ------
2 files changed, 8 insertions(+), 11 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index cc2471f..0168894 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -95,11 +95,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let expr?: Except Protocol.InteractionError GoalState ← runTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => do
- match ← exprParse expr with
- | .ok expr => return .ok (← GoalState.create expr)
- | .error e => return .error e
+ let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
+ | .some expr, .none =>
+ (match syntax_from_str env expr with
+ | .error str => return .error <| errorI "parsing" str
+ | .ok syn => do
+ (match ← syntax_to_expr syn with
+ | .error str => return .error <| errorI "elab" str
+ | .ok expr => return .ok (← GoalState.create expr)))
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index b1a6864..f1115e1 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -76,12 +76,6 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
(trustLevel := 1)
return { env := env }
-/-- Execute a `CoreM` monad -/
-@[export pantograph_exec_core]
-def execCore {α} (context: Lean.Core.Context) (state: Lean.Core.State) (coreM: Lean.CoreM α):
- IO (α × Lean.Core.State) :=
- coreM.toIO context state
-
@[export pantograph_env_catalog_m]
def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
From ef864ea16d5480ecfb7da2d189b3765a5eedd129 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 10 Mar 2024 15:33:32 -0700
Subject: [PATCH 103/465] feat(lib): Option creation function
---
Pantograph.lean | 17 ++++-------
Pantograph/Library.lean | 64 ++++++++++++++++++++++++++++-------------
2 files changed, 50 insertions(+), 31 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 0168894..fceac00 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -71,10 +71,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- let expr ← match ← exprParse args.expr with
- | .ok expr => pure $ expr
- | .error e => return .error e
- exprPrint expr state.options
+ exprEcho args.expr state.options
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
@@ -96,13 +93,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none =>
- (match syntax_from_str env expr with
- | .error str => return .error <| errorI "parsing" str
- | .ok syn => do
- (match ← syntax_to_expr syn with
- | .error str => return .error <| errorI "elab" str
- | .ok expr => return .ok (← GoalState.create expr)))
+ | .some expr, .none => do
+ let expr ← match ← exprParse expr with
+ | .error e => return .error e
+ | .ok expr => pure $ expr
+ return .ok $ ← GoalState.create expr
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index f1115e1..b731fb3 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -80,6 +80,23 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
+@[export pantograph_mk_options]
+def mkOptions
+ (printJsonPretty: Bool)
+ (printExprPretty: Bool)
+ (printExprAST: Bool)
+ (noRepeat: Bool)
+ (printAuxDecls: Bool)
+ (printImplementationDetailHyps: Bool)
+ : Protocol.Options := {
+ printJsonPretty,
+ printExprPretty,
+ printExprAST,
+ noRepeat,
+ printAuxDecls,
+ printImplementationDetailHyps,
+ }
+
@[export pantograph_env_inspect_m]
def envInspect (name: String) (value: Bool) (dependency: Bool) (options: Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.EnvInspectResult) :=
@@ -92,34 +109,41 @@ def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
Lean.CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
-@[export pantograph_expr_parse_m]
-def exprParse (s: String): Lean.CoreM (Protocol.CR Lean.Expr) := do
+/-- This must be a TermElabM since the parsed expr contains extra information -/
+def exprParse (s: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
let env ← Lean.MonadEnv.getEnv
let syn ← match syntax_from_str env s 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 => return .ok expr)
+ match ← syntax_to_expr syn with
+ | .error str => return .error $ errorI "elab" str
+ | .ok expr => return .ok expr
-@[export pantograph_expr_print_m]
-def exprPrint (expr: Lean.Expr) (options: @&Protocol.Options):
+@[export pantograph_expr_echo_m]
+def exprEcho (expr: String) (options: @&Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
- let termElabM: Lean.Elab.TermElabM _ :=
- try
- let type ← Lean.Meta.inferType expr
- return .ok {
- type := (← serialize_expression options type),
- expr := (← serialize_expression options expr)
- }
- catch exception =>
- return .error $ errorI "typing" (← exception.toMessageData.toString)
+ let termElabM: Lean.Elab.TermElabM _ := do
+ let expr ← match ← exprParse expr with
+ | .error e => return .error e
+ | .ok expr => pure expr
+ try
+ let type ← Lean.Meta.inferType expr
+ return .ok {
+ type := (← serialize_expression options type),
+ expr := (← serialize_expression options expr)
+ }
+ catch exception =>
+ return .error $ errorI "typing" (← exception.toMessageData.toString)
runTermElabM termElabM
-@[export pantograph_goal_start_m]
-def goalStart (expr: Lean.Expr): Lean.CoreM GoalState :=
- runTermElabM (GoalState.create expr)
+@[export pantograph_goal_start_expr_m]
+def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
+ let termElabM: Lean.Elab.TermElabM _ := do
+ let expr ← match ← exprParse expr with
+ | .error e => return .error e
+ | .ok expr => pure $ expr
+ return .ok $ ← GoalState.create expr
+ runTermElabM termElabM
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
From 4eec930dd46e0f37c535a1d9a239d694a5474ad1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 11 Mar 2024 21:31:59 -0700
Subject: [PATCH 104/465] fix: Pass options by reference
---
Pantograph/Environment.lean | 2 +-
Pantograph/Library.lean | 4 ++--
Pantograph/Serial.lean | 8 ++++++--
3 files changed, 9 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index df0bc7f..f37225f 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -37,7 +37,7 @@ def catalog (_: Protocol.EnvCatalog): CoreM Protocol.EnvCatalogResult := do
| .some x => acc.push x
| .none => acc)
return { symbols := names }
-def inspect (args: Protocol.EnvInspect) (options: Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
+def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
let info? := env.find? name
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index b731fb3..d72fd3a 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -98,7 +98,7 @@ def mkOptions
}
@[export pantograph_env_inspect_m]
-def envInspect (name: String) (value: Bool) (dependency: Bool) (options: Protocol.Options):
+def envInspect (name: String) (value: Bool) (dependency: Bool) (options: @&Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.EnvInspectResult) :=
Environment.inspect ({
name, value? := .some value, dependency?:= .some dependency
@@ -162,7 +162,7 @@ def goalResume (target: GoalState) (goals: Array String): Except String GoalStat
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
@[export pantograph_goal_serialize_m]
-def goalSerialize (state: GoalState) (options: Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
+def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 547b3dc..213ae6d 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -172,7 +172,7 @@ def serialize_expression (options: @&Protocol.Options) (e: Expr): MetaM Protocol
}
/-- Adapted from ppGoal -/
-def serialize_goal (options: Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+def serialize_goal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
@@ -242,7 +242,11 @@ def serialize_goal (options: Protocol.Options) (goal: MVarId) (mvarDecl: Metavar
where
of_name (n: Name) := name_to_ast n (sanitize := false)
-protected def GoalState.serializeGoals (state: GoalState) (parent: Option GoalState := .none) (options: Protocol.Options := {}): MetaM (Array Protocol.Goal):= do
+protected def GoalState.serializeGoals
+ (state: GoalState)
+ (parent: Option GoalState := .none)
+ (options: @&Protocol.Options := {}):
+ MetaM (Array Protocol.Goal):= do
state.restoreMetaM
let goals := state.goals.toArray
let parentDecl? := parent.bind (λ parentState =>
From 3debcc021a5758cf8184c9ac59871634487ece51 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Mar 2024 16:34:01 -0700
Subject: [PATCH 105/465] feat(lib): Export goal.print function
---
Pantograph.lean | 8 +-------
Pantograph/Library.lean | 9 +++++++++
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index fceac00..bcf8395 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -179,12 +179,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => runMetaM <| do
- goalState.restoreMetaM
- let root? ← goalState.rootExpr?.mapM (λ expr => serialize_expression state.options expr)
- let parent? ← goalState.parentExpr?.mapM (λ expr => serialize_expression state.options expr)
- return .ok {
- root?,
- parent?,
- }
+ return .ok (← goalPrint goalState state.options)
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index d72fd3a..52a88b6 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -165,6 +165,15 @@ def goalResume (target: GoalState) (goals: Array String): Except String GoalStat
def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
+@[export pantograph_goal_print_m]
+def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult := do
+ let metaM := do
+ state.restoreMetaM
+ return {
+ root? := ← state.rootExpr?.mapM (λ expr => serialize_expression options expr),
+ parent? := ← state.parentExpr?.mapM (λ expr => serialize_expression options expr),
+ }
+ runMetaM metaM
end Pantograph
From e6dbf88ce29307f08fc26053393ede5e24fe512a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Mar 2024 22:40:14 -0700
Subject: [PATCH 106/465] fix: Use Arrays only in the ABI
---
Pantograph/Environment.lean | 6 +++---
Pantograph/Protocol.lean | 7 ++++---
Test/Environment.lean | 8 ++++----
3 files changed, 11 insertions(+), 10 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index f37225f..ecae517 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -66,8 +66,8 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
| .inductInfo induct => { core with inductInfo? := .some {
numParams := induct.numParams,
numIndices := induct.numIndices,
- all := induct.all.map (·.toString),
- ctors := induct.ctors.map (·.toString),
+ all := induct.all.toArray.map (·.toString),
+ ctors := induct.ctors.toArray.map (·.toString),
isRec := induct.isRec,
isReflexive := induct.isReflexive,
isNested := induct.isNested,
@@ -79,7 +79,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
numFields := ctor.numFields,
} }
| .recInfo r => { core with recursorInfo? := .some {
- all := r.all.map (·.toString),
+ all := r.all.toArray.map (·.toString),
numParams := r.numParams,
numIndices := r.numIndices,
numMotives := r.numMotives,
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 91c44a8..e9a5f87 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -124,8 +124,8 @@ structure EnvInspect where
structure InductInfo where
numParams: Nat
numIndices: Nat
- all: List String
- ctors: List String
+ all: Array String
+ ctors: Array String
isRec: Bool := false
isReflexive: Bool := false
isNested: Bool := false
@@ -138,7 +138,7 @@ structure ConstructorInfo where
numFields: Nat
deriving Lean.ToJson
structure RecursorInfo where
- all: List String
+ all: Array String
numParams: Nat
numIndices: Nat
numMotives: Nat
@@ -230,6 +230,7 @@ structure GoalContinueResult where
-- Remove goal states
structure GoalDelete where
+ -- This is ok being a List because it doesn't show up in the ABI
stateIds: List Nat
deriving Lean.FromJson
structure GoalDeleteResult where
diff --git a/Test/Environment.lean b/Test/Environment.lean
index df3f3ae..977ed7d 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -34,8 +34,8 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
("Or", ConstantCat.induct {
numParams := 2,
numIndices := 0,
- all := ["Or"],
- ctors := ["Or.inl", "Or.inr"],
+ all := #["Or"],
+ ctors := #["Or.inl", "Or.inr"],
}),
("Except.ok", ConstantCat.ctor {
induct := "Except",
@@ -44,7 +44,7 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
numFields := 1,
}),
("Eq.rec", ConstantCat.recursor {
- all := ["Eq"],
+ all := #["Eq"],
numParams := 2,
numIndices := 1,
numMotives := 1,
@@ -52,7 +52,7 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
k := true,
}),
("ForM.rec", ConstantCat.recursor {
- all := ["ForM"],
+ all := #["ForM"],
numParams := 3,
numIndices := 0,
numMotives := 1,
From 81aabc52eadb2a695b09acfd7c3f36534af918cc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Mar 2024 06:01:25 -0700
Subject: [PATCH 107/465] chore: Lean version bump to 4.7.0-rc2
Multithreading in ABI was not stabilized in 4.1.0
---
Makefile | 8 ++++----
flake.lock | 8 ++++----
flake.nix | 2 +-
lake-manifest.json | 24 +++++++++++++-----------
lakefile.lean | 2 +-
lean-toolchain | 2 +-
6 files changed, 24 insertions(+), 22 deletions(-)
diff --git a/Makefile b/Makefile
index 39350b6..5d4ad6b 100644
--- a/Makefile
+++ b/Makefile
@@ -1,8 +1,8 @@
-LIB := build/lib/Pantograph.olean
-EXE := build/bin/pantograph
+LIB := ./.lake/build/lib/Pantograph.olean
+EXE := ./.lake/build/bin/pantograph
SOURCE := $(wildcard Pantograph/*.lean) $(wildcard *.lean) lean-toolchain
-TEST_EXE := build/bin/test
+TEST_EXE := ./.lake/build/bin/test
TEST_SOURCE := $(wildcard Test/*.lean)
$(LIB) $(EXE): $(SOURCE)
@@ -12,7 +12,7 @@ $(TEST_EXE): $(LIB) $(TEST_SOURCE)
lake build test
test: $(TEST_EXE)
- lake env $(TEST_EXE)
+ $(TEST_EXE)
clean:
lake clean
diff --git a/flake.lock b/flake.lock
index 67246b6..89f0e9d 100644
--- a/flake.lock
+++ b/flake.lock
@@ -41,16 +41,16 @@
"nixpkgs": "nixpkgs_2"
},
"locked": {
- "lastModified": 1695693562,
- "narHash": "sha256-6qbCafG0bL5KxQt2gL6hV4PFDsEMM0UXfldeOOqxsaE=",
+ "lastModified": 1709691092,
+ "narHash": "sha256-jHY8BhDotfGcMS0Xzl5iawqCaug3dDEKuD5Y1WcM06I=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "a832f398b80a5ebb820d27b9e55ec949759043ff",
+ "rev": "6fce8f7d5cd18a4419bca7fd51780c71c9b1cc5a",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "v4.1.0",
+ "ref": "v4.7.0-rc2",
"repo": "lean4",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 9f586f6..54640d3 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean.url = "github:leanprover/lean4?ref=v4.1.0";
+ lean.url = "github:leanprover/lean4?ref=v4.7.0-rc2";
};
outputs = inputs @ {
diff --git a/lake-manifest.json b/lake-manifest.json
index 6c2efa0..6ebbbe5 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,12 +1,14 @@
-{"version": 6,
- "packagesDir": "lake-packages",
+{"version": 7,
+ "packagesDir": ".lake/packages",
"packages":
- [{"git":
- {"url": "https://github.com/lurk-lab/LSpec.git",
- "subDir?": null,
- "rev": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
- "opts": {},
- "name": "LSpec",
- "inputRev?": "88f7d23e56a061d32c7173cea5befa4b2c248b41",
- "inherited": false}}],
- "name": "pantograph"}
+ [{"url": "https://github.com/lurk-lab/LSpec.git",
+ "type": "git",
+ "subDir": null,
+ "rev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "name": "LSpec",
+ "manifestFile": "lake-manifest.json",
+ "inputRev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "inherited": false,
+ "configFile": "lakefile.lean"}],
+ "name": "pantograph",
+ "lakeDir": ".lake"}
diff --git a/lakefile.lean b/lakefile.lean
index 89ad70f..d7bc630 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -15,7 +15,7 @@ lean_exe pantograph {
}
require LSpec from git
- "https://github.com/lurk-lab/LSpec.git" @ "88f7d23e56a061d32c7173cea5befa4b2c248b41"
+ "https://github.com/lurk-lab/LSpec.git" @ "3388be5a1d1390594a74ec469fd54a5d84ff6114"
lean_lib Test {
}
lean_exe test {
diff --git a/lean-toolchain b/lean-toolchain
index a9bddf0..faa2254 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:4.1.0
+leanprover/lean4:4.7.0-rc2
From aae19ec942c5284714faca496137e45e6336cfb6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Mar 2024 18:44:28 -0700
Subject: [PATCH 108/465] chore: Version bump to 4.8.0 prerelease
---
flake.lock | 8 ++++----
flake.nix | 2 +-
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/flake.lock b/flake.lock
index 89f0e9d..6278d68 100644
--- a/flake.lock
+++ b/flake.lock
@@ -41,16 +41,16 @@
"nixpkgs": "nixpkgs_2"
},
"locked": {
- "lastModified": 1709691092,
- "narHash": "sha256-jHY8BhDotfGcMS0Xzl5iawqCaug3dDEKuD5Y1WcM06I=",
+ "lastModified": 1710520221,
+ "narHash": "sha256-8Fm4bj9sqqsUHFZweSdGMM5GdUX3jkGK/ggGq27CeQc=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "6fce8f7d5cd18a4419bca7fd51780c71c9b1cc5a",
+ "rev": "f70895ede54501adf0db77474f452a7fef40d0b3",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "v4.7.0-rc2",
+ "ref": "f70895ede54501adf0db77474f452a7fef40d0b3",
"repo": "lean4",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 54640d3..dd98225 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean.url = "github:leanprover/lean4?ref=v4.7.0-rc2";
+ lean.url = "github:leanprover/lean4?ref=f70895ede54501adf0db77474f452a7fef40d0b3";
};
outputs = inputs @ {
From f016d60d07b44950ab1effb7d3618de0c2a0f338 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 16 Mar 2024 19:00:28 -0700
Subject: [PATCH 109/465] chore: Version bump to 0.2.13
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index e412ced..e23d886 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.12-alpha"
+def version := "0.2.13"
end Pantograph
From 516ab1596149f548df01facdd0d5317c687818fd Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 00:06:35 -0700
Subject: [PATCH 110/465] feat: Bump toolchain version
---
Pantograph/Library.lean | 2 +-
Test/Common.lean | 15 ++++++++-------
Test/Environment.lean | 3 ++-
Test/Holes.lean | 16 ++++------------
Test/Integration.lean | 12 +++---------
Test/Proofs.lean | 20 ++++++--------------
Test/Serial.lean | 7 ++-----
flake.lock | 28 +++++++++++++++++++++++-----
flake.nix | 10 +++++++++-
lean-toolchain | 2 +-
10 files changed, 59 insertions(+), 56 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 52a88b6..078ca0f 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -63,7 +63,7 @@ def createCoreContext (options: Array String): IO Lean.Core.Context := do
currNamespace := Lean.Name.str .anonymous "Aniva"
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
- fileMap := { source := "", positions := #[0], lines := #[1] },
+ fileMap := { source := "", positions := #[0] },
options := options
}
diff --git a/Test/Common.lean b/Test/Common.lean
index 2257c7c..7c5b6e5 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -1,5 +1,6 @@
-import Pantograph.Protocol
import Pantograph.Goal
+import Pantograph.Library
+import Pantograph.Protocol
import LSpec
namespace Pantograph
@@ -35,12 +36,7 @@ def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message fa
open Lean
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq): IO LSpec.TestSeq := do
- let coreContext: Core.Context := {
- currNamespace := Name.str .anonymous "Aniva"
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph/Test>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
+ let coreContext: Core.Context ← createCoreContext #[]
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
@@ -53,4 +49,9 @@ def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α
errToSorry := false,
})
+def defaultTermElabMContext: Lean.Elab.Term.Context := {
+ declName? := some "_pantograph".toName,
+ errToSorry := false
+ }
+
end Pantograph
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 977ed7d..9e3bd70 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -76,7 +76,8 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
- (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
+ (imports := #[`Init])
+ --(imports := #["Prelude"].map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
diff --git a/Test/Holes.lean b/Test/Holes.lean
index afad4e8..af322e9 100644
--- a/Test/Holes.lean
+++ b/Test/Holes.lean
@@ -44,16 +44,8 @@ def buildGoal (nameType: List (String × String)) (target: String) (userName?: O
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
- let coreContext: Lean.Core.Context := {
- currNamespace := Name.append .anonymous "Aniva",
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
+ let coreContext: Lean.Core.Context ← createCoreContext #[]
+ let metaM := termElabM.run' (ctx := defaultTermElabMContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
@@ -169,7 +161,7 @@ def test_partial_continuation: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
+ #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Roundtrip
@@ -183,7 +175,7 @@ def test_partial_continuation: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
+ #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Continuation should fail if the state does not exist:
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 0a6c210..83b3c9d 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -21,13 +21,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
let context: Context := {
imports := ["Init"]
}
- let coreContext: Lean.Core.Context := {
- currNamespace := Lean.Name.str .anonymous "Aniva"
- openDecls := [],
- fileName := "<Test>",
- fileMap := { source := "", positions := #[0], lines := #[1] },
- options := Lean.Options.empty
- }
+ let coreContext: Lean.Core.Context ← createCoreContext #[]
let commands: MainM LSpec.TestSeq :=
steps.foldlM (λ suite step => do
let result ← step
@@ -39,7 +33,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
def test_option_modify : IO LSpec.TestSeq :=
- let pp? := Option.some "∀ (n : Nat), n + 1 = Nat.succ n"
+ let pp? := Option.some "∀ (n : Nat), n + 1 = n.succ"
let sexp? := Option.some "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
let options: Protocol.Options := {}
@@ -142,7 +136,7 @@ def test_env : IO LSpec.TestSeq :=
subroutine_step "env.inspect"
[("name", .str name2)]
(Lean.toJson ({
- value? := .some { pp? := .some "fun a => Int.ofNat a + 1" },
+ value? := .some { pp? := .some "fun a => ↑a + 1" },
type := { pp? := .some "Nat → Int" },
}:
Protocol.EnvInspectResult))
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 85ba66d..833c02e 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -62,16 +62,8 @@ def buildGoal (nameType: List (String × String)) (target: String) (userName?: O
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
- let coreContext: Lean.Core.Context := {
- currNamespace := Name.append .anonymous "Aniva",
- openDecls := [], -- No 'open' directives needed
- fileName := "<Pantograph>",
- fileMap := { source := "", positions := #[0], lines := #[1] }
- }
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
+ let coreContext: Lean.Core.Context ← createCoreContext #[]
+ let metaM := termElabM.run' (ctx := defaultTermElabMContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
@@ -235,7 +227,7 @@ def proof_or_comm: TestM Unit := do
let state2parent ← serialize_expression_ast state2.parentExpr?.get! (sanitize := false)
-- This is due to delayed assignment
addTest $ LSpec.test "(2 parent)" (state2parent ==
- "((:mv _uniq.45) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
+ "((:mv _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
@@ -243,7 +235,7 @@ def proof_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
let state3_1parent ← serialize_expression_ast state3_1.parentExpr?.get! (sanitize := false)
- addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.83))")
+ addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.78))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
| .success state => pure state
@@ -252,7 +244,7 @@ def proof_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
let state4_1parent ← serialize_expression_ast state4_1.parentExpr?.get! (sanitize := false)
- addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.49)")
+ addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.47)")
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
@@ -304,7 +296,7 @@ def proof_or_comm: TestM Unit := do
def suite: IO LSpec.TestSeq := do
let env: Lean.Environment ← Lean.importModules
- (imports := #[{ module := Name.append .anonymous "Init", runtimeOnly := false}])
+ (imports := #[{ module := "Init".toName, runtimeOnly := false}])
(opts := {})
(trustLevel := 1)
let tests := [
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 70e86e8..490b538 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -20,7 +20,7 @@ def test_name_to_ast: LSpec.TestSeq :=
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let entries: List (Name × Protocol.BoundExpression) := [
("Nat.add_comm".toName, { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
- ("Nat.le_of_succ_le".toName, { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "Nat.succ n ≤ m")], target := "n ≤ m" })
+ ("Nat.le_of_succ_le".toName, { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "n.succ ≤ m")], target := "n ≤ m" })
]
let coreM: CoreM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
@@ -58,10 +58,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let expr := (← syntax_to_expr s) |>.toOption |>.get!
let test := LSpec.check source ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- let metaM := termElabM.run' (ctx := {
- declName? := some "_pantograph",
- errToSorry := false
- })
+ let metaM := termElabM.run' (ctx := defaultTermElabMContext)
runMetaMSeq env metaM
-- Instance parsing
diff --git a/flake.lock b/flake.lock
index 6278d68..1878e87 100644
--- a/flake.lock
+++ b/flake.lock
@@ -38,19 +38,20 @@
"flake-utils": "flake-utils",
"lean4-mode": "lean4-mode",
"nix": "nix",
- "nixpkgs": "nixpkgs_2"
+ "nixpkgs": "nixpkgs_2",
+ "nixpkgs-old": "nixpkgs-old"
},
"locked": {
- "lastModified": 1710520221,
- "narHash": "sha256-8Fm4bj9sqqsUHFZweSdGMM5GdUX3jkGK/ggGq27CeQc=",
+ "lastModified": 1711508550,
+ "narHash": "sha256-UK4DnYmwXLcqHA316Zkn0cnujdYlxqUf+b6S4l56Q3s=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "f70895ede54501adf0db77474f452a7fef40d0b3",
+ "rev": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "f70895ede54501adf0db77474f452a7fef40d0b3",
+ "ref": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
"repo": "lean4",
"type": "github"
}
@@ -141,6 +142,23 @@
"type": "github"
}
},
+ "nixpkgs-old": {
+ "flake": false,
+ "locked": {
+ "lastModified": 1581379743,
+ "narHash": "sha256-i1XCn9rKuLjvCdu2UeXKzGLF6IuQePQKFt4hEKRU5oc=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixos-19.03",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
"nixpkgs-regression": {
"locked": {
"lastModified": 1643052045,
diff --git a/flake.nix b/flake.nix
index dd98225..ed89fb0 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean.url = "github:leanprover/lean4?ref=f70895ede54501adf0db77474f452a7fef40d0b3";
+ lean.url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
};
outputs = inputs @ {
@@ -27,12 +27,20 @@
roots = [ "Main" "Pantograph" ];
src = ./.;
};
+ test = leanPkgs.buildLeanPackage {
+ name = "Test";
+ roots = [ "Main" ];
+ src = ./Test;
+ };
in rec {
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
default = project.executable;
};
+ checks = {
+ test = test.executable;
+ };
devShells.default = project.devShell;
};
};
diff --git a/lean-toolchain b/lean-toolchain
index faa2254..c630636 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:4.7.0-rc2
+leanprover/lean4:nightly-2024-03-27
From 62d20be8413bc79f7744891b816a73bec8f4c694 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 11:33:15 -0700
Subject: [PATCH 111/465] build: Nix build targets and checks
---
flake.lock | 40 ++++++++++++++++++++++------------------
flake.nix | 36 ++++++++++++++++++++++++++++++++----
2 files changed, 54 insertions(+), 22 deletions(-)
diff --git a/flake.lock b/flake.lock
index 1878e87..f7f3012 100644
--- a/flake.lock
+++ b/flake.lock
@@ -38,7 +38,9 @@
"flake-utils": "flake-utils",
"lean4-mode": "lean4-mode",
"nix": "nix",
- "nixpkgs": "nixpkgs_2",
+ "nixpkgs": [
+ "nixpkgs"
+ ],
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
@@ -88,6 +90,23 @@
"type": "github"
}
},
+ "lspec": {
+ "flake": false,
+ "locked": {
+ "lastModified": 1701971219,
+ "narHash": "sha256-HYDRzkT2UaLDrqKNWesh9C4LJNt0JpW0u68wYVj4Byw=",
+ "owner": "lurk-lab",
+ "repo": "LSpec",
+ "rev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "type": "github"
+ },
+ "original": {
+ "owner": "lurk-lab",
+ "ref": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "repo": "LSpec",
+ "type": "github"
+ }
+ },
"nix": {
"inputs": {
"lowdown-src": "lowdown-src",
@@ -176,22 +195,6 @@
}
},
"nixpkgs_2": {
- "locked": {
- "lastModified": 1686089707,
- "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "ref": "nixpkgs-unstable",
- "repo": "nixpkgs",
- "type": "github"
- }
- },
- "nixpkgs_3": {
"locked": {
"lastModified": 1697456312,
"narHash": "sha256-roiSnrqb5r+ehnKCauPLugoU8S36KgmWraHgRqVYndo=",
@@ -211,7 +214,8 @@
"inputs": {
"flake-parts": "flake-parts",
"lean": "lean",
- "nixpkgs": "nixpkgs_3"
+ "lspec": "lspec",
+ "nixpkgs": "nixpkgs_2"
}
}
},
diff --git a/flake.nix b/flake.nix
index ed89fb0..539d391 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,14 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean.url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
+ lean = {
+ url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
+ inputs.nixpkgs.follows = "nixpkgs";
+ };
+ lspec = {
+ url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
+ flake = false;
+ };
};
outputs = inputs @ {
@@ -12,6 +19,7 @@
nixpkgs,
flake-parts,
lean,
+ lspec,
...
} : flake-parts.lib.mkFlake { inherit inputs; } {
flake = {
@@ -22,24 +30,44 @@
];
perSystem = { system, pkgs, ... }: let
leanPkgs = lean.packages.${system};
+ lspecLib = leanPkgs.buildLeanPackage {
+ name = "LSpec";
+ roots = [ "Main" "LSpec" ];
+ src = "${lspec}";
+ };
project = leanPkgs.buildLeanPackage {
name = "Pantograph";
+ #roots = pkgs.lib.optional pkgs.stdenv.isDarwin [ "Main" "Pantograph" ];
roots = [ "Main" "Pantograph" ];
src = ./.;
};
test = leanPkgs.buildLeanPackage {
name = "Test";
- roots = [ "Main" ];
- src = ./Test;
+ # NOTE: The src directory must be ./. since that is where the import
+ # root begins (e.g. `import Test.Environment` and not `import
+ # Environment`) and thats where `lakefile.lean` resides.
+ roots = [ "Test.Main" ];
+ deps = [ lspecLib project ];
+ src = pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "Pantograph" path);
+ };
};
in rec {
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
+ test = test.executable;
default = project.executable;
};
checks = {
- test = test.executable;
+ test = pkgs.runCommand "test" {
+ buildInputs = [ test.executable leanPkgs.lean-all ];
+ } ''
+ #export LEAN_SRC_PATH="${./.}"
+ ${test.executable}/bin/test > $out
+ '';
};
devShells.default = project.devShell;
};
From 47fabf333bb6f41293dcf3c565e3c22d2f225a1d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 11:37:07 -0700
Subject: [PATCH 112/465] doc: Update README.md
---
README.md | 25 +++++++++++++++++++++----
1 file changed, 21 insertions(+), 4 deletions(-)
diff --git a/README.md b/README.md
index 1ca4d7b..c845b89 100644
--- a/README.md
+++ b/README.md
@@ -6,6 +6,8 @@ An interaction system for Lean 4.
## Installation
+For Nix based workflow, see below.
+
Install `elan` and `lake`. Execute
``` sh
make build/bin/pantograph
@@ -20,7 +22,7 @@ LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
The provided `flake.nix` has a develop environment with Lean already setup.
-## Usage
+## Executable Usage
``` sh
pantograph MODULES|LEAN_OPTIONS
@@ -63,7 +65,7 @@ stat
```
where the application of `assumption` should lead to a failure.
-## Commands
+### Commands
See `Pantograph/Protocol.lean` for a description of the parameters and return values in JSON.
- `reset`: Delete all cached expressions and proof trees
@@ -82,7 +84,7 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
- `goal.print {"stateId": <id>}"`: Print a goal state
- `stat`: Display resource usage
-## Errors
+### Errors
When an error pertaining to the execution of a command happens, the returning JSON structure is
@@ -97,16 +99,31 @@ Common error forms:
input of another is broken. For example, attempting to query a symbol not
existing in the library or indexing into a non-existent proof state.
-## Troubleshooting
+### Troubleshooting
If lean encounters stack overflow problems when printing catalog, execute this before running lean:
```sh
ulimit -s unlimited
```
+## Library Usage
+
+`Pantograph/Library.lean` exposes a series of interfaces which allow FFI call
+with `Pantograph`.
+
## Testing
The tests are based on `LSpec`. To run tests,
``` sh
make test
```
+
+## Nix based workflow
+
+To run tests:
+``` sh
+nix build .#checks.${system}.test
+```
+
+For example, `${system}` could be `x86_64-linux`. Using `nix develop` drops the
+current session into a development shell with fixed Lean version.
From a698a4250f36d9408b30882547f45b07df6c72da Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 18:56:42 -0700
Subject: [PATCH 113/465] feat: Unfold aux lemmas when printing root expr
---
Pantograph/Library.lean | 12 ++++++++++--
Test/Common.lean | 3 +++
Test/Environment.lean | 3 ++-
Test/Main.lean | 4 ++--
Test/{Holes.lean => Metavar.lean} | 6 +++---
Test/Serial.lean | 3 ++-
6 files changed, 22 insertions(+), 9 deletions(-)
rename Test/{Holes.lean => Metavar.lean} (98%)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 078ca0f..c40322a 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -165,13 +165,21 @@ def goalResume (target: GoalState) (goals: Array String): Except String GoalStat
def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
+def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
+
+/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
+def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
+ Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+
@[export pantograph_goal_print_m]
def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult := do
let metaM := do
state.restoreMetaM
return {
- root? := ← state.rootExpr?.mapM (λ expr => serialize_expression options expr),
- parent? := ← state.parentExpr?.mapM (λ expr => serialize_expression options expr),
+ root? := ← state.rootExpr?.mapM (λ expr => do
+ serialize_expression options (← unfoldAuxLemmas expr)),
+ parent? := ← state.parentExpr?.mapM (λ expr => do
+ serialize_expression options (← unfoldAuxLemmas expr)),
}
runMetaM metaM
diff --git a/Test/Common.lean b/Test/Common.lean
index 7c5b6e5..2e7149d 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -1,8 +1,11 @@
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
+import Lean
import LSpec
+open Lean
+
namespace Pantograph
namespace Protocol
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 9e3bd70..ba99380 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -2,11 +2,12 @@ import LSpec
import Pantograph.Serial
import Pantograph.Environment
import Test.Common
+import Lean
+open Lean
namespace Pantograph.Test.Environment
open Pantograph
-open Lean
deriving instance DecidableEq, Repr for Protocol.InductInfo
deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
diff --git a/Test/Main.lean b/Test/Main.lean
index 4a8ab1f..d24f45f 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,6 +1,6 @@
import LSpec
import Test.Environment
-import Test.Holes
+import Test.Metavar
import Test.Integration
import Test.Proofs
import Test.Serial
@@ -11,7 +11,7 @@ def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
- Holes.suite,
+ Metavar.suite,
Integration.suite,
Proofs.suite,
Serial.suite,
diff --git a/Test/Holes.lean b/Test/Metavar.lean
similarity index 98%
rename from Test/Holes.lean
rename to Test/Metavar.lean
index af322e9..cbbfc81 100644
--- a/Test/Holes.lean
+++ b/Test/Metavar.lean
@@ -3,7 +3,7 @@ import Pantograph.Goal
import Pantograph.Serial
import Test.Common
-namespace Pantograph.Test.Holes
+namespace Pantograph.Test.Metavar
open Pantograph
open Lean
@@ -204,6 +204,6 @@ def suite: IO LSpec.TestSeq := do
let tests ← proofRunner env tests
return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
- return LSpec.group "Holes" tests
+ return LSpec.group "Metavar" tests
-end Pantograph.Test.Holes
+end Pantograph.Test.Metavar
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 490b538..c2810c8 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -1,11 +1,12 @@
import LSpec
import Pantograph.Serial
import Test.Common
+import Lean
+open Lean
namespace Pantograph.Test.Serial
open Pantograph
-open Lean
deriving instance Repr, DecidableEq for Protocol.BoundExpression
From 9e68a9cae47cfb10f4a8214c72ebdf1cf1e10a6f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 19:27:45 -0700
Subject: [PATCH 114/465] test: Elimination of aux lemmas
---
Test/Metavar.lean | 58 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 58 insertions(+)
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index cbbfc81..734c1d9 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -2,6 +2,7 @@ import LSpec
import Pantograph.Goal
import Pantograph.Serial
import Test.Common
+import Lean
namespace Pantograph.Test.Metavar
open Pantograph
@@ -85,6 +86,62 @@ def test_m_couple: TestM Unit := do
addTest $ LSpec.check "exact 3" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 3", .some "3 ≤ 5"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+
+def test_m_couple_simp: TestM Unit := do
+ let state? ← startProof "(2: Nat) ≤ 5"
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
+ let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 2") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "(1b root)" state2.rootExpr?.isNone
+ let state1b ← match state2.continue state1 with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "exact 2" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
+ #[.some "2 ≤ 2", .some "2 ≤ 5"])
+ addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
+ let state3 ← match ← state1b.execute (goalId := 0) (tactic := "simp") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state4 ← match state3.continue state1b with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ let state5 ← match ← state4.execute (goalId := 0) (tactic := "simp") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ state5.restoreMetaM
+ let root ← match state5.rootExpr? with
+ | .some e => pure e
+ | .none =>
+ addTest $ assertUnreachable "(5 root)"
+ return ()
+ let rootStr: String := toString (← Lean.Meta.ppExpr root)
+ addTest $ LSpec.check "(5 root)" (rootStr = "Nat.le_trans (of_eq_true (Init.Data.Nat.Basic._auxLemma.4 2)) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
+ let rootStr: String := toString (← Lean.Meta.ppExpr (← unfoldAuxLemmas root))
+ addTest $ LSpec.check "(5 root)" (rootStr = "Nat.le_trans (of_eq_true (eq_true (Nat.le_refl 2))) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
return ()
def test_proposition_generation: TestM Unit := do
@@ -196,6 +253,7 @@ def suite: IO LSpec.TestSeq := do
(trustLevel := 1)
let tests := [
("2 < 5", test_m_couple),
+ ("2 < 5", test_m_couple_simp),
("Proposition Generation", test_proposition_generation),
("Partial Continuation", test_partial_continuation)
]
From 8fa1a7d383a1d6b3b10196c6f642abf405cb461f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 19:49:44 -0700
Subject: [PATCH 115/465] feat: Stop cataloging internal/detail dependencies
---
Pantograph/Environment.lean | 25 ++++++++++++++++---------
Pantograph/Library.lean | 6 ------
Pantograph/Serial.lean | 17 ++++++++++-------
Test/Environment.lean | 11 +++++------
4 files changed, 31 insertions(+), 28 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index ecae517..a85342a 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -7,14 +7,15 @@ open Pantograph
namespace Pantograph.Environment
-def is_symbol_unsafe_or_internal (n: Lean.Name) (info: Lean.ConstantInfo): Bool :=
- isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ info.isUnsafe
+def isNameInternal (n: Lean.Name): Bool :=
+ -- Returns true if the name is an implementation detail which should not be shown to the user.
+ isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ n.isAuxLemma
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 :=
+def toCompactSymbolName (n: Lean.Name) (info: Lean.ConstantInfo): String :=
let pref := match info with
| .axiomInfo _ => "a"
| .defnInfo _ => "d"
@@ -26,14 +27,14 @@ def to_compact_symbol_name (n: Lean.Name) (info: Lean.ConstantInfo): String :=
| .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
+def toFilteredSymbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String :=
+ if isNameInternal n || info.isUnsafe
then Option.none
- else Option.some <| to_compact_symbol_name n info
+ else Option.some <| toCompactSymbolName n info
def catalog (_: Protocol.EnvCatalog): CoreM Protocol.EnvCatalogResult := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
- match to_filtered_symbol name info with
+ match toFilteredSymbol name info with
| .some x => acc.push x
| .none => acc)
return { symbols := names }
@@ -58,8 +59,14 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
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,
+ 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?.mapM (λ e => do
+ let e ← (unfoldAuxLemmas e).run'
+ pure $ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => name_to_ast n) )
+ else pure (.none),
module? := module?
}
let result := match info with
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index c40322a..7fda4d9 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -165,12 +165,6 @@ def goalResume (target: GoalState) (goals: Array String): Except String GoalStat
def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
-def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
-
-/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
- Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
-
@[export pantograph_goal_print_m]
def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult := do
let metaM := do
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 213ae6d..bf79314 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -6,17 +6,20 @@ import Lean
import Pantograph.Protocol
import Pantograph.Goal
-namespace Pantograph
open Lean
+-- Symbol processing functions --
+
+def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
+
+namespace Pantograph
+
+/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
+def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
+ Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+
--- Input Functions ---
-
-/-- Read a theorem from the environment -/
-def expr_from_const (env: Environment) (name: Name): Except String Lean.Expr :=
- match env.find? name with
- | none => throw s!"Symbol not found: {name}"
- | some cInfo => return cInfo.type
/-- Read syntax object from string -/
def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
Parser.runParserCategory
diff --git a/Test/Environment.lean b/Test/Environment.lean
index ba99380..7014584 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -14,14 +14,14 @@ deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
-def test_symbol_visibility (env: Environment): IO LSpec.TestSeq := do
+def test_symbol_visibility: IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
- ("Lean.Name".toName, true)
+ ("Lean.Name".toName, true),
+ ("Init.Data.Nat.Basic._auxLemma.4".toName, true),
]
let suite := entries.foldl (λ suites (symbol, target) =>
- let constant := env.constants.find! symbol
- let test := LSpec.check symbol.toString ((Environment.is_symbol_unsafe_or_internal symbol constant) == target)
+ let test := LSpec.check symbol.toString ((Environment.isNameInternal symbol) == target)
LSpec.TestSeq.append suites test) LSpec.TestSeq.done
return suite
@@ -78,12 +78,11 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
def suite: IO LSpec.TestSeq := do
let env: Environment ← importModules
(imports := #[`Init])
- --(imports := #["Prelude"].map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
(trustLevel := 1)
return LSpec.group "Environment" $
- (LSpec.group "Symbol visibility" (← test_symbol_visibility env)) ++
+ (LSpec.group "Symbol visibility" (← test_symbol_visibility)) ++
(LSpec.group "Inspect" (← test_inspect env))
end Pantograph.Test.Environment
From e79e386b39fd6900999f60df2f4e2c9984ea97fa Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 19:56:03 -0700
Subject: [PATCH 116/465] test: Catalog has no numeric symbols
---
Pantograph/Environment.lean | 2 +-
Test/Environment.lean | 29 ++++++++++++++++++++++-------
2 files changed, 23 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index a85342a..19c3249 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -9,7 +9,7 @@ namespace Pantograph.Environment
def isNameInternal (n: Lean.Name): Bool :=
-- Returns true if the name is an implementation detail which should not be shown to the user.
- isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ n.isAuxLemma
+ isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ n.isAuxLemma ∨ n.hasMacroScopes
where
isLeanSymbol (name: Lean.Name): Bool := match name.getRoot with
| .str _ name => name == "Lean"
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 7014584..7a398da 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -14,6 +14,21 @@ deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
+def test_catalog: IO LSpec.TestSeq := do
+ let env: Environment ← importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
+ let inner: CoreM LSpec.TestSeq := do
+ let catalogResult ← Environment.catalog {}
+ let symbolsWithNum := env.constants.fold (init := #[]) (λ acc name info =>
+ match (Environment.toFilteredSymbol name info).isSome && (name matches .num _ _) with
+ | false => acc
+ | true => acc.push name
+ )
+ return LSpec.check "No num symbols" (symbolsWithNum.size == 0)
+ runCoreMSeq env inner
+
def test_symbol_visibility: IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
@@ -30,7 +45,11 @@ inductive ConstantCat where
| ctor (info: Protocol.ConstructorInfo)
| recursor (info: Protocol.RecursorInfo)
-def test_inspect (env: Environment): IO LSpec.TestSeq := do
+def test_inspect: IO LSpec.TestSeq := do
+ let env: Environment ← importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
let testCases: List (String × ConstantCat) := [
("Or", ConstantCat.induct {
numParams := 2,
@@ -76,13 +95,9 @@ def test_inspect (env: Environment): IO LSpec.TestSeq := do
runCoreMSeq env inner
def suite: IO LSpec.TestSeq := do
- let env: Environment ← importModules
- (imports := #[`Init])
- (opts := {})
- (trustLevel := 1)
-
return LSpec.group "Environment" $
+ (LSpec.group "Catalog" (← test_catalog)) ++
(LSpec.group "Symbol visibility" (← test_symbol_visibility)) ++
- (LSpec.group "Inspect" (← test_inspect env))
+ (LSpec.group "Inspect" (← test_inspect))
end Pantograph.Test.Environment
From 46faa5c0894aac848277067bd1e1c23754e64e7e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 22:08:22 -0700
Subject: [PATCH 117/465] chore: Version bump
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index e23d886..688fc60 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.13"
+def version := "0.2.14"
end Pantograph
From 4a89aaf70eecff007a4622fabb3481f4e7fa4e62 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 22:09:56 -0700
Subject: [PATCH 118/465] doc: Main README.md
---
README.md | 16 +++++++++++++---
1 file changed, 13 insertions(+), 3 deletions(-)
diff --git a/README.md b/README.md
index c845b89..cde0807 100644
--- a/README.md
+++ b/README.md
@@ -1,9 +1,12 @@
# Pantograph
-An interaction system for Lean 4.
+A Machine-to-Machine interaction system for Lean 4.
+Pantograph provides interfaces to execute proofs, construct expressions, and
+examine the symbol list of a Lean project for machine learning.
+
## Installation
For Nix based workflow, see below.
@@ -109,9 +112,12 @@ ulimit -s unlimited
## Library Usage
`Pantograph/Library.lean` exposes a series of interfaces which allow FFI call
-with `Pantograph`.
+with `Pantograph` which mirrors the REPL commands above. It is recommended to
+call Pantograph via this FFI since it provides a tremendous speed up.
-## Testing
+## Developing
+
+### Testing
The tests are based on `LSpec`. To run tests,
``` sh
@@ -120,6 +126,10 @@ make test
## Nix based workflow
+The included Nix flake provides build targets for `sharedLib` and `executable`.
+The executable can be used as-is, but linking against the shared library
+requires the presence of `lean-all`.
+
To run tests:
``` sh
nix build .#checks.${system}.test
From 4a1114ab00c8d1b8e33c8acf2a0e810c0323a2c5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 22:23:19 -0700
Subject: [PATCH 119/465] build: Ignore test files when building target
---
flake.nix | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/flake.nix b/flake.nix
index 539d391..df63845 100644
--- a/flake.nix
+++ b/flake.nix
@@ -39,7 +39,13 @@
name = "Pantograph";
#roots = pkgs.lib.optional pkgs.stdenv.isDarwin [ "Main" "Pantograph" ];
roots = [ "Main" "Pantograph" ];
- src = ./.;
+ src = pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "/Test/" path) &&
+ !(pkgs.lib.hasSuffix ".md" path) &&
+ !(pkgs.lib.hasSuffix "Makefile" path);
+ };
};
test = leanPkgs.buildLeanPackage {
name = "Test";
@@ -58,7 +64,6 @@
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
- test = test.executable;
default = project.executable;
};
checks = {
From cfd74aba918cd5d77a52fdc8768506b8c7a6cb9e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 28 Mar 2024 22:26:46 -0700
Subject: [PATCH 120/465] build: Dev shell
---
flake.nix | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/flake.nix b/flake.nix
index df63845..fdb3f6b 100644
--- a/flake.nix
+++ b/flake.nix
@@ -37,7 +37,6 @@
};
project = leanPkgs.buildLeanPackage {
name = "Pantograph";
- #roots = pkgs.lib.optional pkgs.stdenv.isDarwin [ "Main" "Pantograph" ];
roots = [ "Main" "Pantograph" ];
src = pkgs.lib.cleanSourceWith {
src = ./.;
@@ -74,7 +73,9 @@
${test.executable}/bin/test > $out
'';
};
- devShells.default = project.devShell;
+ devShells.default = pkgs.mkShell {
+ buildInputs = [ leanPkgs.lean-all leanPkgs.lean ];
+ };
};
};
}
From 252f85e66cad063d1634a1072249a26aa890ed3d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 29 Mar 2024 23:46:08 -0700
Subject: [PATCH 121/465] feat: Instantiation tests
Note that delay assigned metavariables are not instantiated.
---
Pantograph/Library.lean | 6 +++---
Pantograph/Serial.lean | 4 ++++
Test/Metavar.lean | 27 +++++++++++++++++++++++++--
3 files changed, 32 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 7fda4d9..f44fcad 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -127,7 +127,7 @@ def exprEcho (expr: String) (options: @&Protocol.Options):
| .error e => return .error e
| .ok expr => pure expr
try
- let type ← Lean.Meta.inferType expr
+ let type ← instantiateAll (← Lean.Meta.inferType expr)
return .ok {
type := (← serialize_expression options type),
expr := (← serialize_expression options expr)
@@ -171,9 +171,9 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr => do
- serialize_expression options (← unfoldAuxLemmas expr)),
+ serialize_expression options (← instantiateAll expr)),
parent? := ← state.parentExpr?.mapM (λ expr => do
- serialize_expression options (← unfoldAuxLemmas expr)),
+ serialize_expression options (← instantiateAll expr)),
}
runMetaM metaM
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index bf79314..f829611 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -18,6 +18,10 @@ namespace Pantograph
def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+def instantiateAll (e: Lean.Expr) : Lean.MetaM Lean.Expr := do
+ let e ← unfoldAuxLemmas e
+ instantiateMVars (← Lean.Meta.whnf e)
+
--- Input Functions ---
/-- Read syntax object from string -/
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 734c1d9..9820dde 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -13,6 +13,27 @@ abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
+-- Tests that all delay assigned mvars are instantiated
+def test_instantiate_mvar: TestM Unit := do
+ let env ← Lean.MonadEnv.getEnv
+ let value := "@Nat.le_trans 2 2 5 (@of_eq_true (@LE.le Nat instLENat 2 2) (@eq_true (@LE.le Nat instLENat 2 2) (@Nat.le_refl 2))) (@of_eq_true (@LE.le Nat instLENat 2 5) (@eq_true_of_decide (@LE.le Nat instLENat 2 5) (@Nat.decLe 2 5) (@Eq.refl Bool Bool.true)))"
+ let syn ← match syntax_from_str env value with
+ | .ok s => pure $ s
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let expr ← match ← syntax_to_expr syn with
+ | .ok expr => pure $ expr
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let t ← Lean.Meta.inferType expr
+ addTest $ LSpec.check "typing" ((toString (← serialize_expression_ast t)) =
+ "((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))")
+ return ()
+
+
+
def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
let syn? := syntax_from_str env expr
@@ -140,8 +161,9 @@ def test_m_couple_simp: TestM Unit := do
return ()
let rootStr: String := toString (← Lean.Meta.ppExpr root)
addTest $ LSpec.check "(5 root)" (rootStr = "Nat.le_trans (of_eq_true (Init.Data.Nat.Basic._auxLemma.4 2)) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
- let rootStr: String := toString (← Lean.Meta.ppExpr (← unfoldAuxLemmas root))
- addTest $ LSpec.check "(5 root)" (rootStr = "Nat.le_trans (of_eq_true (eq_true (Nat.le_refl 2))) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
+ let unfoldedRoot ← unfoldAuxLemmas root
+ addTest $ LSpec.check "(5 root)" ((toString (← Lean.Meta.ppExpr unfoldedRoot)) =
+ "Nat.le_trans (of_eq_true (eq_true (Nat.le_refl 2))) (of_eq_true (eq_true_of_decide (Eq.refl true)))")
return ()
def test_proposition_generation: TestM Unit := do
@@ -252,6 +274,7 @@ def suite: IO LSpec.TestSeq := do
(opts := {})
(trustLevel := 1)
let tests := [
+ ("Instantiate", test_instantiate_mvar),
("2 < 5", test_m_couple),
("2 < 5", test_m_couple_simp),
("Proposition Generation", test_proposition_generation),
From 1bea2ca4e1161dc5b489fd2c1c31779418dc3261 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 29 Mar 2024 23:50:30 -0700
Subject: [PATCH 122/465] fix: Lean build failure on macOS
---
flake.lock | 22 ++++++++++++++++++----
flake.nix | 1 -
2 files changed, 18 insertions(+), 5 deletions(-)
diff --git a/flake.lock b/flake.lock
index f7f3012..61e8969 100644
--- a/flake.lock
+++ b/flake.lock
@@ -38,9 +38,7 @@
"flake-utils": "flake-utils",
"lean4-mode": "lean4-mode",
"nix": "nix",
- "nixpkgs": [
- "nixpkgs"
- ],
+ "nixpkgs": "nixpkgs_2",
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
@@ -195,6 +193,22 @@
}
},
"nixpkgs_2": {
+ "locked": {
+ "lastModified": 1711715736,
+ "narHash": "sha256-9slQ609YqT9bT/MNX9+5k5jltL9zgpn36DpFB7TkttM=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "807c549feabce7eddbf259dbdcec9e0600a0660d",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs_3": {
"locked": {
"lastModified": 1697456312,
"narHash": "sha256-roiSnrqb5r+ehnKCauPLugoU8S36KgmWraHgRqVYndo=",
@@ -215,7 +229,7 @@
"flake-parts": "flake-parts",
"lean": "lean",
"lspec": "lspec",
- "nixpkgs": "nixpkgs_2"
+ "nixpkgs": "nixpkgs_3"
}
}
},
diff --git a/flake.nix b/flake.nix
index fdb3f6b..583b1a8 100644
--- a/flake.nix
+++ b/flake.nix
@@ -6,7 +6,6 @@
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
- inputs.nixpkgs.follows = "nixpkgs";
};
lspec = {
url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
From 140055b16bd162558246180571e30ca64819a23c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 29 Mar 2024 23:59:14 -0700
Subject: [PATCH 123/465] fix: Update flake so lean builds on Darwin
---
flake.lock | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/flake.lock b/flake.lock
index 61e8969..39888a8 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1696343447,
- "narHash": "sha256-B2xAZKLkkeRFG5XcHHSXXcP7To9Xzr59KXeZiRf4vdQ=",
+ "lastModified": 1709336216,
+ "narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "c9afaba3dfa4085dbd2ccb38dfade5141e33d9d4",
+ "rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
"type": "github"
},
"original": {
@@ -144,11 +144,11 @@
"nixpkgs-lib": {
"locked": {
"dir": "lib",
- "lastModified": 1696019113,
- "narHash": "sha256-X3+DKYWJm93DRSdC5M6K5hLqzSya9BjibtBsuARoPco=",
+ "lastModified": 1709237383,
+ "narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "f5892ddac112a1e9b3612c39af1b72987ee5783a",
+ "rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
"type": "github"
},
"original": {
@@ -194,11 +194,11 @@
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1711715736,
- "narHash": "sha256-9slQ609YqT9bT/MNX9+5k5jltL9zgpn36DpFB7TkttM=",
+ "lastModified": 1686089707,
+ "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "807c549feabce7eddbf259dbdcec9e0600a0660d",
+ "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
"type": "github"
},
"original": {
@@ -210,11 +210,11 @@
},
"nixpkgs_3": {
"locked": {
- "lastModified": 1697456312,
- "narHash": "sha256-roiSnrqb5r+ehnKCauPLugoU8S36KgmWraHgRqVYndo=",
+ "lastModified": 1711703276,
+ "narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "ca012a02bf8327be9e488546faecae5e05d7d749",
+ "rev": "d8fe5e6c92d0d190646fb9f1056741a229980089",
"type": "github"
},
"original": {
From 73e4c1d81c4f230699335a9794e5612a5de32f05 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 30 Mar 2024 00:03:37 -0700
Subject: [PATCH 124/465] doc: Reason why not to follow nixpkgs
---
flake.nix | 1 +
1 file changed, 1 insertion(+)
diff --git a/flake.nix b/flake.nix
index 583b1a8..2458805 100644
--- a/flake.nix
+++ b/flake.nix
@@ -6,6 +6,7 @@
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
+ # Do not follow input's nixpkgs since it could cause build failures
};
lspec = {
url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
From 2b71203c1e800dcd5085bf3b5ec58b5136186dc1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 30 Mar 2024 00:17:16 -0700
Subject: [PATCH 125/465] fix: Instantiation causes infinite loop
---
Pantograph/Library.lean | 6 +++---
Pantograph/Serial.lean | 4 ----
2 files changed, 3 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index f44fcad..15bde0e 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -127,7 +127,7 @@ def exprEcho (expr: String) (options: @&Protocol.Options):
| .error e => return .error e
| .ok expr => pure expr
try
- let type ← instantiateAll (← Lean.Meta.inferType expr)
+ let type ← unfoldAuxLemmas (← Lean.Meta.inferType expr)
return .ok {
type := (← serialize_expression options type),
expr := (← serialize_expression options expr)
@@ -171,9 +171,9 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr => do
- serialize_expression options (← instantiateAll expr)),
+ serialize_expression options (← unfoldAuxLemmas expr)),
parent? := ← state.parentExpr?.mapM (λ expr => do
- serialize_expression options (← instantiateAll expr)),
+ serialize_expression options (← unfoldAuxLemmas expr)),
}
runMetaM metaM
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index f829611..bf79314 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -18,10 +18,6 @@ namespace Pantograph
def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
-def instantiateAll (e: Lean.Expr) : Lean.MetaM Lean.Expr := do
- let e ← unfoldAuxLemmas e
- instantiateMVars (← Lean.Meta.whnf e)
-
--- Input Functions ---
/-- Read syntax object from string -/
From e9c9548f174d0aeb80589ea8415978538407b925 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 15:40:14 -0700
Subject: [PATCH 126/465] fix: unfoldAuxLemma should be coreM
---
Pantograph/Environment.lean | 2 +-
Pantograph/Serial.lean | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 19c3249..303c2b5 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -64,7 +64,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
else .none,
valueDependency? := ← if args.dependency?.getD false
then info.value?.mapM (λ e => do
- let e ← (unfoldAuxLemmas e).run'
+ let e ← unfoldAuxLemmas e
pure $ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => name_to_ast n) )
else pure (.none),
module? := module?
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index bf79314..7377c68 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -15,7 +15,7 @@ def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxL
namespace Pantograph
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-def unfoldAuxLemmas (e : Lean.Expr) : Lean.MetaM Lean.Expr := do
+def unfoldAuxLemmas (e : Lean.Expr) : Lean.CoreM Lean.Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
--- Input Functions ---
From 2802cc204f7ea63abd7b490547f05fb8d16deb8d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 15:55:08 -0700
Subject: [PATCH 127/465] feat: Specify type in echo
---
Pantograph.lean | 2 +-
Pantograph/Environment.lean | 6 +++---
Pantograph/Library.lean | 25 +++++++++++++++++++------
Pantograph/Protocol.lean | 1 +
Pantograph/Serial.lean | 9 ++++-----
Test/Metavar.lean | 8 ++++----
Test/Proofs.lean | 4 ++--
Test/Serial.lean | 8 ++++----
8 files changed, 38 insertions(+), 25 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index bcf8395..075a7f6 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -71,7 +71,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- exprEcho args.expr state.options
+ exprEcho args.expr args.type state.options
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
index 19c3249..f00e857 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -98,13 +98,13 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.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
+ let type ← match parseTerm env args.type with
| .ok syn => do
- match ← syntax_to_expr syn with
+ match ← elabTerm 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
+ let value ← match parseTerm env args.value with
| .ok syn => do
try
let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index f44fcad..d2bc8a0 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -109,21 +109,34 @@ def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
Lean.CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
-/-- This must be a TermElabM since the parsed expr contains extra information -/
-def exprParse (s: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
+def typeParse (typeParse: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
let env ← Lean.MonadEnv.getEnv
- let syn ← match syntax_from_str env s with
+ let syn ← match parseTerm env typeParse with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
- match ← syntax_to_expr syn with
+ match ← elabType syn with
+ | .error str => return .error $ errorI "elab" str
+ | .ok expr => return .ok expr
+
+/-- This must be a TermElabM since the parsed expr contains extra information -/
+def exprParse (exprStr: String) (expectedType?: Option String := .none): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
+ let env ← Lean.MonadEnv.getEnv
+ let expectedType? ← match ← expectedType?.mapM typeParse with
+ | .none => pure $ .none
+ | .some (.ok t) => pure $ .some t
+ | .some (.error e) => return .error e
+ let syn ← match parseTerm env exprStr with
+ | .error str => return .error $ errorI "parsing" str
+ | .ok syn => pure syn
+ match ← elabTerm syn expectedType? with
| .error str => return .error $ errorI "elab" str
| .ok expr => return .ok expr
@[export pantograph_expr_echo_m]
-def exprEcho (expr: String) (options: @&Protocol.Options):
+def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
let termElabM: Lean.Elab.TermElabM _ := do
- let expr ← match ← exprParse expr with
+ let expr ← match ← exprParse expr expectedType? with
| .error e => return .error e
| .ok expr => pure expr
try
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index cd42ab8..7a2b341 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -98,6 +98,7 @@ structure StatResult where
-- Return the type of an expression
structure ExprEcho where
expr: String
+ type: Option String
deriving Lean.FromJson
structure ExprEchoResult where
expr: Expression
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index f829611..2eb09c6 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -25,23 +25,22 @@ def instantiateAll (e: Lean.Expr) : Lean.MetaM Lean.Expr := do
--- Input Functions ---
/-- Read syntax object from string -/
-def syntax_from_str (env: Environment) (s: String): Except String Syntax :=
+def parseTerm (env: Environment) (s: String): Except String Syntax :=
Parser.runParserCategory
(env := env)
(catName := `term)
(input := s)
(fileName := "<stdin>")
-
/-- Parse a syntax object. May generate additional metavariables! -/
-def syntax_to_expr_type (syn: Syntax): Elab.TermElabM (Except String Expr) := do
+def elabType (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
let expr ← Elab.Term.elabType syn
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
-def syntax_to_expr (syn: Syntax): Elab.TermElabM (Except String Expr) := do
+def elabTerm (syn: Syntax) (expectedType? : Option Expr := .none): Elab.TermElabM (Except String Expr) := do
try
- let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .none)
+ let expr ← Elab.Term.elabTerm (stx := syn) expectedType?
return .ok expr
catch ex => return .error (← ex.toMessageData.toString)
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 9820dde..9595b35 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -17,12 +17,12 @@ def addTest (test: LSpec.TestSeq): TestM Unit := do
def test_instantiate_mvar: TestM Unit := do
let env ← Lean.MonadEnv.getEnv
let value := "@Nat.le_trans 2 2 5 (@of_eq_true (@LE.le Nat instLENat 2 2) (@eq_true (@LE.le Nat instLENat 2 2) (@Nat.le_refl 2))) (@of_eq_true (@LE.le Nat instLENat 2 5) (@eq_true_of_decide (@LE.le Nat instLENat 2 5) (@Nat.decLe 2 5) (@Eq.refl Bool Bool.true)))"
- let syn ← match syntax_from_str env value with
+ let syn ← match parseTerm env value with
| .ok s => pure $ s
| .error e => do
addTest $ assertUnreachable e
return ()
- let expr ← match ← syntax_to_expr syn with
+ let expr ← match ← elabTerm syn with
| .ok expr => pure $ expr
| .error e => do
addTest $ assertUnreachable e
@@ -36,14 +36,14 @@ def test_instantiate_mvar: TestM Unit := do
def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
- let syn? := syntax_from_str env expr
+ let syn? := parseTerm env expr
addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
- let expr? ← syntax_to_expr_type syn
+ let expr? ← elabType syn
addTest $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 833c02e..133eee0 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -32,14 +32,14 @@ def startProof (start: Start): TestM (Option GoalState) := do
| .none =>
return Option.none
| .expr expr =>
- let syn? := syntax_from_str env expr
+ let syn? := parseTerm env expr
addTest $ LSpec.check s!"Parsing {expr}" (syn?.isOk)
match syn? with
| .error error =>
IO.println error
return Option.none
| .ok syn =>
- let expr? ← syntax_to_expr_type syn
+ let expr? ← elabType syn
addTest $ LSpec.check s!"Elaborating" expr?.isOk
match expr? with
| .error error =>
diff --git a/Test/Serial.lean b/Test/Serial.lean
index c2810c8..f186bbb 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -55,8 +55,8 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (source, target) => do
let env ← MonadEnv.getEnv
- let s := syntax_from_str env source |>.toOption |>.get!
- let expr := (← syntax_to_expr s) |>.toOption |>.get!
+ let s := parseTerm env source |>.toOption |>.get!
+ let expr := (← elabTerm s) |>.toOption |>.get!
let test := LSpec.check source ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let metaM := termElabM.run' (ctx := defaultTermElabMContext)
@@ -67,8 +67,8 @@ def test_instance (env: Environment): IO LSpec.TestSeq := do
let metaM: MetaM LSpec.TestSeq := do
let env ← MonadEnv.getEnv
let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
- let s := syntax_from_str env source |>.toOption |>.get!
- let _expr := (← runTermElabMInMeta <| syntax_to_expr s) |>.toOption |>.get!
+ let s := parseTerm env source |>.toOption |>.get!
+ let _expr := (← runTermElabMInMeta <| elabTerm s) |>.toOption |>.get!
return LSpec.TestSeq.done
runMetaMSeq env metaM
From 7988a25ce8eba153e7caf0c1c3993e93c45b0936 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 16:06:30 -0700
Subject: [PATCH 128/465] refactor: Use library goalStartExpr function
---
Pantograph.lean | 6 +-----
Pantograph/Library.lean | 2 +-
Test/Integration.lean | 14 +++++++-------
3 files changed, 9 insertions(+), 13 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 075a7f6..18f8e27 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -93,11 +93,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => do
- let expr ← match ← exprParse expr with
- | .error e => return .error e
- | .ok expr => pure $ expr
- return .ok $ ← GoalState.create expr
+ | .some expr, .none => goalStartExpr expr
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index d2bc8a0..56b8edb 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -152,7 +152,7 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&
@[export pantograph_goal_start_expr_m]
def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
let termElabM: Lean.Elab.TermElabM _ := do
- let expr ← match ← exprParse expr with
+ let expr ← match ← typeParse expr with
| .error e => return .error e
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 92c5007..5f2523b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -73,22 +73,22 @@ def test_malformed_command : IO LSpec.TestSeq :=
]
def test_tactic : IO LSpec.TestSeq :=
let goal1: Protocol.Goal := {
- name := "_uniq.10",
+ name := "_uniq.11",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
- vars := #[{ name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
+ vars := #[{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
- name := "_uniq.13",
+ name := "_uniq.14",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
- { name := "_uniq.9", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.12", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ { name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
+ { name := "_uniq.13", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
],
}
subroutine_runner [
subroutine_step "goal.start"
[("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
- (Lean.toJson ({stateId := 0, root := "_uniq.8"}:
+ (Lean.toJson ({stateId := 0, root := "_uniq.9"}:
Protocol.GoalStartResult)),
subroutine_step "goal.tactic"
[("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
@@ -100,7 +100,7 @@ def test_tactic : IO LSpec.TestSeq :=
subroutine_step "goal.print"
[("stateId", .num 1)]
(Lean.toJson ({
- parent? := .some { pp? := .some "fun x => ?m.11 x" },
+ parent? := .some { pp? := .some "fun x => ?m.12 x" },
}:
Protocol.GoalPrintResult)),
subroutine_step "goal.tactic"
From a1ed8f4b3dd70b17856a1a496ec4c3338b9c81aa Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 16:11:41 -0700
Subject: [PATCH 129/465] refactor: Use library functions when possible
---
Pantograph.lean | 2 +-
Pantograph/Library.lean | 14 +++++++-------
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 18f8e27..1def945 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -148,7 +148,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .some branchId, .none => do
match state.goalStates.find? branchId with
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
- | .some branch => pure $ target.continue branch
+ | .some branch => pure $ goalContinue target branch
| .none, .some goals =>
pure $ goalResume target goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 56b8edb..d5652de 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -109,9 +109,9 @@ def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
Lean.CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
-def typeParse (typeParse: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
+def parseElabType (type: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
let env ← Lean.MonadEnv.getEnv
- let syn ← match parseTerm env typeParse with
+ let syn ← match parseTerm env type with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
match ← elabType syn with
@@ -119,13 +119,13 @@ def typeParse (typeParse: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) :
| .ok expr => return .ok expr
/-- This must be a TermElabM since the parsed expr contains extra information -/
-def exprParse (exprStr: String) (expectedType?: Option String := .none): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
+def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
let env ← Lean.MonadEnv.getEnv
- let expectedType? ← match ← expectedType?.mapM typeParse with
+ let expectedType? ← match ← expectedType?.mapM parseElabType with
| .none => pure $ .none
| .some (.ok t) => pure $ .some t
| .some (.error e) => return .error e
- let syn ← match parseTerm env exprStr with
+ let syn ← match parseTerm env expr with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
match ← elabTerm syn expectedType? with
@@ -136,7 +136,7 @@ def exprParse (exprStr: String) (expectedType?: Option String := .none): Lean.El
def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
let termElabM: Lean.Elab.TermElabM _ := do
- let expr ← match ← exprParse expr expectedType? with
+ let expr ← match ← parseElabExpr expr expectedType? with
| .error e => return .error e
| .ok expr => pure expr
try
@@ -152,7 +152,7 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&
@[export pantograph_goal_start_expr_m]
def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
let termElabM: Lean.Elab.TermElabM _ := do
- let expr ← match ← typeParse expr with
+ let expr ← match ← parseElabType expr with
| .error e => return .error e
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
From f4628432189d88a75f635ced7d1eba64bb013ee4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 16:12:23 -0700
Subject: [PATCH 130/465] docs: Update README.md
---
README.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/README.md b/README.md
index cde0807..26bf788 100644
--- a/README.md
+++ b/README.md
@@ -72,7 +72,7 @@ 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": <expr>}`: Determine the type of an expression and round-trip it
+- `expr.echo {"expr": <expr>, "type": <optional expected type>}`: Determine the type of an expression and round-trip it
- `env.catalog`: Display a list of all safe Lean symbols in the current environment
- `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
given symbol; If value flag is set, the value is printed or hidden. By default
From 216bb9e920c18d846140f431a62326288f69065f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 16:43:30 -0700
Subject: [PATCH 131/465] test: Library test
---
Pantograph.lean | 2 +-
Pantograph/Protocol.lean | 2 +-
Test/Common.lean | 7 +++++--
Test/Library.lean | 35 +++++++++++++++++++++++++++++++++++
Test/Main.lean | 8 +++++---
5 files changed, 47 insertions(+), 7 deletions(-)
create mode 100644 Test/Library.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 1def945..97f03f4 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -71,7 +71,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- exprEcho args.expr args.type state.options
+ exprEcho args.expr args.type? state.options
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 7a2b341..6ee3354 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -98,7 +98,7 @@ structure StatResult where
-- Return the type of an expression
structure ExprEcho where
expr: String
- type: Option String
+ type?: Option String
deriving Lean.FromJson
structure ExprEchoResult where
expr: Expression
diff --git a/Test/Common.lean b/Test/Common.lean
index 2e7149d..378dce8 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -24,6 +24,9 @@ def Goal.devolatilize (goal: Goal): Goal :=
deriving instance DecidableEq, Repr for Expression
deriving instance DecidableEq, Repr for Variable
deriving instance DecidableEq, Repr for Goal
+deriving instance DecidableEq, Repr for ExprEchoResult
+deriving instance DecidableEq, Repr for InteractionError
+deriving instance DecidableEq, Repr for Option
end Protocol
def TacticResult.toString : TacticResult → String
@@ -38,8 +41,8 @@ def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message fa
open Lean
-def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq): IO LSpec.TestSeq := do
- let coreContext: Core.Context ← createCoreContext #[]
+def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
+ let coreContext: Core.Context ← createCoreContext options
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
return LSpec.test "Exception" (s!"internal exception #{← exception.toMessageData.toString}" = "")
diff --git a/Test/Library.lean b/Test/Library.lean
new file mode 100644
index 0000000..265335a
--- /dev/null
+++ b/Test/Library.lean
@@ -0,0 +1,35 @@
+import LSpec
+import Lean
+import Pantograph.Library
+import Test.Common
+
+open Lean
+open Pantograph
+
+namespace Pantograph.Test.Library
+
+def test_expr_echo: IO LSpec.TestSeq := do
+ let env: Environment ← importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
+ let inner: CoreM LSpec.TestSeq := do
+ let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
+ let tests := LSpec.TestSeq.done
+ let echoResult ← exprEcho prop_and_proof (options := {})
+ let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
+ type := { pp? := "?m.2" }, expr := { pp? := "?m.3" }
+ }))
+ let echoResult ← exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := {})
+ let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
+ type := { pp? := "(p : Prop) ×' p" }, expr := { pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩" }
+ }))
+ return tests
+ runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
+
+def suite: IO LSpec.TestSeq := do
+
+ return LSpec.group "Library" $
+ (LSpec.group "ExprEcho" (← test_expr_echo))
+
+end Pantograph.Test.Library
diff --git a/Test/Main.lean b/Test/Main.lean
index d24f45f..6baffad 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,7 +1,8 @@
import LSpec
import Test.Environment
-import Test.Metavar
import Test.Integration
+import Test.Library
+import Test.Metavar
import Test.Proofs
import Test.Serial
@@ -11,11 +12,12 @@ def main := do
Lean.initSearchPath (← Lean.findSysroot)
let suites := [
- Metavar.suite,
+ Environment.suite,
Integration.suite,
+ Library.suite,
+ Metavar.suite,
Proofs.suite,
Serial.suite,
- Environment.suite
]
let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
LSpec.lspecIO $ all
From 8b43dc0f25d4423a1dd839b8618578351fc4c000 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 31 Mar 2024 17:09:24 -0700
Subject: [PATCH 132/465] feat: Instantiate mvars during echo
---
Pantograph/Library.lean | 4 ++--
Test/Library.lean | 11 +++++++++--
2 files changed, 11 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index e2cf3f1..d36866a 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -116,7 +116,7 @@ def parseElabType (type: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) :=
| .ok syn => pure syn
match ← elabType syn with
| .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok expr
+ | .ok expr => return .ok (← Lean.instantiateMVars expr)
/-- This must be a TermElabM since the parsed expr contains extra information -/
def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
@@ -130,7 +130,7 @@ def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.E
| .ok syn => pure syn
match ← elabTerm syn expectedType? with
| .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok expr
+ | .ok expr => return .ok (← Lean.instantiateMVars expr)
@[export pantograph_expr_echo_m]
def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options):
diff --git a/Test/Library.lean b/Test/Library.lean
index 265335a..8c935ee 100644
--- a/Test/Library.lean
+++ b/Test/Library.lean
@@ -20,9 +20,16 @@ def test_expr_echo: IO LSpec.TestSeq := do
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
type := { pp? := "?m.2" }, expr := { pp? := "?m.3" }
}))
- let echoResult ← exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := {})
+ let echoResult ← exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := { printExprAST := true })
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
- type := { pp? := "(p : Prop) ×' p" }, expr := { pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩" }
+ type := {
+ pp? := "(p : Prop) ×' p",
+ sexp? := "((:c PSigma) (:sort 0) (:lambda p (:sort 0) 0))",
+ },
+ expr := {
+ pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
+ sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall _ 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
+ }
}))
return tests
runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
From 8a447e67cd0cef71f570ad04438445d828822778 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 14:07:13 -0700
Subject: [PATCH 133/465] test: Parallel testing infrastructure
---
Test/Common.lean | 29 +++++++++++++++++++++++++++--
Test/Environment.lean | 11 ++++++-----
Test/Integration.lean | 16 ++++++++--------
Test/Library.lean | 14 +++++---------
Test/Main.lean | 25 +++++++++++++++----------
Test/Metavar.lean | 13 ++-----------
Test/Proofs.lean | 14 ++------------
Test/Serial.lean | 20 ++++++++------------
8 files changed, 73 insertions(+), 69 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index 378dce8..2711ff2 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -8,6 +8,7 @@ open Lean
namespace Pantograph
+-- Auxiliary functions
namespace Protocol
/-- Set internal names to "" -/
def Goal.devolatilize (goal: Goal): Goal :=
@@ -37,9 +38,32 @@ def TacticResult.toString : TacticResult → String
| .parseError error => s!".parseError {error}"
| .indexError index => s!".indexError {index}"
-def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
+namespace Test
-open Lean
+def expectationFailure (desc: String) (error: String): LSpec.TestSeq := LSpec.test desc (LSpec.ExpectationFailure "ok _" error)
+
+-- Test running infrastructure
+
+def addPrefix (pref: String) (tests: List (String × α)): List (String × α) :=
+ tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
+
+/-- Runs test in parallel. Filters test name if given -/
+def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
+ let tests: List (String × IO LSpec.TestSeq) := match filter with
+ | .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
+ | .none => tests
+ let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
+ return (name, ← EIO.asTask task))
+ let all := tasks.foldl (λ acc (name, task) =>
+ let v: Except IO.Error LSpec.TestSeq := Task.get task
+ match v with
+ | .ok case => acc ++ (LSpec.group name case)
+ | .error e => acc ++ (expectationFailure name e.toString)
+ ) LSpec.TestSeq.done
+ return all
+
+
+def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
let coreContext: Core.Context ← createCoreContext options
@@ -59,5 +83,6 @@ def defaultTermElabMContext: Lean.Elab.Term.Context := {
declName? := some "_pantograph".toName,
errToSorry := false
}
+end Test
end Pantograph
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 7a398da..927793d 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -94,10 +94,11 @@ def test_inspect: IO LSpec.TestSeq := do
) LSpec.TestSeq.done
runCoreMSeq env inner
-def suite: IO LSpec.TestSeq := do
- return LSpec.group "Environment" $
- (LSpec.group "Catalog" (← test_catalog)) ++
- (LSpec.group "Symbol visibility" (← test_symbol_visibility)) ++
- (LSpec.group "Inspect" (← test_inspect))
+def suite: List (String × IO LSpec.TestSeq) :=
+ [
+ ("Catalog", test_catalog),
+ ("Symbol Visibility", test_symbol_visibility),
+ ("Inspect", test_inspect),
+ ]
end Pantograph.Test.Environment
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 5f2523b..4f3bcba 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -112,7 +112,7 @@ def test_tactic : IO LSpec.TestSeq :=
Protocol.GoalTacticResult))
]
-def test_env : IO LSpec.TestSeq :=
+def test_env_add_inspect : IO LSpec.TestSeq :=
let name1 := "Pantograph.mystery"
let name2 := "Pantograph.mystery2"
subroutine_runner [
@@ -148,13 +148,13 @@ def test_env : IO LSpec.TestSeq :=
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 "Env" (← test_env))
+def suite: List (String × IO LSpec.TestSeq) :=
+ [
+ ("Option modify", test_option_modify),
+ ("Malformed command", test_malformed_command),
+ ("Tactic", test_tactic),
+ ("env.add env.inspect", test_env_add_inspect),
+ ]
end Pantograph.Test.Integration
diff --git a/Test/Library.lean b/Test/Library.lean
index 8c935ee..d995374 100644
--- a/Test/Library.lean
+++ b/Test/Library.lean
@@ -8,11 +8,7 @@ open Pantograph
namespace Pantograph.Test.Library
-def test_expr_echo: IO LSpec.TestSeq := do
- let env: Environment ← importModules
- (imports := #[`Init])
- (opts := {})
- (trustLevel := 1)
+def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
let inner: CoreM LSpec.TestSeq := do
let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
let tests := LSpec.TestSeq.done
@@ -34,9 +30,9 @@ def test_expr_echo: IO LSpec.TestSeq := do
return tests
runCoreMSeq env (options := #["pp.proofs.threshold=100"]) inner
-def suite: IO LSpec.TestSeq := do
-
- return LSpec.group "Library" $
- (LSpec.group "ExprEcho" (← test_expr_echo))
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("expr_echo", test_expr_echo env),
+ ]
end Pantograph.Test.Library
diff --git a/Test/Main.lean b/Test/Main.lean
index 6baffad..42b9d5e 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -8,16 +8,21 @@ import Test.Serial
open Pantograph.Test
-def main := do
+def main (args: List String) := do
+ let name_filter := args.head?
Lean.initSearchPath (← Lean.findSysroot)
+ let env_default: Lean.Environment ← Lean.importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
- let suites := [
- Environment.suite,
- Integration.suite,
- Library.suite,
- Metavar.suite,
- Proofs.suite,
- Serial.suite,
+ let suites: List (String × List (String × IO LSpec.TestSeq)) := [
+ ("Environment", Environment.suite),
+ ("Integration", Integration.suite),
+ ("Library", Library.suite env_default),
+ ("Metavar", Metavar.suite env_default),
+ ("Proofs", Proofs.suite env_default),
+ ("Serial", Serial.suite env_default),
]
- let all ← suites.foldlM (λ acc m => do pure $ acc ++ (← m)) LSpec.TestSeq.done
- LSpec.lspecIO $ all
+ let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
+ LSpec.lspecIO (← runTestGroup name_filter tests)
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 9595b35..433326d 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -268,11 +268,7 @@ def test_partial_continuation: TestM Unit := do
return ()
-def suite: IO LSpec.TestSeq := do
- let env: Lean.Environment ← Lean.importModules
- (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
- (opts := {})
- (trustLevel := 1)
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Instantiate", test_instantiate_mvar),
("2 < 5", test_m_couple),
@@ -280,11 +276,6 @@ def suite: IO LSpec.TestSeq := do
("Proposition Generation", test_proposition_generation),
("Partial Continuation", test_partial_continuation)
]
- let tests ← tests.foldlM (fun acc tests => do
- let (name, tests) := tests
- let tests ← proofRunner env tests
- return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
-
- return LSpec.group "Metavar" tests
+ tests.map (fun (name, test) => (name, proofRunner env test))
end Pantograph.Test.Metavar
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 133eee0..a4a1927 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -293,12 +293,7 @@ def proof_or_comm: TestM Unit := do
]
}
-
-def suite: IO LSpec.TestSeq := do
- let env: Lean.Environment ← Lean.importModules
- (imports := #[{ module := "Init".toName, runtimeOnly := false}])
- (opts := {})
- (trustLevel := 1)
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Nat.add_comm", proof_nat_add_comm false),
("Nat.add_comm manual", proof_nat_add_comm true),
@@ -306,11 +301,6 @@ def suite: IO LSpec.TestSeq := do
("arithmetic", proof_arith),
("Or.comm", proof_or_comm)
]
- let tests ← tests.foldlM (fun acc tests => do
- let (name, tests) := tests
- let tests ← proofRunner env tests
- return acc ++ (LSpec.group name tests)) LSpec.TestSeq.done
-
- return LSpec.group "Proofs" tests
+ tests.map (fun (name, test) => (name, proofRunner env test))
end Pantograph.Test.Proofs
diff --git a/Test/Serial.lean b/Test/Serial.lean
index f186bbb..0a46acc 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -72,17 +72,13 @@ def test_instance (env: Environment): IO LSpec.TestSeq := do
return LSpec.TestSeq.done
runMetaMSeq env metaM
-def suite: IO LSpec.TestSeq := do
- let env: Environment ← importModules
- (imports := #["Init"].map (λ str => { module := str.toName, runtimeOnly := false }))
- (opts := {})
- (trustLevel := 1)
-
- return LSpec.group "Serialization" $
- (LSpec.group "name_to_ast" test_name_to_ast) ++
- (LSpec.group "Expression binder" (← test_expr_to_binder env)) ++
- (LSpec.group "Sexp from symbol" (← test_sexp_of_symbol env)) ++
- (LSpec.group "Sexp from expr" (← test_sexp_of_expr env)) ++
- (LSpec.group "Instance" (← test_instance env))
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("name_to_ast", do pure test_name_to_ast),
+ ("Expression binder", test_expr_to_binder env),
+ ("Sexp from symbol", test_sexp_of_symbol env),
+ ("Sexp from expr", test_sexp_of_expr env),
+ ("Instance", test_instance env),
+ ]
end Pantograph.Test.Serial
From 92351c9a3d11cce85dec723413e702b72b19b634 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 14:14:30 -0700
Subject: [PATCH 134/465] test: Move parallelism to Test/Main.lean
---
Test/Common.lean | 22 ----------------------
Test/Main.lean | 25 +++++++++++++++++++++++++
2 files changed, 25 insertions(+), 22 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index 2711ff2..9c13a6d 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -41,28 +41,6 @@ def TacticResult.toString : TacticResult → String
namespace Test
def expectationFailure (desc: String) (error: String): LSpec.TestSeq := LSpec.test desc (LSpec.ExpectationFailure "ok _" error)
-
--- Test running infrastructure
-
-def addPrefix (pref: String) (tests: List (String × α)): List (String × α) :=
- tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
-
-/-- Runs test in parallel. Filters test name if given -/
-def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
- let tests: List (String × IO LSpec.TestSeq) := match filter with
- | .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
- | .none => tests
- let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
- return (name, ← EIO.asTask task))
- let all := tasks.foldl (λ acc (name, task) =>
- let v: Except IO.Error LSpec.TestSeq := Task.get task
- match v with
- | .ok case => acc ++ (LSpec.group name case)
- | .error e => acc ++ (expectationFailure name e.toString)
- ) LSpec.TestSeq.done
- return all
-
-
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
diff --git a/Test/Main.lean b/Test/Main.lean
index 42b9d5e..1aa1d3d 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -6,8 +6,33 @@ import Test.Metavar
import Test.Proofs
import Test.Serial
+-- Test running infrastructure
+
+namespace Pantograph.Test
+
+def addPrefix (pref: String) (tests: List (String × α)): List (String × α) :=
+ tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
+
+/-- Runs test in parallel. Filters test name if given -/
+def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
+ let tests: List (String × IO LSpec.TestSeq) := match filter with
+ | .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
+ | .none => tests
+ let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
+ return (name, ← EIO.asTask task))
+ let all := tasks.foldl (λ acc (name, task) =>
+ let v: Except IO.Error LSpec.TestSeq := Task.get task
+ match v with
+ | .ok case => acc ++ (LSpec.group name case)
+ | .error e => acc ++ (expectationFailure name e.toString)
+ ) LSpec.TestSeq.done
+ return all
+
+end Pantograph.Test
+
open Pantograph.Test
+/-- Main entry of tests; Provide an argument to filter tests by prefix -/
def main (args: List String) := do
let name_filter := args.head?
Lean.initSearchPath (← Lean.findSysroot)
From 042dc8f530960098365929c1983be25069de386f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 14:15:58 -0700
Subject: [PATCH 135/465] doc: Documentation for `nix flake check`
---
README.md | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/README.md b/README.md
index 26bf788..f60ee22 100644
--- a/README.md
+++ b/README.md
@@ -132,8 +132,5 @@ requires the presence of `lean-all`.
To run tests:
``` sh
-nix build .#checks.${system}.test
+nix flake check
```
-
-For example, `${system}` could be `x86_64-linux`. Using `nix develop` drops the
-current session into a development shell with fixed Lean version.
From 1b7b6a644bc84a5d6dedc5fa797d9b852e49f193 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 16:33:20 -0700
Subject: [PATCH 136/465] feat: `GoalState.tryHave` tactic (tests failing)
---
Pantograph/Goal.lean | 128 +++++++++++++++++++++++++---------------
Pantograph/Library.lean | 2 +-
Pantograph/Serial.lean | 4 +-
Test/Metavar.lean | 18 +++---
Test/Proofs.lean | 86 +++++++++++++++++++--------
5 files changed, 150 insertions(+), 88 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b56c893..5b6e467 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -10,6 +10,8 @@ def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
namespace Pantograph
open Lean
+def filename: String := "<pantograph>"
+
structure GoalState where
savedState : Elab.Tactic.SavedState
@@ -18,9 +20,6 @@ structure GoalState where
-- New metavariables acquired in this state
newMVars: SSet MVarId
- -- The id of the goal in the parent
- parentGoalId: Nat := 0
-
-- Parent state metavariable source
parentMVar: Option MVarId
@@ -56,7 +55,7 @@ private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
state.savedState.term.restore
-def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
+protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
state.savedState.term.meta.restore
/-- Inner function for executing tactic on goal state -/
@@ -89,7 +88,7 @@ inductive TacticResult where
| indexError (goalId: Nat)
/-- Execute tactic on given state -/
-protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String):
+protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
M TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
@@ -99,7 +98,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
(env := ← MonadEnv.getEnv)
(catName := `tactic)
(input := tactic)
- (fileName := "<stdin>") with
+ (fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
@@ -122,10 +121,48 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tactic: String
root := state.root,
savedState := nextSavedState
newMVars,
- parentGoalId := goalId,
parentMVar := .some goal,
}
+/-- Assumes elabM has already been restored -/
+protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr): M TacticResult := do
+ let goalType ← goal.getType
+ try
+ let exprType ← Meta.inferType expr
+ -- This elaboration is necessary
+ if !(← Meta.isDefEq goalType exprType) then
+ return .failure #["Type unification failed", toString (← Meta.ppExpr goalType), toString (← Meta.ppExpr exprType)]
+ goal.checkNotAssigned `GoalState.tryAssign
+ goal.assign expr
+ if (← getThe Core.State).messages.hasErrors then
+ let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
+ let errors ← (messages.map Message.data).mapM fun md => md.toString
+ return .failure errors
+ else
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ let nextMCtx ← getMCtx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ return acc
+ else
+ return mvarId :: acc
+ ) []
+ let nextGoals ← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned))
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals := nextGoals }
+ },
+ newMVars := newMVars.toSSet,
+ parentMVar := .some goal,
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
@@ -135,50 +172,43 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
(env := state.env)
(catName := `term)
(input := expr)
- (fileName := "<stdin>") with
+ (fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- let tacticM: Elab.Tactic.TacticM TacticResult := do
- state.savedState.restore
- Elab.Tactic.setGoals [goal]
- try
- let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
- -- Attempt to unify the expression
- let goalType ← goal.getType
- let exprType ← Meta.inferType expr
- if !(← Meta.isDefEq goalType exprType) then
- return .failure #["Type unification failed", toString (← Meta.ppExpr goalType), toString (← Meta.ppExpr exprType)]
- goal.checkNotAssigned `GoalState.tryAssign
- goal.assign expr
- if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
- return .failure errors
- else
- let prevMCtx := state.savedState.term.meta.meta.mctx
- let nextMCtx ← getMCtx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
- if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- return acc
- else
- return mvarId :: acc
- ) []
- -- The new goals are the newMVars that lack an assignment
- Elab.Tactic.setGoals (← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned)))
- let nextSavedState ← MonadBacktrack.saveState
- return .success {
- root := state.root,
- savedState := nextSavedState,
- newMVars := newMVars.toSSet,
- parentGoalId := goalId,
- parentMVar := .some goal,
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
- tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ let goalType ← goal.getType
+ try
+ let expr ← Elab.Term.elabTermAndSynthesize (stx := expr) (expectedType? := .some goalType)
+ state.assign goal expr
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
+-- Specialized Tactics
+
+protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): M TacticResult := do
+ state.restoreElabM
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let type ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := type)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ try
+ let type ← Elab.Term.elabType (stx := type)
+
+ -- The branch created by "have"
+ let mvarBranch ← Meta.mkFreshExprSyntheticOpaqueMVar type
+
+ -- The main branch
+ let mvarUpstream ← Meta.mkFreshExprSyntheticOpaqueMVar (← goal.getType)
+ let expr := Expr.app (.lam binderName.toName type mvarBranch .default) mvarUpstream
+ state.assign goal expr
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
/--
Brings into scope a list of goals
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index d36866a..1d31e97 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -160,7 +160,7 @@ def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
- runTermElabM <| GoalState.execute state goalId tactic
+ runTermElabM <| GoalState.tryTactic state goalId tactic
@[export pantograph_goal_try_assign_m]
def goalTryAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 8bb61df..6ff8150 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -251,9 +251,7 @@ protected def GoalState.serializeGoals
MetaM (Array Protocol.Goal):= do
state.restoreMetaM
let goals := state.goals.toArray
- let parentDecl? := parent.bind (λ parentState =>
- let parentGoal := parentState.goals.get! state.parentGoalId
- parentState.mctx.findDecl? parentGoal)
+ let parentDecl? := parent.bind (λ parentState => parentState.mctx.findDecl? state.parentMVar.get!)
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 433326d..1b49e95 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -84,7 +84,7 @@ def test_m_couple: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -93,7 +93,7 @@ def test_m_couple: TestM Unit := do
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
-- Set m to 3
- let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 3") with
+ let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "exact 3") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -116,14 +116,14 @@ def test_m_couple_simp: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
- let state2 ← match ← state1.execute (goalId := 2) (tactic := "exact 2") with
+ let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "exact 2") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -137,7 +137,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ LSpec.check "exact 2" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 2", .some "2 ≤ 5"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
- let state3 ← match ← state1b.execute (goalId := 0) (tactic := "simp") with
+ let state3 ← match ← state1b.tryTactic (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -147,7 +147,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
- let state5 ← match ← state4.execute (goalId := 0) (tactic := "simp") with
+ let state5 ← match ← state4.tryTactic (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -174,7 +174,7 @@ def test_proposition_generation: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply PSigma.mk") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply PSigma.mk") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -216,7 +216,7 @@ def test_partial_continuation: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -224,7 +224,7 @@ def test_partial_continuation: TestM Unit := do
addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
- let state2 ← match ← state1.execute (goalId := 2) (tactic := "apply Nat.succ") with
+ let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "apply Nat.succ") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a4a1927..91c8f0c 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -75,7 +75,7 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
rw [Nat.add_comm]
-def proof_nat_add_comm (manual: Bool): TestM Unit := do
+def test_nat_add_comm (manual: Bool): TestM Unit := do
let state? ← startProof <| match manual with
| false => .copy "Nat.add_comm"
| true => .expr "∀ (a b: Nat), a + b = b + a"
@@ -86,7 +86,7 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n m") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro n m") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -94,13 +94,13 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"])
- match ← state1.execute (goalId := 0) (tactic := "assumption") with
+ match ← state1.tryTactic (goalId := 0) (tactic := "assumption") with
| .failure #[message] =>
addTest $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
| other => do
addTest $ assertUnreachable $ other.toString
- let state2 ← match ← state1.execute (goalId := 0) (tactic := "rw [Nat.add_comm]") with
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "rw [Nat.add_comm]") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -108,7 +108,7 @@ def proof_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ LSpec.test "rw [Nat.add_comm]" state2.goals.isEmpty
return ()
-def proof_delta_variable: TestM Unit := do
+def test_delta_variable: TestM Unit := do
let options: Protocol.Options := { noRepeat := true }
let state? ← startProof <| .expr "∀ (a b: Nat), a + b = b + a"
addTest $ LSpec.check "Start goal" state?.isSome
@@ -118,14 +118,14 @@ def proof_delta_variable: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro n") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro n") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro n" ((← state1.serializeGoals (parent := state0) options).map (·.devolatilize) =
#[buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"])
- let state2 ← match ← state1.execute (goalId := 0) (tactic := "intro m") with
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "intro m") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -149,7 +149,7 @@ example (w x y z : Nat) (p : Nat → Prop)
(h : p (x * y + z * w * x)) : p (x * w * z + y * x) := by
simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *
assumption
-def proof_arith: TestM Unit := do
+def test_arith: TestM Unit := do
let state? ← startProof (.expr "∀ (w x y z : Nat) (p : Nat → Prop) (h : p (x * y + z * w * x)), p (x * w * z + y * x)")
let state0 ← match state? with
| .some state => pure state
@@ -157,21 +157,21 @@ def proof_arith: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "intros") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intros") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intros" (state1.goals.length = 1)
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
- let state2 ← match ← state1.execute (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
- let state3 ← match ← state2.execute (goalId := 0) (tactic := "assumption") with
+ let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -195,7 +195,7 @@ example: ∀ (p q: Prop), p ∨ q → q ∨ p := by
assumption
. apply Or.inl
assumption
-def proof_or_comm: TestM Unit := do
+def test_or_comm: TestM Unit := do
let state? ← startProof (.expr "∀ (p q: Prop), p ∨ q → q ∨ p")
let state0 ← match state? with
| .some state => pure state
@@ -205,16 +205,16 @@ def proof_or_comm: TestM Unit := do
addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
- let state1 ← match ← state0.execute (goalId := 0) (tactic := "intro p q h") with
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro p q h") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ addTest $ LSpec.check "intro p q h" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"])
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
- let state2 ← match ← state1.execute (goalId := 0) (tactic := "cases h") with
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "cases h") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -229,7 +229,7 @@ def proof_or_comm: TestM Unit := do
addTest $ LSpec.test "(2 parent)" (state2parent ==
"((:mv _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
- let state3_1 ← match ← state2.execute (goalId := 0) (tactic := "apply Or.inr") with
+ let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -237,7 +237,7 @@ def proof_or_comm: TestM Unit := do
let state3_1parent ← serialize_expression_ast state3_1.parentExpr?.get! (sanitize := false)
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.78))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
- let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
+ let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -246,13 +246,13 @@ def proof_or_comm: TestM Unit := do
let state4_1parent ← serialize_expression_ast state4_1.parentExpr?.get! (sanitize := false)
addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.47)")
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
- let state3_2 ← match ← state2.execute (goalId := 1) (tactic := "apply Or.inl") with
+ let state3_2 ← match ← state2.tryTactic (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inl" (state3_2.goals.length = 1)
- let state4_2 ← match ← state3_2.execute (goalId := 0) (tactic := "assumption") with
+ let state4_2 ← match ← state3_2.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -266,13 +266,13 @@ def proof_or_comm: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals.get! 0])
- let state3_1 ← match ← state2b.execute (goalId := 0) (tactic := "apply Or.inr") with
+ let state3_1 ← match ← state2b.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
- let state4_1 ← match ← state3_1.execute (goalId := 0) (tactic := "assumption") with
+ let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -292,14 +292,48 @@ def proof_or_comm: TestM Unit := do
{ userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible? := .some true }
]
}
+def test_have_tactic: TestM Unit := do
+ let state? ← startProof (.expr "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
+ addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
+
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro p q h") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "intro p q h" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
+
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "Or.inl (Or.inl h)") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "have" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [] ""])
+
+ let state2 ← match ← state1.tryHave (goalId := 0) (binderName := "y") (type := "p ∨ q") with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "have" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [] ""])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
- ("Nat.add_comm", proof_nat_add_comm false),
- ("Nat.add_comm manual", proof_nat_add_comm true),
- ("Nat.add_comm delta", proof_delta_variable),
- ("arithmetic", proof_arith),
- ("Or.comm", proof_or_comm)
+ ("Nat.add_comm", test_nat_add_comm false),
+ ("Nat.add_comm manual", test_nat_add_comm true),
+ ("Nat.add_comm delta", test_delta_variable),
+ ("arithmetic", test_arith),
+ ("Or.comm", test_or_comm),
+ ("Have", test_have_tactic),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 058f5a98b2ee504274c58a7ac341f502743bd817 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 16:40:22 -0700
Subject: [PATCH 137/465] feat: Bindings for the `have` tactic
---
Pantograph.lean | 13 ++++++++-----
Pantograph/Goal.lean | 5 +++++
Pantograph/Library.lean | 8 ++++++--
Pantograph/Protocol.lean | 5 +++++
4 files changed, 24 insertions(+), 7 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 97f03f4..70d64b9 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -114,12 +114,15 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
- let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr? with
- | .some tactic, .none => do
+ let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr?, args.have? with
+ | .some tactic, .none, .none => do
pure ( Except.ok (← goalTactic goalState args.goalId tactic))
- | .none, .some expr => do
- pure ( Except.ok (← goalTryAssign goalState args.goalId expr))
- | _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr} must be supplied")
+ | .none, .some expr, .none => do
+ pure ( Except.ok (← goalAssign goalState args.goalId expr))
+ | .none, .none, .some type => do
+ let binderName := args.binderName?.getD ""
+ pure ( Except.ok (← goalHave goalState args.goalId binderName type))
+ | _, _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr, have} must be supplied")
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 5b6e467..04fa0d5 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -1,3 +1,8 @@
+/-
+Functions for handling metavariables
+
+All the functions starting with `try` resume their inner monadic state.
+-/
import Pantograph.Protocol
import Lean
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 1d31e97..04a8d71 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -162,10 +162,14 @@ def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
runTermElabM <| GoalState.tryTactic state goalId tactic
-@[export pantograph_goal_try_assign_m]
-def goalTryAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
+@[export pantograph_goal_assign_m]
+def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
runTermElabM <| GoalState.tryAssign state goalId expr
+@[export pantograph_goal_have_m]
+def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+ runTermElabM <| GoalState.tryHave state goalId binderName type
+
@[export pantograph_goal_continue]
def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
target.continue branch
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 6ee3354..3055136 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -201,6 +201,11 @@ structure GoalTactic where
-- One of the fields here must be filled
tactic?: Option String := .none
expr?: Option String := .none
+ have?: Option String := .none
+
+ -- In case of the `have` tactic, the new free variable name
+ binderName?: Option String := .none
+
deriving Lean.FromJson
structure GoalTacticResult where
-- The next goal state id. Existence of this field shows success
From 41cb3f68cdba1b52cbfd6a8ac99a013c46e0b5f3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 17:22:09 -0700
Subject: [PATCH 138/465] test: Tests for conv and calc
---
Test/Proofs.lean | 77 ++++++++++++++++++++++++++++++++++++++++++++----
1 file changed, 72 insertions(+), 5 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 91c8f0c..ca46d95 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -292,16 +292,14 @@ def test_or_comm: TestM Unit := do
{ userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible? := .some true }
]
}
-def test_have_tactic: TestM Unit := do
+
+def test_have: TestM Unit := do
let state? ← startProof (.expr "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
- addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
- addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
-
let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro p q h") with
| .success state => pure state
| other => do
@@ -326,6 +324,71 @@ def test_have_tactic: TestM Unit := do
addTest $ LSpec.check "have" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [] ""])
+example : ∀ (a b c: Nat), (a + b) + c = (b + a) + c := by
+ intro a b c
+ conv =>
+ lhs
+ congr
+ rw [Nat.add_comm]
+ rfl
+
+def test_conv: TestM Unit := do
+ let state? ← startProof (.expr "∀ (a b c: Nat), (a + b) + c = (b + a) + c")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ let tactic := "intro a b c"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c = b + a + c"])
+
+ -- This solves the state in one-shot
+ let tactic := "conv => { lhs; congr; rw [Nat.add_comm]; rfl }"
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+example : ∀ (a: Nat), 1 + a + 1 = a + 2 := by
+ intro a
+ calc 1 + a + 1 = a + 1 + 1 := by conv =>
+ rhs
+ rw [Nat.add_comm]
+ _ = a + 2 := by rw [Nat.add_assoc]
+
+def test_calc: TestM Unit := do
+ let state? ← startProof (.expr "∀ (a: Nat), 1 + a + 1 = a + 2")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ let tactic := "intro a"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("a", "Nat")] "1 + a + 1 = a + 2"])
+ let tactic := "calc"
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("a", "Nat")] "1 + a + 1 = a + 2"])
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Nat.add_comm", test_nat_add_comm false),
@@ -333,8 +396,12 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Nat.add_comm delta", test_delta_variable),
("arithmetic", test_arith),
("Or.comm", test_or_comm),
- ("Have", test_have_tactic),
+ ("have", test_have),
+ ("conv", test_conv),
+ ("calc", test_calc),
]
tests.map (fun (name, test) => (name, proofRunner env test))
+
+
end Pantograph.Test.Proofs
From 5a60ca74d5a455716f05efdba5d6113f97f96c81 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 17:45:36 -0700
Subject: [PATCH 139/465] fix: Auto bound implicit in elab
---
Pantograph/Library.lean | 10 ++++++----
Test/Common.lean | 12 ++++--------
Test/Integration.lean | 11 +++++++++++
Test/Serial.lean | 12 +++++++++---
4 files changed, 30 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index d36866a..bf8a014 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -36,13 +36,15 @@ end Lean
namespace Pantograph
+def defaultTermElabMContext: Lean.Elab.Term.Context := {
+ autoBoundImplicit := true,
+ declName? := some "_pantograph".toName,
+ errToSorry := false
+ }
def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
metaM.run'
def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
- termElabM.run' (ctx := {
- declName? := .none,
- errToSorry := false,
- }) |>.run'
+ termElabM.run' (ctx := defaultTermElabMContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
diff --git a/Test/Common.lean b/Test/Common.lean
index 9c13a6d..6fa858b 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -43,6 +43,9 @@ namespace Test
def expectationFailure (desc: String) (error: String): LSpec.TestSeq := LSpec.test desc (LSpec.ExpectationFailure "ok _" error)
def assertUnreachable (message: String): LSpec.TestSeq := LSpec.check message false
+def parseFailure (error: String) := expectationFailure "parse" error
+def elabFailure (error: String) := expectationFailure "elab" error
+
def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array String := #[]): IO LSpec.TestSeq := do
let coreContext: Core.Context ← createCoreContext options
match ← (coreM.run' coreContext { env := env }).toBaseIO with
@@ -52,15 +55,8 @@ def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array
def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSeq :=
runCoreMSeq env metaM.run'
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
- termElabM.run' (ctx := {
- declName? := .none,
- errToSorry := false,
- })
+ termElabM.run' (ctx := Pantograph.defaultTermElabMContext)
-def defaultTermElabMContext: Lean.Elab.Term.Context := {
- declName? := some "_pantograph".toName,
- errToSorry := false
- }
end Test
end Pantograph
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 4f3bcba..29cb82d 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -32,6 +32,16 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
catch ex =>
return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
+def test_elab : IO LSpec.TestSeq :=
+ subroutine_runner [
+ subroutine_step "expr.echo"
+ [("expr", .str "λ {α : Sort (u + 1)} => List α")]
+ (Lean.toJson ({
+ type := { pp? := .some "{α : Type u} → Type u" },
+ expr := { pp? := .some "fun {α} => List α" }
+ }: Protocol.ExprEchoResult)),
+ ]
+
def test_option_modify : IO LSpec.TestSeq :=
let pp? := Option.some "∀ (n : Nat), n + 1 = n.succ"
let sexp? := Option.some "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"
@@ -150,6 +160,7 @@ def test_env_add_inspect : IO LSpec.TestSeq :=
def suite: List (String × IO LSpec.TestSeq) :=
[
+ ("Elab", test_elab),
("Option modify", test_option_modify),
("Malformed command", test_malformed_command),
("Tactic", test_tactic),
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 0a46acc..15761c5 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -51,12 +51,18 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
("λ x: Nat × Bool => x.1", "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
- ("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))")
+ ("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
+ -- This tests `autoBoundImplicit`
+ ("λ {α : Sort (u + 1)} => List α", "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (source, target) => do
let env ← MonadEnv.getEnv
- let s := parseTerm env source |>.toOption |>.get!
- let expr := (← elabTerm s) |>.toOption |>.get!
+ let s ← match parseTerm env source with
+ | .ok s => pure s
+ | .error e => return parseFailure e
+ let expr ← match (← elabTerm s) with
+ | .ok expr => pure expr
+ | .error e => return elabFailure e
let test := LSpec.check source ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
let metaM := termElabM.run' (ctx := defaultTermElabMContext)
From 7fe73551c33c43da308573178d1278d38886689e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Apr 2024 21:52:25 -0700
Subject: [PATCH 140/465] feat: The `have` tactic
---
Pantograph/Goal.lean | 90 ++++++++++++++++++++++++++++++--------------
Test/Metavar.lean | 2 +-
Test/Proofs.lean | 61 +++++++++++++++++++++++-------
3 files changed, 110 insertions(+), 43 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 04fa0d5..57f524b 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -17,6 +17,9 @@ open Lean
def filename: String := "<pantograph>"
+/--
+Represents an interconnected set of metavariables, or a state in proof search
+ -/
structure GoalState where
savedState : Elab.Tactic.SavedState
@@ -28,15 +31,13 @@ structure GoalState where
-- Parent state metavariable source
parentMVar: Option MVarId
-abbrev M := Elab.TermElabM
-
-protected def GoalState.create (expr: Expr): M GoalState := do
+protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
--let expr ← instantiateMVars expr
- let goal := (← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous))
+ let goal ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
let root := goal.mvarId!
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
@@ -46,12 +47,8 @@ protected def GoalState.create (expr: Expr): M GoalState := do
newMVars := SSet.insert .empty root,
parentMVar := .none,
}
-protected def GoalState.goals (state: GoalState): List MVarId := state.savedState.tactic.goals
-
-protected def GoalState.runM {α: Type} (state: GoalState) (m: Elab.TermElabM α) : M α := do
- state.savedState.term.restore
- m
-
+protected def GoalState.goals (state: GoalState): List MVarId :=
+ state.savedState.tactic.goals
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
protected def GoalState.env (state: GoalState): Environment :=
@@ -65,7 +62,7 @@ protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
- M (Except (Array String) Elab.Tactic.SavedState):= do
+ Elab.TermElabM (Except (Array String) Elab.Tactic.SavedState):= do
let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) Elab.Tactic.SavedState) := do
state.restore
Elab.Tactic.setGoals [goal]
@@ -94,11 +91,12 @@ inductive TacticResult where
/-- Execute tactic on given state -/
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
- M TacticResult := do
+ Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryTactic
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `tactic)
@@ -129,15 +127,22 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
parentMVar := .some goal,
}
-/-- Assumes elabM has already been restored -/
-protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr): M TacticResult := do
+/-- Assumes elabM has already been restored. Assumes expr has already typechecked -/
+protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
+ Elab.TermElabM TacticResult := do
let goalType ← goal.getType
try
- let exprType ← Meta.inferType expr
- -- This elaboration is necessary
- if !(← Meta.isDefEq goalType exprType) then
- return .failure #["Type unification failed", toString (← Meta.ppExpr goalType), toString (← Meta.ppExpr exprType)]
- goal.checkNotAssigned `GoalState.tryAssign
+ -- For some reason this is needed. One of the unit tests will fail if this isn't here
+ let error?: Option String ← goal.withContext (do
+ let exprType ← Meta.inferType expr
+ if ← Meta.isDefEq goalType exprType then
+ pure .none
+ else do
+ return .some s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} != {← Meta.ppExpr goalType}"
+ )
+ if let .some error := error? then
+ return .failure #["Type unification failed", error]
+ goal.checkNotAssigned `GoalState.assign
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
@@ -168,7 +173,8 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr): M
catch exception =>
return .failure #[← exception.toMessageData.toString]
-protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String): M TacticResult := do
+protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String):
+ Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
@@ -182,14 +188,16 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
| .error error => return .parseError error
let goalType ← goal.getType
try
- let expr ← Elab.Term.elabTermAndSynthesize (stx := expr) (expectedType? := .some goalType)
+ let expr ← goal.withContext $
+ Elab.Term.elabTermAndSynthesize (stx := expr) (expectedType? := .some goalType)
state.assign goal expr
catch exception =>
return .failure #[← exception.toMessageData.toString]
-- Specialized Tactics
-protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): M TacticResult := do
+protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
+ Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
@@ -201,16 +209,40 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
+ let binderName := binderName.toName
try
- let type ← Elab.Term.elabType (stx := type)
+ -- Implemented similarly to the intro tactic
+ let nextGoals: List MVarId ← goal.withContext $ (do
+ let type ← Elab.Term.elabType (stx := type)
+ let lctx ← MonadLCtx.getLCtx
- -- The branch created by "have"
- let mvarBranch ← Meta.mkFreshExprSyntheticOpaqueMVar type
+ -- The branch goal inherits the same context, but with a different type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
- -- The main branch
- let mvarUpstream ← Meta.mkFreshExprSyntheticOpaqueMVar (← goal.getType)
- let expr := Expr.app (.lam binderName.toName type mvarBranch .default) mvarUpstream
- state.assign goal expr
+ -- Create the context for the `upstream` goal
+ let fvarId ← mkFreshFVarId
+ let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
+ let fvar := mkFVar fvarId
+ let mvarUpstream ←
+ withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
+ Meta.withNewLocalInstances #[fvar] 0 (do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
+ let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
+ goal.assign expr
+ pure mvarUpstream)
+
+ pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
+ )
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals := nextGoals }
+ },
+ newMVars := nextGoals.toSSet,
+ parentMVar := .some goal,
+ }
catch exception =>
return .failure #[← exception.toMessageData.toString]
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 1b49e95..eff2103 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -8,7 +8,7 @@ namespace Pantograph.Test.Metavar
open Pantograph
open Lean
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ca46d95..5a25b87 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -14,7 +14,7 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options M)
+abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
def addTest (test: LSpec.TestSeq): TestM Unit := do
set $ (← get) ++ test
@@ -205,21 +205,24 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(0 parent)" state0.parentExpr?.isNone
addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro p q h") with
+ let tactic := "intro p q h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intro p q h" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"])
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "cases h") with
+
+ let tactic := "cases h"
+ let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "cases h" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
@@ -300,29 +303,61 @@ def test_have: TestM Unit := do
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro p q h") with
+ let tactic := "intro p q h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intro p q h" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "Or.inl (Or.inl h)") with
+ let expr := "Or.inl (Or.inl h)"
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "have" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [] ""])
+ addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
- let state2 ← match ← state1.tryHave (goalId := 0) (binderName := "y") (type := "p ∨ q") with
+ let haveBind := "y"
+ let haveType := "p ∨ q"
+ let state2 ← match ← state1.tryHave (goalId := 0) (binderName := haveBind) (type := haveType) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "have" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [] ""])
+ addTest $ LSpec.check s!"have {haveBind}: {haveType}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "p ∨ q",
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p"), ("y", "p ∨ q")] "(p ∨ q) ∨ p ∨ q"
+ ])
+
+ let expr := "Or.inl h"
+ let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+ let state2b ← match state3.continue state2 with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let expr := "Or.inl y"
+ let state4 ← match ← state2b.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+ addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
example : ∀ (a b c: Nat), (a + b) + c = (b + a) + c := by
intro a b c
From d9ed051b4de210835445f86abba48e994cdae448 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 7 Apr 2024 14:22:20 -0700
Subject: [PATCH 141/465] feat: Partial implementation of `conv`
---
Pantograph/Goal.lean | 85 ++++++++++++++++++++++++++++++++++++++++++--
Test/Proofs.lean | 40 +++++++++++++++++----
2 files changed, 117 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 57f524b..b0be1d1 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -55,10 +55,13 @@ protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
-private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
- state.savedState.term.restore
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
state.savedState.term.meta.restore
+private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
+ state.savedState.term.restore
+private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
+ state.savedState.restore
+ Elab.Tactic.setGoals [goal]
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
@@ -246,6 +249,84 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
catch exception =>
return .failure #[← exception.toMessageData.toString]
+/-- Enter conv tactic mode -/
+protected def GoalState.tryConv (state: GoalState) (goalId: Nat):
+ Elab.TermElabM TacticResult := do
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
+ state.restoreTacticM goal
+ --let mm ← Meta.matchEq? (← goal.getType)
+ --if let .some (_, _, rhs) := mm then
+ -- if rhs.getAppFn.isMVar then
+ -- IO.println "isMVar ok"
+ -- else
+ -- IO.println "isMVar failed"
+ --else
+ -- IO.println "matchEq? failed"
+ IO.println s!"Old goals: {(← Elab.Tactic.getGoals).map (λ x => x.name.toString)}"
+ --Elab.Tactic.Conv.remarkAsConvGoal
+ let goalNew ← Elab.Tactic.Conv.markAsConvGoal goal
+ -- TODO: Error if `goal == goalNew`
+ Elab.Tactic.setGoals [goalNew]
+ --Elab.Tactic.Conv.remarkAsConvGoal
+ IO.println s!"New goals: {(← Elab.Tactic.getGoals).map (λ x => x.name.toString)}"
+ MonadBacktrack.saveState
+ let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ return acc
+ else
+ return acc.insert mvarId
+ ) SSet.empty
+ return .success {
+ root := state.root,
+ savedState := nextSavedState
+ newMVars,
+ parentMVar := .some goal,
+ }
+
+protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTactic: String):
+ Elab.TermElabM TacticResult := do
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let convTactic ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `conv)
+ (input := convTactic)
+ (fileName := filename) with
+ | .ok stx => pure $ stx
+ | .error error => return .parseError error
+ let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
+ state.restoreTacticM goal
+ Elab.Tactic.Conv.evalConvTactic convTactic
+ MonadBacktrack.saveState
+ let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
+ if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ return acc
+ else
+ return acc.insert mvarId
+ ) SSet.empty
+ return .success {
+ root := state.root,
+ savedState := nextSavedState
+ newMVars,
+ parentMVar := .some goal,
+ }
+
/--
Brings into scope a list of goals
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 5a25b87..bfc0d4e 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -157,12 +157,13 @@ def test_arith: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intros") with
+ let tactic := "intros"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "intros" (state1.goals.length = 1)
+ addTest $ LSpec.check tactic (state1.goals.length = 1)
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
@@ -171,12 +172,13 @@ def test_arith: TestM Unit := do
return ()
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
- let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := "assumption") with
+ let tactic := "assumption"
+ let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.test "assumption" state3.goals.isEmpty
+ addTest $ LSpec.test tactic state3.goals.isEmpty
addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
return ()
@@ -385,14 +387,40 @@ def test_conv: TestM Unit := do
-- This solves the state in one-shot
let tactic := "conv => { lhs; congr; rw [Nat.add_comm]; rfl }"
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
+ let stateT ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ addTest $ LSpec.check tactic ((← stateT.serializeGoals (options := ← read)).map (·.devolatilize) =
#[])
+ let state2 ← match ← state1.tryConv (goalId := 0) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check "conv => ..." ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c" with isConversion := true }])
+
+ let convTactic := "lhs"
+ let state3L ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" {convTactic}" ((← state3L.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c" with isConversion := true }])
+
+ let convTactic := "rhs"
+ let state3R ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" {convTactic}" ((← state3R.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "b + a + c" with isConversion := true }])
+
example : ∀ (a: Nat), 1 + a + 1 = a + 2 := by
intro a
calc 1 + a + 1 = a + 1 + 1 := by conv =>
From d50720f6228638f9ee280c58b3bfb22616b40300 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 7 Apr 2024 14:32:25 -0700
Subject: [PATCH 142/465] refactor: Metavariable set diff function
---
Pantograph/Goal.lean | 52 +++++++++++++-------------------------------
1 file changed, 15 insertions(+), 37 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b0be1d1..6257627 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -63,6 +63,15 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
state.savedState.restore
Elab.Tactic.setGoals [goal]
+private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
+ mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
+ if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ acc
+ else
+ acc.insert mvarId
+ ) SSet.empty
+
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
Elab.TermElabM (Except (Array String) Elab.Tactic.SavedState):= do
@@ -116,17 +125,10 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
let prevMCtx := state.savedState.term.meta.meta.mctx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
- let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
- if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- return acc
- else
- return acc.insert mvarId
- ) SSet.empty
return .success {
root := state.root,
savedState := nextSavedState
- newMVars,
+ newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar := .some goal,
}
@@ -156,21 +158,15 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
let nextMCtx ← getMCtx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
- let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
- if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- return acc
- else
- return mvarId :: acc
- ) []
- let nextGoals ← newMVars.filterM (λ mvar => do pure !(← mvar.isAssigned))
+ let newMVars := newMVarSet prevMCtx nextMCtx
+ let nextGoals ← newMVars.toList.filterM (λ mvar => do pure !(← mvar.isAssigned))
return .success {
root := state.root,
savedState := {
term := ← MonadBacktrack.saveState,
tactic := { goals := nextGoals }
},
- newMVars := newMVars.toSSet,
+ newMVars,
parentMVar := .some goal,
}
catch exception =>
@@ -276,19 +272,10 @@ protected def GoalState.tryConv (state: GoalState) (goalId: Nat):
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
let prevMCtx := state.savedState.term.meta.meta.mctx
let nextMCtx := nextSavedState.term.meta.meta.mctx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
- if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- return acc
- else
- return acc.insert mvarId
- ) SSet.empty
return .success {
root := state.root,
savedState := nextSavedState
- newMVars,
+ newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar := .some goal,
}
@@ -311,19 +298,10 @@ protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTact
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
let nextMCtx := nextSavedState.term.meta.meta.mctx
let prevMCtx := state.savedState.term.meta.meta.mctx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- let newMVars ← nextMCtx.decls.foldlM (fun acc mvarId mvarDecl => do
- if let .some prevMVarDecl := prevMCtx.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- return acc
- else
- return acc.insert mvarId
- ) SSet.empty
return .success {
root := state.root,
savedState := nextSavedState
- newMVars,
+ newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar := .some goal,
}
From 19d2f5ff3fadb7db3c005b8451ef5d3e46885822 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 7 Apr 2024 17:03:49 -0700
Subject: [PATCH 143/465] feat: Conv tactic mode
---
Pantograph/Goal.lean | 26 ++++++++++----------------
Test/Proofs.lean | 2 +-
2 files changed, 11 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 6257627..b238332 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -253,21 +253,15 @@ protected def GoalState.tryConv (state: GoalState) (goalId: Nat):
| .none => return .indexError goalId
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
state.restoreTacticM goal
- --let mm ← Meta.matchEq? (← goal.getType)
- --if let .some (_, _, rhs) := mm then
- -- if rhs.getAppFn.isMVar then
- -- IO.println "isMVar ok"
- -- else
- -- IO.println "isMVar failed"
- --else
- -- IO.println "matchEq? failed"
- IO.println s!"Old goals: {(← Elab.Tactic.getGoals).map (λ x => x.name.toString)}"
- --Elab.Tactic.Conv.remarkAsConvGoal
- let goalNew ← Elab.Tactic.Conv.markAsConvGoal goal
- -- TODO: Error if `goal == goalNew`
- Elab.Tactic.setGoals [goalNew]
- --Elab.Tactic.Conv.remarkAsConvGoal
- IO.println s!"New goals: {(← Elab.Tactic.getGoals).map (λ x => x.name.toString)}"
+
+ -- TODO: Fail if this is already in conv
+
+ -- See Lean.Elab.Tactic.Conv.convTarget
+ Elab.Tactic.withMainContext do
+ -- TODO: Memorize this `rhs` as a conv resultant goal
+ let (rhs, newGoal) ← Elab.Tactic.Conv.mkConvGoalFor (← Elab.Tactic.getMainTarget)
+ Elab.Tactic.setGoals [newGoal.mvarId!]
+ --Elab.Tactic.liftMetaTactic1 fun mvarId => mvarId.replaceTargetEq rhs proof
MonadBacktrack.saveState
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
let prevMCtx := state.savedState.term.meta.meta.mctx
@@ -293,7 +287,7 @@ protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTact
| .error error => return .parseError error
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
state.restoreTacticM goal
- Elab.Tactic.Conv.evalConvTactic convTactic
+ Elab.Tactic.evalTactic convTactic
MonadBacktrack.saveState
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
let nextMCtx := nextSavedState.term.meta.meta.mctx
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index bfc0d4e..4b2b57e 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -401,7 +401,7 @@ def test_conv: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "conv => ..." ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c" with isConversion := true }])
+ #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c = b + a + c" with isConversion := true }])
let convTactic := "lhs"
let state3L ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
From 09189ce600385bbacb4a60d736e5a8d30de1af43 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 10:32:13 -0700
Subject: [PATCH 144/465] perf: Lazy run print monads
---
Pantograph/Serial.lean | 14 ++++++--------
1 file changed, 6 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 8bb61df..14960bb 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -160,14 +160,12 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
of_name (name: Name) := name_to_ast name sanitize
def serialize_expression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
- let pp := toString (← Meta.ppExpr e)
- let pp?: Option String := match options.printExprPretty with
- | true => .some pp
- | false => .none
- let sexp: String ← serialize_expression_ast e
- let sexp?: Option String := match options.printExprAST with
- | true => .some sexp
- | false => .none
+ let pp?: Option String ← match options.printExprPretty with
+ | true => pure $ .some $ toString $ ← Meta.ppExpr e
+ | false => pure $ .none
+ let sexp?: Option String ← match options.printExprAST with
+ | true => pure $ .some $ ← serialize_expression_ast e
+ | false => pure $ .none
return {
pp?,
sexp?
From 63e64a1e9f62efd6837f9222b60fe06857346117 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 12:26:22 -0700
Subject: [PATCH 145/465] feat: Conv tactic functions
---
Pantograph.lean | 2 +
Pantograph/Goal.lean | 112 +++++++++++++++++++++++++++++++++----------
Test/Common.lean | 1 +
Test/Proofs.lean | 106 ++++++++++++++++++++++++++++++----------
4 files changed, 171 insertions(+), 50 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 70d64b9..626afae 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -140,6 +140,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { parseError? := .some message }
| .ok (.indexError goalId) =>
return .error $ errorIndex s!"Invalid goal id index {goalId}"
+ | .ok (.invalidAction message) =>
+ return .error $ errorI "invalid" message
| .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b238332..78affd7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -31,6 +31,9 @@ structure GoalState where
-- Parent state metavariable source
parentMVar: Option MVarId
+ -- Existence of this field shows that we are currently in `conv` mode.
+ convMVar: Option (MVarId × MVarId × List MVarId) := .none
+
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
@@ -100,6 +103,8 @@ inductive TacticResult where
| parseError (message: String)
-- The goal index is out of bounds
| indexError (goalId: Nat)
+ -- The given action cannot be executed in the state
+ | invalidAction (message: String)
/-- Execute tactic on given state -/
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
@@ -122,11 +127,11 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
| .ok nextSavedState =>
-- Assert that the definition of metavariables are the same
let nextMCtx := nextSavedState.term.meta.meta.mctx
- let prevMCtx := state.savedState.term.meta.meta.mctx
+ let prevMCtx := state.mctx
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
return .success {
- root := state.root,
+ state with
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar := .some goal,
@@ -146,7 +151,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
return .some s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} != {← Meta.ppExpr goalType}"
)
if let .some error := error? then
- return .failure #["Type unification failed", error]
+ return .parseError error
goal.checkNotAssigned `GoalState.assign
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
@@ -246,35 +251,45 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
return .failure #[← exception.toMessageData.toString]
/-- Enter conv tactic mode -/
-protected def GoalState.tryConv (state: GoalState) (goalId: Nat):
+protected def GoalState.conv (state: GoalState) (goalId: Nat):
Elab.TermElabM TacticResult := do
+ if state.convMVar.isSome then
+ return .invalidAction "Already in conv state"
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
- let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
+ let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do
state.restoreTacticM goal
-- TODO: Fail if this is already in conv
-- See Lean.Elab.Tactic.Conv.convTarget
- Elab.Tactic.withMainContext do
+ let convMVar ← Elab.Tactic.withMainContext do
-- TODO: Memorize this `rhs` as a conv resultant goal
let (rhs, newGoal) ← Elab.Tactic.Conv.mkConvGoalFor (← Elab.Tactic.getMainTarget)
Elab.Tactic.setGoals [newGoal.mvarId!]
- --Elab.Tactic.liftMetaTactic1 fun mvarId => mvarId.replaceTargetEq rhs proof
- MonadBacktrack.saveState
- let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- let prevMCtx := state.savedState.term.meta.meta.mctx
- let nextMCtx := nextSavedState.term.meta.meta.mctx
- return .success {
- root := state.root,
- savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some goal,
- }
+ pure rhs.mvarId!
+ return (← MonadBacktrack.saveState, convMVar)
+ try
+ let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ let prevMCtx := state.mctx
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ return .success {
+ root := state.root,
+ savedState := nextSavedState
+ newMVars := newMVarSet prevMCtx nextMCtx,
+ parentMVar := .some goal,
+ convMVar := .some (convRhs, goal, state.goals),
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+/-- Execute a tactic in conv mode -/
protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTactic: String):
Elab.TermElabM TacticResult := do
+ let _ ← match state.convMVar with
+ | .some mvar => pure mvar
+ | .none => return .invalidAction "Not in conv state"
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
@@ -289,15 +304,60 @@ protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTact
state.restoreTacticM goal
Elab.Tactic.evalTactic convTactic
MonadBacktrack.saveState
- let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- let nextMCtx := nextSavedState.term.meta.meta.mctx
- let prevMCtx := state.savedState.term.meta.meta.mctx
- return .success {
- root := state.root,
- savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some goal,
- }
+ try
+ let prevMCtx := state.mctx
+ let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ return .success {
+ state with
+ savedState := nextSavedState
+ newMVars := newMVarSet prevMCtx nextMCtx,
+ parentMVar := .some goal,
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
+protected def GoalState.convExit (state: GoalState):
+ Elab.TermElabM TacticResult := do
+ let (convRhs, convGoal, savedGoals) ← match state.convMVar with
+ | .some mvar => pure mvar
+ | .none => return .invalidAction "Not in conv state"
+ let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
+ -- Vide `Lean.Elab.Tactic.Conv.convert`
+ state.savedState.restore
+
+ IO.println "Restored state"
+
+ -- Close all existing goals with `refl`
+ for mvarId in (← Elab.Tactic.getGoals) do
+ liftM <| mvarId.refl <|> mvarId.inferInstance <|> pure ()
+ Elab.Tactic.pruneSolvedGoals
+ unless (← Elab.Tactic.getGoals).isEmpty do
+ throwError "convert tactic failed, there are unsolved goals\n{Elab.goalsToMessageData (← Elab.Tactic.getGoals)}"
+
+ IO.println "Caching"
+ Elab.Tactic.setGoals savedGoals
+
+ let targetNew ← instantiateMVars (.mvar convRhs)
+ let proof ← instantiateMVars (.mvar convGoal)
+
+ Elab.Tactic.liftMetaTactic1 fun mvarId => mvarId.replaceTargetEq targetNew proof
+ MonadBacktrack.saveState
+ try
+ let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ IO.println "Finished caching"
+ let nextMCtx := nextSavedState.term.meta.meta.mctx
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ return .success {
+ root := state.root,
+ savedState := nextSavedState
+ newMVars := newMVarSet prevMCtx nextMCtx,
+ parentMVar := .some convGoal,
+ convMVar := .none
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
/--
diff --git a/Test/Common.lean b/Test/Common.lean
index 6fa858b..8719ebd 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -37,6 +37,7 @@ def TacticResult.toString : TacticResult → String
s!".failure {messages}"
| .parseError error => s!".parseError {error}"
| .indexError index => s!".indexError {index}"
+ | .invalidAction error => s!".invalidAction {error}"
namespace Test
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 4b2b57e..c8ceeee 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -361,47 +361,48 @@ def test_have: TestM Unit := do
addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
-example : ∀ (a b c: Nat), (a + b) + c = (b + a) + c := by
- intro a b c
+example : ∀ (a b c1 c2: Nat), (b + a) + c1 = (b + a) + c2 → (a + b) + c1 = (b + a) + c2 := by
+ intro a b c1 c2 h
conv =>
lhs
congr
- rw [Nat.add_comm]
- rfl
+ . rw [Nat.add_comm]
+ . rfl
+ exact h
def test_conv: TestM Unit := do
- let state? ← startProof (.expr "∀ (a b c: Nat), (a + b) + c = (b + a) + c")
+ let state? ← startProof (.expr "∀ (a b c1 c2: Nat), (b + a) + c1 = (b + a) + c2 → (a + b) + c1 = (b + a) + c2")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let tactic := "intro a b c"
+
+ let tactic := "intro a b c1 c2 h"
let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c = b + a + c"])
+ #[interiorGoal [] "a + b + c1 = b + a + c2"])
- -- This solves the state in one-shot
- let tactic := "conv => { lhs; congr; rw [Nat.add_comm]; rfl }"
- let stateT ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← stateT.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
-
- let state2 ← match ← state1.tryConv (goalId := 0) with
+ let state2 ← match ← state1.conv (goalId := 0) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "conv => ..." ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c = b + a + c" with isConversion := true }])
+ #[{ interiorGoal [] "a + b + c1 = b + a + c2" with isConversion := true }])
+
+ let convTactic := "rhs"
+ let state3R ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" {convTactic} (discard)" ((← state3R.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[{ interiorGoal [] "b + a + c2" with isConversion := true }])
let convTactic := "lhs"
let state3L ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
@@ -410,16 +411,73 @@ def test_conv: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check s!" {convTactic}" ((← state3L.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "a + b + c" with isConversion := true }])
+ #[{ interiorGoal [] "a + b + c1" with isConversion := true }])
- let convTactic := "rhs"
- let state3R ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let convTactic := "congr"
+ let state4 ← match ← state3L.tryConvTactic (goalId := 0) (convTactic := convTactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check s!" {convTactic}" ((← state3R.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[{ buildGoal [("a", "Nat"), ("b", "Nat"), ("c", "Nat")] "b + a + c" with isConversion := true }])
+ addTest $ LSpec.check s!" {convTactic}" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ { interiorGoal [] "a + b" with isConversion := true, userName? := .some "a" },
+ { interiorGoal [] "c1" with isConversion := true, userName? := .some "a" }
+ ])
+
+ let convTactic := "rw [Nat.add_comm]"
+ let state5_1 ← match ← state4.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" · {convTactic}" ((← state5_1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[{ interiorGoal [] "b + a" with isConversion := true, userName? := .some "a" }])
+
+ let convTactic := "rfl"
+ let state6_1 ← match ← state5_1.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" {convTactic}" ((← state6_1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+ let state4_1 ← match state6_1.continue state4 with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ expectationFailure "continue" e
+ return ()
+
+ let convTactic := "rfl"
+ let state6 ← match ← state4_1.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!" · {convTactic}" ((← state6.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+ let state1_1 ← match ← state6.convExit with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ let tactic := "exact h"
+ let stateF ← match ← state1_1.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+
+ where
+ h := "b + a + c1 = b + a + c2"
+ interiorGoal (free: List (String × String)) (target: String) :=
+ let free := [("a", "Nat"), ("b", "Nat"), ("c1", "Nat"), ("c2", "Nat"), ("h", h)] ++ free
+ buildGoal free target
example : ∀ (a: Nat), 1 + a + 1 = a + 2 := by
intro a
From 22bb818a1c06c253e9702bdd04803a9e42bbd0c4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 12:32:27 -0700
Subject: [PATCH 146/465] refactor: Use the `tactic interface for `conv
---
Pantograph/Goal.lean | 38 ++++----------------------------------
Test/Proofs.lean | 12 ++++++------
2 files changed, 10 insertions(+), 40 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 78affd7..ed181a3 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -50,6 +50,8 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
newMVars := SSet.insert .empty root,
parentMVar := .none,
}
+protected def GoalState.isConv (state: GoalState): Bool :=
+ state.convMVar.isSome
protected def GoalState.goals (state: GoalState): List MVarId :=
state.savedState.tactic.goals
protected def GoalState.mctx (state: GoalState): MetavarContext :=
@@ -116,7 +118,7 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
goal.checkNotAssigned `GoalState.tryTactic
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
- (catName := `tactic)
+ (catName := if state.isConv then `conv else `tactic)
(input := tactic)
(fileName := filename) with
| .ok stx => pure $ stx
@@ -284,39 +286,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
catch exception =>
return .failure #[← exception.toMessageData.toString]
-/-- Execute a tactic in conv mode -/
-protected def GoalState.tryConvTactic (state: GoalState) (goalId: Nat) (convTactic: String):
- Elab.TermElabM TacticResult := do
- let _ ← match state.convMVar with
- | .some mvar => pure mvar
- | .none => return .invalidAction "Not in conv state"
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- let convTactic ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `conv)
- (input := convTactic)
- (fileName := filename) with
- | .ok stx => pure $ stx
- | .error error => return .parseError error
- let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
- state.restoreTacticM goal
- Elab.Tactic.evalTactic convTactic
- MonadBacktrack.saveState
- try
- let prevMCtx := state.mctx
- let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- let nextMCtx := nextSavedState.term.meta.meta.mctx
- return .success {
- state with
- savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some goal,
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
-
+/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
let (convRhs, convGoal, savedGoals) ← match state.convMVar with
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index c8ceeee..7a23290 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -396,7 +396,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "a + b + c1 = b + a + c2" with isConversion := true }])
let convTactic := "rhs"
- let state3R ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state3R ← match ← state2.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -405,7 +405,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "b + a + c2" with isConversion := true }])
let convTactic := "lhs"
- let state3L ← match ← state2.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state3L ← match ← state2.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -414,7 +414,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "a + b + c1" with isConversion := true }])
let convTactic := "congr"
- let state4 ← match ← state3L.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state4 ← match ← state3L.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -426,7 +426,7 @@ def test_conv: TestM Unit := do
])
let convTactic := "rw [Nat.add_comm]"
- let state5_1 ← match ← state4.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state5_1 ← match ← state4.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -435,7 +435,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "b + a" with isConversion := true, userName? := .some "a" }])
let convTactic := "rfl"
- let state6_1 ← match ← state5_1.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state6_1 ← match ← state5_1.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -450,7 +450,7 @@ def test_conv: TestM Unit := do
return ()
let convTactic := "rfl"
- let state6 ← match ← state4_1.tryConvTactic (goalId := 0) (convTactic := convTactic) with
+ let state6 ← match ← state4_1.tryTactic (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
From 2f48cfbc19fbb564db02baf6a775ab16a390afb6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 12:45:03 -0700
Subject: [PATCH 147/465] doc: Remove outdated comments
---
Pantograph/Goal.lean | 3 ---
1 file changed, 3 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index ed181a3..07a432b 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -263,11 +263,8 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do
state.restoreTacticM goal
- -- TODO: Fail if this is already in conv
-
-- See Lean.Elab.Tactic.Conv.convTarget
let convMVar ← Elab.Tactic.withMainContext do
- -- TODO: Memorize this `rhs` as a conv resultant goal
let (rhs, newGoal) ← Elab.Tactic.Conv.mkConvGoalFor (← Elab.Tactic.getMainTarget)
Elab.Tactic.setGoals [newGoal.mvarId!]
pure rhs.mvarId!
From d4e49310f069e30206ccc8c4998d856ca760d1a8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 12:50:41 -0700
Subject: [PATCH 148/465] feat: FFI interface to conv functions
---
Pantograph/Library.lean | 14 +++++++++++---
1 file changed, 11 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 5ac38c8..04d1a57 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -162,15 +162,23 @@ def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
- runTermElabM <| GoalState.tryTactic state goalId tactic
+ runTermElabM <| state.tryTactic goalId tactic
@[export pantograph_goal_assign_m]
def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
- runTermElabM <| GoalState.tryAssign state goalId expr
+ runTermElabM <| state.tryAssign goalId expr
@[export pantograph_goal_have_m]
def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
- runTermElabM <| GoalState.tryHave state goalId binderName type
+ runTermElabM <| state.tryHave goalId binderName type
+
+@[export pantograph_goal_conv_m]
+def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
+ runTermElabM <| state.conv goalId
+
+@[export pantograph_goal_conv_exit_m]
+def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
+ runTermElabM <| state.convExit
@[export pantograph_goal_continue]
def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
From 0e63583a1d42cb839757519b7cae95128338bc01 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 12:54:02 -0700
Subject: [PATCH 149/465] refactor: Monads in library
---
Pantograph/Library.lean | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 04d1a57..6da555d 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -136,8 +136,8 @@ def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.E
@[export pantograph_expr_echo_m]
def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options):
- Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) := do
- let termElabM: Lean.Elab.TermElabM _ := do
+ Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) :=
+ runTermElabM do
let expr ← match ← parseElabExpr expr expectedType? with
| .error e => return .error e
| .ok expr => pure expr
@@ -149,16 +149,14 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
- runTermElabM termElabM
@[export pantograph_goal_start_expr_m]
def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
- let termElabM: Lean.Elab.TermElabM _ := do
+ runTermElabM do
let expr ← match ← parseElabType expr with
| .error e => return .error e
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
- runTermElabM termElabM
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
@@ -193,8 +191,8 @@ def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (
runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m]
-def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult := do
- let metaM := do
+def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult :=
+ runMetaM do
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr => do
@@ -202,7 +200,6 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
parent? := ← state.parentExpr?.mapM (λ expr => do
serialize_expression options (← unfoldAuxLemmas expr)),
}
- runMetaM metaM
end Pantograph
From f02f9592d7fc4ba7967eacadbb5b3efb8e8cbac7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 8 Apr 2024 13:12:51 -0700
Subject: [PATCH 150/465] feat: Focus command
---
Pantograph/Goal.lean | 11 ++++++++++-
Pantograph/Library.lean | 10 +++++++---
2 files changed, 17 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 07a432b..7609dae 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -327,6 +327,16 @@ protected def GoalState.convExit (state: GoalState):
+protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
+ let goal ← state.savedState.tactic.goals.get? goalId
+ return {
+ state with
+ savedState := {
+ state.savedState with
+ tactic := { goals := [goal] },
+ },
+ }
+
/--
Brings into scope a list of goals
-/
@@ -345,7 +355,6 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
tactic := { goals := unassigned },
},
}
-
/--
Brings into scope all goals from `branch`
-/
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6da555d..0febba4 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -178,14 +178,18 @@ def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
runTermElabM <| state.convExit
-@[export pantograph_goal_continue]
-def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
- target.continue branch
+@[export pantograph_goal_focus]
+def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
+ state.focus goalId
@[export pantograph_goal_resume]
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
+@[export pantograph_goal_continue]
+def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
+ target.continue branch
+
@[export pantograph_goal_serialize_m]
def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
From 30c1fd894fe4433412730d2b57a74aee7d365610 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 9 Apr 2024 09:11:15 -0700
Subject: [PATCH 151/465] fix: Coupling from unrelated goals
---
Pantograph/Goal.lean | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 7609dae..7e5c0c2 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -32,7 +32,7 @@ structure GoalState where
parentMVar: Option MVarId
-- Existence of this field shows that we are currently in `conv` mode.
- convMVar: Option (MVarId × MVarId × List MVarId) := .none
+ convMVar: Option (MVarId × MVarId) := .none
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
@@ -278,7 +278,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar := .some goal,
- convMVar := .some (convRhs, goal, state.goals),
+ convMVar := .some (convRhs, goal),
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -286,7 +286,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
- let (convRhs, convGoal, savedGoals) ← match state.convMVar with
+ let (convRhs, convGoal) ← match state.convMVar with
| .some mvar => pure mvar
| .none => return .invalidAction "Not in conv state"
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
@@ -303,7 +303,7 @@ protected def GoalState.convExit (state: GoalState):
throwError "convert tactic failed, there are unsolved goals\n{Elab.goalsToMessageData (← Elab.Tactic.getGoals)}"
IO.println "Caching"
- Elab.Tactic.setGoals savedGoals
+ Elab.Tactic.setGoals [convGoal]
let targetNew ← instantiateMVars (.mvar convRhs)
let proof ← instantiateMVars (.mvar convGoal)
From 55b44c3fa141f2be64830ce24823046f131a99be Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 9 Apr 2024 10:03:36 -0700
Subject: [PATCH 152/465] fix: Serialization of .proj
---
Pantograph/Serial.lean | 9 +++++++--
Test/Serial.lean | 36 ++++++++++++++++++++++++++----------
2 files changed, 33 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 14960bb..66abf63 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -86,6 +86,8 @@ partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
/--
Completely serializes an expression tree. Json not used due to compactness
+
+A `_` symbol in the AST indicates automatic deductions not present in the original expression.
-/
partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr
@@ -147,10 +149,13 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
self inner
| .proj typeName idx inner => do
let env ← getEnv
+ let ctor := getStructureCtor env typeName
let fieldName := getStructureFields env typeName |>.get! idx
let projectorName := getProjFnForField? env typeName fieldName |>.get!
- let e := Expr.app (.const projectorName []) inner
- self e
+
+ let autos := String.intercalate " " (List.replicate ctor.numParams "_")
+ let inner ← self inner
+ pure s!"(:app (:c {projectorName}) {autos} {inner})"
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 15761c5..0dac925 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -23,12 +23,11 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
("Nat.add_comm".toName, { binders := #[("n", "Nat"), ("m", "Nat")], target := "n + m = m + n" }),
("Nat.le_of_succ_le".toName, { binders := #[("n", "Nat"), ("m", "Nat"), ("h", "n.succ ≤ m")], target := "n ≤ m" })
]
- let coreM: CoreM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
+ runCoreMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol |>.get! |>.type
let test := LSpec.check symbol.toString ((← type_expr_to_bound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
- runCoreMSeq env coreM
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
@@ -41,14 +40,13 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
]
- let metaM: MetaM LSpec.TestSeq := entries.foldlM (λ suites (symbol, target) => do
+ runMetaMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol.toName |>.get! |>.type
let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- runMetaMSeq env metaM
-def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
+def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
("λ x: Nat × Bool => x.1", "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
@@ -65,24 +63,42 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
| .error e => return elabFailure e
let test := LSpec.check source ((← serialize_expression_ast expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- let metaM := termElabM.run' (ctx := defaultTermElabMContext)
- runMetaMSeq env metaM
+ runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
+
+def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
+ let entries: List (Expr × String) := [
+ (.lam `p (.sort .zero)
+ (.lam `q (.sort .zero)
+ (.lam `k (mkApp2 (.const `And []) (.bvar 1) (.bvar 0))
+ (.proj `And 1 (.bvar 0))
+ .default)
+ .implicit)
+ .implicit,
+ "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) (:app (:c And.right) _ _ 0)) :implicit) :implicit)"
+ ),
+ ]
+ let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
+ let env ← MonadEnv.getEnv
+ let testCaseName := target.take 10
+ let test := LSpec.check testCaseName ((← serialize_expression_ast expr) = target)
+ return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
+ runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
-- Instance parsing
-def test_instance (env: Environment): IO LSpec.TestSeq := do
- let metaM: MetaM LSpec.TestSeq := do
+def test_instance (env: Environment): IO LSpec.TestSeq :=
+ runMetaMSeq env do
let env ← MonadEnv.getEnv
let source := "λ x y: Nat => HAdd.hAdd Nat Nat Nat (instHAdd Nat instAddNat) x y"
let s := parseTerm env source |>.toOption |>.get!
let _expr := (← runTermElabMInMeta <| elabTerm s) |>.toOption |>.get!
return LSpec.TestSeq.done
- runMetaMSeq env metaM
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("name_to_ast", do pure test_name_to_ast),
("Expression binder", test_expr_to_binder env),
("Sexp from symbol", test_sexp_of_symbol env),
+ ("Sexp from elaborated expr", test_sexp_of_elab env),
("Sexp from expr", test_sexp_of_expr env),
("Instance", test_instance env),
]
From 823c9635c77921208e32e8bbb5bcb259d861dc85 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 9 Apr 2024 10:06:26 -0700
Subject: [PATCH 153/465] fix: Leading element in .proj sexp
---
Pantograph/Serial.lean | 2 +-
Test/Serial.lean | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 66abf63..17629ab 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -155,7 +155,7 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
let autos := String.intercalate " " (List.replicate ctor.numParams "_")
let inner ← self inner
- pure s!"(:app (:c {projectorName}) {autos} {inner})"
+ pure s!"((:c {projectorName}) {autos} {inner})"
-- Elides all unhygenic names
binder_info_to_ast : Lean.BinderInfo → String
| .default => ""
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 0dac925..e9f4d85 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -74,7 +74,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
.default)
.implicit)
.implicit,
- "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) (:app (:c And.right) _ _ 0)) :implicit) :implicit)"
+ "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :implicit) :implicit)"
),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
From 535770bbd7c396596a7ce11018f99e235740e05c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 14:59:55 -0700
Subject: [PATCH 154/465] feat: Calc tactic
---
Pantograph/Goal.lean | 105 ++++++++++++++++++++++++++++++++++-------
Pantograph/Serial.lean | 2 +-
Test/Proofs.lean | 63 ++++++++++++++++++++-----
3 files changed, 138 insertions(+), 32 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 7e5c0c2..a6d99bc 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -29,10 +29,12 @@ structure GoalState where
newMVars: SSet MVarId
-- Parent state metavariable source
- parentMVar: Option MVarId
+ parentMVar?: Option MVarId
-- Existence of this field shows that we are currently in `conv` mode.
- convMVar: Option (MVarId × MVarId) := .none
+ convMVar?: Option (MVarId × MVarId) := .none
+ -- Previous RHS for calc, so we don't have to repeat it every time
+ calcPrevRhs?: Option Expr := .none
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
@@ -48,10 +50,10 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
savedState,
root,
newMVars := SSet.insert .empty root,
- parentMVar := .none,
+ parentMVar? := .none,
}
protected def GoalState.isConv (state: GoalState): Bool :=
- state.convMVar.isSome
+ state.convMVar?.isSome
protected def GoalState.goals (state: GoalState): List MVarId :=
state.savedState.tactic.goals
protected def GoalState.mctx (state: GoalState): MetavarContext :=
@@ -136,7 +138,7 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
state with
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some goal,
+ parentMVar? := .some goal,
}
/-- Assumes elabM has already been restored. Assumes expr has already typechecked -/
@@ -174,7 +176,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
tactic := { goals := nextGoals }
},
newMVars,
- parentMVar := .some goal,
+ parentMVar? := .some goal,
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -247,7 +249,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
tactic := { goals := nextGoals }
},
newMVars := nextGoals.toSSet,
- parentMVar := .some goal,
+ parentMVar? := .some goal,
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -255,7 +257,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
/-- Enter conv tactic mode -/
protected def GoalState.conv (state: GoalState) (goalId: Nat):
Elab.TermElabM TacticResult := do
- if state.convMVar.isSome then
+ if state.convMVar?.isSome then
return .invalidAction "Already in conv state"
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
@@ -277,8 +279,8 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
root := state.root,
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some goal,
- convMVar := .some (convRhs, goal),
+ parentMVar? := .some goal,
+ convMVar? := .some (convRhs, goal),
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -286,15 +288,13 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
- let (convRhs, convGoal) ← match state.convMVar with
+ let (convRhs, convGoal) ← match state.convMVar? with
| .some mvar => pure mvar
| .none => return .invalidAction "Not in conv state"
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
-- Vide `Lean.Elab.Tactic.Conv.convert`
state.savedState.restore
- IO.println "Restored state"
-
-- Close all existing goals with `refl`
for mvarId in (← Elab.Tactic.getGoals) do
liftM <| mvarId.refl <|> mvarId.inferInstance <|> pure ()
@@ -302,7 +302,6 @@ protected def GoalState.convExit (state: GoalState):
unless (← Elab.Tactic.getGoals).isEmpty do
throwError "convert tactic failed, there are unsolved goals\n{Elab.goalsToMessageData (← Elab.Tactic.getGoals)}"
- IO.println "Caching"
Elab.Tactic.setGoals [convGoal]
let targetNew ← instantiateMVars (.mvar convRhs)
@@ -312,19 +311,89 @@ protected def GoalState.convExit (state: GoalState):
MonadBacktrack.saveState
try
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- IO.println "Finished caching"
let nextMCtx := nextSavedState.term.meta.meta.mctx
let prevMCtx := state.savedState.term.meta.meta.mctx
return .success {
root := state.root,
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar := .some convGoal,
- convMVar := .none
+ parentMVar? := .some convGoal,
+ convMVar? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
+protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ if state.convMVar?.isSome then
+ return .invalidAction "Cannot initiate `calc` while in `conv` state"
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let `(term|$pred) ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := pred)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ try
+ goal.withContext do
+ let target ← instantiateMVars (← goal.getDecl).type
+ let tag := (← goal.getDecl).userName
+
+ let mut step ← Elab.Term.elabType <| ← do
+ if let some prevRhs := state.calcPrevRhs? then
+ Elab.Term.annotateFirstHoleWithType pred (← Meta.inferType prevRhs)
+ else
+ pure pred
+
+ let some (_, lhs, rhs) ← Elab.Term.getCalcRelation? step |
+ throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
+ if let some prevRhs := state.calcPrevRhs? then
+ unless (← Meta.isDefEqGuarded lhs prevRhs) do
+ throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
+
+ -- Creates a mvar to represent the proof that the calc tactic solves the
+ -- current branch
+ -- In the Lean `calc` tactic this is gobbled up by
+ -- `withCollectingNewGoalsFrom`
+ let mut proof ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances) step
+ (userName := tag ++ `calc)
+ let mvarBranch := proof.mvarId!
+
+ let calcPrevRhs? := Option.some rhs
+ let mut proofType ← Meta.inferType proof
+ let mut remainder := Option.none
+
+ -- The calc tactic either solves the main goal or leaves another relation.
+ -- Replace the main goal, and save the new goal if necessary
+ if ¬(← Meta.isDefEq proofType target) then
+ let rec throwFailed :=
+ throwError "'calc' tactic failed, has type{indentExpr proofType}\nbut it is expected to have type{indentExpr target}"
+ let some (_, _, rhs) ← Elab.Term.getCalcRelation? proofType | throwFailed
+ let some (r, _, rhs') ← Elab.Term.getCalcRelation? target | throwFailed
+ let lastStep := mkApp2 r rhs rhs'
+ let lastStepGoal ← Meta.mkFreshExprSyntheticOpaqueMVar lastStep tag
+ (proof, proofType) ← Elab.Term.mkCalcTrans proof proofType lastStepGoal lastStep
+ unless (← Meta.isDefEq proofType target) do throwFailed
+ remainder := .some lastStepGoal.mvarId!
+ goal.assign proof
+
+ let goals := [ mvarBranch ] ++ remainder.toList
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals },
+ },
+ newMVars := goals.toSSet,
+ parentMVar? := .some goal,
+ calcPrevRhs?
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
@@ -377,7 +446,7 @@ protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
assert! goalState.goals.isEmpty
return expr
protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
- let parent ← goalState.parentMVar
+ let parent ← goalState.parentMVar?
let expr := goalState.mctx.eAssignment.find! parent
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 57df5de..f975f76 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -249,7 +249,7 @@ protected def GoalState.serializeGoals
MetaM (Array Protocol.Goal):= do
state.restoreMetaM
let goals := state.goals.toArray
- let parentDecl? := parent.bind (λ parentState => parentState.mctx.findDecl? state.parentMVar.get!)
+ let parentDecl? := parent.bind (λ parentState => parentState.mctx.findDecl? state.parentMVar?.get!)
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 7a23290..9ede63e 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -479,36 +479,73 @@ def test_conv: TestM Unit := do
let free := [("a", "Nat"), ("b", "Nat"), ("c1", "Nat"), ("c2", "Nat"), ("h", h)] ++ free
buildGoal free target
-example : ∀ (a: Nat), 1 + a + 1 = a + 2 := by
- intro a
- calc 1 + a + 1 = a + 1 + 1 := by conv =>
- rhs
- rw [Nat.add_comm]
- _ = a + 2 := by rw [Nat.add_assoc]
+example : ∀ (a b c d: Nat), a + b = b + c → b + c = c + d → a + b = c + d := by
+ intro a b c d h1 h2
+ calc a + b = b + c := by apply h1
+ _ = c + d := by apply h2
def test_calc: TestM Unit := do
- let state? ← startProof (.expr "∀ (a: Nat), 1 + a + 1 = a + 2")
+ let state? ← startProof (.expr "∀ (a b c d: Nat), a + b = b + c → b + c = c + d → a + b = c + d")
let state0 ← match state? with
| .some state => pure state
| .none => do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let tactic := "intro a"
+ let tactic := "intro a b c d h1 h2"
let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("a", "Nat")] "1 + a + 1 = a + 2"])
- let tactic := "calc"
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
+ #[interiorGoal [] "a + b = c + d"])
+ let pred := "a + b = b + c"
+ let state2 ← match ← state1.tryCalc (goalId := 0) (pred := pred) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("a", "Nat")] "1 + a + 1 = a + 2"])
+ addTest $ LSpec.check s!"calc {pred} := _" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ interiorGoal [] "a + b = b + c" (.some "calc"),
+ interiorGoal [] "b + c = c + d"
+ ])
+
+ let tactic := "apply h1"
+ let state2m ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state3 ← match state2m.continue state2 with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ expectationFailure "continue" e
+ return ()
+ let pred := "_ = c + d"
+ let state4 ← match ← state3.tryCalc (goalId := 0) (pred := pred) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!"calc {pred} := _" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ interiorGoal [] "b + c = c + d" (.some "calc")
+ ])
+ let tactic := "apply h2"
+ let state4m ← match ← state4.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "(4m root)" state4m.rootExpr?.isSome
+
+
+ where
+ interiorGoal (free: List (String × String)) (target: String) (userName?: Option String := .none) :=
+ let free := [("a", "Nat"), ("b", "Nat"), ("c", "Nat"), ("d", "Nat"),
+ ("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
+ buildGoal free target userName?
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From 6b44d9ef1468e7782208f7e3a1d1eea35f86fcec Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 15:03:14 -0700
Subject: [PATCH 155/465] fix: Remove `calcPrevRhs?` in non-calc tactics
---
Pantograph/Goal.lean | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index a6d99bc..fbb850a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -34,6 +34,7 @@ structure GoalState where
-- Existence of this field shows that we are currently in `conv` mode.
convMVar?: Option (MVarId × MVarId) := .none
-- Previous RHS for calc, so we don't have to repeat it every time
+ -- WARNING: If using `state with` outside of `calc`, this must be set to `.none`
calcPrevRhs?: Option Expr := .none
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
@@ -139,6 +140,7 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
savedState := nextSavedState
newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar? := .some goal,
+ calcPrevRhs? := .none,
}
/-- Assumes elabM has already been restored. Assumes expr has already typechecked -/
@@ -404,6 +406,7 @@ protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState
state.savedState with
tactic := { goals := [goal] },
},
+ calcPrevRhs? := .none,
}
/--
@@ -423,6 +426,7 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
term := state.savedState.term,
tactic := { goals := unassigned },
},
+ calcPrevRhs? := .none,
}
/--
Brings into scope all goals from `branch`
From 6d85c19589cbd060c528fff2b51158e92292cb55 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 15:04:36 -0700
Subject: [PATCH 156/465] feat: Add library bindings for calc
---
Pantograph/Library.lean | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 0febba4..ff365b2 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -178,6 +178,10 @@ def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
runTermElabM <| state.convExit
+@[export pantograph_goal_calc_m]
+def goalCalc (state: GoalState) (goalId: Nat) (pred: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryCalc goalId pred
+
@[export pantograph_goal_focus]
def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
state.focus goalId
From 7eb5419f3690b250937280fc3048aa76522235d5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 15:11:10 -0700
Subject: [PATCH 157/465] feat: REPL interface for `calc`
---
Pantograph.lean | 17 ++++++++++++-----
Pantograph/Protocol.lean | 5 ++++-
2 files changed, 16 insertions(+), 6 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 626afae..a0580d2 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -114,15 +114,22 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match state.goalStates.find? args.stateId with
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => do
- let nextGoalState?: Except _ GoalState ← match args.tactic?, args.expr?, args.have? with
- | .some tactic, .none, .none => do
+ let nextGoalState?: Except _ GoalState ←
+ match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
+ | .some tactic, .none, .none, .none, .none => do
pure ( Except.ok (← goalTactic goalState args.goalId tactic))
- | .none, .some expr, .none => do
+ | .none, .some expr, .none, .none, .none => do
pure ( Except.ok (← goalAssign goalState args.goalId expr))
- | .none, .none, .some type => do
+ | .none, .none, .some type, .none, .none => do
let binderName := args.binderName?.getD ""
pure ( Except.ok (← goalHave goalState args.goalId binderName type))
- | _, _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr, have} must be supplied")
+ | .none, .none, .none, .some pred, .none => do
+ pure ( Except.ok (← goalCalc goalState args.goalId pred))
+ | .none, .none, .none, .none, .some true => do
+ pure ( Except.ok (← goalConv goalState args.goalId))
+ | .none, .none, .none, .none, .some false => do
+ pure ( Except.ok (← goalConvExit goalState))
+ | _, _, _, _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr, have} must be supplied")
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 3055136..86ab14b 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -202,8 +202,11 @@ structure GoalTactic where
tactic?: Option String := .none
expr?: Option String := .none
have?: Option String := .none
+ calc?: Option String := .none
+ -- true to enter `conv`, `false` to exit. In case of exit the `goalId` is ignored.
+ conv?: Option Bool := .none
- -- In case of the `have` tactic, the new free variable name
+ -- In case of the `have` tactic, the new free variable name is provided here
binderName?: Option String := .none
deriving Lean.FromJson
From ed220bc7fb0ff19eadcdf2da55287d8ff229efae Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 15:13:12 -0700
Subject: [PATCH 158/465] doc: New tactics in README.md
---
README.md | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/README.md b/README.md
index f60ee22..4a8f448 100644
--- a/README.md
+++ b/README.md
@@ -81,7 +81,12 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
- `options.print`: Display the current set of options
- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
-- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr": <expr>]}`: Execute a tactic string on a given goal
+- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr":
+ <expr>]}`: Execute a tactic string on a given goal. `tactic` executes an
+ ordinary tactic, `expr` assigns an expression to the current goal, `have`
+ executes the have tactic, ``calc` (of the form `lhs op rhs`) executes one step
+ of `calc`, and `"conv": true`/`"conv": false` enters/exits conversion tactic
+ mode.
- `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`: Continue from a proof state
- `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
- `goal.print {"stateId": <id>}"`: Print a goal state
From a11df9f2e95d41b58ab29809e2623b5a22add890 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 9 Apr 2024 21:24:08 -0700
Subject: [PATCH 159/465] feat: Print recursor rules
---
Pantograph/Environment.lean | 16 +++++++++++-----
Pantograph/Protocol.lean | 8 ++++++++
Test/Environment.lean | 3 +++
3 files changed, 22 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 5e19bdf..0385cad 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -69,8 +69,8 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
else pure (.none),
module? := module?
}
- let result := match info with
- | .inductInfo induct => { core with inductInfo? := .some {
+ let result ← match info with
+ | .inductInfo induct => pure { core with inductInfo? := .some {
numParams := induct.numParams,
numIndices := induct.numIndices,
all := induct.all.toArray.map (·.toString),
@@ -79,21 +79,27 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
isReflexive := induct.isReflexive,
isNested := induct.isNested,
} }
- | .ctorInfo ctor => { core with constructorInfo? := .some {
+ | .ctorInfo ctor => pure { core with constructorInfo? := .some {
induct := ctor.induct.toString,
cidx := ctor.cidx,
numParams := ctor.numParams,
numFields := ctor.numFields,
} }
- | .recInfo r => { core with recursorInfo? := .some {
+ | .recInfo r => pure { core with recursorInfo? := .some {
all := r.all.toArray.map (·.toString),
numParams := r.numParams,
numIndices := r.numIndices,
numMotives := r.numMotives,
numMinors := r.numMinors,
+ rules := ← r.rules.toArray.mapM (λ rule => do
+ pure {
+ ctor := rule.ctor.toString,
+ nFields := rule.nfields,
+ rhs := ← (serialize_expression options rule.rhs).run',
+ })
k := r.k,
} }
- | _ => core
+ | _ => pure core
return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 6ee3354..0f27e48 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -138,12 +138,20 @@ structure ConstructorInfo where
numParams: Nat
numFields: Nat
deriving Lean.ToJson
+
+/-- See `Lean/Declaration.lean` -/
+structure RecursorRule where
+ ctor: String
+ nFields: Nat
+ rhs: Expression
+ deriving Lean.ToJson
structure RecursorInfo where
all: Array String
numParams: Nat
numIndices: Nat
numMotives: Nat
numMinors: Nat
+ rules: Array RecursorRule
k: Bool
deriving Lean.ToJson
structure EnvInspectResult where
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 927793d..631ea54 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -11,6 +11,7 @@ open Pantograph
deriving instance DecidableEq, Repr for Protocol.InductInfo
deriving instance DecidableEq, Repr for Protocol.ConstructorInfo
+deriving instance DecidableEq, Repr for Protocol.RecursorRule
deriving instance DecidableEq, Repr for Protocol.RecursorInfo
deriving instance DecidableEq, Repr for Protocol.EnvInspectResult
@@ -69,6 +70,7 @@ def test_inspect: IO LSpec.TestSeq := do
numIndices := 1,
numMotives := 1,
numMinors := 1,
+ rules := #[{ ctor := "Eq.refl", nFields := 0, rhs := { pp? := .some "fun {α} a motive refl => refl" } }]
k := true,
}),
("ForM.rec", ConstantCat.recursor {
@@ -77,6 +79,7 @@ def test_inspect: IO LSpec.TestSeq := do
numIndices := 0,
numMotives := 1,
numMinors := 1,
+ rules := #[{ ctor := "ForM.mk", nFields := 1, rhs := { pp? := .some "fun m γ α motive mk forM => mk forM" } }]
k := false,
})
]
From 036fab0ad6a5e137059c634e9931ea7e1724c060 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 16:11:06 -0700
Subject: [PATCH 160/465] fix: Prevent incorrect inheritance of calc rhs
---
Pantograph/Goal.lean | 10 ++++++++--
Test/Proofs.lean | 3 +++
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index fbb850a..75dc3f3 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -325,6 +325,11 @@ protected def GoalState.convExit (state: GoalState):
catch exception =>
return .failure #[← exception.toMessageData.toString]
+protected def GoalState.calcPrevRhsOf? (state: GoalState) (goalId: Nat) :=
+ if goalId == 1 then
+ state.calcPrevRhs?
+ else
+ .none
protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
@@ -340,20 +345,21 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
+ let calcPrevRhs? := state.calcPrevRhsOf? goalId
try
goal.withContext do
let target ← instantiateMVars (← goal.getDecl).type
let tag := (← goal.getDecl).userName
let mut step ← Elab.Term.elabType <| ← do
- if let some prevRhs := state.calcPrevRhs? then
+ if let some prevRhs := calcPrevRhs? then
Elab.Term.annotateFirstHoleWithType pred (← Meta.inferType prevRhs)
else
pure pred
let some (_, lhs, rhs) ← Elab.Term.getCalcRelation? step |
throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
- if let some prevRhs := state.calcPrevRhs? then
+ if let some prevRhs := calcPrevRhs? then
unless (← Meta.isDefEqGuarded lhs prevRhs) do
throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9ede63e..1b1b9de 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -510,6 +510,8 @@ def test_calc: TestM Unit := do
interiorGoal [] "a + b = b + c" (.some "calc"),
interiorGoal [] "b + c = c + d"
])
+ addTest $ LSpec.test "(2.0 prev rhs)" (state2.calcPrevRhsOf? 0 |>.isNone)
+ addTest $ LSpec.test "(2.1 prev rhs)" (state2.calcPrevRhsOf? 1 |>.isSome)
let tactic := "apply h1"
let state2m ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
@@ -532,6 +534,7 @@ def test_calc: TestM Unit := do
#[
interiorGoal [] "b + c = c + d" (.some "calc")
])
+ addTest $ LSpec.test "(4.0 prev rhs)" (state4.calcPrevRhsOf? 0 |>.isNone)
let tactic := "apply h2"
let state4m ← match ← state4.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
From dc6e79def7a00e1d4a2e936a09e578c851b45bc4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 16:18:04 -0700
Subject: [PATCH 161/465] doc: Update error message in interaction
---
Pantograph.lean | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index a0580d2..f59bc11 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -129,7 +129,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure ( Except.ok (← goalConv goalState args.goalId))
| .none, .none, .none, .none, .some false => do
pure ( Except.ok (← goalConvExit goalState))
- | _, _, _, _, _ => pure (Except.error <| errorI "arguments" "Exactly one of {tactic, expr, have} must be supplied")
+ | _, _, _, _, _ => pure (Except.error <|
+ errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied")
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) =>
From e834765896497e64ef0e30be576843792029f4ac Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 16:25:17 -0700
Subject: [PATCH 162/465] refactor: Code simplification
---
Pantograph/Goal.lean | 37 ++++++++++++++++++-------------------
1 file changed, 18 insertions(+), 19 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 75dc3f3..a27f765 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -164,22 +164,21 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
let errors ← (messages.map Message.data).mapM fun md => md.toString
return .failure errors
- else
- let prevMCtx := state.savedState.term.meta.meta.mctx
- let nextMCtx ← getMCtx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- let newMVars := newMVarSet prevMCtx nextMCtx
- let nextGoals ← newMVars.toList.filterM (λ mvar => do pure !(← mvar.isAssigned))
- return .success {
- root := state.root,
- savedState := {
- term := ← MonadBacktrack.saveState,
- tactic := { goals := nextGoals }
- },
- newMVars,
- parentMVar? := .some goal,
- }
+ let prevMCtx := state.savedState.term.meta.meta.mctx
+ let nextMCtx ← getMCtx
+ -- Generate a list of mvarIds that exist in the parent state; Also test the
+ -- assertion that the types have not changed on any mvars.
+ let newMVars := newMVarSet prevMCtx nextMCtx
+ let nextGoals ← newMVars.toList.filterM (λ mvar => do pure !(← mvar.isAssigned))
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals := nextGoals }
+ },
+ newMVars,
+ parentMVar? := .some goal,
+ }
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -346,10 +345,10 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
| .ok syn => pure syn
| .error error => return .parseError error
let calcPrevRhs? := state.calcPrevRhsOf? goalId
+ let target ← instantiateMVars (← goal.getDecl).type
+ let tag := (← goal.getDecl).userName
try
goal.withContext do
- let target ← instantiateMVars (← goal.getDecl).type
- let tag := (← goal.getDecl).userName
let mut step ← Elab.Term.elabType <| ← do
if let some prevRhs := calcPrevRhs? then
@@ -377,7 +376,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
-- The calc tactic either solves the main goal or leaves another relation.
-- Replace the main goal, and save the new goal if necessary
- if ¬(← Meta.isDefEq proofType target) then
+ unless ← Meta.isDefEq proofType target do
let rec throwFailed :=
throwError "'calc' tactic failed, has type{indentExpr proofType}\nbut it is expected to have type{indentExpr target}"
let some (_, _, rhs) ← Elab.Term.getCalcRelation? proofType | throwFailed
From a864c4d3ff72360b397ecc450805163627b91755 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 16:29:47 -0700
Subject: [PATCH 163/465] refactor: Code simplification
---
Pantograph/Goal.lean | 18 ++++++++----------
1 file changed, 8 insertions(+), 10 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index a27f765..f1c2503 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -48,8 +48,8 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
let root := goal.mvarId!
let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
return {
- savedState,
root,
+ savedState,
newMVars := SSet.insert .empty root,
parentMVar? := .none,
}
@@ -126,7 +126,7 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
(fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
- match (← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic)) with
+ match ← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic) with
| .error errors =>
return .failure errors
| .ok nextSavedState =>
@@ -149,13 +149,12 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
let goalType ← goal.getType
try
-- For some reason this is needed. One of the unit tests will fail if this isn't here
- let error?: Option String ← goal.withContext (do
+ let error?: Option String ← goal.withContext do
let exprType ← Meta.inferType expr
if ← Meta.isDefEq goalType exprType then
pure .none
else do
return .some s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} != {← Meta.ppExpr goalType}"
- )
if let .some error := error? then
return .parseError error
goal.checkNotAssigned `GoalState.assign
@@ -221,7 +220,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
let binderName := binderName.toName
try
-- Implemented similarly to the intro tactic
- let nextGoals: List MVarId ← goal.withContext $ (do
+ let nextGoals: List MVarId ← goal.withContext do
let type ← Elab.Term.elabType (stx := type)
let lctx ← MonadLCtx.getLCtx
@@ -234,15 +233,14 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
let fvar := mkFVar fvarId
let mvarUpstream ←
withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
- Meta.withNewLocalInstances #[fvar] 0 (do
+ Meta.withNewLocalInstances #[fvar] 0 do
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
(← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
goal.assign expr
- pure mvarUpstream)
+ pure mvarUpstream
pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
- )
return .success {
root := state.root,
savedState := {
@@ -359,7 +357,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
let some (_, lhs, rhs) ← Elab.Term.getCalcRelation? step |
throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
if let some prevRhs := calcPrevRhs? then
- unless (← Meta.isDefEqGuarded lhs prevRhs) do
+ unless ← Meta.isDefEqGuarded lhs prevRhs do
throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
-- Creates a mvar to represent the proof that the calc tactic solves the
@@ -384,7 +382,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
let lastStep := mkApp2 r rhs rhs'
let lastStepGoal ← Meta.mkFreshExprSyntheticOpaqueMVar lastStep tag
(proof, proofType) ← Elab.Term.mkCalcTrans proof proofType lastStepGoal lastStep
- unless (← Meta.isDefEq proofType target) do throwFailed
+ unless ← Meta.isDefEq proofType target do throwFailed
remainder := .some lastStepGoal.mvarId!
goal.assign proof
From 4d4f660f3f0e5e717104a937661bd0d80f1614c1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 11 Apr 2024 17:57:24 -0700
Subject: [PATCH 164/465] chore: Update version
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 688fc60..4ab34c4 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.14"
+def version := "0.2.15"
end Pantograph
From 991ee5ad94122a06dcaa47c79eef28d4ce318d28 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 12:37:37 -0700
Subject: [PATCH 165/465] refactor: Rename functions to camel case
---
Pantograph/Environment.lean | 10 ++++-----
Pantograph/Library.lean | 8 +++----
Pantograph/Serial.lean | 44 ++++++++++++++++++-------------------
Test/Metavar.lean | 6 ++---
Test/Proofs.lean | 6 ++---
Test/Serial.lean | 16 +++++++-------
6 files changed, 45 insertions(+), 45 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 0385cad..b696c25 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -54,18 +54,18 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
| .none, _ => .none
-- Information common to all symbols
let core := {
- type := ← (serialize_expression options info.type).run',
+ type := ← (serializeExpression options info.type).run',
isUnsafe := info.isUnsafe,
- value? := ← value?.mapM (λ v => serialize_expression options v |>.run'),
+ value? := ← value?.mapM (λ v => serializeExpression 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)
+ then .some <| info.type.getUsedConstants.map (λ n => serializeName n)
else .none,
valueDependency? := ← if args.dependency?.getD false
then info.value?.mapM (λ e => do
let e ← unfoldAuxLemmas e
- pure $ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => name_to_ast n) )
+ pure $ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
else pure (.none),
module? := module?
}
@@ -95,7 +95,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
pure {
ctor := rule.ctor.toString,
nFields := rule.nfields,
- rhs := ← (serialize_expression options rule.rhs).run',
+ rhs := ← (serializeExpression options rule.rhs).run',
})
k := r.k,
} }
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index ff365b2..9be86e7 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -144,8 +144,8 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&
try
let type ← unfoldAuxLemmas (← Lean.Meta.inferType expr)
return .ok {
- type := (← serialize_expression options type),
- expr := (← serialize_expression options expr)
+ type := (← serializeExpression options type),
+ expr := (← serializeExpression options expr)
}
catch exception =>
return .error $ errorI "typing" (← exception.toMessageData.toString)
@@ -204,9 +204,9 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr => do
- serialize_expression options (← unfoldAuxLemmas expr)),
+ serializeExpression options (← unfoldAuxLemmas expr)),
parent? := ← state.parentExpr?.mapM (λ expr => do
- serialize_expression options (← unfoldAuxLemmas expr)),
+ serializeExpression options (← unfoldAuxLemmas expr)),
}
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 6c3102f..953a60e 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -49,7 +49,7 @@ def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
return { binders, target := toString (← Meta.ppExpr body) }
-def name_to_ast (name: Name) (sanitize: Bool := true): String :=
+def serializeName (name: Name) (sanitize: Bool := true): String :=
let internal := name.isInaccessibleUserName || name.hasMacroScopes
if sanitize && internal then "_"
else toString name |> enclose_if_escaped
@@ -59,25 +59,25 @@ def name_to_ast (name: Name) (sanitize: Bool := true): String :=
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
-partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
+partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
let k := level.getOffset
let u := level.getLevelOffset
let u_str := match u with
| .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ"
| .max v w =>
- let v := serialize_sort_level_ast v sanitize
- let w := serialize_sort_level_ast w sanitize
+ let v := serializeSortLevel v sanitize
+ let w := serializeSortLevel w sanitize
s!"(:max {v} {w})"
| .imax v w =>
- let v := serialize_sort_level_ast v sanitize
- let w := serialize_sort_level_ast w sanitize
+ let v := serializeSortLevel v sanitize
+ let w := serializeSortLevel w sanitize
s!"(:imax {v} {w})"
| .param name =>
- let name := name_to_ast name sanitize
+ let name := serializeName name sanitize
s!"{name}"
| .mvar id =>
- let name := name_to_ast id.name sanitize
+ let name := serializeName id.name sanitize
s!"(:mv {name})"
match k, u with
| 0, _ => u_str
@@ -89,7 +89,7 @@ partial def serialize_sort_level_ast (level: Level) (sanitize: Bool): String :=
A `_` symbol in the AST indicates automatic deductions not present in the original expression.
-/
-partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): MetaM String := do
+partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr
where
self (e: Expr): MetaM String :=
@@ -106,7 +106,7 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
let name := of_name mvarId.name
pure s!"(:mv {name})"
| .sort level =>
- let level := serialize_sort_level_ast level sanitize
+ let level := serializeSortLevel level sanitize
pure s!"(:sort {level})"
| .const declName _ =>
-- The universe level of the const expression is elided since it should be
@@ -131,7 +131,7 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ => do
-- Dependent boolean flag diacarded
- let name' := name_to_ast name
+ let name' := serializeName name
let type' ← self type
let value' ← self value
let body' ← self body
@@ -162,14 +162,14 @@ partial def serialize_expression_ast (expr: Expr) (sanitize: Bool := true): Meta
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
- of_name (name: Name) := name_to_ast name sanitize
+ of_name (name: Name) := serializeName name sanitize
-def serialize_expression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
+def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with
| true => pure $ .some $ toString $ ← Meta.ppExpr e
| false => pure $ .none
let sexp?: Option String ← match options.printExprAST with
- | true => pure $ .some $ ← serialize_expression_ast e
+ | true => pure $ .some $ ← serializeExpressionSexp e
| false => pure $ .none
return {
pp?,
@@ -177,7 +177,7 @@ def serialize_expression (options: @&Protocol.Options) (e: Expr): MetaM Protocol
}
/-- Adapted from ppGoal -/
-def serialize_goal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
@@ -208,21 +208,21 @@ def serialize_goal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metav
name := of_name fvarId.name,
userName:= of_name userName,
isInaccessible? := .some userName.isInaccessibleUserName
- type? := .some (← serialize_expression options type)
+ type? := .some (← serializeExpression options type)
}
| .ldecl _ fvarId userName type val _ _ => do
let userName := userName.simpMacroScopes
let type ← instantiateMVars type
let value? ← if showLetValues then
let val ← instantiateMVars val
- pure $ .some (← serialize_expression options val)
+ pure $ .some (← serializeExpression options val)
else
pure $ .none
return {
name := of_name fvarId.name,
userName:= of_name userName,
isInaccessible? := .some userName.isInaccessibleUserName
- type? := .some (← serialize_expression options type)
+ type? := .some (← serializeExpression options type)
value? := value?
}
let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
@@ -241,11 +241,11 @@ def serialize_goal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metav
name := of_name goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
- target := (← serialize_expression options (← instantiateMVars mvarDecl.type)),
+ target := (← serializeExpression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
}
where
- of_name (n: Name) := name_to_ast n (sanitize := false)
+ of_name (n: Name) := serializeName n (sanitize := false)
protected def GoalState.serializeGoals
(state: GoalState)
@@ -258,7 +258,7 @@ protected def GoalState.serializeGoals
goals.mapM fun goal => do
match state.mctx.findDecl? goal with
| .some mvarDecl =>
- let serializedGoal ← serialize_goal options goal mvarDecl (parentDecl? := parentDecl?)
+ let serializedGoal ← serializeGoal options goal mvarDecl (parentDecl? := parentDecl?)
pure serializedGoal
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
@@ -298,7 +298,7 @@ protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag
let type ← if options.instantiate
then instantiateMVars decl.type
else pure $ decl.type
- let type_sexp ← serialize_expression_ast type (sanitize := false)
+ let type_sexp ← serializeExpressionSexp type (sanitize := false)
IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index eff2103..bf26941 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -28,7 +28,7 @@ def test_instantiate_mvar: TestM Unit := do
addTest $ assertUnreachable e
return ()
let t ← Lean.Meta.inferType expr
- addTest $ LSpec.check "typing" ((toString (← serialize_expression_ast t)) =
+ addTest $ LSpec.check "typing" ((toString (← serializeExpressionSexp t)) =
"((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))")
return ()
@@ -245,8 +245,8 @@ def test_partial_continuation: TestM Unit := do
-- Roundtrip
--let coupled_goals := coupled_goals.map (λ g =>
- -- { name := str_to_name $ name_to_ast g.name (sanitize := false)})
- let coupled_goals := coupled_goals.map (λ g => name_to_ast g.name (sanitize := false))
+ -- { name := str_to_name $ serializeName g.name (sanitize := false)})
+ let coupled_goals := coupled_goals.map (λ g => serializeName g.name (sanitize := false))
let coupled_goals := coupled_goals.map (λ g => { name := g.toName })
let state1b ← match state2.resume (goals := coupled_goals) with
| .error msg => do
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9ede63e..d016558 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -229,7 +229,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
- let state2parent ← serialize_expression_ast state2.parentExpr?.get! (sanitize := false)
+ let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
-- This is due to delayed assignment
addTest $ LSpec.test "(2 parent)" (state2parent ==
"((:mv _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
@@ -239,7 +239,7 @@ def test_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let state3_1parent ← serialize_expression_ast state3_1.parentExpr?.get! (sanitize := false)
+ let state3_1parent ← serializeExpressionSexp state3_1.parentExpr?.get! (sanitize := false)
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.78))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
@@ -248,7 +248,7 @@ def test_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
- let state4_1parent ← serialize_expression_ast state4_1.parentExpr?.get! (sanitize := false)
+ let state4_1parent ← serializeExpressionSexp state4_1.parentExpr?.get! (sanitize := false)
addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.47)")
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.tryTactic (goalId := 1) (tactic := "apply Or.inl") with
diff --git a/Test/Serial.lean b/Test/Serial.lean
index e9f4d85..0e87110 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -10,13 +10,13 @@ open Pantograph
deriving instance Repr, DecidableEq for Protocol.BoundExpression
-def test_name_to_ast: LSpec.TestSeq :=
+def test_serializeName: LSpec.TestSeq :=
let quote := "\""
let escape := "\\"
- LSpec.test "a.b.1" (name_to_ast (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
- LSpec.test "seg.«a.b»" (name_to_ast (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}") ++
+ LSpec.test "a.b.1" (serializeName (Name.num (.str (.str .anonymous "a") "b") 1) = "a.b.1") ++
+ LSpec.test "seg.«a.b»" (serializeName (Name.str (.str .anonymous "seg") "a.b") = s!"{quote}seg.«a.b»{quote}") ++
-- Pathological test case
- LSpec.test s!"«̈{escape}{quote}»" (name_to_ast (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«{escape}{quote}»{quote}")
+ LSpec.test s!"«̈{escape}{quote}»" (serializeName (Name.str .anonymous s!"{escape}{quote}") = s!"{quote}«{escape}{quote}»{quote}")
def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
let entries: List (Name × Protocol.BoundExpression) := [
@@ -43,7 +43,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
runMetaMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol.toName |>.get! |>.type
- let test := LSpec.check symbol ((← serialize_expression_ast expr) = target)
+ let test := LSpec.check symbol ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
@@ -61,7 +61,7 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
let expr ← match (← elabTerm s) with
| .ok expr => pure expr
| .error e => return elabFailure e
- let test := LSpec.check source ((← serialize_expression_ast expr) = target)
+ let test := LSpec.check source ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
@@ -80,7 +80,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
let env ← MonadEnv.getEnv
let testCaseName := target.take 10
- let test := LSpec.check testCaseName ((← serialize_expression_ast expr) = target)
+ let test := LSpec.check testCaseName ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
@@ -95,7 +95,7 @@ def test_instance (env: Environment): IO LSpec.TestSeq :=
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("name_to_ast", do pure test_name_to_ast),
+ ("serializeName", do pure test_serializeName),
("Expression binder", test_expr_to_binder env),
("Sexp from symbol", test_sexp_of_symbol env),
("Sexp from elaborated expr", test_sexp_of_elab env),
From 8e377c20929669058fa50f9fa567354e0a417806 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 16:34:21 -0700
Subject: [PATCH 166/465] refactor: CamelCase rename
---
Pantograph/Serial.lean | 44 +++++++++++++++++++++---------------------
Test/Serial.lean | 2 +-
2 files changed, 23 insertions(+), 23 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 953a60e..b00488e 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -43,7 +43,7 @@ def elabTerm (syn: Syntax) (expectedType? : Option Expr := .none): Elab.TermElab
--- Output Functions ---
-def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
+def typeExprToBound (expr: Expr): MetaM Protocol.BoundExpression := do
Meta.forallTelescope expr fun arr body => do
let binders ← arr.mapM fun fvar => do
return (toString (← fvar.fvarId!.getUserName), toString (← Meta.ppExpr (← fvar.fvarId!.getType)))
@@ -52,9 +52,9 @@ def type_expr_to_bound (expr: Expr): MetaM Protocol.BoundExpression := do
def serializeName (name: Name) (sanitize: Bool := true): String :=
let internal := name.isInaccessibleUserName || name.hasMacroScopes
if sanitize && internal then "_"
- else toString name |> enclose_if_escaped
+ else toString name |> addQuotes
where
- enclose_if_escaped (n: String) :=
+ addQuotes (n: String) :=
let quote := "\""
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
@@ -100,10 +100,10 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
-- Lean these are handled using a `#` prefix.
pure s!"{deBruijnIndex}"
| .fvar fvarId =>
- let name := of_name fvarId.name
+ let name := ofName fvarId.name
pure s!"(:fv {name})"
| .mvar mvarId =>
- let name := of_name mvarId.name
+ let name := ofName mvarId.name
pure s!"(:mv {name})"
| .sort level =>
let level := serializeSortLevel level sanitize
@@ -118,16 +118,16 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
let args := " ".intercalate args
pure s!"({fn'} {args})"
| .lam binderName binderType body binderInfo => do
- let binderName' := of_name binderName
+ let binderName' := ofName binderName
let binderType' ← self binderType
let body' ← self body
- let binderInfo' := binder_info_to_ast binderInfo
+ let binderInfo' := binderInfoSexp binderInfo
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo => do
- let binderName' := of_name binderName
+ let binderName' := ofName binderName
let binderType' ← self binderType
let body' ← self body
- let binderInfo' := binder_info_to_ast binderInfo
+ let binderInfo' := binderInfoSexp binderInfo
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ => do
-- Dependent boolean flag diacarded
@@ -157,12 +157,12 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
let inner ← self inner
pure s!"((:c {projectorName}) {autos} {inner})"
-- Elides all unhygenic names
- binder_info_to_ast : Lean.BinderInfo → String
+ binderInfoSexp : Lean.BinderInfo → String
| .default => ""
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
- of_name (name: Name) := serializeName name sanitize
+ ofName (name: Name) := serializeName name sanitize
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with
@@ -191,12 +191,12 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
| .cdecl _ fvarId userName _ _ _ =>
let userName := userName.simpMacroScopes
return {
- name := of_name fvarId.name,
- userName:= of_name userName.simpMacroScopes,
+ name := ofName fvarId.name,
+ userName:= ofName userName.simpMacroScopes,
}
| .ldecl _ fvarId userName _ _ _ _ => do
return {
- name := of_name fvarId.name,
+ name := ofName fvarId.name,
userName := toString userName.simpMacroScopes,
}
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
@@ -205,8 +205,8 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
let userName := userName.simpMacroScopes
let type ← instantiateMVars type
return {
- name := of_name fvarId.name,
- userName:= of_name userName,
+ name := ofName fvarId.name,
+ userName:= ofName userName,
isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
}
@@ -219,8 +219,8 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
else
pure $ .none
return {
- name := of_name fvarId.name,
- userName:= of_name userName,
+ name := ofName fvarId.name,
+ userName:= ofName userName,
isInaccessible? := .some userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
value? := value?
@@ -238,14 +238,14 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
| false => ppVar localDecl
return var::acc
return {
- name := of_name goal.name,
- userName? := if mvarDecl.userName == .anonymous then .none else .some (of_name mvarDecl.userName),
+ name := ofName goal.name,
+ userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serializeExpression options (← instantiateMVars mvarDecl.type)),
vars := vars.reverse.toArray
}
where
- of_name (n: Name) := serializeName n (sanitize := false)
+ ofName (n: Name) := serializeName n (sanitize := false)
protected def GoalState.serializeGoals
(state: GoalState)
@@ -263,7 +263,7 @@ protected def GoalState.serializeGoals
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
/-- Print the metavariables in a readable format -/
-protected def GoalState.print (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
+protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
goalState.restoreMetaM
let savedState := goalState.savedState
let goals := savedState.tactic.goals
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 0e87110..f55c18f 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -26,7 +26,7 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
runCoreMSeq env $ entries.foldlM (λ suites (symbol, target) => do
let env ← MonadEnv.getEnv
let expr := env.find? symbol |>.get! |>.type
- let test := LSpec.check symbol.toString ((← type_expr_to_bound expr) = target)
+ let test := LSpec.check symbol.toString ((← typeExprToBound expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done |>.run'
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
From e5d55e31ff0bd51d78303c786aef0e159c45fea3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 20:51:54 -0700
Subject: [PATCH 167/465] feat: Print expression dependent mvars
---
Pantograph/Protocol.lean | 3 +++
Pantograph/Serial.lean | 6 +++++-
Test/Metavar.lean | 6 +++++-
3 files changed, 13 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index ff89222..17618fc 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -18,6 +18,7 @@ structure Options where
printExprPretty: Bool := true
-- When enabled, print the raw AST of expressions
printExprAST: Bool := false
+ printDependentMVars: Bool := false
-- When enabled, the types and values of persistent variables in a goal
-- are not shown unless they are new to the proof step. Reduces overhead.
-- NOTE: that this assumes the type and assignment of variables can never change.
@@ -41,6 +42,7 @@ structure Expression where
pp?: Option String := .none
-- AST structure
sexp?: Option String := .none
+ dependentMVars?: Option (Array String) := .none
deriving Lean.ToJson
structure Variable where
@@ -182,6 +184,7 @@ structure OptionsSet where
printJsonPretty?: Option Bool
printExprPretty?: Option Bool
printExprAST?: Option Bool
+ printDependentMVars?: Option Bool
noRepeat?: Option Bool
printAuxDecls?: Option Bool
printImplementationDetailHyps?: Option Bool
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index b00488e..950818e 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -15,7 +15,7 @@ def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxL
namespace Pantograph
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-def unfoldAuxLemmas (e : Lean.Expr) : Lean.CoreM Lean.Expr := do
+def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
--- Input Functions ---
@@ -171,9 +171,13 @@ def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.
let sexp?: Option String ← match options.printExprAST with
| true => pure $ .some $ ← serializeExpressionSexp e
| false => pure $ .none
+ let dependentMVars? ← match options.printDependentMVars with
+ | true => pure $ .some $ (← Meta.getMVars e).map (λ mvarId => mvarId.name.toString)
+ | false => pure $ .none
return {
pp?,
sexp?
+ dependentMVars?,
}
/-- Adapted from ppGoal -/
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index bf26941..33fe8cb 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -121,8 +121,12 @@ def test_m_couple_simp: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
+ let serializedState1 ← state1.serializeGoals (options := { ← read with printDependentMVars := true })
+ addTest $ LSpec.check "apply Nat.le_trans" (serializedState1.map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
+ addTest $ LSpec.check "(metavariables)" (serializedState1.map (·.target.dependentMVars?.get!) =
+ #[#["_uniq.38"], #["_uniq.38"], #[]])
+
let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "exact 2") with
| .success state => pure state
| other => do
From 4ee955c21fd7d51b0d5e2b9933a1c7854a5d1970 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 21:16:00 -0700
Subject: [PATCH 168/465] test: Tests the `let` tactic
---
Test/Proofs.lean | 72 ++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 70 insertions(+), 2 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 1b1b9de..9837e04 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -542,14 +542,81 @@ def test_calc: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.test "(4m root)" state4m.rootExpr?.isSome
-
-
where
interiorGoal (free: List (String × String)) (target: String) (userName?: Option String := .none) :=
let free := [("a", "Nat"), ("b", "Nat"), ("c", "Nat"), ("d", "Nat"),
("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
buildGoal free target userName?
+def test_let: TestM Unit := do
+ let state? ← startProof (.expr "∀ (a: Nat) (p: Prop), p → p ∨ ¬p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ let tactic := "intro a p h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[interiorGoal [] "p ∨ ¬p"])
+
+ let expr := "let b: Nat := _; _"
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check expr ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[
+ interiorGoal [] "Nat",
+ interiorGoal [] "let b := ?m.20;\np ∨ ¬p"
+ ])
+
+ let tactic := "exact a"
+ let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) = #[])
+
+ let state3r ← match state3.continue state2 with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "(continue)" ((← state3r.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[interiorGoal [] "let b := a;\np ∨ ¬p"])
+
+ let tactic := "exact h"
+ match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ | .failure #[message] =>
+ addTest $ LSpec.check tactic (message = "type mismatch\n h\nhas type\n p : Prop\nbut is expected to have type\n let b := a;\n p ∨ ¬p : Prop")
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+
+ let tactic := "intro b"
+ let state4 ← match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let tactic := "exact Or.inl h"
+ let state5 ← match ← state4.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "(5 root)" state5.rootExpr?.isSome
+ where
+ interiorGoal (free: List (String × String)) (target: String) (userName?: Option String := .none) :=
+ let free := [("a", "Nat"), ("p", "Prop"), ("h", "p")] ++ free
+ buildGoal free target userName?
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Nat.add_comm", test_nat_add_comm false),
@@ -560,6 +627,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("have", test_have),
("conv", test_conv),
("calc", test_calc),
+ ("let", test_let),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 77907fd0609eb5db081b25dabca4fbf4a5f98e00 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 21:30:56 -0700
Subject: [PATCH 169/465] feat: `goalLet` function
---
Pantograph/Goal.lean | 46 +++++++++++++++++++++++++++++++++++++++++
Pantograph/Library.lean | 3 +++
Test/Proofs.lean | 10 ++++++---
3 files changed, 56 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index f1c2503..484ff51 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -177,6 +177,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
},
newMVars,
parentMVar? := .some goal,
+ calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -249,6 +250,49 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
},
newMVars := nextGoals.toSSet,
parentMVar? := .some goal,
+ calcPrevRhs? := .none
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ let type ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := type)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ let binderName := binderName.toName
+ try
+ -- Implemented similarly to the intro tactic
+ let nextGoals: List MVarId ← goal.withContext do
+ let type ← Elab.Term.elabType (stx := type)
+ let lctx ← MonadLCtx.getLCtx
+
+ -- The branch goal inherits the same context, but with a different type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
+
+ let upstreamType := .letE binderName type mvarBranch (← goal.getType) false
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ upstreamType (kind := MetavarKind.synthetic) (userName := (← goal.getTag))
+
+ goal.assign mvarUpstream
+
+ pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals := nextGoals }
+ },
+ newMVars := nextGoals.toSSet,
+ parentMVar? := .some goal,
+ calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -280,6 +324,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar? := .some goal,
convMVar? := .some (convRhs, goal),
+ calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -318,6 +363,7 @@ protected def GoalState.convExit (state: GoalState):
newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar? := .some convGoal,
convMVar? := .none
+ calcPrevRhs? := .none
}
catch exception =>
return .failure #[← exception.toMessageData.toString]
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index ff365b2..17925cd 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -169,6 +169,9 @@ def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM Tacti
@[export pantograph_goal_have_m]
def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryHave goalId binderName type
+@[export pantograph_goal_let_m]
+def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryLet goalId binderName type
@[export pantograph_goal_conv_m]
def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9837e04..4f81085 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -548,7 +548,7 @@ def test_calc: TestM Unit := do
("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
buildGoal free target userName?
-def test_let: TestM Unit := do
+def test_let (specialized: Bool): TestM Unit := do
let state? ← startProof (.expr "∀ (a: Nat) (p: Prop), p → p ∨ ¬p")
let state0 ← match state? with
| .some state => pure state
@@ -565,7 +565,10 @@ def test_let: TestM Unit := do
#[interiorGoal [] "p ∨ ¬p"])
let expr := "let b: Nat := _; _"
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ let result2 ← match specialized with
+ | true => state1.tryLet (goalId := 0) (binderName := "b") (type := "Nat")
+ | false => state1.tryAssign (goalId := 0) (expr := expr)
+ let state2 ← match result2 with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -627,7 +630,8 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("have", test_have),
("conv", test_conv),
("calc", test_calc),
- ("let", test_let),
+ ("let via assign", test_let false),
+ ("let via tryLet", test_let true),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From b45b90b810c845629788eca844a68873305bd1fd Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 21:41:16 -0700
Subject: [PATCH 170/465] test: Metavariable name matches in let
---
Test/Proofs.lean | 13 +++++++++----
1 file changed, 9 insertions(+), 4 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 4f81085..ad22e8d 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -564,20 +564,25 @@ def test_let (specialized: Bool): TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[interiorGoal [] "p ∨ ¬p"])
- let expr := "let b: Nat := _; _"
+
+ let letType := "Nat"
+ let expr := s!"let b: {letType} := _; _"
let result2 ← match specialized with
- | true => state1.tryLet (goalId := 0) (binderName := "b") (type := "Nat")
+ | true => state1.tryLet (goalId := 0) (binderName := "b") (type := letType)
| false => state1.tryAssign (goalId := 0) (expr := expr)
let state2 ← match result2 with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check expr ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
+ let serializedState2 ← state2.serializeGoals (options := ← read)
+ addTest $ LSpec.check expr (serializedState2.map (·.devolatilize) =
#[
- interiorGoal [] "Nat",
+ interiorGoal [] letType,
interiorGoal [] "let b := ?m.20;\np ∨ ¬p"
])
+ -- Check that the goal mvar ids match up
+ addTest $ LSpec.check expr ((serializedState2.map (·.name) |>.get! 0) = "_uniq.20")
let tactic := "exact a"
let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
From adbb07af2d12d170fb097f8186be3526e8bade7b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 12 Apr 2024 22:39:47 -0700
Subject: [PATCH 171/465] fix: Option setting in REPL
---
Pantograph.lean | 1 +
Pantograph/Library.lean | 17 -----------------
2 files changed, 1 insertion(+), 17 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index f59bc11..c637303 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -81,6 +81,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
printExprPretty := args.printExprPretty?.getD options.printExprPretty,
printExprAST := args.printExprAST?.getD options.printExprAST,
+ printDependentMVars := args.printDependentMVars?.getD options.printDependentMVars,
noRepeat := args.noRepeat?.getD options.noRepeat,
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6b8e2e2..6505fec 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -82,23 +82,6 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
-@[export pantograph_mk_options]
-def mkOptions
- (printJsonPretty: Bool)
- (printExprPretty: Bool)
- (printExprAST: Bool)
- (noRepeat: Bool)
- (printAuxDecls: Bool)
- (printImplementationDetailHyps: Bool)
- : Protocol.Options := {
- printJsonPretty,
- printExprPretty,
- printExprAST,
- noRepeat,
- printAuxDecls,
- printImplementationDetailHyps,
- }
-
@[export pantograph_env_inspect_m]
def envInspect (name: String) (value: Bool) (dependency: Bool) (options: @&Protocol.Options):
Lean.CoreM (Protocol.CR Protocol.EnvInspectResult) :=
From b954f12526eb6eca25d1f77c5b2729ad23b447a3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 13 Apr 2024 19:41:49 -0700
Subject: [PATCH 172/465] refactor: Move all tactic operations to the bottom
---
Pantograph/Goal.lean | 127 ++++++++++++++++++++++---------------------
1 file changed, 64 insertions(+), 63 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 484ff51..c6700b6 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -80,6 +80,70 @@ private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext):
acc.insert mvarId
) SSet.empty
+
+protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
+ let goal ← state.savedState.tactic.goals.get? goalId
+ return {
+ state with
+ savedState := {
+ state.savedState with
+ tactic := { goals := [goal] },
+ },
+ calcPrevRhs? := .none,
+ }
+
+/--
+Brings into scope a list of goals
+-/
+protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
+ if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
+ .error s!"Goals not in scope"
+ else
+ -- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
+ let unassigned := goals.filter (λ goal =>
+ let mctx := state.mctx
+ ¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
+ .ok {
+ state with
+ savedState := {
+ term := state.savedState.term,
+ tactic := { goals := unassigned },
+ },
+ calcPrevRhs? := .none,
+ }
+/--
+Brings into scope all goals from `branch`
+-/
+protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
+ if !target.goals.isEmpty then
+ .error s!"Target state has unresolved goals"
+ else if target.root != branch.root then
+ .error s!"Roots of two continued goal states do not match: {target.root.name} != {branch.root.name}"
+ else
+ target.resume (goals := branch.goals)
+
+protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
+ let expr ← goalState.mctx.eAssignment.find? goalState.root
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ if expr.hasMVar then
+ -- Must not assert that the goal state is empty here. We could be in a branch goal.
+ --assert! ¬goalState.goals.isEmpty
+ .none
+ else
+ assert! goalState.goals.isEmpty
+ return expr
+protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
+ let parent ← goalState.parentMVar?
+ let expr := goalState.mctx.eAssignment.find! parent
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ return expr
+protected def GoalState.assignedExprOf? (goalState: GoalState) (mvar: MVarId): Option Expr := do
+ let expr ← goalState.mctx.eAssignment.find? mvar
+ let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
+ return expr
+
+--- Tactic execution functions ---
+
/-- Inner function for executing tactic on goal state -/
def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
Elab.TermElabM (Except (Array String) Elab.Tactic.SavedState):= do
@@ -446,67 +510,4 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
catch exception =>
return .failure #[← exception.toMessageData.toString]
-
-protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
- let goal ← state.savedState.tactic.goals.get? goalId
- return {
- state with
- savedState := {
- state.savedState with
- tactic := { goals := [goal] },
- },
- calcPrevRhs? := .none,
- }
-
-/--
-Brings into scope a list of goals
--/
-protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
- if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
- .error s!"Goals not in scope"
- else
- -- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
- let unassigned := goals.filter (λ goal =>
- let mctx := state.mctx
- ¬(mctx.eAssignment.contains goal || mctx.dAssignment.contains goal))
- .ok {
- state with
- savedState := {
- term := state.savedState.term,
- tactic := { goals := unassigned },
- },
- calcPrevRhs? := .none,
- }
-/--
-Brings into scope all goals from `branch`
--/
-protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
- if !target.goals.isEmpty then
- .error s!"Target state has unresolved goals"
- else if target.root != branch.root then
- .error s!"Roots of two continued goal states do not match: {target.root.name} != {branch.root.name}"
- else
- target.resume (goals := branch.goals)
-
-protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
- let expr ← goalState.mctx.eAssignment.find? goalState.root
- let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
- if expr.hasMVar then
- -- Must not assert that the goal state is empty here. We could be in a branch goal.
- --assert! ¬goalState.goals.isEmpty
- .none
- else
- assert! goalState.goals.isEmpty
- return expr
-protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
- let parent ← goalState.parentMVar?
- let expr := goalState.mctx.eAssignment.find! parent
- let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
- return expr
-protected def GoalState.assignedExprOf? (goalState: GoalState) (mvar: MVarId): Option Expr := do
- let expr ← goalState.mctx.eAssignment.find? mvar
- let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
- return expr
-
-
end Pantograph
From 75b4648ba9d53e7032c1196b55e92483ca761a24 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 14 Apr 2024 15:40:57 -0700
Subject: [PATCH 173/465] feat: mapply stub
---
Pantograph/Goal.lean | 66 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 66 insertions(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index c6700b6..176e48e 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -252,6 +252,7 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryAssign
let expr ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
@@ -275,6 +276,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryHave
let type ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
@@ -324,6 +326,7 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryLet
let type ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
@@ -369,6 +372,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure goal
| .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.conv
let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do
state.restoreTacticM goal
@@ -452,6 +456,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
+ goal.checkNotAssigned `GoalState.tryCalc
let calcPrevRhs? := state.calcPrevRhsOf? goalId
let target ← instantiateMVars (← goal.getDecl).type
let tag := (← goal.getDecl).userName
@@ -510,4 +515,65 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
catch exception =>
return .failure #[← exception.toMessageData.toString]
+def getForallArgsBody: Expr → List Expr × Expr
+ | .forallE _ d b _ =>
+ let (innerArgs, innerBody) := getForallArgsBody b
+ (d :: innerArgs, innerBody)
+ | e => ([], e)
+def collectMotiveArguments (forallBody: Expr): SSet Nat :=
+ -- Get all de Bruijn indices
+ Id.run $ do
+ Expr.foldlM (λ acc subexpr => do
+ match subexpr with
+ | .app (.bvar i) _ => return acc.insert i
+ | _ => return acc
+ ) SSet.empty forallBody
+
+protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryMotivatedApply
+
+ let recursor ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := recursor)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ try
+ -- Implemented similarly to the intro tactic
+ let nextGoals: List MVarId ← goal.withContext do
+ let recursor ← Elab.Term.elabType (stx := recursor)
+ let recursorType ← Meta.inferType recursor
+
+ let (forallArgs, forallBody) := getForallArgsBody recursorType
+ let motiveIndices := collectMotiveArguments forallBody
+
+ let numArgs ← Meta.getExpectedNumArgs recursorType
+
+ let rec go (i: Nat): MetaM (List MVarId × Expr) := do
+ let argType := forallArgs.get! i
+ sorry
+ let (newMVars, assign) ← go numArgs
+
+ goal.assign assign
+
+ pure newMVars
+ return .success {
+ root := state.root,
+ savedState := {
+ term := ← MonadBacktrack.saveState,
+ tactic := { goals := nextGoals }
+ },
+ newMVars := nextGoals.toSSet,
+ parentMVar? := .some goal,
+ calcPrevRhs? := .none
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
end Pantograph
From dbd54f767938027c43427a0eb90245ccc420e26d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Apr 2024 12:47:02 -0700
Subject: [PATCH 174/465] feat: Implement the mapply tactic
---
Pantograph/Goal.lean | 24 ++++++++----
Test/Common.lean | 11 ++++--
Test/Proofs.lean | 87 +++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 111 insertions(+), 11 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 176e48e..0fdf2e1 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -547,7 +547,7 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
try
-- Implemented similarly to the intro tactic
let nextGoals: List MVarId ← goal.withContext do
- let recursor ← Elab.Term.elabType (stx := recursor)
+ let recursor ← Elab.Term.elabTerm (stx := recursor) .none
let recursorType ← Meta.inferType recursor
let (forallArgs, forallBody) := getForallArgsBody recursorType
@@ -555,14 +555,24 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
let numArgs ← Meta.getExpectedNumArgs recursorType
- let rec go (i: Nat): MetaM (List MVarId × Expr) := do
- let argType := forallArgs.get! i
- sorry
- let (newMVars, assign) ← go numArgs
+ let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
+ if i ≥ numArgs then
+ return prev
+ else
+ let argType := forallArgs.get! i
+ -- If `argType` has motive references, its goal needs to be placed in it
+ let argType := argType.instantiateRev prev
+ -- Create the goal
+ let argGoal ← Meta.mkFreshExprMVar argType .natural .anonymous
+ let prev := prev ++ [argGoal]
+ go (i + 1) prev
+ termination_by numArgs - i
+ let newMVars ← go 0 #[]
- goal.assign assign
+ -- Create the main goal for the return type of the recursor
+ goal.assign (mkAppN recursor newMVars)
- pure newMVars
+ pure $ newMVars.toList.map (·.mvarId!)
return .success {
root := state.root,
savedState := {
diff --git a/Test/Common.lean b/Test/Common.lean
index 8719ebd..8b8e977 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -10,11 +10,9 @@ namespace Pantograph
-- Auxiliary functions
namespace Protocol
-/-- Set internal names to "" -/
-def Goal.devolatilize (goal: Goal): Goal :=
+def Goal.devolatilizeVars (goal: Goal): Goal :=
{
goal with
- name := "",
vars := goal.vars.map removeInternalAux,
}
where removeInternalAux (v: Variable): Variable :=
@@ -22,6 +20,13 @@ def Goal.devolatilize (goal: Goal): Goal :=
v with
name := ""
}
+/-- Set internal names to "" -/
+def Goal.devolatilize (goal: Goal): Goal :=
+ {
+ goal.devolatilizeVars with
+ name := "",
+ }
+
deriving instance DecidableEq, Repr for Expression
deriving instance DecidableEq, Repr for Variable
deriving instance DecidableEq, Repr for Goal
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index e14ba4a..ae94054 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -49,6 +49,16 @@ def startProof (start: Start): TestM (Option GoalState) := do
let goal ← GoalState.create (expr := expr)
return Option.some goal
+def buildNamedGoal (name: String) (nameType: List (String × String)) (target: String): Protocol.Goal :=
+ {
+ name,
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ userName := x.fst,
+ type? := .some { pp? := .some x.snd },
+ isInaccessible? := .some false
+ })).toArray
+ }
def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
{
userName?,
@@ -582,7 +592,7 @@ def test_let (specialized: Bool): TestM Unit := do
interiorGoal [] "let b := ?m.20;\np ∨ ¬p"
])
-- Check that the goal mvar ids match up
- addTest $ LSpec.check expr ((serializedState2.map (·.name) |>.get! 0) = "_uniq.20")
+ addTest $ LSpec.check "(mvarId)" ((serializedState2.map (·.name) |>.get! 0) = "_uniq.20")
let tactic := "exact a"
let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
@@ -625,6 +635,80 @@ def test_let (specialized: Bool): TestM Unit := do
let free := [("a", "Nat"), ("p", "Prop"), ("h", "p")] ++ free
buildGoal free target userName?
+def test_nat_zero_add: TestM Unit := do
+ let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ let tactic := "intro n"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("n", "Nat")] "n + 0 = n"])
+ let recursor := "@Nat.brecOn"
+ let state2 ← match ← state1.tryMotivatedApply (goalId := 0) (recursor := recursor) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
+ #[
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "Nat → Sort ?u.66",
+ buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat",
+ buildNamedGoal "_uniq.72" [("n", "Nat")] "(t : Nat) → Nat.below t → ?m.70 t"
+ ])
+
+ let tactic := "exact n"
+ let state3b ← match ← state2.tryTactic (goalId := 1) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3b.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+ let state2b ← match state3b.continue state2 with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let tactic := "exact (λ x => x + 0 = x)"
+ let state3c ← match ← state2b.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3c.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[])
+ let state2c ← match state3c.continue state2b with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let tactic := "intro t h"
+ let state3 ← match ← state2c.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
+
+ let tactic := "simp"
+ let stateF ← match ← state3.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)) =
+ #[])
+
+ addTest $ LSpec.check "(F root)" stateF.rootExpr?.isSome
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Nat.add_comm", test_nat_add_comm false),
@@ -637,6 +721,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("calc", test_calc),
("let via assign", test_let false),
("let via tryLet", test_let true),
+ ("Nat.zero_add", test_nat_zero_add),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 7aa7e6d7e948a22cec20a259c4f244f11711be65 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Apr 2024 12:56:28 -0700
Subject: [PATCH 175/465] feat: Library interface for mapply
---
Pantograph/Library.lean | 58 +++++++++++++++++++----------------------
1 file changed, 27 insertions(+), 31 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6b8e2e2..01b5a42 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -158,37 +158,6 @@ def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
-@[export pantograph_goal_tactic_m]
-def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryTactic goalId tactic
-
-@[export pantograph_goal_assign_m]
-def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryAssign goalId expr
-
-@[export pantograph_goal_have_m]
-def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryHave goalId binderName type
-@[export pantograph_goal_let_m]
-def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryLet goalId binderName type
-
-@[export pantograph_goal_conv_m]
-def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
- runTermElabM <| state.conv goalId
-
-@[export pantograph_goal_conv_exit_m]
-def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
- runTermElabM <| state.convExit
-
-@[export pantograph_goal_calc_m]
-def goalCalc (state: GoalState) (goalId: Nat) (pred: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryCalc goalId pred
-
-@[export pantograph_goal_focus]
-def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
- state.focus goalId
-
@[export pantograph_goal_resume]
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
@@ -212,5 +181,32 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
serializeExpression options (← unfoldAuxLemmas expr)),
}
+@[export pantograph_goal_tactic_m]
+def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryTactic goalId tactic
+@[export pantograph_goal_assign_m]
+def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryAssign goalId expr
+@[export pantograph_goal_have_m]
+def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryHave goalId binderName type
+@[export pantograph_goal_let_m]
+def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryLet goalId binderName type
+@[export pantograph_goal_conv_m]
+def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
+ runTermElabM <| state.conv goalId
+@[export pantograph_goal_conv_exit_m]
+def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
+ runTermElabM <| state.convExit
+@[export pantograph_goal_calc_m]
+def goalCalc (state: GoalState) (goalId: Nat) (pred: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryCalc goalId pred
+@[export pantograph_goal_focus]
+def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
+ state.focus goalId
+@[export pantograph_goal_motivated_apply_m]
+def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryMotivatedApply goalId recursor
end Pantograph
From 52e5b5df50fba53ead80135926cb838fc6771dce Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Apr 2024 19:57:05 -0700
Subject: [PATCH 176/465] doc: README.md fix
---
README.md | 58 +++++++++++++++++++++++++++++++++++--------------------
1 file changed, 37 insertions(+), 21 deletions(-)
diff --git a/README.md b/README.md
index 4a8f448..220e7a9 100644
--- a/README.md
+++ b/README.md
@@ -13,9 +13,15 @@ For Nix based workflow, see below.
Install `elan` and `lake`. Execute
``` sh
-make build/bin/pantograph
+make
```
-setup the `LEAN_PATH` environment variable so it contains the library path of lean libraries. The libraries must be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
+This builds the executable in `.lake/build/bin/pantograph`.
+
+To use Pantograph in a project environment, setup the `LEAN_PATH` environment
+variable so it contains the library path of lean libraries. The libraries must
+be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
+the environment might be setup like this:
+
``` sh
LIB="../lib"
LIB_MATHLIB="$LIB/mathlib4/lake-packages"
@@ -23,7 +29,10 @@ export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATH
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
```
-The provided `flake.nix` has a develop environment with Lean already setup.
+The `$LEAN_PATH` executable of any project can be extracted by
+``` sh
+lake env printenv LEAN_PATH
+```
## Executable Usage
@@ -71,33 +80,38 @@ where the application of `assumption` should lead to a failure.
### Commands
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": <expr>, "type": <optional expected type>}`: Determine the type of an expression and round-trip it
-- `env.catalog`: Display a list of all safe Lean symbols in the current environment
-- `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
+* `reset`: Delete all cached expressions and proof trees
+* `stat`: Display resource usage
+* `expr.echo {"expr": <expr>, "type": <optional expected type>}`: Determine the type of an expression and format it
+* `env.catalog`: Display a list of all safe Lean symbols in the current environment
+* `env.inspect {"name": <name>, "value": <bool>}`: 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
+* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
-- `options.print`: Display the current set of options
-- `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`: Start a new goal from a given expression or symbol
-- `goal.tactic {"stateId": <id>, "goalId": <id>, ["tactic": <tactic>], ["expr":
- <expr>]}`: Execute a tactic string on a given goal. `tactic` executes an
- ordinary tactic, `expr` assigns an expression to the current goal, `have`
- executes the have tactic, ``calc` (of the form `lhs op rhs`) executes one step
- of `calc`, and `"conv": true`/`"conv": false` enters/exits conversion tactic
- mode.
-- `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`: Continue from a proof state
-- `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
-- `goal.print {"stateId": <id>}"`: Print a goal state
-- `stat`: Display resource usage
+* `options.print`: Display the current set of options
+* `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`:
+ Start a new proof from a given expression or symbol
+* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
+ given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
+ - `{ "tactic": <tactic> }`: Executes an ordinary tactic
+ - `{ "expr": <expr> }`: Assigns the given proof term to the current expression
+ - `{ "have": <expr>, "binderName": <name> }`: Executes `have` and create a branch goal
+ - `{ "calc": <expr> }`: Executes one step of a `calc` tactic. Each step must
+ be of the form `lhs op rhs`. An `lhs` of `_` indicates that it should be set
+ to the previous `rhs`.
+ - `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
+ exit, the goal id is ignored.
+* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`: Continue from a proof state
+* `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
+* `goal.print {"stateId": <id>}"`: Print a goal state
### Errors
When an error pertaining to the execution of a command happens, the returning JSON structure is
``` json
-{ error: "type", desc: "description" }
+{ "error": "type", "desc": "description" }
```
Common error forms:
* `command`: Indicates malformed command structure which results from either
@@ -122,6 +136,8 @@ call Pantograph via this FFI since it provides a tremendous speed up.
## Developing
+A Lean development shell is provided in the Nix flake.
+
### Testing
The tests are based on `LSpec`. To run tests,
From 7531ad628cc7fc94a771e075cb5bc0c5c17d2730 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Apr 2024 20:00:59 -0700
Subject: [PATCH 177/465] doc: Documentation about conditional arguments
---
README.md | 18 +++++++++++-------
1 file changed, 11 insertions(+), 7 deletions(-)
diff --git a/README.md b/README.md
index 220e7a9..508d026 100644
--- a/README.md
+++ b/README.md
@@ -82,7 +82,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
* `stat`: Display resource usage
-* `expr.echo {"expr": <expr>, "type": <optional expected type>}`: Determine the type of an expression and format it
+* `expr.echo {"expr": <expr>, "type": <optional expected type>}`: Determine the
+ type of an expression and format it
* `env.catalog`: Display a list of all safe Lean symbols in the current environment
* `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
given symbol; If value flag is set, the value is printed or hidden. By default
@@ -94,16 +95,19 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
Start a new proof from a given expression or symbol
* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
- - `{ "tactic": <tactic> }`: Executes an ordinary tactic
- - `{ "expr": <expr> }`: Assigns the given proof term to the current expression
- - `{ "have": <expr>, "binderName": <name> }`: Executes `have` and create a branch goal
- - `{ "calc": <expr> }`: Executes one step of a `calc` tactic. Each step must
+ - `{ "tactic": <tactic> }`: Execute an ordinary tactic
+ - `{ "expr": <expr> }`: Assign the given proof term to the current goal
+ - `{ "have": <expr>, "binderName": <name> }`: Execute `have` and creates a branch goal
+ - `{ "calc": <expr> }`: Execute one step of a `calc` tactic. Each step must
be of the form `lhs op rhs`. An `lhs` of `_` indicates that it should be set
to the previous `rhs`.
- `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
exit, the goal id is ignored.
-* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`: Continue from a proof state
-* `goal.remove {"stateIds": [<id>]}"`: Remove a bunch of stored goals.
+* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`:
+ Execute continuation/resumption
+ - `{ "branch": <id> }`: Continue on branch state. The current state must have no goals.
+ - `{ "goals": <names> }`: Resume the given goals
+* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state
### Errors
From fec13ddb5176323a2878f00be197fa976c5c7e1e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 18 Apr 2024 14:19:25 -0700
Subject: [PATCH 178/465] chore: Code cleanup
---
Pantograph/Goal.lean | 27 +++++++++++++++++----------
Pantograph/Library.lean | 2 +-
Test/Proofs.lean | 11 +++++++----
3 files changed, 25 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0fdf2e1..5c6a583 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -232,7 +232,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
-- Generate a list of mvarIds that exist in the parent state; Also test the
-- assertion that the types have not changed on any mvars.
let newMVars := newMVarSet prevMCtx nextMCtx
- let nextGoals ← newMVars.toList.filterM (λ mvar => do pure !(← mvar.isAssigned))
+ let nextGoals ← newMVars.toList.filterM (not <$> ·.isAssigned)
return .success {
root := state.root,
savedState := {
@@ -521,13 +521,9 @@ def getForallArgsBody: Expr → List Expr × Expr
(d :: innerArgs, innerBody)
| e => ([], e)
def collectMotiveArguments (forallBody: Expr): SSet Nat :=
- -- Get all de Bruijn indices
- Id.run $ do
- Expr.foldlM (λ acc subexpr => do
- match subexpr with
- | .app (.bvar i) _ => return acc.insert i
- | _ => return acc
- ) SSet.empty forallBody
+ match forallBody with
+ | .app (.bvar i) _ => SSet.empty.insert i
+ | _ => SSet.empty
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
Elab.TermElabM TacticResult := do
@@ -552,6 +548,7 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
let (forallArgs, forallBody) := getForallArgsBody recursorType
let motiveIndices := collectMotiveArguments forallBody
+ --IO.println s!"{motiveIndices.toList} from {← Meta.ppExpr forallBody}"
let numArgs ← Meta.getExpectedNumArgs recursorType
@@ -563,16 +560,26 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
-- If `argType` has motive references, its goal needs to be placed in it
let argType := argType.instantiateRev prev
-- Create the goal
- let argGoal ← Meta.mkFreshExprMVar argType .natural .anonymous
+ let userName := if motiveIndices.contains (numArgs - i - 1) then `motive else .anonymous
+ let argGoal ← Meta.mkFreshExprMVar argType .syntheticOpaque (userName := userName)
+ IO.println s!"Creating [{i}] {← Meta.ppExpr argGoal}"
let prev := prev ++ [argGoal]
go (i + 1) prev
termination_by numArgs - i
let newMVars ← go 0 #[]
+ -- FIXME: Add an `Eq` target and swap out the motive type
+
+ --let sourceType := forallBody.instantiateRev newMVars
+ --unless ← withTheReader Meta.Context (λ ctx => { ctx with config := { ctx.config with } }) $
+ -- Meta.isDefEq sourceType (← goal.getType) do
+ -- throwError "invalid mapply: The resultant type {← Meta.ppExpr sourceType} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
+
-- Create the main goal for the return type of the recursor
goal.assign (mkAppN recursor newMVars)
- pure $ newMVars.toList.map (·.mvarId!)
+ let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
+ pure nextGoals
return .success {
root := state.root,
savedState := {
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 01b5a42..00b4bc7 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -38,7 +38,7 @@ namespace Pantograph
def defaultTermElabMContext: Lean.Elab.Term.Context := {
autoBoundImplicit := true,
- declName? := some "_pantograph".toName,
+ declName? := .some `_pantograph,
errToSorry := false
}
def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ae94054..1adc9d4 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -49,9 +49,11 @@ def startProof (start: Start): TestM (Option GoalState) := do
let goal ← GoalState.create (expr := expr)
return Option.some goal
-def buildNamedGoal (name: String) (nameType: List (String × String)) (target: String): Protocol.Goal :=
+def buildNamedGoal (name: String) (nameType: List (String × String)) (target: String)
+ (userName?: Option String := .none): Protocol.Goal :=
{
name,
+ userName?,
target := { pp? := .some target},
vars := (nameType.map fun x => ({
userName := x.fst,
@@ -59,7 +61,8 @@ def buildNamedGoal (name: String) (nameType: List (String × String)) (target: S
isInaccessible? := .some false
})).toArray
}
-def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none): Protocol.Goal :=
+def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none):
+ Protocol.Goal :=
{
userName?,
target := { pp? := .some target},
@@ -658,9 +661,9 @@ def test_nat_zero_add: TestM Unit := do
return ()
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.70" [("n", "Nat")] "Nat → Sort ?u.66",
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "Nat → Sort ?u.66" (.some "motive"),
buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.72" [("n", "Nat")] "(t : Nat) → Nat.below t → ?m.70 t"
+ buildNamedGoal "_uniq.72" [("n", "Nat")] "(t : Nat) → Nat.below t → ?motive t"
])
let tactic := "exact n"
From 398b1c39edd070d4c14981201d630cfc30a19632 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 19 Apr 2024 12:37:17 -0700
Subject: [PATCH 179/465] refactor: Common tactic execute function
---
Pantograph/Goal.lean | 127 ++++++--------------------
Pantograph/Tactic.lean | 2 +
Pantograph/Tactic/MotivatedApply.lean | 59 ++++++++++++
3 files changed, 89 insertions(+), 99 deletions(-)
create mode 100644 Pantograph/Tactic.lean
create mode 100644 Pantograph/Tactic/MotivatedApply.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 5c6a583..0b7e306 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -4,6 +4,7 @@ Functions for handling metavariables
All the functions starting with `try` resume their inner monadic state.
-/
import Pantograph.Protocol
+import Pantograph.Tactic
import Lean
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
@@ -144,24 +145,6 @@ protected def GoalState.assignedExprOf? (goalState: GoalState) (mvar: MVarId): O
--- Tactic execution functions ---
-/-- Inner function for executing tactic on goal state -/
-def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax) :
- Elab.TermElabM (Except (Array String) Elab.Tactic.SavedState):= do
- let tacticM (stx: Syntax): Elab.Tactic.TacticM (Except (Array String) Elab.Tactic.SavedState) := do
- state.restore
- Elab.Tactic.setGoals [goal]
- try
- Elab.Tactic.evalTactic stx
- if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
- return .error errors
- else
- return .ok (← MonadBacktrack.saveState)
- catch exception =>
- return .error #[← exception.toMessageData.toString]
- tacticM tactic { elaborator := .anonymous } |>.run' state.tactic
-
/-- Response for executing a tactic -/
inductive TacticResult where
-- Goes to next state
@@ -175,14 +158,35 @@ inductive TacticResult where
-- The given action cannot be executed in the state
| invalidAction (message: String)
-/-- Execute tactic on given state -/
-protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
- Elab.TermElabM TacticResult := do
+protected def GoalState.execute (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
+ Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryTactic
+ goal.checkNotAssigned `GoalState.execute
+ try
+ let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
+ if (← getThe Core.State).messages.hasErrors then
+ let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
+ let errors ← (messages.map Message.data).mapM fun md => md.toString
+ return .failure errors
+ let nextElabState ← MonadBacktrack.saveState
+ let nextMCtx := nextElabState.meta.meta.mctx
+ let prevMCtx := state.mctx
+ return .success {
+ state with
+ savedState := { term := nextElabState, tactic := newGoals },
+ newMVars := newMVarSet prevMCtx nextMCtx,
+ parentMVar? := .some goal,
+ calcPrevRhs? := .none,
+ }
+ catch exception =>
+ return .failure #[← exception.toMessageData.toString]
+
+/-- Execute tactic on given state -/
+protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
+ Elab.TermElabM TacticResult := do
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := if state.isConv then `conv else `tactic)
@@ -190,22 +194,7 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
(fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
- match ← executeTactic (state := state.savedState) (goal := goal) (tactic := tactic) with
- | .error errors =>
- return .failure errors
- | .ok nextSavedState =>
- -- Assert that the definition of metavariables are the same
- let nextMCtx := nextSavedState.term.meta.meta.mctx
- let prevMCtx := state.mctx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- return .success {
- state with
- savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar? := .some goal,
- calcPrevRhs? := .none,
- }
+ state.execute goalId $ Elab.Tactic.evalTactic tactic
/-- Assumes elabM has already been restored. Assumes expr has already typechecked -/
protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
@@ -515,15 +504,6 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
catch exception =>
return .failure #[← exception.toMessageData.toString]
-def getForallArgsBody: Expr → List Expr × Expr
- | .forallE _ d b _ =>
- let (innerArgs, innerBody) := getForallArgsBody b
- (d :: innerArgs, innerBody)
- | e => ([], e)
-def collectMotiveArguments (forallBody: Expr): SSet Nat :=
- match forallBody with
- | .app (.bvar i) _ => SSet.empty.insert i
- | _ => SSet.empty
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
Elab.TermElabM TacticResult := do
@@ -540,57 +520,6 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- try
- -- Implemented similarly to the intro tactic
- let nextGoals: List MVarId ← goal.withContext do
- let recursor ← Elab.Term.elabTerm (stx := recursor) .none
- let recursorType ← Meta.inferType recursor
-
- let (forallArgs, forallBody) := getForallArgsBody recursorType
- let motiveIndices := collectMotiveArguments forallBody
- --IO.println s!"{motiveIndices.toList} from {← Meta.ppExpr forallBody}"
-
- let numArgs ← Meta.getExpectedNumArgs recursorType
-
- let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
- if i ≥ numArgs then
- return prev
- else
- let argType := forallArgs.get! i
- -- If `argType` has motive references, its goal needs to be placed in it
- let argType := argType.instantiateRev prev
- -- Create the goal
- let userName := if motiveIndices.contains (numArgs - i - 1) then `motive else .anonymous
- let argGoal ← Meta.mkFreshExprMVar argType .syntheticOpaque (userName := userName)
- IO.println s!"Creating [{i}] {← Meta.ppExpr argGoal}"
- let prev := prev ++ [argGoal]
- go (i + 1) prev
- termination_by numArgs - i
- let newMVars ← go 0 #[]
-
- -- FIXME: Add an `Eq` target and swap out the motive type
-
- --let sourceType := forallBody.instantiateRev newMVars
- --unless ← withTheReader Meta.Context (λ ctx => { ctx with config := { ctx.config with } }) $
- -- Meta.isDefEq sourceType (← goal.getType) do
- -- throwError "invalid mapply: The resultant type {← Meta.ppExpr sourceType} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
-
- -- Create the main goal for the return type of the recursor
- goal.assign (mkAppN recursor newMVars)
-
- let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
- pure nextGoals
- return .success {
- root := state.root,
- savedState := {
- term := ← MonadBacktrack.saveState,
- tactic := { goals := nextGoals }
- },
- newMVars := nextGoals.toSSet,
- parentMVar? := .some goal,
- calcPrevRhs? := .none
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
+ state.execute goalId (tacticM := Tactic.motivatedApply recursor)
end Pantograph
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
new file mode 100644
index 0000000..0148548
--- /dev/null
+++ b/Pantograph/Tactic.lean
@@ -0,0 +1,2 @@
+
+import Pantograph.Tactic.MotivatedApply
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
new file mode 100644
index 0000000..50a660f
--- /dev/null
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -0,0 +1,59 @@
+import Lean
+
+open Lean
+
+namespace Pantograph.Tactic
+
+def getForallArgsBody: Expr → List Expr × Expr
+ | .forallE _ d b _ =>
+ let (innerArgs, innerBody) := getForallArgsBody b
+ (d :: innerArgs, innerBody)
+ | e => ([], e)
+def collectMotiveArguments (forallBody: Expr): SSet Nat :=
+ match forallBody with
+ | .app (.bvar i) _ => SSet.empty.insert i
+ | _ => SSet.empty
+
+def motivatedApply: Elab.Tactic.Tactic := λ stx => do
+ let goal ← Elab.Tactic.getMainGoal
+ let nextGoals: List MVarId ← goal.withContext do
+ let recursor ← Elab.Term.elabTerm (stx := stx) .none
+ let recursorType ← Meta.inferType recursor
+
+ let (forallArgs, forallBody) := getForallArgsBody recursorType
+ let motiveIndices := collectMotiveArguments forallBody
+ --IO.println s!"{motiveIndices.toList} from {← Meta.ppExpr forallBody}"
+
+ let numArgs ← Meta.getExpectedNumArgs recursorType
+
+ let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
+ if i ≥ numArgs then
+ return prev
+ else
+ let argType := forallArgs.get! i
+ -- If `argType` has motive references, its goal needs to be placed in it
+ let argType := argType.instantiateRev prev
+ -- Create the goal
+ let userName := if motiveIndices.contains (numArgs - i - 1) then `motive else .anonymous
+ let argGoal ← Meta.mkFreshExprMVar argType .syntheticOpaque (userName := userName)
+ IO.println s!"Creating [{i}] {← Meta.ppExpr argGoal}"
+ let prev := prev ++ [argGoal]
+ go (i + 1) prev
+ termination_by numArgs - i
+ let newMVars ← go 0 #[]
+
+ -- FIXME: Add an `Eq` target and swap out the motive type
+
+ --let sourceType := forallBody.instantiateRev newMVars
+ --unless ← withTheReader Meta.Context (λ ctx => { ctx with config := { ctx.config with } }) $
+ -- Meta.isDefEq sourceType (← goal.getType) do
+ -- throwError "invalid mapply: The resultant type {← Meta.ppExpr sourceType} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
+
+ -- Create the main goal for the return type of the recursor
+ goal.assign (mkAppN recursor newMVars)
+
+ let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
+ pure nextGoals
+ Elab.Tactic.setGoals nextGoals
+
+end Pantograph.Tactic
From 4a92e655f6515d1c6eaaaa991721f5cfb2774154 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 20 Apr 2024 13:09:41 -0700
Subject: [PATCH 180/465] test: Tactic test stub
---
Pantograph/Tactic/MotivatedApply.lean | 1 +
Test/Main.lean | 2 ++
Test/Tactic.lean | 1 +
Test/Tactic/MotivatedApply.lean | 11 +++++++++++
4 files changed, 15 insertions(+)
create mode 100644 Test/Tactic.lean
create mode 100644 Test/Tactic/MotivatedApply.lean
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 50a660f..817942d 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -14,6 +14,7 @@ def collectMotiveArguments (forallBody: Expr): SSet Nat :=
| .app (.bvar i) _ => SSet.empty.insert i
| _ => SSet.empty
+/-- Applies a symbol of the type `∀ (motive: α → Sort u) (a: α)..., (motive α)` -/
def motivatedApply: Elab.Tactic.Tactic := λ stx => do
let goal ← Elab.Tactic.getMainGoal
let nextGoals: List MVarId ← goal.withContext do
diff --git a/Test/Main.lean b/Test/Main.lean
index 1aa1d3d..ae897d4 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -5,6 +5,7 @@ import Test.Library
import Test.Metavar
import Test.Proofs
import Test.Serial
+import Test.Tactic
-- Test running infrastructure
@@ -48,6 +49,7 @@ def main (args: List String) := do
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
("Serial", Serial.suite env_default),
+ ("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
LSpec.lspecIO (← runTestGroup name_filter tests)
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
new file mode 100644
index 0000000..4284a41
--- /dev/null
+++ b/Test/Tactic.lean
@@ -0,0 +1 @@
+import Test.Tactic.MotivatedApply
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
new file mode 100644
index 0000000..04d7825
--- /dev/null
+++ b/Test/Tactic/MotivatedApply.lean
@@ -0,0 +1,11 @@
+import LSpec
+import Lean
+
+open Lean
+
+namespace Pantograph.Test.Tactic.MotivatedApply
+
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ []
+
+end Pantograph.Test.Tactic.MotivatedApply
From 3812aa56ecb871a9531d3cabec61a51eab7acbde Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 22 Apr 2024 00:11:41 -0700
Subject: [PATCH 181/465] feat: Phantom var in mapply
---
Makefile | 4 +-
Pantograph/Goal.lean | 2 +-
Pantograph/Tactic/MotivatedApply.lean | 88 +++++++++++++++++++++------
Test/Common.lean | 6 ++
Test/Proofs.lean | 9 ++-
Test/Tactic/MotivatedApply.lean | 65 +++++++++++++++++++-
6 files changed, 147 insertions(+), 27 deletions(-)
diff --git a/Makefile b/Makefile
index 5d4ad6b..86f9e5b 100644
--- a/Makefile
+++ b/Makefile
@@ -1,9 +1,9 @@
LIB := ./.lake/build/lib/Pantograph.olean
EXE := ./.lake/build/bin/pantograph
-SOURCE := $(wildcard Pantograph/*.lean) $(wildcard *.lean) lean-toolchain
+SOURCE := $(wildcard *.lean Pantograph/*.lean Pantograph/**/*.lean) lean-toolchain
TEST_EXE := ./.lake/build/bin/test
-TEST_SOURCE := $(wildcard Test/*.lean)
+TEST_SOURCE := $(wildcard Test/*.lean Test/**/*.lean)
$(LIB) $(EXE): $(SOURCE)
lake build pantograph
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0b7e306..17d94c0 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -126,7 +126,7 @@ protected def GoalState.continue (target: GoalState) (branch: GoalState): Except
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
let expr ← goalState.mctx.eAssignment.find? goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
- if expr.hasMVar then
+ if expr.hasExprMVar then
-- Must not assert that the goal state is empty here. We could be in a branch goal.
--assert! ¬goalState.goals.isEmpty
.none
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 817942d..9826e3d 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -9,6 +9,54 @@ def getForallArgsBody: Expr → List Expr × Expr
let (innerArgs, innerBody) := getForallArgsBody b
(d :: innerArgs, innerBody)
| e => ([], e)
+
+def replaceForallBody: Expr → Expr → Expr
+ | .forallE param domain body binderInfo, target =>
+ let body := replaceForallBody body target
+ .forallE param domain body binderInfo
+ | _, target => target
+
+structure RecursorWithMotive where
+ args: List Expr
+ body: Expr
+
+ -- .bvar index for the motive and major from the body
+ iMotive: Nat
+ iMajor: Nat
+
+namespace RecursorWithMotive
+
+protected def nArgs (info: RecursorWithMotive): Nat := info.args.length
+
+protected def getMotiveType (info: RecursorWithMotive): Expr :=
+ let level := info.nArgs - info.iMotive - 1
+ let a := info.args.get! level
+ a
+
+protected def surrogateMotiveType (info: RecursorWithMotive) (resultant: Expr): MetaM Expr := do
+ let motiveType := info.getMotiveType
+ let resultantType ← Meta.inferType resultant
+ return replaceForallBody motiveType resultantType
+
+protected def phantomType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
+ let goalMotive := mvars.get! (info.nArgs - info.iMotive - 1)
+ let goalMajor := mvars.get! (info.nArgs - info.iMajor - 1)
+ Meta.mkEq (.app goalMotive goalMajor) resultant
+
+end RecursorWithMotive
+
+def getRecursorInformation (recursorType: Expr): Option RecursorWithMotive := do
+ let (args, body) := getForallArgsBody recursorType
+ let (iMotive, iMajor) ← match body with
+ | .app (.bvar iMotive) (.bvar iMajor) => pure (iMotive, iMajor)
+ | _ => .none
+ return {
+ args,
+ body,
+ iMotive,
+ iMajor,
+ }
+
def collectMotiveArguments (forallBody: Expr): SSet Nat :=
match forallBody with
| .app (.bvar i) _ => SSet.empty.insert i
@@ -21,38 +69,38 @@ def motivatedApply: Elab.Tactic.Tactic := λ stx => do
let recursor ← Elab.Term.elabTerm (stx := stx) .none
let recursorType ← Meta.inferType recursor
- let (forallArgs, forallBody) := getForallArgsBody recursorType
- let motiveIndices := collectMotiveArguments forallBody
- --IO.println s!"{motiveIndices.toList} from {← Meta.ppExpr forallBody}"
+ let resultant ← goal.getType
- let numArgs ← Meta.getExpectedNumArgs recursorType
+ let info ← match getRecursorInformation recursorType with
+ | .some info => pure info
+ | .none => throwError "Recursor return type does not correspond with the invocation of a motive: {← Meta.ppExpr recursorType}"
let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
- if i ≥ numArgs then
+ if i ≥ info.nArgs then
return prev
else
- let argType := forallArgs.get! i
+ let argType := info.args.get! i
-- If `argType` has motive references, its goal needs to be placed in it
let argType := argType.instantiateRev prev
- -- Create the goal
- let userName := if motiveIndices.contains (numArgs - i - 1) then `motive else .anonymous
- let argGoal ← Meta.mkFreshExprMVar argType .syntheticOpaque (userName := userName)
- IO.println s!"Creating [{i}] {← Meta.ppExpr argGoal}"
+ let bvarIndex := info.nArgs - i - 1
+ let argGoal ← if bvarIndex = info.iMotive then
+ let surrogateMotiveType ← info.surrogateMotiveType resultant
+ Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
+ else if bvarIndex = info.iMajor then
+ Meta.mkFreshExprMVar argType .syntheticOpaque (userName := `major)
+ else
+ Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
let prev := prev ++ [argGoal]
go (i + 1) prev
- termination_by numArgs - i
- let newMVars ← go 0 #[]
+ termination_by info.nArgs - i
+ let mut newMVars ← go 0 #[]
- -- FIXME: Add an `Eq` target and swap out the motive type
-
- --let sourceType := forallBody.instantiateRev newMVars
- --unless ← withTheReader Meta.Context (λ ctx => { ctx with config := { ctx.config with } }) $
- -- Meta.isDefEq sourceType (← goal.getType) do
- -- throwError "invalid mapply: The resultant type {← Meta.ppExpr sourceType} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
-
- -- Create the main goal for the return type of the recursor
goal.assign (mkAppN recursor newMVars)
+ let phantomType ← info.phantomType newMVars resultant
+ let goalPhantom ← Meta.mkFreshExprMVar phantomType .syntheticOpaque (userName := `phantom)
+ newMVars := newMVars ++ [goalPhantom]
+
let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
pure nextGoals
Elab.Tactic.setGoals nextGoals
diff --git a/Test/Common.lean b/Test/Common.lean
index 8b8e977..6ea4fb2 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -63,6 +63,12 @@ def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSe
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
termElabM.run' (ctx := Pantograph.defaultTermElabMContext)
+def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
+
+def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
+ let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
+ return newGoals.goals
+
end Test
end Pantograph
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 1adc9d4..43c346b 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -661,9 +661,10 @@ def test_nat_zero_add: TestM Unit := do
return ()
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.70" [("n", "Nat")] "Nat → Sort ?u.66" (.some "motive"),
- buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.72" [("n", "Nat")] "(t : Nat) → Nat.below t → ?motive t"
+ buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat" (.some "major"),
+ buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?major = (n + 0 = n)" (.some "phantom")
])
let tactic := "exact n"
@@ -710,6 +711,8 @@ def test_nat_zero_add: TestM Unit := do
addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)) =
#[])
+ let expr := stateF.mctx.eAssignment.find! stateF.root
+ let (expr, _) := instantiateMVarsCore (mctx := stateF.mctx) (e := expr)
addTest $ LSpec.check "(F root)" stateF.rootExpr?.isSome
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 04d7825..60ed7be 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -1,11 +1,74 @@
import LSpec
import Lean
+import Test.Common
open Lean
+open Pantograph
namespace Pantograph.Test.Tactic.MotivatedApply
+def valueAndType (recursor: String): MetaM (Expr × Expr) := do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := recursor)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ runTermElabMInMeta do
+ let recursor ← Elab.Term.elabTerm (stx := recursor) .none
+ let recursorType ← Meta.inferType recursor
+ return (recursor, recursorType)
+
+
+def test_type_extract (env: Environment): IO LSpec.TestSeq :=
+ runMetaMSeq env do
+ let mut tests := LSpec.TestSeq.done
+ let (recursor, recursorType) ← valueAndType "@Nat.brecOn"
+ tests := tests ++ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
+ (← exprToStr recursorType))
+ let info ← match Tactic.getRecursorInformation recursorType with
+ | .some info => pure info
+ | .none => throwError "Failed to extract recursor info"
+ tests := tests ++ LSpec.check "iMotive" (info.iMotive = 2)
+ tests := tests ++ LSpec.check "iMajor" (info.iMajor = 1)
+ let motiveType := info.getMotiveType
+ tests := tests ++ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
+ (← exprToStr motiveType))
+ return tests
+
+def test_execute (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (n t: Nat) => n + 0 = n"
+ runMetaMSeq env do
+ let (expr, exprType) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "@Nat.brecOn")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Nat → Prop",
+ "Nat",
+ "∀ (t : Nat), Nat.below t → ?motive t",
+ "?motive ?major = (n + 0 = n)",
+ ])
+ tests := tests ++ test
+ return tests
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
- []
+ [
+ ("type_extract", test_type_extract env),
+ ("execute", test_execute env),
+ ]
end Pantograph.Test.Tactic.MotivatedApply
From feff62a3c53de6ba111cb6aa48371a2ae0effb7e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 22 Apr 2024 09:52:13 -0700
Subject: [PATCH 182/465] fix: Remove determination of major
---
Pantograph/Tactic/MotivatedApply.lean | 15 ++++++---------
Test/Proofs.lean | 4 ++--
Test/Tactic/MotivatedApply.lean | 3 +--
3 files changed, 9 insertions(+), 13 deletions(-)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 9826e3d..1201174 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -22,7 +22,6 @@ structure RecursorWithMotive where
-- .bvar index for the motive and major from the body
iMotive: Nat
- iMajor: Nat
namespace RecursorWithMotive
@@ -39,22 +38,22 @@ protected def surrogateMotiveType (info: RecursorWithMotive) (resultant: Expr):
return replaceForallBody motiveType resultantType
protected def phantomType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
- let goalMotive := mvars.get! (info.nArgs - info.iMotive - 1)
- let goalMajor := mvars.get! (info.nArgs - info.iMajor - 1)
- Meta.mkEq (.app goalMotive goalMajor) resultant
+ let motiveCall := Expr.instantiateRev info.body mvars
+ Meta.mkEq motiveCall resultant
end RecursorWithMotive
def getRecursorInformation (recursorType: Expr): Option RecursorWithMotive := do
let (args, body) := getForallArgsBody recursorType
- let (iMotive, iMajor) ← match body with
- | .app (.bvar iMotive) (.bvar iMajor) => pure (iMotive, iMajor)
+ if ¬ body.isApp then
+ .none
+ let iMotive ← match body.getAppFn with
+ | .bvar iMotive => pure iMotive
| _ => .none
return {
args,
body,
iMotive,
- iMajor,
}
def collectMotiveArguments (forallBody: Expr): SSet Nat :=
@@ -86,8 +85,6 @@ def motivatedApply: Elab.Tactic.Tactic := λ stx => do
let argGoal ← if bvarIndex = info.iMotive then
let surrogateMotiveType ← info.surrogateMotiveType resultant
Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
- else if bvarIndex = info.iMajor then
- Meta.mkFreshExprMVar argType .syntheticOpaque (userName := `major)
else
Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
let prev := prev ++ [argGoal]
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 43c346b..2df0868 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -662,9 +662,9 @@ def test_nat_zero_add: TestM Unit := do
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat" (.some "major"),
+ buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?major = (n + 0 = n)" (.some "phantom")
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "phantom")
])
let tactic := "exact n"
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 60ed7be..1f751ed 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -31,7 +31,6 @@ def test_type_extract (env: Environment): IO LSpec.TestSeq :=
| .some info => pure info
| .none => throwError "Failed to extract recursor info"
tests := tests ++ LSpec.check "iMotive" (info.iMotive = 2)
- tests := tests ++ LSpec.check "iMajor" (info.iMajor = 1)
let motiveType := info.getMotiveType
tests := tests ++ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
(← exprToStr motiveType))
@@ -60,7 +59,7 @@ def test_execute (env: Environment): IO LSpec.TestSeq :=
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?major = (n + 0 = n)",
+ "?motive ?m.69 = (n + 0 = n)",
])
tests := tests ++ test
return tests
From 6ffb227cd641f77109c539152e0b38f6d2bfa125 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 22 Apr 2024 10:02:09 -0700
Subject: [PATCH 183/465] feat: Conduit modus ponens
---
Pantograph/Tactic/MotivatedApply.lean | 12 ++++++------
Test/Proofs.lean | 15 +++++++++++++--
2 files changed, 19 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 1201174..821b681 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -37,7 +37,7 @@ protected def surrogateMotiveType (info: RecursorWithMotive) (resultant: Expr):
let resultantType ← Meta.inferType resultant
return replaceForallBody motiveType resultantType
-protected def phantomType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
+protected def conduitType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
let motiveCall := Expr.instantiateRev info.body mvars
Meta.mkEq motiveCall resultant
@@ -92,11 +92,11 @@ def motivatedApply: Elab.Tactic.Tactic := λ stx => do
termination_by info.nArgs - i
let mut newMVars ← go 0 #[]
- goal.assign (mkAppN recursor newMVars)
-
- let phantomType ← info.phantomType newMVars resultant
- let goalPhantom ← Meta.mkFreshExprMVar phantomType .syntheticOpaque (userName := `phantom)
- newMVars := newMVars ++ [goalPhantom]
+ -- Create the conduit type which proves the result of the motive is equal to the goal
+ let conduitType ← info.conduitType newMVars resultant
+ let goalConduit ← Meta.mkFreshExprMVar conduitType .syntheticOpaque (userName := `conduit)
+ goal.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
+ newMVars := newMVars ++ [goalConduit]
let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
pure nextGoals
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 2df0868..429d4d2 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -664,7 +664,7 @@ def test_nat_zero_add: TestM Unit := do
buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "phantom")
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
])
let tactic := "exact n"
@@ -703,7 +703,18 @@ def test_nat_zero_add: TestM Unit := do
#[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
let tactic := "simp"
- let stateF ← match ← state3.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3d ← match ← state3.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state2d ← match state3d.continue state2c with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let tactic := "rfl"
+ let stateF ← match ← state2d.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
From 4cff6677d27a9629eb44d173c321977ac860e5e8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 4 May 2024 23:36:42 -0700
Subject: [PATCH 184/465] chore: Lean version bump to 4.8.0-rc1
---
Pantograph.lean | 2 +-
Pantograph/Goal.lean | 4 ++--
Pantograph/Protocol.lean | 1 -
Test/Integration.lean | 2 +-
flake.lock | 8 ++++----
flake.nix | 2 +-
lean-toolchain | 2 +-
7 files changed, 10 insertions(+), 11 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index f59bc11..74289d6 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -87,7 +87,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
}
}
return .ok { }
- options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.OptionsPrintResult) := do
+ options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
return .ok (← get).options
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 17d94c0..921f60b 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -169,7 +169,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tacticM: Elab.
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
+ let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .failure errors
let nextElabState ← MonadBacktrack.saveState
let nextMCtx := nextElabState.meta.meta.mctx
@@ -214,7 +214,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
+ let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .failure errors
let prevMCtx := state.savedState.term.meta.meta.mctx
let nextMCtx ← getMCtx
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 17618fc..f73c3b0 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -193,7 +193,6 @@ structure OptionsSetResult where
deriving Lean.ToJson
structure OptionsPrint where
deriving Lean.FromJson
-abbrev OptionsPrintResult := Options
structure GoalStart where
-- Only one of the fields below may be populated.
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 29cb82d..9bd5db6 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -65,7 +65,7 @@ def test_option_modify : IO LSpec.TestSeq :=
subroutine_step "options.print"
[]
(Lean.toJson ({ options with printExprAST := true }:
- Protocol.OptionsPrintResult))
+ Protocol.Options))
]
def test_malformed_command : IO LSpec.TestSeq :=
let invalid := "invalid"
diff --git a/flake.lock b/flake.lock
index 39888a8..1a50363 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,16 +42,16 @@
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
- "lastModified": 1711508550,
- "narHash": "sha256-UK4DnYmwXLcqHA316Zkn0cnujdYlxqUf+b6S4l56Q3s=",
+ "lastModified": 1714704934,
+ "narHash": "sha256-q0kLyIahUXolkSrBZSegPF+R99WAH1YC96JfKoFntDE=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
+ "rev": "dcccfb73cb247e9478220375ab7de03f7c67e505",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
+ "ref": "v4.8.0-rc1",
"repo": "lean4",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 2458805..ad40a3f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -5,8 +5,8 @@
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
- url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
# Do not follow input's nixpkgs since it could cause build failures
+ url = "github:leanprover/lean4?ref=v4.8.0-rc1";
};
lspec = {
url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
diff --git a/lean-toolchain b/lean-toolchain
index c630636..d8a6d7e 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:nightly-2024-03-27
+leanprover/lean4:v4.8.0-rc1
From 63417ef179066bfd847ff5efc5e74085268b1795 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 5 May 2024 00:43:32 -0700
Subject: [PATCH 185/465] fix: Motive extra arguments not instiantiated
---
Pantograph/Tactic/MotivatedApply.lean | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 821b681..a7b9a07 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -32,8 +32,8 @@ protected def getMotiveType (info: RecursorWithMotive): Expr :=
let a := info.args.get! level
a
-protected def surrogateMotiveType (info: RecursorWithMotive) (resultant: Expr): MetaM Expr := do
- let motiveType := info.getMotiveType
+protected def surrogateMotiveType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
+ let motiveType := Expr.instantiateRev info.getMotiveType mvars
let resultantType ← Meta.inferType resultant
return replaceForallBody motiveType resultantType
@@ -83,7 +83,7 @@ def motivatedApply: Elab.Tactic.Tactic := λ stx => do
let argType := argType.instantiateRev prev
let bvarIndex := info.nArgs - i - 1
let argGoal ← if bvarIndex = info.iMotive then
- let surrogateMotiveType ← info.surrogateMotiveType resultant
+ let surrogateMotiveType ← info.surrogateMotiveType prev resultant
Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
else
Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
From 1e1995255a91a738f3e1ce0dc2a8f8842acc4152 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 5 May 2024 10:36:43 -0700
Subject: [PATCH 186/465] test: mapply captures dependent types
---
Test/Tactic/MotivatedApply.lean | 35 +++++++++++++++++++++++++++++++--
1 file changed, 33 insertions(+), 2 deletions(-)
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 1f751ed..84ca804 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -36,7 +36,7 @@ def test_type_extract (env: Environment): IO LSpec.TestSeq :=
(← exprToStr motiveType))
return tests
-def test_execute (env: Environment): IO LSpec.TestSeq :=
+def test_nat_brec_on (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (n t: Nat) => n + 0 = n"
runMetaMSeq env do
let (expr, exprType) ← valueAndType expr
@@ -64,10 +64,41 @@ def test_execute (env: Environment): IO LSpec.TestSeq :=
tests := tests ++ test
return tests
+def test_list_brec_on (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
+ runMetaMSeq env do
+ let (expr, exprType) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "@List.brecOn")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Type ?u.92",
+ "List ?m.94 → Prop",
+ "List ?m.94",
+ "∀ (t : List ?m.94), List.below t → ?motive t",
+ "?motive ?m.96 = (l ++ [] = [] ++ l)",
+ ])
+ tests := tests ++ test
+ return tests
+
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("type_extract", test_type_extract env),
- ("execute", test_execute env),
+ ("nat_brec_on", test_nat_brec_on env),
+ ("list_brec_on", test_list_brec_on env),
]
end Pantograph.Test.Tactic.MotivatedApply
From cf1289f159ddddf85430fbdd04d47d4f3be6eeae Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 5 May 2024 13:24:29 -0700
Subject: [PATCH 187/465] feat: NoConfuse tactic
---
Pantograph/Goal.lean | 16 +++++
Pantograph/Tactic.lean | 1 +
Pantograph/Tactic/NoConfuse.lean | 18 ++++++
Test/Main.lean | 1 +
Test/Tactic.lean | 1 +
Test/Tactic/NoConfuse.lean | 100 +++++++++++++++++++++++++++++++
6 files changed, 137 insertions(+)
create mode 100644 Pantograph/Tactic/NoConfuse.lean
create mode 100644 Test/Tactic/NoConfuse.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 921f60b..7ada190 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -521,5 +521,21 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.motivatedApply recursor)
+protected def GoalState.tryNoConfusion (state: GoalState) (goalId: Nat) (eq: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let goal ← match state.savedState.tactic.goals.get? goalId with
+ | .some goal => pure goal
+ | .none => return .indexError goalId
+ goal.checkNotAssigned `GoalState.tryMotivatedApply
+
+ let recursor ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := eq)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ state.execute goalId (tacticM := Tactic.noConfuse recursor)
end Pantograph
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 0148548..5a7828c 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -1,2 +1,3 @@
import Pantograph.Tactic.MotivatedApply
+import Pantograph.Tactic.NoConfuse
diff --git a/Pantograph/Tactic/NoConfuse.lean b/Pantograph/Tactic/NoConfuse.lean
new file mode 100644
index 0000000..b8bc84e
--- /dev/null
+++ b/Pantograph/Tactic/NoConfuse.lean
@@ -0,0 +1,18 @@
+import Lean
+
+open Lean
+
+namespace Pantograph.Tactic
+
+def noConfuse: Elab.Tactic.Tactic := λ stx => do
+ let goal ← Elab.Tactic.getMainGoal
+ goal.withContext do
+ let absurd ← Elab.Term.elabTerm (stx := stx) .none
+ let noConfusion ← Meta.mkNoConfusion (target := ← goal.getType) (h := absurd)
+
+ unless ← Meta.isDefEq (← Meta.inferType noConfusion) (← goal.getType) do
+ throwError "invalid noConfuse call: The resultant type {← Meta.ppExpr $ ← Meta.inferType noConfusion} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
+ goal.assign noConfusion
+ Elab.Tactic.setGoals []
+
+end Pantograph.Tactic
diff --git a/Test/Main.lean b/Test/Main.lean
index ae897d4..4a1ca69 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -50,6 +50,7 @@ def main (args: List String) := do
("Proofs", Proofs.suite env_default),
("Serial", Serial.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
+ ("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
LSpec.lspecIO (← runTestGroup name_filter tests)
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
index 4284a41..f1e2649 100644
--- a/Test/Tactic.lean
+++ b/Test/Tactic.lean
@@ -1 +1,2 @@
import Test.Tactic.MotivatedApply
+import Test.Tactic.NoConfuse
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
new file mode 100644
index 0000000..54c2be7
--- /dev/null
+++ b/Test/Tactic/NoConfuse.lean
@@ -0,0 +1,100 @@
+import LSpec
+import Lean
+import Test.Common
+
+open Lean
+open Pantograph
+
+namespace Pantograph.Test.Tactic.NoConfuse
+
+def valueAndType (recursor: String): MetaM (Expr × Expr) := do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := recursor)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ runTermElabMInMeta do
+ let recursor ← Elab.Term.elabTerm (stx := recursor) .none
+ let recursorType ← Meta.inferType recursor
+ return (recursor, recursorType)
+
+def test_nat (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (n: Nat) (h: 0 = n + 1) => False"
+ runMetaMSeq env do
+ let (expr, exprType) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.noConfuse recursor
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [])
+ tests := tests ++ test
+ return tests
+
+def test_nat_fail (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (n: Nat) (h: n = n) => False"
+ runMetaMSeq env do
+ let (expr, _) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ try
+ let tactic := Tactic.noConfuse recursor
+ let _ ← runTermElabMInMeta $ runTacticOnMVar tactic target.mvarId!
+ tests := tests ++ assertUnreachable "Tactic should fail"
+ catch _ =>
+ tests := tests ++ LSpec.check "Tactic should fail" true
+ return tests
+ return tests
+
+def test_list (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
+ runMetaMSeq env do
+ let (expr, exprType) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.noConfuse recursor
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [])
+ tests := tests ++ test
+ return tests
+
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("nat", test_nat env),
+ ("nat_fail", test_nat_fail env),
+ ("list", test_list env),
+ ]
+
+end Pantograph.Test.Tactic.NoConfuse
From 2937675044bcefe266a9c1d1116dbec53ee3942a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 5 May 2024 13:25:48 -0700
Subject: [PATCH 188/465] feat: Library interface for calling no_confuse
---
Pantograph/Goal.lean | 2 +-
Pantograph/Library.lean | 3 +++
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 7ada190..11e5b20 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -521,7 +521,7 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.motivatedApply recursor)
-protected def GoalState.tryNoConfusion (state: GoalState) (goalId: Nat) (eq: String):
+protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 00b4bc7..608aeeb 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -208,5 +208,8 @@ def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
@[export pantograph_goal_motivated_apply_m]
def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryMotivatedApply goalId recursor
+@[export pantograph_goal_no_confuse_m]
+def goalNoConfuse (state: GoalState) (goalId: Nat) (recursor: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryNoConfuse goalId recursor
end Pantograph
From 679871cbc659ce9ff58e832d20f51f52ae3dc2f1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 5 May 2024 13:26:46 -0700
Subject: [PATCH 189/465] fix: NoConfuse arg name
---
Pantograph/Library.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 608aeeb..6dda2f0 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -209,7 +209,7 @@ def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryMotivatedApply goalId recursor
@[export pantograph_goal_no_confuse_m]
-def goalNoConfuse (state: GoalState) (goalId: Nat) (recursor: String): Lean.CoreM TacticResult :=
- runTermElabM <| state.tryNoConfuse goalId recursor
+def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
+ runTermElabM <| state.tryNoConfuse goalId eq
end Pantograph
From aa106f7591b8719ce91baa25e7434b808b62e0d6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 May 2024 22:20:20 -0700
Subject: [PATCH 190/465] feat: Do not filter mvars from mapply
---
Pantograph/Tactic/MotivatedApply.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index a7b9a07..f570560 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -94,11 +94,11 @@ def motivatedApply: Elab.Tactic.Tactic := λ stx => do
-- Create the conduit type which proves the result of the motive is equal to the goal
let conduitType ← info.conduitType newMVars resultant
- let goalConduit ← Meta.mkFreshExprMVar conduitType .syntheticOpaque (userName := `conduit)
+ let goalConduit ← Meta.mkFreshExprMVar conduitType .natural (userName := `conduit)
goal.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
newMVars := newMVars ++ [goalConduit]
- let nextGoals ← newMVars.toList.map (·.mvarId!) |>.filterM (not <$> ·.isAssigned)
+ let nextGoals := newMVars.toList.map (·.mvarId!)
pure nextGoals
Elab.Tactic.setGoals nextGoals
From 69ec70ffbe7caec196c549bf30018c6433e4104b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 6 May 2024 22:39:17 -0700
Subject: [PATCH 191/465] feat: Do not explicitly show delay assigned mvar
---
Pantograph/Serial.lean | 9 ++++++---
Test/Proofs.lean | 2 +-
2 files changed, 7 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 950818e..26b0c9f 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -102,9 +102,12 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
| .fvar fvarId =>
let name := ofName fvarId.name
pure s!"(:fv {name})"
- | .mvar mvarId =>
- let name := ofName mvarId.name
- pure s!"(:mv {name})"
+ | .mvar mvarId => do
+ if ← mvarId.isDelayedAssigned then
+ pure s!"(:mv)"
+ else
+ let name := ofName mvarId.name
+ pure s!"(:mv {name})"
| .sort level =>
let level := serializeSortLevel level sanitize
pure s!"(:sort {level})"
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 429d4d2..8e77227 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -245,7 +245,7 @@ def test_or_comm: TestM Unit := do
let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
-- This is due to delayed assignment
addTest $ LSpec.test "(2 parent)" (state2parent ==
- "((:mv _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
+ "((:mv) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
From 66a5dfcf3c615a3f5d970acd624364d3dc5551d5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 May 2024 12:41:21 -0700
Subject: [PATCH 192/465] feat: Diagnostics command for FFI users
---
Pantograph/Library.lean | 4 +++
Pantograph/Serial.lean | 63 ++++++++++++++++++++++-------------------
2 files changed, 38 insertions(+), 29 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6dda2f0..fa5d414 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -212,4 +212,8 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryNoConfuse goalId eq
+@[export pantograph_goal_diag]
+def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
+ runMetaM $ state.diag diagOptions
+
end Pantograph
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 26b0c9f..b2a4529 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -270,51 +270,56 @@ protected def GoalState.serializeGoals
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
/-- Print the metavariables in a readable format -/
-protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM Unit := do
+protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM String := do
goalState.restoreMetaM
let savedState := goalState.savedState
let goals := savedState.tactic.goals
let mctx ← getMCtx
let root := goalState.root
-- Print the root
- match mctx.decls.find? root with
- | .some decl => printMVar ">" root decl
- | .none => IO.println s!">{root.name}: ??"
- goals.forM (fun mvarId => do
- if mvarId != root then
- match mctx.decls.find? mvarId with
- | .some decl => printMVar "⊢" mvarId decl
- | .none => IO.println s!"⊢{mvarId.name}: ??"
+ let result: String ← match mctx.decls.find? root with
+ | .some decl => printMVar ">" root decl
+ | .none => pure s!">{root.name}: ??"
+ let resultGoals ← goals.filter (· != root) |>.mapM (fun mvarId =>
+ match mctx.decls.find? mvarId with
+ | .some decl => printMVar "⊢" mvarId decl
+ | .none => pure s!"⊢{mvarId.name}: ??"
)
let goals := goals.toSSet
- mctx.decls.forM (fun mvarId decl => do
- if goals.contains mvarId || mvarId == root then
- pure ()
- -- Print the remainig ones that users don't see in Lean
- else if options.printAll then
+ let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
+ !(goals.contains mvarId || mvarId == root) && options.printAll)
+ |>.mapM (fun (mvarId, decl) => do
let pref := if goalState.newMVars.contains mvarId then "~" else " "
printMVar pref mvarId decl
- else
- pure ()
- --IO.println s!" {mvarId.name}{userNameToString decl.userName}"
)
+ pure $ result ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
where
- printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM Unit := do
- if options.printContext then
- decl.lctx.fvarIdToDecl.forM printFVar
+ printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := do
+ let resultFVars: List String ←
+ if options.printContext then
+ decl.lctx.fvarIdToDecl.toList.mapM (λ (fvarId, decl) =>
+ do pure $ (← printFVar fvarId decl) ++ "\n")
+ else
+ pure []
let type ← if options.instantiate
then instantiateMVars decl.type
else pure $ decl.type
let type_sexp ← serializeExpressionSexp type (sanitize := false)
- IO.println s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
- if options.printValue then
- if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
- let value ← if options.instantiate
- then instantiateMVars value
- else pure $ value
- IO.println s!" := {← Meta.ppExpr value}"
- printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM Unit := do
- IO.println s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
+ let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
+ let resultValue: String ←
+ if options.printValue then
+ if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
+ let value ← if options.instantiate
+ then instantiateMVars value
+ else pure $ value
+ pure s!"\n := {← Meta.ppExpr value}"
+ else
+ pure ""
+ else
+ pure ""
+ pure $ (String.join resultFVars) ++ resultMain ++ resultValue
+ printFVar (fvarId: FVarId) (decl: LocalDecl): MetaM String := do
+ pure s!" | {fvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}"
userNameToString : Name → String
| .anonymous => ""
| other => s!"[{other}]"
From e58dbc66a92ef10b014a30745a542ec0dd9be6ef Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 May 2024 20:51:36 -0700
Subject: [PATCH 193/465] fix: Consistent naming in library functions
---
Pantograph/Library.lean | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index fa5d414..3ae852f 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -180,6 +180,9 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
parent? := ← state.parentExpr?.mapM (λ expr => do
serializeExpression options (← unfoldAuxLemmas expr)),
}
+@[export pantograph_goal_diag_m]
+def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
+ runMetaM $ state.diag diagOptions
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
@@ -212,8 +215,4 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryNoConfuse goalId eq
-@[export pantograph_goal_diag]
-def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
- runMetaM $ state.diag diagOptions
-
end Pantograph
From 0b88f6708e299f0282f048364a885f7913525bc7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 9 May 2024 14:02:43 -0700
Subject: [PATCH 194/465] test: Delayed mvar assignment for mapply
---
Test/Proofs.lean | 52 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8e77227..04fe79c 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -726,6 +726,57 @@ def test_nat_zero_add: TestM Unit := do
let (expr, _) := instantiateMVarsCore (mctx := stateF.mctx) (e := expr)
addTest $ LSpec.check "(F root)" stateF.rootExpr?.isSome
+def test_nat_zero_add_alt: TestM Unit := do
+ let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+ let tactic := "intro n"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("n", "Nat")] "n + 0 = n"])
+ let recursor := "@Nat.brecOn"
+ let state2 ← match ← state1.tryMotivatedApply (goalId := 0) (recursor := recursor) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
+ #[
+ buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
+ buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
+ ])
+
+ let tactic := "intro x"
+ let state3m ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3m.serializeGoals (options := ← read)).map (·.devolatilize) =
+ #[buildGoal [("n", "Nat"), ("x", "Nat")] "Prop" (.some "motive")])
+ let tactic := "apply Eq"
+ let state3m2 ← match ← state3m.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let state2b ← match state3m2.resume (state3m2.goals ++ state2.goals) with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
+ #[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("Nat.add_comm", test_nat_add_comm false),
@@ -739,6 +790,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("let via assign", test_let false),
("let via tryLet", test_let true),
("Nat.zero_add", test_nat_zero_add),
+ ("Nat.zero_add alt", test_nat_zero_add_alt),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 03ecb6cf19b7741a6bb20f2eb969374ac59b8643 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 11 May 2024 20:01:02 -0700
Subject: [PATCH 195/465] feat: Partial instantiate metavariables
---
Pantograph/Library.lean | 4 ++--
Pantograph/Serial.lean | 32 ++++++++++++++++++-------
Test/Integration.lean | 4 ++--
Test/Proofs.lean | 2 +-
Test/Serial.lean | 1 +
Test/Tactic/MotivatedApply.lean | 42 +++++++++++++++++++++++++++++++--
6 files changed, 70 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 3ae852f..59d7adc 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -176,9 +176,9 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
state.restoreMetaM
return {
root? := ← state.rootExpr?.mapM (λ expr => do
- serializeExpression options (← unfoldAuxLemmas expr)),
+ serializeExpression options (← instantiateAll expr)),
parent? := ← state.parentExpr?.mapM (λ expr => do
- serializeExpression options (← unfoldAuxLemmas expr)),
+ serializeExpression options (← instantiateAll expr)),
}
@[export pantograph_goal_diag_m]
def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index b2a4529..cdb35ce 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -18,6 +18,23 @@ namespace Pantograph
def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
+ Meta.transform e
+ (pre := fun e => e.withApp fun f args => do
+ if let .mvar mvarId := f then
+ if let some decl ← getDelayedMVarAssignment? mvarId then
+ if args.size ≥ decl.fvars.size then
+ let pending ← instantiateMVars (.mvar decl.mvarIdPending)
+ if !pending.isMVar then
+ return .visit <| (← Meta.mkLambdaFVars decl.fvars pending).beta args
+ return .continue)
+
+def instantiateAll (e: Expr): MetaM Expr := do
+ let e ← instantiateMVars e
+ let e ← unfoldAuxLemmas e
+ let e ← instantiatePartialDelayedMVars e
+ return e
+
--- Input Functions ---
/-- Read syntax object from string -/
@@ -103,11 +120,9 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
let name := ofName fvarId.name
pure s!"(:fv {name})"
| .mvar mvarId => do
- if ← mvarId.isDelayedAssigned then
- pure s!"(:mv)"
- else
+ let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
let name := ofName mvarId.name
- pure s!"(:mv {name})"
+ pure s!"(:{pref} {name})"
| .sort level =>
let level := serializeSortLevel level sanitize
pure s!"(:sort {level})"
@@ -210,7 +225,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
match localDecl with
| .cdecl _ fvarId userName type _ _ =>
let userName := userName.simpMacroScopes
- let type ← instantiateMVars type
+ let type ← instantiate type
return {
name := ofName fvarId.name,
userName:= ofName userName,
@@ -219,9 +234,9 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
}
| .ldecl _ fvarId userName type val _ _ => do
let userName := userName.simpMacroScopes
- let type ← instantiateMVars type
+ let type ← instantiate type
let value? ← if showLetValues then
- let val ← instantiateMVars val
+ let val ← instantiate val
pure $ .some (← serializeExpression options val)
else
pure $ .none
@@ -248,10 +263,11 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
- target := (← serializeExpression options (← instantiateMVars mvarDecl.type)),
+ target := (← serializeExpression options (← instantiateAll mvarDecl.type)),
vars := vars.reverse.toArray
}
where
+ instantiate := instantiateAll
ofName (n: Name) := serializeName n (sanitize := false)
protected def GoalState.serializeGoals
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9bd5db6..66b3637 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -88,11 +88,11 @@ def test_tactic : IO LSpec.TestSeq :=
vars := #[{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
- name := "_uniq.14",
+ name := "_uniq.17",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.13", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ { name := "_uniq.16", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
],
}
subroutine_runner [
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 04fe79c..496bcc8 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -245,7 +245,7 @@ def test_or_comm: TestM Unit := do
let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
-- This is due to delayed assignment
addTest $ LSpec.test "(2 parent)" (state2parent ==
- "((:mv) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
+ "((:mvd _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
diff --git a/Test/Serial.lean b/Test/Serial.lean
index f55c18f..093dd8b 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -52,6 +52,7 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
-- This tests `autoBoundImplicit`
("λ {α : Sort (u + 1)} => List α", "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
+ ("(2: Nat) <= (5: Nat)", "((:c LE.le) (:mv _uniq.37) (:mv _uniq.38) ((:c OfNat.ofNat) (:mv _uniq.23) (:lit 2) (:mv _uniq.24)) ((:c OfNat.ofNat) (:mv _uniq.33) (:lit 5) (:mv _uniq.34)))"),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (source, target) => do
let env ← MonadEnv.getEnv
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 84ca804..ad8ebdc 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -93,12 +93,50 @@ def test_list_brec_on (env: Environment): IO LSpec.TestSeq :=
tests := tests ++ test
return tests
+def test_partial_motive_instantiation (env: Environment): IO LSpec.TestSeq := do
+ let expr := "λ (n t: Nat) => n + 0 = n"
+ runMetaMSeq env $ runTermElabMInMeta do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "@Nat.brecOn")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let (expr, exprType) ← valueAndType expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ tests := tests ++ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Nat → Prop",
+ "Nat",
+ "∀ (t : Nat), Nat.below t → ?motive t",
+ "?motive ?m.69 = (n + 0 = n)",
+ ]))
+ let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
+ tests := tests ++ (LSpec.check "goal name" (major.name.toString = "_uniq.69"))
+
+ -- Assign motive to `λ x => x + _`
+ let (motive_assign, _) ← valueAndType "λ (x: Nat) => @Nat.add x + 0 = _"
+ motive.assign motive_assign
+
+ let test ← conduit.withContext do
+ let t := toString (← Meta.ppExpr $ ← conduit.getType)
+ return LSpec.check "conduit" (t = "(?m.69.add + 0 = ?m.140 ?m.69) = (n + 0 = n)")
+ tests := tests ++ test
+
+ return tests
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("type_extract", test_type_extract env),
- ("nat_brec_on", test_nat_brec_on env),
- ("list_brec_on", test_list_brec_on env),
+ ("Nat.brecOn", test_nat_brec_on env),
+ ("List.brecOn", test_list_brec_on env),
+ ("Nat.brecOn partial motive instantiation", test_partial_motive_instantiation env),
]
end Pantograph.Test.Tactic.MotivatedApply
From c04b363de70611f68e45c938a03dfff0be4efc34 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 12 May 2024 22:33:38 -0700
Subject: [PATCH 196/465] feat: Handle delay assigned mvars
---
Pantograph/Goal.lean | 3 ++-
Pantograph/Serial.lean | 35 +++++++++++++++++++++++++++++++++--
Test/Integration.lean | 4 ++--
Test/Metavar.lean | 2 +-
Test/Proofs.lean | 32 +++++++++++++++++++++++++++-----
5 files changed, 65 insertions(+), 11 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 11e5b20..e1d36b3 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -98,7 +98,8 @@ Brings into scope a list of goals
-/
protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
- .error s!"Goals not in scope"
+ let invalid_goals := goals.filter (λ goal => ¬ state.mvars.contains goal) |>.map (·.name.toString)
+ .error s!"Goals {invalid_goals} are not in scope"
else
-- Set goals to the goals that have not been assigned yet, similar to the `focus` tactic.
let unassigned := goals.filter (λ goal =>
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index cdb35ce..14a4002 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -32,7 +32,7 @@ def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
def instantiateAll (e: Expr): MetaM Expr := do
let e ← instantiateMVars e
let e ← unfoldAuxLemmas e
- let e ← instantiatePartialDelayedMVars e
+ --let e ← instantiatePartialDelayedMVars e
return e
--- Input Functions ---
@@ -101,6 +101,7 @@ partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
+
/--
Completely serializes an expression tree. Json not used due to compactness
@@ -109,7 +110,37 @@ A `_` symbol in the AST indicates automatic deductions not present in the origin
partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM String := do
self expr
where
- self (e: Expr): MetaM String :=
+ delayedMVarToSexp (e: Expr): MetaM (Option String) := do
+ let .mvar mvarId := e.getAppFn | return .none
+ let .some decl ← getDelayedMVarAssignment? mvarId | return .none
+ let mvarIdPending := decl.mvarIdPending
+ -- Print the function application e. See Lean's `withOverApp`
+ let args := e.getAppArgs
+
+ -- Not enough arguments to instantiate this
+ if args.size < decl.fvars.size then
+ return .none
+
+ let callee ← self $ ← instantiateMVars $ .mvar mvarIdPending
+ let sites ←
+ decl.fvars.zip args |>.mapM (λ (fvar, arg) => do
+ let fvarName := Expr.fvarId! fvar |>.name
+ return s!"({toString fvarName} {← self arg})"
+ )
+ let tailArgs ← args.toList.drop decl.fvars.size |>.mapM self
+
+
+ let sites := " ".intercalate sites.toList
+ let result := if tailArgs.isEmpty then
+ s!"(:subst {callee} {sites})"
+ else
+ let tailArgs := " ".intercalate tailArgs
+ s!"((:subst {callee} {sites}) {tailArgs})"
+ return .some result
+
+ self (e: Expr): MetaM String := do
+ if let .some result ← delayedMVarToSexp e then
+ return result
match e with
| .bvar deBruijnIndex =>
-- This is very common so the index alone is shown. Literals are handled below.
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 66b3637..9bd5db6 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -88,11 +88,11 @@ def test_tactic : IO LSpec.TestSeq :=
vars := #[{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
- name := "_uniq.17",
+ name := "_uniq.14",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.16", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ { name := "_uniq.13", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
],
}
subroutine_runner [
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 33fe8cb..0818881 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -263,7 +263,7 @@ def test_partial_continuation: TestM Unit := do
-- Continuation should fail if the state does not exist:
match state0.resume coupled_goals with
- | .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals not in scope")
+ | .error error => addTest $ LSpec.check "(continuation failure message)" (error = "Goals [_uniq.40, _uniq.41, _uniq.38, _uniq.47] are not in scope")
| .ok _ => addTest $ assertUnreachable "(continuation failure)"
-- Continuation should fail if some goals have not been solved
match state2.continue state1 with
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 496bcc8..0d31273 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -243,9 +243,10 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
- -- This is due to delayed assignment
+ let substHead := "((:c Or.casesOn) (:fv _uniq.10) (:fv _uniq.13) (:lambda t._@._hyg.26 ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:forall h ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) 0) ((:c Or) (:fv _uniq.13) (:fv _uniq.10)))) (:fv _uniq.16) (:lambda h._@._hyg.27 (:fv _uniq.10) (:subst (:lambda h._@._hyg.28 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inl) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47))) (:subst (:subst (:mv _uniq.59) (_uniq.54 (:fv _uniq.16)) (_uniq.55 (:fv _uniq.50))) (_uniq.50 0))) (_uniq.47 0))) (:lambda h._@._hyg.29 (:fv _uniq.13) (:subst (:lambda h._@._hyg.30 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inr) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60))) (:subst (:subst (:mv _uniq.72) (_uniq.67 (:fv _uniq.16)) (_uniq.68 (:fv _uniq.63))) (_uniq.63 0))) (_uniq.60 0))))"
+ let extra := "((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
- "((:mvd _uniq.43) (:fv _uniq.16) ((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))")
+ s!"((:subst {substHead} (_uniq.41 (:fv _uniq.16))) {extra}")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
@@ -769,13 +770,34 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let state2b ← match state3m2.resume (state3m2.goals ++ state2.goals) with
+ addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = ["_uniq.85", "_uniq.86", "_uniq.84"]
+ let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
+ let state2b ← match state3m2.resume [conduit] with
| .ok state => pure state
| .error e => do
addTest $ assertUnreachable e
return ()
- addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
- #[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
+
+ let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
+ let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
+ let fvN := "_uniq.63"
+ addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
+ #[
+ {
+ name := "_uniq.70",
+ userName? := .some "conduit",
+ target := {
+ pp? := .some "?m.79 ?m.68 = (n + 0 = n)",
+ sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv _uniq.84) (:mv _uniq.85) (:mv _uniq.86)) (_uniq.77 (:mv _uniq.68))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+ },
+ vars := #[{
+ name := fvN,
+ userName := "n",
+ type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
+ isInaccessible? := .some false
+ }],
+ }
+ ])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From f813d4a8dd201a01674917b18d1d39c7ec8138af Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 May 2024 13:49:05 -0700
Subject: [PATCH 197/465] refactor: Delayed mvar instantiation function
---
Pantograph/Serial.lean | 43 +++++++++++++++++++++++++-----------------
Test/Proofs.lean | 8 +++++---
2 files changed, 31 insertions(+), 20 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 14a4002..a95180e 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -101,6 +101,26 @@ partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
+structure DelayedMVarInvocation where
+ mvarIdPending: MVarId
+ args: Array (FVarId × Expr)
+ tail: Array Expr
+
+def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
+ let .mvar mvarId := e.getAppFn | return .none
+ let .some decl ← getDelayedMVarAssignment? mvarId | return .none
+ let mvarIdPending := decl.mvarIdPending
+ -- Print the function application e. See Lean's `withOverApp`
+ let args := e.getAppArgs
+
+ assert! args.size >= decl.fvars.size
+
+ return .some {
+ mvarIdPending,
+ args := decl.fvars.map (·.fvarId!) |>.zip args,
+ tail := args.toList.drop decl.fvars.size |>.toArray,
+ }
+
/--
Completely serializes an expression tree. Json not used due to compactness
@@ -111,30 +131,19 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
self expr
where
delayedMVarToSexp (e: Expr): MetaM (Option String) := do
- let .mvar mvarId := e.getAppFn | return .none
- let .some decl ← getDelayedMVarAssignment? mvarId | return .none
- let mvarIdPending := decl.mvarIdPending
- -- Print the function application e. See Lean's `withOverApp`
- let args := e.getAppArgs
-
- -- Not enough arguments to instantiate this
- if args.size < decl.fvars.size then
- return .none
-
- let callee ← self $ ← instantiateMVars $ .mvar mvarIdPending
- let sites ←
- decl.fvars.zip args |>.mapM (λ (fvar, arg) => do
- let fvarName := Expr.fvarId! fvar |>.name
- return s!"({toString fvarName} {← self arg})"
+ let .some invocation ← toDelayedMVarInvocation e | return .none
+ let callee ← self $ ← instantiateMVars $ .mvar invocation.mvarIdPending
+ let sites ← invocation.args.mapM (λ (fvar, arg) => do
+ pure s!"({toString fvar.name} {← self arg})"
)
- let tailArgs ← args.toList.drop decl.fvars.size |>.mapM self
+ let tailArgs ← invocation.tail.mapM self
let sites := " ".intercalate sites.toList
let result := if tailArgs.isEmpty then
s!"(:subst {callee} {sites})"
else
- let tailArgs := " ".intercalate tailArgs
+ let tailArgs := " ".intercalate tailArgs.toList
s!"((:subst {callee} {sites}) {tailArgs})"
return .some result
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 0d31273..54b5016 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -748,10 +748,11 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ let major := "_uniq.68"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
+ buildNamedGoal major [("n", "Nat")] "Nat",
buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
])
@@ -770,7 +771,8 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = ["_uniq.85", "_uniq.86", "_uniq.84"]
+ let (eqL, eqR, eqT) := ("_uniq.85", "_uniq.86", "_uniq.84")
+ addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with
| .ok state => pure state
@@ -788,7 +790,7 @@ def test_nat_zero_add_alt: TestM Unit := do
userName? := .some "conduit",
target := {
pp? := .some "?m.79 ?m.68 = (n + 0 = n)",
- sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv _uniq.84) (:mv _uniq.85) (:mv _uniq.86)) (_uniq.77 (:mv _uniq.68))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+ sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) (_uniq.77 (:mv {major}))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
},
vars := #[{
name := fvN,
From bc09f4a29df6e32a1b016b6b563d58b9a26f2411 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 May 2024 13:58:50 -0700
Subject: [PATCH 198/465] refactor: Expr related functions to Expr.lean
---
Pantograph/Expr.lean | 52 +++++++++++++++++++++++++++++++++++++++++
Pantograph/Library.lean | 4 ++++
Pantograph/Serial.lean | 43 +---------------------------------
3 files changed, 57 insertions(+), 42 deletions(-)
create mode 100644 Pantograph/Expr.lean
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
new file mode 100644
index 0000000..14d063e
--- /dev/null
+++ b/Pantograph/Expr.lean
@@ -0,0 +1,52 @@
+import Lean
+
+open Lean
+
+namespace Pantograph
+
+def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
+
+/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
+def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
+ Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+
+def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
+ Meta.transform e
+ (pre := fun e => e.withApp fun f args => do
+ if let .mvar mvarId := f then
+ if let some decl ← getDelayedMVarAssignment? mvarId then
+ if args.size ≥ decl.fvars.size then
+ let pending ← instantiateMVars (.mvar decl.mvarIdPending)
+ if !pending.isMVar then
+ return .visit <| (← Meta.mkLambdaFVars decl.fvars pending).beta args
+ return .continue)
+
+@[export pantograph_instantiate_all_meta_m]
+def instantiateAll (e: Expr): MetaM Expr := do
+ let e ← instantiateMVars e
+ let e ← unfoldAuxLemmas e
+ --let e ← instantiatePartialDelayedMVars e
+ return e
+
+structure DelayedMVarInvocation where
+ mvarIdPending: MVarId
+ args: Array (FVarId × Expr)
+ tail: Array Expr
+
+@[export pantograph_to_delayed_mvar_invocation_meta_m]
+def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
+ let .mvar mvarId := e.getAppFn | return .none
+ let .some decl ← getDelayedMVarAssignment? mvarId | return .none
+ let mvarIdPending := decl.mvarIdPending
+ -- Print the function application e. See Lean's `withOverApp`
+ let args := e.getAppArgs
+
+ assert! args.size >= decl.fvars.size
+
+ return .some {
+ mvarIdPending,
+ args := decl.fvars.map (·.fvarId!) |>.zip args,
+ tail := args.toList.drop decl.fvars.size |>.toArray,
+ }
+
+end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 59d7adc..9c64b69 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -78,6 +78,10 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
(trustLevel := 1)
return { env := env }
+@[export pantograph_create_meta_context]
+def createMetaContext: IO Lean.Meta.Context := do
+ return {}
+
@[export pantograph_env_catalog_m]
def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index a95180e..58d4ea7 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -2,6 +2,7 @@
All serialisation functions
-/
import Lean
+import Pantograph.Expr
import Pantograph.Protocol
import Pantograph.Goal
@@ -10,30 +11,8 @@ open Lean
-- Symbol processing functions --
-def Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
-
namespace Pantograph
-/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
- Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
-
-def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
- Meta.transform e
- (pre := fun e => e.withApp fun f args => do
- if let .mvar mvarId := f then
- if let some decl ← getDelayedMVarAssignment? mvarId then
- if args.size ≥ decl.fvars.size then
- let pending ← instantiateMVars (.mvar decl.mvarIdPending)
- if !pending.isMVar then
- return .visit <| (← Meta.mkLambdaFVars decl.fvars pending).beta args
- return .continue)
-
-def instantiateAll (e: Expr): MetaM Expr := do
- let e ← instantiateMVars e
- let e ← unfoldAuxLemmas e
- --let e ← instantiatePartialDelayedMVars e
- return e
--- Input Functions ---
@@ -101,26 +80,6 @@ partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
-structure DelayedMVarInvocation where
- mvarIdPending: MVarId
- args: Array (FVarId × Expr)
- tail: Array Expr
-
-def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
- let .mvar mvarId := e.getAppFn | return .none
- let .some decl ← getDelayedMVarAssignment? mvarId | return .none
- let mvarIdPending := decl.mvarIdPending
- -- Print the function application e. See Lean's `withOverApp`
- let args := e.getAppArgs
-
- assert! args.size >= decl.fvars.size
-
- return .some {
- mvarIdPending,
- args := decl.fvars.map (·.fvarId!) |>.zip args,
- tail := args.toList.drop decl.fvars.size |>.toArray,
- }
-
/--
Completely serializes an expression tree. Json not used due to compactness
From 5c7bb288b2914d5179fa117289e4455893b3ddd2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 14 May 2024 19:08:25 -0700
Subject: [PATCH 199/465] feat: Display full free variable list in subst
---
Pantograph/Expr.lean | 12 ++++++++++--
Pantograph/Serial.lean | 8 +++++---
Test/Proofs.lean | 8 ++++----
3 files changed, 19 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 14d063e..7e691d5 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -30,7 +30,7 @@ def instantiateAll (e: Expr): MetaM Expr := do
structure DelayedMVarInvocation where
mvarIdPending: MVarId
- args: Array (FVarId × Expr)
+ args: Array (FVarId × (Option Expr))
tail: Array Expr
@[export pantograph_to_delayed_mvar_invocation_meta_m]
@@ -38,14 +38,22 @@ def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := d
let .mvar mvarId := e.getAppFn | return .none
let .some decl ← getDelayedMVarAssignment? mvarId | return .none
let mvarIdPending := decl.mvarIdPending
+ let mvarDecl ← mvarIdPending.getDecl
-- Print the function application e. See Lean's `withOverApp`
let args := e.getAppArgs
assert! args.size >= decl.fvars.size
+ let fvarArgMap: HashMap FVarId Expr := HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
+ let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
+ let fvarId := localDecl.fvarId
+ let a := fvarArgMap.find? fvarId
+ return acc ++ [(fvarId, a)]
+
+ assert! decl.fvars.all (λ fvar => mvarDecl.lctx.findFVar? fvar |>.isSome)
return .some {
mvarIdPending,
- args := decl.fvars.map (·.fvarId!) |>.zip args,
+ args := subst.toArray,
tail := args.toList.drop decl.fvars.size |>.toArray,
}
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 58d4ea7..3d46ee2 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -92,12 +92,14 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
delayedMVarToSexp (e: Expr): MetaM (Option String) := do
let .some invocation ← toDelayedMVarInvocation e | return .none
let callee ← self $ ← instantiateMVars $ .mvar invocation.mvarIdPending
- let sites ← invocation.args.mapM (λ (fvar, arg) => do
- pure s!"({toString fvar.name} {← self arg})"
+ let sites ← invocation.args.mapM (λ (fvarId, arg) => do
+ let arg := match arg with
+ | .some arg => arg
+ | .none => .fvar fvarId
+ self arg
)
let tailArgs ← invocation.tail.mapM self
-
let sites := " ".intercalate sites.toList
let result := if tailArgs.isEmpty then
s!"(:subst {callee} {sites})"
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 54b5016..b09e403 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -243,10 +243,10 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
- let substHead := "((:c Or.casesOn) (:fv _uniq.10) (:fv _uniq.13) (:lambda t._@._hyg.26 ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:forall h ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) 0) ((:c Or) (:fv _uniq.13) (:fv _uniq.10)))) (:fv _uniq.16) (:lambda h._@._hyg.27 (:fv _uniq.10) (:subst (:lambda h._@._hyg.28 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inl) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47))) (:subst (:subst (:mv _uniq.59) (_uniq.54 (:fv _uniq.16)) (_uniq.55 (:fv _uniq.50))) (_uniq.50 0))) (_uniq.47 0))) (:lambda h._@._hyg.29 (:fv _uniq.13) (:subst (:lambda h._@._hyg.30 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inr) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60))) (:subst (:subst (:mv _uniq.72) (_uniq.67 (:fv _uniq.16)) (_uniq.68 (:fv _uniq.63))) (_uniq.63 0))) (_uniq.60 0))))"
- let extra := "((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16)))"
+ let substHead := "((:c Or.casesOn) (:fv _uniq.10) (:fv _uniq.13) (:lambda t._@._hyg.26 ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:forall h ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) 0) ((:c Or) (:fv _uniq.13) (:fv _uniq.10)))) (:fv _uniq.16) (:lambda h._@._hyg.27 (:fv _uniq.10) (:subst (:lambda h._@._hyg.28 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inl) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47))) (:subst (:subst (:mv _uniq.59) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47) (:fv _uniq.16) (:fv _uniq.50)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.47) 0)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) 0)) (:lambda h._@._hyg.29 (:fv _uniq.13) (:subst (:lambda h._@._hyg.30 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inr) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60))) (:subst (:subst (:mv _uniq.72) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60) (:fv _uniq.16) (:fv _uniq.63)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.60) 0)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) 0)))"
+ let extra := "((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
- s!"((:subst {substHead} (_uniq.41 (:fv _uniq.16))) {extra}")
+ s!"((:subst {substHead} (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.16)) {extra})")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
@@ -790,7 +790,7 @@ def test_nat_zero_add_alt: TestM Unit := do
userName? := .some "conduit",
target := {
pp? := .some "?m.79 ?m.68 = (n + 0 = n)",
- sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) (_uniq.77 (:mv {major}))) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+ sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) (:fv {fvN}) (:mv {major})) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
},
vars := #[{
name := fvN,
From cf174280014dcfa3533e15b85a455bd2146e2951 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 15 May 2024 21:34:15 -0700
Subject: [PATCH 200/465] fix: Panic in partial instantiation
---
Pantograph/Expr.lean | 10 ++++++++--
Test/Integration.lean | 4 ++--
Test/Proofs.lean | 6 +++---
3 files changed, 13 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 7e691d5..85c7f35 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -14,18 +14,24 @@ def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
Meta.transform e
(pre := fun e => e.withApp fun f args => do
if let .mvar mvarId := f then
+ if ← mvarId.isAssigned then
+ return .visit <| (← instantiateMVars e)
if let some decl ← getDelayedMVarAssignment? mvarId then
if args.size ≥ decl.fvars.size then
+ -- Do not use instantiateMVars here. Only one step of instantiation should happen.
let pending ← instantiateMVars (.mvar decl.mvarIdPending)
if !pending.isMVar then
- return .visit <| (← Meta.mkLambdaFVars decl.fvars pending).beta args
+ let pending := pending.abstract decl.fvars
+ let pending := pending.instantiateRevRange 0 decl.fvars.size args
+ let pending := mkAppRange pending decl.fvars.size args.size args
+ return .visit <| pending
return .continue)
@[export pantograph_instantiate_all_meta_m]
def instantiateAll (e: Expr): MetaM Expr := do
let e ← instantiateMVars e
+ let e ← instantiatePartialDelayedMVars e
let e ← unfoldAuxLemmas e
- --let e ← instantiatePartialDelayedMVars e
return e
structure DelayedMVarInvocation where
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9bd5db6..66b3637 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -88,11 +88,11 @@ def test_tactic : IO LSpec.TestSeq :=
vars := #[{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
- name := "_uniq.14",
+ name := "_uniq.17",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.13", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ { name := "_uniq.16", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
],
}
subroutine_runner [
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index b09e403..ea6ff11 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -771,7 +771,7 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let (eqL, eqR, eqT) := ("_uniq.85", "_uniq.86", "_uniq.84")
+ let (eqL, eqR, eqT) := ("_uniq.88", "_uniq.89", "_uniq.87")
addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with
@@ -789,8 +789,8 @@ def test_nat_zero_add_alt: TestM Unit := do
name := "_uniq.70",
userName? := .some "conduit",
target := {
- pp? := .some "?m.79 ?m.68 = (n + 0 = n)",
- sexp? := .some s!"((:c Eq) (:sort 0) (:subst ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) (:fv {fvN}) (:mv {major})) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+ pp? := .some "(?motive.a = ?motive.a) = (n + 0 = n)",
+ sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
},
vars := #[{
name := fvN,
From 6ad24b72d474f015543e425f148fb7a3dc7b81da Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 16 May 2024 10:31:38 -0700
Subject: [PATCH 201/465] fix: Nested delayed assignment instantiation
---
Pantograph/Expr.lean | 93 ++++++++++++++++++++++++++++++++++--------
Pantograph/Serial.lean | 4 +-
Test/Proofs.lean | 37 ++++++++++++-----
3 files changed, 106 insertions(+), 28 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 85c7f35..9f4b8d9 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -10,35 +10,94 @@ def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _
def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
-def instantiatePartialDelayedMVars (e: Expr): MetaM Expr := do
- Meta.transform e
+/--
+Force the instantiation of delayed metavariables even if they cannot be fully
+instantiated. This is used during resumption.
+
+Since Lean 4 does not have an `Expr` constructor corresponding to delayed
+metavariables, any delayed metavariables must be recursively handled by this
+function to ensure that nested delayed metavariables can be properly processed.
+The caveat is this recursive call will lead to infinite recursion if a loop
+between metavariable assignment exists.
+
+This function ensures any metavariable in the result is either
+1. Delayed assigned with its pending mvar not assigned in any form
+2. Not assigned (delay or not)
+ -/
+partial def instantiateDelayedMVars (eOrig: Expr): MetaM Expr := do
+ --let padding := String.join $ List.replicate level " "
+ --IO.println s!"{padding}Starting {toString eOrig}"
+ let result ← Meta.transform (← instantiateMVars eOrig)
(pre := fun e => e.withApp fun f args => do
+ --IO.println s!"{padding} V {toString e}"
if let .mvar mvarId := f then
if ← mvarId.isAssigned then
- return .visit <| (← instantiateMVars e)
- if let some decl ← getDelayedMVarAssignment? mvarId then
- if args.size ≥ decl.fvars.size then
- -- Do not use instantiateMVars here. Only one step of instantiation should happen.
- let pending ← instantiateMVars (.mvar decl.mvarIdPending)
- if !pending.isMVar then
- let pending := pending.abstract decl.fvars
- let pending := pending.instantiateRevRange 0 decl.fvars.size args
- let pending := mkAppRange pending decl.fvars.size args.size args
- return .visit <| pending
- return .continue)
+ --IO.println s!"{padding} A ?{mvarId.name}"
+ return .continue <| .some (← self e)
+ if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
+ -- No progress can be made on this
+ if !(← mvarIdPending.isAssigned) then
+ --IO.println s!"{padding} D/T1: {toString e}"
+ let args ← args.mapM self
+ let result := mkAppN f args
+ return .done result
+ --IO.println s!"{padding} D ?{mvarId.name} := [{fvars.size}] ?{mvarIdPending.name}"
+ -- This asstion fails when a tactic or elaboration function is
+ -- implemented incorrectly. See `instantiateExprMVars`
+ if args.size < fvars.size then
+ --IO.println s!"{padding} Illegal callsite: {args.size} < {fvars.size}"
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
+ assert! !(← mvarIdPending.isDelayedAssigned)
+ let pending ← self (.mvar mvarIdPending)
+ if pending == .mvar mvarIdPending then
+ -- No progress could be made on this case
+ --IO.println s!"{padding}D/N {toString e}"
+ assert! !(← mvarIdPending.isAssigned)
+ assert! !(← mvarIdPending.isDelayedAssigned)
+ --else if pending.isMVar then
+ -- assert! !(← pending.mvarId!.isAssigned)
+ -- assert! !(← pending.mvarId!.isDelayedAssigned)
+ -- -- Progress made, but this is now another delayed assigned mvar
+ -- let nextMVarId ← mkFreshMVarId
+ -- assignDelayedMVar nextMVarId fvars pending.mvarId!
+ -- let args ← args.mapM self
+ -- let result := mkAppN (.mvar nextMVarId) args
+ -- return .done result
+ else
+ -- Progress has been made on this mvar
+ let pending := pending.abstract fvars
+ let args ← args.mapM self
+ -- Craete the function call structure
+ let subst := pending.instantiateRevRange 0 fvars.size args
+ let result := mkAppRange subst fvars.size args.size args
+ --IO.println s!"{padding}D/T2 {toString result}"
+ return .done result
+ return .continue)
+ --IO.println s!"{padding}Result {toString result}"
+ return result
+ where
+ self e := instantiateDelayedMVars e
+
+/--
+Convert an expression to an equiavlent form with
+1. No nested delayed assigned mvars
+2. No aux lemmas
+3. No assigned mvars
+ -/
@[export pantograph_instantiate_all_meta_m]
def instantiateAll (e: Expr): MetaM Expr := do
- let e ← instantiateMVars e
- let e ← instantiatePartialDelayedMVars e
+ let e ← instantiateDelayedMVars e
let e ← unfoldAuxLemmas e
return e
structure DelayedMVarInvocation where
mvarIdPending: MVarId
args: Array (FVarId × (Option Expr))
+ -- Extra arguments applied to the result of this substitution
tail: Array Expr
+-- The pending mvar of any delayed assigned mvar must not be assigned in any way.
@[export pantograph_to_delayed_mvar_invocation_meta_m]
def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
let .mvar mvarId := e.getAppFn | return .none
@@ -48,7 +107,9 @@ def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := d
-- Print the function application e. See Lean's `withOverApp`
let args := e.getAppArgs
- assert! args.size >= decl.fvars.size
+ assert! args.size ≥ decl.fvars.size
+ assert! !(← mvarIdPending.isAssigned)
+ assert! !(← mvarIdPending.isDelayedAssigned)
let fvarArgMap: HashMap FVarId Expr := HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
let fvarId := localDecl.fvarId
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 3d46ee2..17dee2d 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -91,7 +91,7 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
where
delayedMVarToSexp (e: Expr): MetaM (Option String) := do
let .some invocation ← toDelayedMVarInvocation e | return .none
- let callee ← self $ ← instantiateMVars $ .mvar invocation.mvarIdPending
+ let callee ← self $ .mvar invocation.mvarIdPending
let sites ← invocation.args.mapM (λ (fvarId, arg) => do
let arg := match arg with
| .some arg => arg
@@ -264,7 +264,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
- target := (← serializeExpression options (← instantiateAll mvarDecl.type)),
+ target := (← serializeExpression options (← instantiate mvarDecl.type)),
vars := vars.reverse.toArray
}
where
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ea6ff11..aa730ba 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -226,11 +226,25 @@ def test_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p ∨ q")] "q ∨ p"])
+ let fvP := "_uniq.10"
+ let fvQ := "_uniq.13"
+ let fvH := "_uniq.16"
+ let state1g0 := "_uniq.17"
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)) =
+ #[{
+ name := state1g0,
+ target := { pp? := .some "q ∨ p" },
+ vars := #[
+ { name := fvP, userName := "p", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
+ { name := fvQ, userName := "q", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
+ { name := fvH, userName := "h", type? := .some { pp? := .some "p ∨ q" }, isInaccessible? := .some false }
+ ]
+ }])
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
+ let state1parent ← serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
+ addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) (:fv {fvP}) (:fv {fvQ}) 0))))")
let tactic := "cases h"
let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
@@ -239,22 +253,25 @@ def test_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
+ let (caseL, caseR) := ("_uniq.62", "_uniq.75")
+ addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) =
+ #[caseL, caseR])
addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
- let state2parent ← serializeExpressionSexp state2.parentExpr?.get! (sanitize := false)
- let substHead := "((:c Or.casesOn) (:fv _uniq.10) (:fv _uniq.13) (:lambda t._@._hyg.26 ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:forall h ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) 0) ((:c Or) (:fv _uniq.13) (:fv _uniq.10)))) (:fv _uniq.16) (:lambda h._@._hyg.27 (:fv _uniq.10) (:subst (:lambda h._@._hyg.28 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inl) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47))) (:subst (:subst (:mv _uniq.59) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.47) (:fv _uniq.16) (:fv _uniq.50)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.47) 0)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) 0)) (:lambda h._@._hyg.29 (:fv _uniq.13) (:subst (:lambda h._@._hyg.30 ((:c Eq) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16) ((:c Or.inr) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60))) (:subst (:subst (:mv _uniq.72) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.60) (:fv _uniq.16) (:fv _uniq.63)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.60) 0)) (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) 0)))"
- let extra := "((:c Eq.refl) ((:c Or) (:fv _uniq.10) (:fv _uniq.13)) (:fv _uniq.16))"
+ let state2parent ← serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
+ let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
+ let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
- s!"((:subst {substHead} (:fv _uniq.10) (:fv _uniq.13) (:fv _uniq.16) (:fv _uniq.16)) {extra})")
+ s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) (:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) {orPQ} (:fv {fvH}) 0) {orQP})) (:fv {fvH}) (:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:mv {caseL}))) (:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:mv {caseR}))) ((:c Eq.refl) {orPQ} (:fv {fvH})))")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let state3_1parent ← serializeExpressionSexp state3_1.parentExpr?.get! (sanitize := false)
- addTest $ LSpec.test "(3_1 parent)" (state3_1parent == "((:c Or.inr) (:fv _uniq.13) (:fv _uniq.10) (:mv _uniq.78))")
+ let state3_1parent ← serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
+ addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.87))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
@@ -262,8 +279,8 @@ def test_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check " assumption" state4_1.goals.isEmpty
- let state4_1parent ← serializeExpressionSexp state4_1.parentExpr?.get! (sanitize := false)
- addTest $ LSpec.test "(4_1 parent)" (state4_1parent == "(:fv _uniq.47)")
+ let state4_1parent ← instantiateAll state4_1.parentExpr?.get!
+ addTest $ LSpec.test "(4_1 parent)" state4_1parent.isFVar
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
let state3_2 ← match ← state2.tryTactic (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
From e165e41efa8a65628501f6b8390b14040eb0ac62 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 17 May 2024 20:31:45 -0700
Subject: [PATCH 202/465] chore: Version bump to v4.8.0-rc1
---
Pantograph/Goal.lean | 4 ++--
flake.lock | 8 ++++----
flake.nix | 2 +-
lean-toolchain | 2 +-
4 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 484ff51..e6a59d0 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -90,7 +90,7 @@ def executeTactic (state: Elab.Tactic.SavedState) (goal: MVarId) (tactic: Syntax
Elab.Tactic.evalTactic stx
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
+ let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .error errors
else
return .ok (← MonadBacktrack.saveState)
@@ -161,7 +161,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
- let errors ← (messages.map Message.data).mapM fun md => md.toString
+ let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .failure errors
let prevMCtx := state.savedState.term.meta.meta.mctx
let nextMCtx ← getMCtx
diff --git a/flake.lock b/flake.lock
index 39888a8..1a50363 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,16 +42,16 @@
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
- "lastModified": 1711508550,
- "narHash": "sha256-UK4DnYmwXLcqHA316Zkn0cnujdYlxqUf+b6S4l56Q3s=",
+ "lastModified": 1714704934,
+ "narHash": "sha256-q0kLyIahUXolkSrBZSegPF+R99WAH1YC96JfKoFntDE=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
+ "rev": "dcccfb73cb247e9478220375ab7de03f7c67e505",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "b4caee80a3dfc5c9619d88b16c40cc3db90da4e2",
+ "ref": "v4.8.0-rc1",
"repo": "lean4",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 2458805..ad40a3f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -5,8 +5,8 @@
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
- url = "github:leanprover/lean4?ref=b4caee80a3dfc5c9619d88b16c40cc3db90da4e2";
# Do not follow input's nixpkgs since it could cause build failures
+ url = "github:leanprover/lean4?ref=v4.8.0-rc1";
};
lspec = {
url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
diff --git a/lean-toolchain b/lean-toolchain
index c630636..d8a6d7e 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:nightly-2024-03-27
+leanprover/lean4:v4.8.0-rc1
From 2f951c8fefcf3566fd5f2b38c508db96ef5cba00 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 19 May 2024 15:43:10 -0700
Subject: [PATCH 203/465] fix: Decoupling of mvars during instantiation
---
Pantograph/Expr.lean | 114 ++++++++++++++++++++++------------------
Pantograph/Goal.lean | 10 ++++
Pantograph/Library.lean | 10 ++--
Pantograph/Serial.lean | 2 +-
Test/Proofs.lean | 51 ++++++++++++++----
5 files changed, 122 insertions(+), 65 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 9f4b8d9..8f890e3 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -12,7 +12,8 @@ def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
/--
Force the instantiation of delayed metavariables even if they cannot be fully
-instantiated. This is used during resumption.
+instantiated. This is used during resumption to provide diagnostic data about
+the current goal.
Since Lean 4 does not have an `Expr` constructor corresponding to delayed
metavariables, any delayed metavariables must be recursively handled by this
@@ -24,60 +25,73 @@ This function ensures any metavariable in the result is either
1. Delayed assigned with its pending mvar not assigned in any form
2. Not assigned (delay or not)
-/
-partial def instantiateDelayedMVars (eOrig: Expr): MetaM Expr := do
- --let padding := String.join $ List.replicate level " "
+partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
+ --let padding := String.join $ List.replicate level "│ "
--IO.println s!"{padding}Starting {toString eOrig}"
- let result ← Meta.transform (← instantiateMVars eOrig)
+ let mut result ← Meta.transform (← instantiateMVars eOrig)
(pre := fun e => e.withApp fun f args => do
- --IO.println s!"{padding} V {toString e}"
- if let .mvar mvarId := f then
- if ← mvarId.isAssigned then
- --IO.println s!"{padding} A ?{mvarId.name}"
- return .continue <| .some (← self e)
- if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
- -- No progress can be made on this
- if !(← mvarIdPending.isAssigned) then
- --IO.println s!"{padding} D/T1: {toString e}"
- let args ← args.mapM self
- let result := mkAppN f args
- return .done result
+ let .mvar mvarId := f | return .continue
+ --IO.println s!"{padding}├V {e}"
+ let mvarDecl ← mvarId.getDecl
- --IO.println s!"{padding} D ?{mvarId.name} := [{fvars.size}] ?{mvarIdPending.name}"
- -- This asstion fails when a tactic or elaboration function is
- -- implemented incorrectly. See `instantiateExprMVars`
- if args.size < fvars.size then
- --IO.println s!"{padding} Illegal callsite: {args.size} < {fvars.size}"
- throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
- assert! !(← mvarIdPending.isDelayedAssigned)
- let pending ← self (.mvar mvarIdPending)
- if pending == .mvar mvarIdPending then
- -- No progress could be made on this case
- --IO.println s!"{padding}D/N {toString e}"
- assert! !(← mvarIdPending.isAssigned)
- assert! !(← mvarIdPending.isDelayedAssigned)
- --else if pending.isMVar then
- -- assert! !(← pending.mvarId!.isAssigned)
- -- assert! !(← pending.mvarId!.isDelayedAssigned)
- -- -- Progress made, but this is now another delayed assigned mvar
- -- let nextMVarId ← mkFreshMVarId
- -- assignDelayedMVar nextMVarId fvars pending.mvarId!
- -- let args ← args.mapM self
- -- let result := mkAppN (.mvar nextMVarId) args
- -- return .done result
- else
- -- Progress has been made on this mvar
- let pending := pending.abstract fvars
- let args ← args.mapM self
- -- Craete the function call structure
- let subst := pending.instantiateRevRange 0 fvars.size args
- let result := mkAppRange subst fvars.size args.size args
- --IO.println s!"{padding}D/T2 {toString result}"
- return .done result
- return .continue)
- --IO.println s!"{padding}Result {toString result}"
+ -- This is critical to maintaining the interdependency of metavariables.
+ -- Without setting `.syntheticOpaque`, Lean's metavariable elimination
+ -- system will not make the necessary delayed assigned mvars in case of
+ -- nested mvars.
+ mvarId.setKind .syntheticOpaque
+
+ let lctx ← MonadLCtx.getLCtx
+ if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
+ let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
+ | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
+ | .none => acc) []
+ panic! s!"Local context variable violation: {violations}"
+
+ if let .some assign ← getExprMVarAssignment? mvarId then
+ --IO.println s!"{padding}├A ?{mvarId.name}"
+ assert! !(← mvarId.isDelayedAssigned)
+ return .visit (mkAppN assign args)
+ else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
+ --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
+
+ if args.size < fvars.size then
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments End"
+ if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
+ --IO.println s!"{padding}├T1"
+ let result := mkAppN f args
+ return .done result
+
+ let pending ← mvarIdPending.withContext do
+ let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
+ --IO.println s!"{padding}├Pre: {inner}"
+ let r := (← Expr.abstractM inner fvars).instantiateRev args
+ pure r
+
+ -- Tail arguments
+ let result := mkAppN pending (List.drop fvars.size args.toList |>.toArray)
+ --IO.println s!"{padding}├MD {result}"
+ return .done result
+ else
+ assert! !(← mvarId.isAssigned)
+ assert! !(← mvarId.isDelayedAssigned)
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments End"
+
+ --IO.println s!"{padding}├M ?{mvarId.name}"
+ return .done (mkAppN f args))
+ --IO.println s!"{padding}└Result {result}"
return result
where
- self e := instantiateDelayedMVars e
+ self e := instantiateDelayedMVars e --(level := level + 1)
/--
Convert an expression to an equiavlent form with
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index e1d36b3..8efc20f 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -62,6 +62,16 @@ protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
+
+protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
+ let metaM := mvarId.withContext m
+ metaM.run' (← read) state.savedState.term.meta.meta
+
+protected def GoalState.withParentContext (state: GoalState) (m: MetaM α): MetaM α := do
+ state.withContext state.parentMVar?.get! m
+protected def GoalState.withRootContext (state: GoalState) (m: MetaM α): MetaM α := do
+ state.withContext state.root m
+
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 9c64b69..34e1ecc 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -179,10 +179,12 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Proto
runMetaM do
state.restoreMetaM
return {
- root? := ← state.rootExpr?.mapM (λ expr => do
- serializeExpression options (← instantiateAll expr)),
- parent? := ← state.parentExpr?.mapM (λ expr => do
- serializeExpression options (← instantiateAll expr)),
+ root? := ← state.rootExpr?.mapM (λ expr =>
+ state.withRootContext do
+ serializeExpression options (← instantiateAll expr)),
+ parent? := ← state.parentExpr?.mapM (λ expr =>
+ state.withParentContext do
+ serializeExpression options (← instantiateAll expr)),
}
@[export pantograph_goal_diag_m]
def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : Lean.CoreM String :=
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 17dee2d..a6c0ece 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -264,7 +264,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
- target := (← serializeExpression options (← instantiate mvarDecl.type)),
+ target := (← serializeExpression options (← instantiateMVars (← instantiate mvarDecl.type))),
vars := vars.reverse.toArray
}
where
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index aa730ba..9c45138 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -84,6 +84,27 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
| .ok (_, a) =>
return a
+def test_identity: TestM Unit := do
+ let state? ← startProof (.expr "∀ (p: Prop), p → p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let tactic := "intro p h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let inner := "_uniq.12"
+ addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.name) =
+ #[inner])
+ let state1parent ← state1.withParentContext do
+ serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
+ addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda h 0 (:subst (:mv {inner}) 1 0)))")
+
-- Individual test cases
example: ∀ (a b: Nat), a + b = b + a := by
intro n m
@@ -243,8 +264,9 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
- let state1parent ← serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
- addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) (:fv {fvP}) (:fv {fvQ}) 0))))")
+ let state1parent ← state1.withParentContext do
+ serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
+ addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))")
let tactic := "cases h"
let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
| .success state => pure state
@@ -253,25 +275,31 @@ def test_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
- let (caseL, caseR) := ("_uniq.62", "_uniq.75")
+ let (caseL, caseR) := ("_uniq.64", "_uniq.77")
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) =
#[caseL, caseR])
- addTest $ LSpec.check "(2 parent)" state2.parentExpr?.isSome
+ addTest $ LSpec.check "(2 parent exists)" state2.parentExpr?.isSome
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
- let state2parent ← serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
+ let state2parent ← state2.withParentContext do
+ serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
+ let motive := s!"(:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
+ let caseL := s!"(:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
+ let caseR := s!"(:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
+ let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
- s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) (:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) {orPQ} (:fv {fvH}) 0) {orQP})) (:fv {fvH}) (:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:mv {caseL}))) (:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:mv {caseR}))) ((:c Eq.refl) {orPQ} (:fv {fvH})))")
+ s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let state3_1parent ← serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
- addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.87))")
+ let state3_1parent ← state3_1.withParentContext do
+ serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
+ addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
| .success state => pure state
@@ -800,14 +828,16 @@ def test_nat_zero_add_alt: TestM Unit := do
let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
let fvN := "_uniq.63"
+ let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
+ let substOf (mv: String) := s!"(:subst (:mv {mv}) (:fv {fvN}) (:mv {major}))"
addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
#[
{
name := "_uniq.70",
userName? := .some "conduit",
target := {
- pp? := .some "(?motive.a = ?motive.a) = (n + 0 = n)",
- sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) (:mv {eqT}) (:mv {eqL}) (:mv {eqR})) ((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN})))",
+ pp? := .some "(?m.92 ?m.68 = ?m.94 ?m.68) = (n + 0 = n)",
+ sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
},
vars := #[{
name := fvN,
@@ -820,6 +850,7 @@ def test_nat_zero_add_alt: TestM Unit := do
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
+ ("identity", test_identity),
("Nat.add_comm", test_nat_add_comm false),
("Nat.add_comm manual", test_nat_add_comm true),
("Nat.add_comm delta", test_delta_variable),
From cc74d41b150343215f40f391b52f308adc14a65c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 20 May 2024 10:55:52 -0700
Subject: [PATCH 204/465] feat: Congruence tactics
---
Pantograph/Tactic.lean | 1 +
Pantograph/Tactic/Congruence.lean | 78 +++++++++++++++++++++++++++++++
2 files changed, 79 insertions(+)
create mode 100644 Pantograph/Tactic/Congruence.lean
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 5a7828c..225ad31 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -1,3 +1,4 @@
+import Pantograph.Tactic.Congruence
import Pantograph.Tactic.MotivatedApply
import Pantograph.Tactic.NoConfuse
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
new file mode 100644
index 0000000..3de904f
--- /dev/null
+++ b/Pantograph/Tactic/Congruence.lean
@@ -0,0 +1,78 @@
+import Lean
+
+open Lean
+
+namespace Pantograph.Tactic
+
+def congruenceArg: Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ -- Create the descendant goals
+
+ let nextGoals ← goal.withContext do
+ let u ← Meta.mkFreshLevelMVar
+ let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
+ let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous alpha beta .default)
+ .synthetic (userName := goal.name ++ `f)
+ let a₁ ← Meta.mkFreshExprMVar (.some alpha)
+ .synthetic (userName := goal.name ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some alpha)
+ .synthetic (userName := goal.name ++ `a₂)
+ let h ← Meta.mkEq a₁ a₂
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) (← goal.getType)
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := goal.name ++ `conduit)
+ goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
+ return [alpha, a₁, a₂, f, h, conduit]
+ Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+
+def congruenceFun: Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ -- Create the descendant goals
+
+ let nextGoals ← goal.withContext do
+ let u ← Meta.mkFreshLevelMVar
+ let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
+ let fType := .forallE .anonymous alpha beta .default
+ let f₁ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := goal.name ++ `f₁)
+ let f₂ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := goal.name ++ `f₂)
+ let a ← Meta.mkFreshExprMVar (.some alpha)
+ .synthetic (userName := goal.name ++ `a)
+ let h ← Meta.mkEq f₁ f₂
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) (← goal.getType)
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := goal.name ++ `conduit)
+ goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
+ return [alpha, f₁, f₂, h, a, conduit]
+ Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+
+def congruence: Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ -- Create the descendant goals
+
+ let nextGoals ← goal.withContext do
+ let u ← Meta.mkFreshLevelMVar
+ let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
+ let fType := .forallE .anonymous alpha beta .default
+ let f₁ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := goal.name ++ `f₁)
+ let f₂ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := goal.name ++ `f₂)
+ let a₁ ← Meta.mkFreshExprMVar (.some alpha)
+ .synthetic (userName := goal.name ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some alpha)
+ .synthetic (userName := goal.name ++ `a₂)
+ let h₁ ← Meta.mkEq f₁ f₂
+ let h₂ ← Meta.mkEq a₁ a₂
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) (← goal.getType)
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := goal.name ++ `conduit)
+ goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
+ return [alpha, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
+ Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+
+end Pantograph.Tactic
From 92acf7782c66f9efc6026a5896be35b84b202f5d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 20 May 2024 11:51:35 -0700
Subject: [PATCH 205/465] test: CongruenceArg tactic
---
Pantograph/Tactic/Congruence.lean | 81 +++++++++++++++++--------------
Test/Common.lean | 15 ++++++
Test/Main.lean | 1 +
Test/Tactic.lean | 1 +
Test/Tactic/Congruence.lean | 36 ++++++++++++++
Test/Tactic/NoConfuse.lean | 6 +--
6 files changed, 100 insertions(+), 40 deletions(-)
create mode 100644 Test/Tactic/Congruence.lean
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
index 3de904f..bbb9d75 100644
--- a/Pantograph/Tactic/Congruence.lean
+++ b/Pantograph/Tactic/Congruence.lean
@@ -6,73 +6,80 @@ namespace Pantograph.Tactic
def congruenceArg: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- -- Create the descendant goals
+ let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ let userName := (← goal.getDecl).userName
let nextGoals ← goal.withContext do
let u ← Meta.mkFreshLevelMVar
- let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
- let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous alpha beta .default)
- .synthetic (userName := goal.name ++ `f)
- let a₁ ← Meta.mkFreshExprMVar (.some alpha)
- .synthetic (userName := goal.name ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some alpha)
- .synthetic (userName := goal.name ++ `a₂)
- let h ← Meta.mkEq a₁ a₂
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous α β .default)
+ .synthetic (userName := userName ++ `f)
+ let a₁ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₂)
+ let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
+ .synthetic (userName := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) (← goal.getType)
let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := goal.name ++ `conduit)
+ .synthetic (userName := userName ++ `conduit)
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
- return [alpha, a₁, a₂, f, h, conduit]
+ return [α, a₁, a₂, f, h, conduit]
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
def congruenceFun: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- -- Create the descendant goals
+ let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ let userName := (← goal.getDecl).userName
let nextGoals ← goal.withContext do
let u ← Meta.mkFreshLevelMVar
- let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
- let fType := .forallE .anonymous alpha beta .default
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let fType := .forallE .anonymous α β .default
let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := goal.name ++ `f₁)
+ .synthetic (userName := userName ++ `f₁)
let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := goal.name ++ `f₂)
- let a ← Meta.mkFreshExprMVar (.some alpha)
- .synthetic (userName := goal.name ++ `a)
- let h ← Meta.mkEq f₁ f₂
+ .synthetic (userName := userName ++ `f₂)
+ let a ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a)
+ let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
+ .synthetic (userName := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) (← goal.getType)
let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := goal.name ++ `conduit)
+ .synthetic (userName := userName ++ `conduit)
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
- return [alpha, f₁, f₂, h, a, conduit]
+ return [α, f₁, f₂, h, a, conduit]
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
def congruence: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- -- Create the descendant goals
+ let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
+ let userName := (← goal.getDecl).userName
let nextGoals ← goal.withContext do
let u ← Meta.mkFreshLevelMVar
- let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
- let fType := .forallE .anonymous alpha beta .default
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let fType := .forallE .anonymous α β .default
let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := goal.name ++ `f₁)
+ .synthetic (userName := userName ++ `f₁)
let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := goal.name ++ `f₂)
- let a₁ ← Meta.mkFreshExprMVar (.some alpha)
- .synthetic (userName := goal.name ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some alpha)
- .synthetic (userName := goal.name ++ `a₂)
- let h₁ ← Meta.mkEq f₁ f₂
- let h₂ ← Meta.mkEq a₁ a₂
+ .synthetic (userName := userName ++ `f₂)
+ let a₁ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₂)
+ let h₁ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
+ .synthetic (userName := userName ++ `h₁)
+ let h₂ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
+ .synthetic (userName := userName ++ `h₂)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) (← goal.getType)
let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := goal.name ++ `conduit)
+ .synthetic (userName := userName ++ `conduit)
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
- return [alpha, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
+ return [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
end Pantograph.Tactic
diff --git a/Test/Common.lean b/Test/Common.lean
index 6ea4fb2..c656309 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -27,6 +27,7 @@ def Goal.devolatilize (goal: Goal): Goal :=
name := "",
}
+deriving instance DecidableEq, Repr for Name
deriving instance DecidableEq, Repr for Expression
deriving instance DecidableEq, Repr for Variable
deriving instance DecidableEq, Repr for Goal
@@ -65,9 +66,23 @@ def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
+def parseSentence (s: String): MetaM Expr := do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := s)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ runTermElabMInMeta $ Elab.Term.elabTerm (stx := recursor) .none
+
def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
return newGoals.goals
+def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
+ let name := (← mvarId.getDecl).userName
+ let t ← exprToStr (← mvarId.getType)
+ return (name, t)
end Test
diff --git a/Test/Main.lean b/Test/Main.lean
index 4a1ca69..31042c5 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -49,6 +49,7 @@ def main (args: List String) := do
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
("Serial", Serial.suite env_default),
+ ("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
]
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
index f1e2649..5863ec0 100644
--- a/Test/Tactic.lean
+++ b/Test/Tactic.lean
@@ -1,2 +1,3 @@
+import Test.Tactic.Congruence
import Test.Tactic.MotivatedApply
import Test.Tactic.NoConfuse
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
new file mode 100644
index 0000000..7ef358a
--- /dev/null
+++ b/Test/Tactic/Congruence.lean
@@ -0,0 +1,36 @@
+import LSpec
+import Lean
+import Test.Common
+
+open Lean
+open Pantograph
+
+namespace Pantograph.Test.Tactic.Congruence
+
+def test_congr_arg (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
+ runMetaMSeq env do
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let mut tests := LSpec.TestSeq.done
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.70"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`f, "?α → Nat"),
+ (`h, "?a₁ = ?a₂"),
+ (`conduit, "(?f ?a₁ = ?f ?a₂) = (n * n = m * m)"),
+ ])
+ tests := tests ++ test
+ return tests
+
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("congrArg", test_congr_arg env),
+ ]
+
+end Pantograph.Test.Tactic.Congruence
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
index 54c2be7..442e2ca 100644
--- a/Test/Tactic/NoConfuse.lean
+++ b/Test/Tactic/NoConfuse.lean
@@ -92,9 +92,9 @@ def test_list (env: Environment): IO LSpec.TestSeq :=
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("nat", test_nat env),
- ("nat_fail", test_nat_fail env),
- ("list", test_list env),
+ ("Nat", test_nat env),
+ ("Nat fail", test_nat_fail env),
+ ("List", test_list env),
]
end Pantograph.Test.Tactic.NoConfuse
From 75df7268c5c229769c606963b2ef2bb178810bdd Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 20 May 2024 11:55:38 -0700
Subject: [PATCH 206/465] test: Simplify testing structure for tactics
---
Test/Tactic/MotivatedApply.lean | 44 ++++++++++++---------------------
Test/Tactic/NoConfuse.lean | 19 +++-----------
2 files changed, 19 insertions(+), 44 deletions(-)
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index ad8ebdc..154e34c 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -7,24 +7,11 @@ open Pantograph
namespace Pantograph.Test.Tactic.MotivatedApply
-def valueAndType (recursor: String): MetaM (Expr × Expr) := do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := recursor)
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- runTermElabMInMeta do
- let recursor ← Elab.Term.elabTerm (stx := recursor) .none
- let recursorType ← Meta.inferType recursor
- return (recursor, recursorType)
-
-
def test_type_extract (env: Environment): IO LSpec.TestSeq :=
runMetaMSeq env do
let mut tests := LSpec.TestSeq.done
- let (recursor, recursorType) ← valueAndType "@Nat.brecOn"
+ let recursor ← parseSentence "@Nat.brecOn"
+ let recursorType ← Meta.inferType recursor
tests := tests ++ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
(← exprToStr recursorType))
let info ← match Tactic.getRecursorInformation recursorType with
@@ -39,7 +26,7 @@ def test_type_extract (env: Environment): IO LSpec.TestSeq :=
def test_nat_brec_on (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (n t: Nat) => n + 0 = n"
runMetaMSeq env do
- let (expr, exprType) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
@@ -59,7 +46,7 @@ def test_nat_brec_on (env: Environment): IO LSpec.TestSeq :=
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.69 = (n + 0 = n)",
+ "?motive ?m.67 = (n + 0 = n)",
])
tests := tests ++ test
return tests
@@ -67,7 +54,7 @@ def test_nat_brec_on (env: Environment): IO LSpec.TestSeq :=
def test_list_brec_on (env: Environment): IO LSpec.TestSeq :=
let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
runMetaMSeq env do
- let (expr, exprType) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
@@ -84,11 +71,11 @@ def test_list_brec_on (env: Environment): IO LSpec.TestSeq :=
let newGoals ← runTacticOnMVar tactic target.mvarId!
pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
- "Type ?u.92",
- "List ?m.94 → Prop",
- "List ?m.94",
- "∀ (t : List ?m.94), List.below t → ?motive t",
- "?motive ?m.96 = (l ++ [] = [] ++ l)",
+ "Type ?u.90",
+ "List ?m.92 → Prop",
+ "List ?m.92",
+ "∀ (t : List ?m.92), List.below t → ?motive t",
+ "?motive ?m.94 = (l ++ [] = [] ++ l)",
])
tests := tests ++ test
return tests
@@ -103,30 +90,31 @@ def test_partial_motive_instantiation (env: Environment): IO LSpec.TestSeq := do
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
- let (expr, exprType) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let mut tests := LSpec.TestSeq.done
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.motivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
+ let majorId := 67
tests := tests ++ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.69 = (n + 0 = n)",
+ s!"?motive ?m.{majorId} = (n + 0 = n)",
]))
let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
- tests := tests ++ (LSpec.check "goal name" (major.name.toString = "_uniq.69"))
+ tests := tests ++ (LSpec.check "goal name" (major.name.toString = s!"_uniq.{majorId}"))
-- Assign motive to `λ x => x + _`
- let (motive_assign, _) ← valueAndType "λ (x: Nat) => @Nat.add x + 0 = _"
+ let motive_assign ← parseSentence "λ (x: Nat) => @Nat.add x + 0 = _"
motive.assign motive_assign
let test ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = "(?m.69.add + 0 = ?m.140 ?m.69) = (n + 0 = n)")
+ return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
tests := tests ++ test
return tests
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
index 442e2ca..c672a0b 100644
--- a/Test/Tactic/NoConfuse.lean
+++ b/Test/Tactic/NoConfuse.lean
@@ -7,23 +7,10 @@ open Pantograph
namespace Pantograph.Test.Tactic.NoConfuse
-def valueAndType (recursor: String): MetaM (Expr × Expr) := do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := recursor)
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- runTermElabMInMeta do
- let recursor ← Elab.Term.elabTerm (stx := recursor) .none
- let recursorType ← Meta.inferType recursor
- return (recursor, recursorType)
-
def test_nat (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (n: Nat) (h: 0 = n + 1) => False"
runMetaMSeq env do
- let (expr, exprType) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
@@ -46,7 +33,7 @@ def test_nat (env: Environment): IO LSpec.TestSeq :=
def test_nat_fail (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (n: Nat) (h: n = n) => False"
runMetaMSeq env do
- let (expr, _) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
@@ -70,7 +57,7 @@ def test_nat_fail (env: Environment): IO LSpec.TestSeq :=
def test_list (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
runMetaMSeq env do
- let (expr, exprType) ← valueAndType expr
+ let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
From bbc00cbbb80748a53c2741bd2e4ee1415ba92f8d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 20 May 2024 14:00:04 -0700
Subject: [PATCH 207/465] feat: Congruence tactic FFI interface and tests
---
Pantograph/Goal.lean | 12 +---------
Pantograph/Library.lean | 16 ++++++++++++++
Test/Tactic/Congruence.lean | 44 +++++++++++++++++++++++++++++++++++++
3 files changed, 61 insertions(+), 11 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 3a8e2fe..46888e7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -76,7 +76,7 @@ private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
state.savedState.term.meta.restore
-private def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
+protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
state.savedState.term.restore
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
state.savedState.restore
@@ -518,11 +518,6 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryMotivatedApply
-
let recursor ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
@@ -534,11 +529,6 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryMotivatedApply
-
let recursor ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 20eaa34..e0625e8 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -204,4 +204,20 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Lean
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): Lean.CoreM TacticResult :=
runTermElabM <| state.tryNoConfuse goalId eq
+inductive TacticExecute where
+ | congruenceArg
+ | congruenceFun
+ | congruence
+@[export pantograph_goal_tactic_execute_m]
+def goalTacticExecute (state: GoalState) (goalId: Nat) (tacticExecute: TacticExecute): Lean.CoreM TacticResult :=
+ runTermElabM do
+ state.restoreElabM
+ let tactic := match tacticExecute with
+ | .congruenceArg => Tactic.congruenceArg
+ | .congruenceFun => Tactic.congruenceFun
+ | .congruence => Tactic.congruence
+ state.execute goalId tactic
+
+
+
end Pantograph
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 7ef358a..1421263 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -27,10 +27,54 @@ def test_congr_arg (env: Environment): IO LSpec.TestSeq :=
])
tests := tests ++ test
return tests
+def test_congr_fun (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (n m: Nat) => (n + m) + (n + m) = (n + m) * 2"
+ runMetaMSeq env do
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let mut tests := LSpec.TestSeq.done
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar Tactic.congruenceFun target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.159"),
+ (`f₁, "?α → Nat"),
+ (`f₂, "?α → Nat"),
+ (`h, "?f₁ = ?f₂"),
+ (`a, "?α"),
+ (`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
+ ])
+ tests := tests ++ test
+ return tests
+def test_congr (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ (a b: Nat) => a = b"
+ runMetaMSeq env do
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let mut tests := LSpec.TestSeq.done
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar Tactic.congruence target.mvarId!
+ pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.10"),
+ (`f₁, "?α → Nat"),
+ (`f₂, "?α → Nat"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`h₁, "?f₁ = ?f₂"),
+ (`h₂, "?a₁ = ?a₂"),
+ (`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
+ ])
+ tests := tests ++ test
+ return tests
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("congrArg", test_congr_arg env),
+ ("congrFun", test_congr_fun env),
+ ("congr", test_congr env),
]
end Pantograph.Test.Tactic.Congruence
From bd42c396d71097b100852aa1f25d3759f76edfe0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 20 May 2024 14:19:10 -0700
Subject: [PATCH 208/465] chore: Code cleanup
---
Pantograph/Expr.lean | 5 ++---
Pantograph/Library.lean | 3 +--
2 files changed, 3 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 8f890e3..63331af 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -70,11 +70,10 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
let pending ← mvarIdPending.withContext do
let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
--IO.println s!"{padding}├Pre: {inner}"
- let r := (← Expr.abstractM inner fvars).instantiateRev args
- pure r
+ pure <| (← inner.abstractM fvars).instantiateRev args
-- Tail arguments
- let result := mkAppN pending (List.drop fvars.size args.toList |>.toArray)
+ let result := mkAppRange pending fvars.size args.size args
--IO.println s!"{padding}├MD {result}"
return .done result
else
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index e0625e8..d3df45f 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -212,11 +212,10 @@ inductive TacticExecute where
def goalTacticExecute (state: GoalState) (goalId: Nat) (tacticExecute: TacticExecute): Lean.CoreM TacticResult :=
runTermElabM do
state.restoreElabM
- let tactic := match tacticExecute with
+ state.execute goalId $ match tacticExecute with
| .congruenceArg => Tactic.congruenceArg
| .congruenceFun => Tactic.congruenceFun
| .congruence => Tactic.congruence
- state.execute goalId tactic
From 09628309a920ec487973afb7753c7fa4fe958f59 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 28 May 2024 17:25:22 -0700
Subject: [PATCH 209/465] feat: Basic tactic extraction (before/after/tactic)
---
Pantograph.lean | 15 ++-
Pantograph/Compile.lean | 252 +++++++++++++++++++++++++++++++++++++++
Pantograph/Protocol.lean | 13 ++
3 files changed, 277 insertions(+), 3 deletions(-)
create mode 100644 Pantograph/Compile.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index c637303..42d46a7 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,9 +1,10 @@
+import Lean.Data.HashMap
+import Pantograph.Compile
+import Pantograph.Environment
import Pantograph.Goal
+import Pantograph.Library
import Pantograph.Protocol
import Pantograph.Serial
-import Pantograph.Environment
-import Pantograph.Library
-import Lean.Data.HashMap
namespace Pantograph
@@ -44,6 +45,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
+ | "compile.tactics" => run compile_tactics
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -190,5 +192,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => runMetaM <| do
return .ok (← goalPrint goalState state.options)
+ compile_tactics (args: Protocol.CompileTactics): MainM (CR Protocol.CompileTacticsResult) := do
+ let module := args.module.toName
+ try
+ let result ← Compile.compileAndCollectTacticInvocations module
+ return .ok result
+ catch e =>
+ return .error $ errorI "compile" (← e.toMessageData.toString)
end Pantograph
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
new file mode 100644
index 0000000..d2a6167
--- /dev/null
+++ b/Pantograph/Compile.lean
@@ -0,0 +1,252 @@
+/- Adapted from lean-training-data by semorrison -/
+import Lean.Parser
+import Lean.Elab.Import
+import Lean.Elab.Command
+import Lean.Elab.Frontend
+import Lean.Elab.InfoTree
+import Lean.Util.Path
+
+import Pantograph.Protocol
+
+
+open Lean
+
+namespace Lean.PersistentArray
+/--
+Drop the first `n` elements of a `PersistentArray`, returning the results as a `List`.
+-/
+-- We can't remove the `[Inhabited α]` hypotheses here until
+-- `PersistentArray`'s `GetElem` instance also does.
+def drop [Inhabited α] (t : PersistentArray α) (n : Nat) : List α :=
+ List.range (t.size - n) |>.map fun i => t.get! (n + i)
+end Lean.PersistentArray
+
+namespace Lean.Elab.Info
+/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
+def stx? : Info → Option Syntax
+ | .ofTacticInfo info => info.stx
+ | .ofTermInfo info => info.stx
+ | .ofCommandInfo info => info.stx
+ | .ofMacroExpansionInfo info => info.stx
+ | .ofOptionInfo info => info.stx
+ | .ofFieldInfo info => info.stx
+ | .ofCompletionInfo info => info.stx
+ | .ofUserWidgetInfo info => info.stx
+ | .ofCustomInfo info => info.stx
+ | .ofFVarAliasInfo _ => none
+ | .ofFieldRedeclInfo info => info.stx
+ | .ofOmissionInfo info => info.stx
+/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
+def isOriginal (i : Info) : Bool :=
+ match i.stx? with
+ | none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
+ | some stx => match stx.getHeadInfo with
+ | .original .. => true
+ | _ => false
+end Lean.Elab.Info
+
+namespace Lean.Elab.TacticInfo
+
+/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
+def name? (t : TacticInfo) : Option Name :=
+ match t.stx with
+ | Syntax.node _ n _ => some n
+ | _ => none
+/-- Decide whether a tactic is "substantive",
+or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
+def isSubstantive (t : TacticInfo) : Bool :=
+ match t.name? with
+ | none => false
+ | some `null => false
+ | some ``cdot => false
+ | some ``cdotTk => false
+ | some ``Lean.Parser.Term.byTactic => false
+ | some ``Lean.Parser.Tactic.tacticSeq => false
+ | some ``Lean.Parser.Tactic.tacticSeq1Indented => false
+ | some ``Lean.Parser.Tactic.«tactic_<;>_» => false
+ | some ``Lean.Parser.Tactic.paren => false
+ | _ => true
+
+end Lean.Elab.TacticInfo
+
+namespace Lean.Elab.InfoTree
+
+/--
+Keep `.node` nodes and `.hole` nodes satisfying predicates.
+
+Returns a `List InfoTree`, although in most situations this will be a singleton.
+-/
+partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
+ InfoTree → List InfoTree
+ | .context ctx tree => tree.filter p m |>.map (.context ctx)
+ | .node info children =>
+ if p info then
+ [.node info (children.toList.map (filter p m)).join.toPArray']
+ else
+ (children.toList.map (filter p m)).join
+ | .hole mvar => if m mvar then [.hole mvar] else []
+
+end Lean.Elab.InfoTree
+
+namespace Lean.FileMap
+
+/-- Extract the range of a `Syntax` expressed as lines and columns. -/
+-- Extracted from the private declaration `Lean.Elab.formatStxRange`,
+-- in `Lean.Elab.InfoTree.Main`.
+def stxRange (fileMap : FileMap) (stx : Syntax) : Position × Position :=
+ let pos := stx.getPos?.getD 0
+ let endPos := stx.getTailPos?.getD pos
+ (fileMap.toPosition pos, fileMap.toPosition endPos)
+
+end Lean.FileMap
+
+-- Main
+
+namespace Pantograph.Compile
+
+structure CompilationStep where
+ fileName : String
+ fileMap : FileMap
+ src : Substring
+ stx : Syntax
+ before : Environment
+ after : Environment
+ msgs : List Message
+ trees : List Elab.InfoTree
+
+
+/--
+Process one command, returning a `CompilationStep` and
+`done : Bool`, indicating whether this was the last command.
+-/
+def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
+ let s := (← get).commandState
+ let before := s.env
+ let done ← Elab.Frontend.processCommand
+ let stx := (← get).commands.back
+ let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
+ let s' := (← get).commandState
+ let after := s'.env
+ let msgs := s'.messages.msgs.drop s.messages.msgs.size
+ let trees := s'.infoState.trees.drop s.infoState.trees.size
+ let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
+ return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
+
+partial def processFile : Elab.Frontend.FrontendM (List CompilationStep) := do
+ let (cmd, done) ← processOneCommand
+ if done then
+ return [cmd]
+ else
+ return cmd :: (← processFile)
+
+
+def findSourcePath (module : Name) : IO System.FilePath := do
+ return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
+
+def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) := unsafe do
+ let file ← IO.FS.readFile (← findSourcePath module)
+ let inputCtx := Parser.mkInputContext file module.toString
+
+ let (header, parserState, messages) ← Parser.parseHeader inputCtx
+ let (env, messages) ← Elab.processHeader header opts messages inputCtx
+ let commandState := Elab.Command.mkState env messages opts
+ processFile.run { inputCtx }
+ |>.run' {
+ commandState := { commandState with infoState.enabled := true },
+ parserState,
+ cmdPos := parserState.pos
+ }
+
+-- Info tree filtering functions
+
+structure TacticInvocation where
+ info : Elab.TacticInfo
+ ctx : Elab.ContextInfo
+ children : PersistentArray Elab.InfoTree
+namespace TacticInvocation
+
+/-- Return the range of the tactic, as a pair of file positions. -/
+def range (t : TacticInvocation) : Position × Position := t.ctx.fileMap.stxRange t.info.stx
+
+/-- Pretty print a tactic. -/
+def pp (t : TacticInvocation) : IO Format :=
+ t.ctx.runMetaM {} try
+ Lean.PrettyPrinter.ppTactic ⟨t.info.stx⟩
+ catch _ =>
+ pure "<failed to pretty print>"
+
+open Meta
+
+/-- Run a tactic on the goals stored in a `TacticInvocation`. -/
+def runMetaMGoalsBefore (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
+ t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxBefore <| x t.info.goalsBefore
+
+/-- Run a tactic on the after goals stored in a `TacticInvocation`. -/
+def runMetaMGoalsAfter (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
+ t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxAfter <| x t.info.goalsAfter
+
+/-- Run a tactic on the main goal stored in a `TacticInvocation`. -/
+def runMetaM (t : TacticInvocation) (x : MVarId → MetaM α) : IO α := do
+ match t.info.goalsBefore.head? with
+ | none => throw <| IO.userError s!"No goals at {← t.pp}"
+ | some g => t.runMetaMGoalsBefore fun _ => do g.withContext <| x g
+
+def mainGoal (t : TacticInvocation) : IO Expr :=
+ t.runMetaM (fun g => do instantiateMVars (← g.getType))
+
+def formatMainGoal (t : TacticInvocation) : IO Format :=
+ t.runMetaM (fun g => do ppExpr (← instantiateMVars (← g.getType)))
+
+def goalState (t : TacticInvocation) : IO (List Format) := do
+ t.runMetaMGoalsBefore (fun gs => gs.mapM fun g => do Meta.ppGoal g)
+
+def goalStateAfter (t : TacticInvocation) : IO (List Format) := do
+ t.runMetaMGoalsAfter (fun gs => gs.mapM fun g => do Meta.ppGoal g)
+
+def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
+ t.runMetaM (fun _ => do Meta.ppExpr (← instantiateMVars e))
+
+end TacticInvocation
+
+/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
+partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
+ List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+ match t with
+ | .context inner t => findAllInfo t (inner.mergeIntoOuter? ctx) pred
+ | .node i children =>
+ (if pred i then [(i, ctx, children)] else []) ++ children.toList.bind (fun t => findAllInfo t ctx pred)
+ | _ => []
+
+/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
+each equipped with its relevant `ContextInfo`, and any children info trees. -/
+def collectTacticNodes (t : Elab.InfoTree) : List (Elab.TacticInfo × Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+ let infos := findAllInfo t none fun i => match i with
+ | .ofTacticInfo _ => true
+ | _ => false
+ infos.filterMap fun p => match p with
+ | (.ofTacticInfo i, some ctx, children) => (i, ctx, children)
+ | _ => none
+
+def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
+ collectTacticNodes t |>.map (fun ⟨i, ctx, children⟩ => ⟨i, ctx, children⟩)
+ |>.filter fun i => i.info.isSubstantive
+
+def compileAndCollectTacticInvocations (module : Name) : IO Protocol.CompileTacticsResult := do
+ let steps ← processSource module
+ let infoTrees := steps.bind (·.trees)
+ let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
+ | info@(.ofTacticInfo _) => true --info.isOriginal
+ | _ => false
+ let tactics := tacticInfoTrees.bind collectTactics
+ IO.println s!"{steps.length} compilation steps, {infoTrees.length} trees found, {tacticInfoTrees.length} tactic trees, {tactics.length} tactics found"
+ let invocations : List Protocol.InvokedTactic ← tactics.mapM λ invocation => do
+ let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
+ let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
+ let tactic ← invocation.ctx.runMetaM {} do
+ let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
+ return t.pretty
+ return { goalBefore, goalAfter, tactic }
+ return { invocations }
+
+
+end Pantograph.Compile
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 17618fc..87c511a 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -275,6 +275,19 @@ structure GoalDiag where
printAll: Bool := false
instantiate: Bool := true
+structure CompileTactics where
+ module: String
+ deriving Lean.FromJson
+
+structure InvokedTactic where
+ goalBefore: String
+ goalAfter: String
+ tactic: String
+ deriving Lean.ToJson
+structure CompileTacticsResult where
+ invocations: List InvokedTactic
+ deriving Lean.ToJson
+
abbrev CR α := Except InteractionError α
end Pantograph.Protocol
From b9b16ba0e9d99279837527bcb40176277d11e725 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 28 May 2024 20:24:23 -0700
Subject: [PATCH 210/465] refactor: Code cleanup
---
Pantograph/Compile.lean | 229 +------------------------------
Pantograph/Compile/Elab.lean | 153 +++++++++++++++++++++
Pantograph/Compile/Frontend.lean | 86 ++++++++++++
3 files changed, 242 insertions(+), 226 deletions(-)
create mode 100644 Pantograph/Compile/Elab.lean
create mode 100644 Pantograph/Compile/Frontend.lean
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
index d2a6167..7ac4d27 100644
--- a/Pantograph/Compile.lean
+++ b/Pantograph/Compile.lean
@@ -1,241 +1,18 @@
/- Adapted from lean-training-data by semorrison -/
-import Lean.Parser
-import Lean.Elab.Import
-import Lean.Elab.Command
-import Lean.Elab.Frontend
-import Lean.Elab.InfoTree
-import Lean.Util.Path
-
import Pantograph.Protocol
+import Pantograph.Compile.Frontend
+import Pantograph.Compile.Elab
open Lean
-namespace Lean.PersistentArray
-/--
-Drop the first `n` elements of a `PersistentArray`, returning the results as a `List`.
--/
--- We can't remove the `[Inhabited α]` hypotheses here until
--- `PersistentArray`'s `GetElem` instance also does.
-def drop [Inhabited α] (t : PersistentArray α) (n : Nat) : List α :=
- List.range (t.size - n) |>.map fun i => t.get! (n + i)
-end Lean.PersistentArray
-
-namespace Lean.Elab.Info
-/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
-def stx? : Info → Option Syntax
- | .ofTacticInfo info => info.stx
- | .ofTermInfo info => info.stx
- | .ofCommandInfo info => info.stx
- | .ofMacroExpansionInfo info => info.stx
- | .ofOptionInfo info => info.stx
- | .ofFieldInfo info => info.stx
- | .ofCompletionInfo info => info.stx
- | .ofUserWidgetInfo info => info.stx
- | .ofCustomInfo info => info.stx
- | .ofFVarAliasInfo _ => none
- | .ofFieldRedeclInfo info => info.stx
- | .ofOmissionInfo info => info.stx
-/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
-def isOriginal (i : Info) : Bool :=
- match i.stx? with
- | none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
- | some stx => match stx.getHeadInfo with
- | .original .. => true
- | _ => false
-end Lean.Elab.Info
-
-namespace Lean.Elab.TacticInfo
-
-/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
-def name? (t : TacticInfo) : Option Name :=
- match t.stx with
- | Syntax.node _ n _ => some n
- | _ => none
-/-- Decide whether a tactic is "substantive",
-or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
-def isSubstantive (t : TacticInfo) : Bool :=
- match t.name? with
- | none => false
- | some `null => false
- | some ``cdot => false
- | some ``cdotTk => false
- | some ``Lean.Parser.Term.byTactic => false
- | some ``Lean.Parser.Tactic.tacticSeq => false
- | some ``Lean.Parser.Tactic.tacticSeq1Indented => false
- | some ``Lean.Parser.Tactic.«tactic_<;>_» => false
- | some ``Lean.Parser.Tactic.paren => false
- | _ => true
-
-end Lean.Elab.TacticInfo
-
-namespace Lean.Elab.InfoTree
-
-/--
-Keep `.node` nodes and `.hole` nodes satisfying predicates.
-
-Returns a `List InfoTree`, although in most situations this will be a singleton.
--/
-partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
- InfoTree → List InfoTree
- | .context ctx tree => tree.filter p m |>.map (.context ctx)
- | .node info children =>
- if p info then
- [.node info (children.toList.map (filter p m)).join.toPArray']
- else
- (children.toList.map (filter p m)).join
- | .hole mvar => if m mvar then [.hole mvar] else []
-
-end Lean.Elab.InfoTree
-
-namespace Lean.FileMap
-
-/-- Extract the range of a `Syntax` expressed as lines and columns. -/
--- Extracted from the private declaration `Lean.Elab.formatStxRange`,
--- in `Lean.Elab.InfoTree.Main`.
-def stxRange (fileMap : FileMap) (stx : Syntax) : Position × Position :=
- let pos := stx.getPos?.getD 0
- let endPos := stx.getTailPos?.getD pos
- (fileMap.toPosition pos, fileMap.toPosition endPos)
-
-end Lean.FileMap
-
--- Main
-
namespace Pantograph.Compile
-structure CompilationStep where
- fileName : String
- fileMap : FileMap
- src : Substring
- stx : Syntax
- before : Environment
- after : Environment
- msgs : List Message
- trees : List Elab.InfoTree
-
-
-/--
-Process one command, returning a `CompilationStep` and
-`done : Bool`, indicating whether this was the last command.
--/
-def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
- let s := (← get).commandState
- let before := s.env
- let done ← Elab.Frontend.processCommand
- let stx := (← get).commands.back
- let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
- let s' := (← get).commandState
- let after := s'.env
- let msgs := s'.messages.msgs.drop s.messages.msgs.size
- let trees := s'.infoState.trees.drop s.infoState.trees.size
- let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
- return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
-
-partial def processFile : Elab.Frontend.FrontendM (List CompilationStep) := do
- let (cmd, done) ← processOneCommand
- if done then
- return [cmd]
- else
- return cmd :: (← processFile)
-
-
-def findSourcePath (module : Name) : IO System.FilePath := do
- return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
-
-def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) := unsafe do
- let file ← IO.FS.readFile (← findSourcePath module)
- let inputCtx := Parser.mkInputContext file module.toString
-
- let (header, parserState, messages) ← Parser.parseHeader inputCtx
- let (env, messages) ← Elab.processHeader header opts messages inputCtx
- let commandState := Elab.Command.mkState env messages opts
- processFile.run { inputCtx }
- |>.run' {
- commandState := { commandState with infoState.enabled := true },
- parserState,
- cmdPos := parserState.pos
- }
-
--- Info tree filtering functions
-
-structure TacticInvocation where
- info : Elab.TacticInfo
- ctx : Elab.ContextInfo
- children : PersistentArray Elab.InfoTree
-namespace TacticInvocation
-
-/-- Return the range of the tactic, as a pair of file positions. -/
-def range (t : TacticInvocation) : Position × Position := t.ctx.fileMap.stxRange t.info.stx
-
-/-- Pretty print a tactic. -/
-def pp (t : TacticInvocation) : IO Format :=
- t.ctx.runMetaM {} try
- Lean.PrettyPrinter.ppTactic ⟨t.info.stx⟩
- catch _ =>
- pure "<failed to pretty print>"
-
-open Meta
-
-/-- Run a tactic on the goals stored in a `TacticInvocation`. -/
-def runMetaMGoalsBefore (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
- t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxBefore <| x t.info.goalsBefore
-
-/-- Run a tactic on the after goals stored in a `TacticInvocation`. -/
-def runMetaMGoalsAfter (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
- t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxAfter <| x t.info.goalsAfter
-
-/-- Run a tactic on the main goal stored in a `TacticInvocation`. -/
-def runMetaM (t : TacticInvocation) (x : MVarId → MetaM α) : IO α := do
- match t.info.goalsBefore.head? with
- | none => throw <| IO.userError s!"No goals at {← t.pp}"
- | some g => t.runMetaMGoalsBefore fun _ => do g.withContext <| x g
-
-def mainGoal (t : TacticInvocation) : IO Expr :=
- t.runMetaM (fun g => do instantiateMVars (← g.getType))
-
-def formatMainGoal (t : TacticInvocation) : IO Format :=
- t.runMetaM (fun g => do ppExpr (← instantiateMVars (← g.getType)))
-
-def goalState (t : TacticInvocation) : IO (List Format) := do
- t.runMetaMGoalsBefore (fun gs => gs.mapM fun g => do Meta.ppGoal g)
-
-def goalStateAfter (t : TacticInvocation) : IO (List Format) := do
- t.runMetaMGoalsAfter (fun gs => gs.mapM fun g => do Meta.ppGoal g)
-
-def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
- t.runMetaM (fun _ => do Meta.ppExpr (← instantiateMVars e))
-
-end TacticInvocation
-
-/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
-partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
- List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
- match t with
- | .context inner t => findAllInfo t (inner.mergeIntoOuter? ctx) pred
- | .node i children =>
- (if pred i then [(i, ctx, children)] else []) ++ children.toList.bind (fun t => findAllInfo t ctx pred)
- | _ => []
-
-/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
-each equipped with its relevant `ContextInfo`, and any children info trees. -/
-def collectTacticNodes (t : Elab.InfoTree) : List (Elab.TacticInfo × Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
- let infos := findAllInfo t none fun i => match i with
- | .ofTacticInfo _ => true
- | _ => false
- infos.filterMap fun p => match p with
- | (.ofTacticInfo i, some ctx, children) => (i, ctx, children)
- | _ => none
-
-def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
- collectTacticNodes t |>.map (fun ⟨i, ctx, children⟩ => ⟨i, ctx, children⟩)
- |>.filter fun i => i.info.isSubstantive
-
def compileAndCollectTacticInvocations (module : Name) : IO Protocol.CompileTacticsResult := do
let steps ← processSource module
let infoTrees := steps.bind (·.trees)
let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
- | info@(.ofTacticInfo _) => true --info.isOriginal
+ | info@(.ofTacticInfo _) => info.isOriginal
| _ => false
let tactics := tacticInfoTrees.bind collectTactics
IO.println s!"{steps.length} compilation steps, {infoTrees.length} trees found, {tacticInfoTrees.length} tactic trees, {tactics.length} tactics found"
diff --git a/Pantograph/Compile/Elab.lean b/Pantograph/Compile/Elab.lean
new file mode 100644
index 0000000..a13a5e0
--- /dev/null
+++ b/Pantograph/Compile/Elab.lean
@@ -0,0 +1,153 @@
+
+import Lean.Elab.Import
+import Lean.Elab.Command
+import Lean.Elab.InfoTree
+
+import Pantograph.Compile.Frontend
+
+open Lean
+
+namespace Lean.Elab.Info
+/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
+protected def stx? : Info → Option Syntax
+ | .ofTacticInfo info => info.stx
+ | .ofTermInfo info => info.stx
+ | .ofCommandInfo info => info.stx
+ | .ofMacroExpansionInfo info => info.stx
+ | .ofOptionInfo info => info.stx
+ | .ofFieldInfo info => info.stx
+ | .ofCompletionInfo info => info.stx
+ | .ofUserWidgetInfo info => info.stx
+ | .ofCustomInfo info => info.stx
+ | .ofFVarAliasInfo _ => none
+ | .ofFieldRedeclInfo info => info.stx
+ | .ofOmissionInfo info => info.stx
+/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
+protected def isOriginal (i : Info) : Bool :=
+ match i.stx? with
+ | none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
+ | some stx => match stx.getHeadInfo with
+ | .original .. => true
+ | _ => false
+end Lean.Elab.Info
+
+namespace Lean.Elab.TacticInfo
+
+/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
+def name? (t : TacticInfo) : Option Name :=
+ match t.stx with
+ | Syntax.node _ n _ => some n
+ | _ => none
+/-- Decide whether a tactic is "substantive",
+or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
+def isSubstantive (t : TacticInfo) : Bool :=
+ match t.name? with
+ | none => false
+ | some `null => false
+ | some ``cdot => false
+ | some ``cdotTk => false
+ | some ``Lean.Parser.Term.byTactic => false
+ | some ``Lean.Parser.Tactic.tacticSeq => false
+ | some ``Lean.Parser.Tactic.tacticSeq1Indented => false
+ | some ``Lean.Parser.Tactic.«tactic_<;>_» => false
+ | some ``Lean.Parser.Tactic.paren => false
+ | _ => true
+
+end Lean.Elab.TacticInfo
+
+namespace Lean.Elab.InfoTree
+
+/--
+Keep `.node` nodes and `.hole` nodes satisfying predicates.
+
+Returns a `List InfoTree`, although in most situations this will be a singleton.
+-/
+partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
+ InfoTree → List InfoTree
+ | .context ctx tree => tree.filter p m |>.map (.context ctx)
+ | .node info children =>
+ if p info then
+ [.node info (children.toList.map (filter p m)).join.toPArray']
+ else
+ (children.toList.map (filter p m)).join
+ | .hole mvar => if m mvar then [.hole mvar] else []
+
+end Lean.Elab.InfoTree
+
+
+namespace Pantograph.Compile
+
+-- Info tree filtering functions
+
+structure TacticInvocation where
+ info : Elab.TacticInfo
+ ctx : Elab.ContextInfo
+ children : PersistentArray Elab.InfoTree
+namespace TacticInvocation
+
+/-- Return the range of the tactic, as a pair of file positions. -/
+protected def range (t : TacticInvocation) : Position × Position := t.ctx.fileMap.stxRange t.info.stx
+
+/-- Pretty print a tactic. -/
+protected def pp (t : TacticInvocation) : IO Format :=
+ t.ctx.runMetaM {} try
+ Lean.PrettyPrinter.ppTactic ⟨t.info.stx⟩
+ catch _ =>
+ pure "<failed to pretty print>"
+
+/-- Run a tactic on the goals stored in a `TacticInvocation`. -/
+protected def runMetaMGoalsBefore (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
+ t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxBefore <| x t.info.goalsBefore
+
+/-- Run a tactic on the after goals stored in a `TacticInvocation`. -/
+protected def runMetaMGoalsAfter (t : TacticInvocation) (x : List MVarId → MetaM α) : IO α := do
+ t.ctx.runMetaM {} <| Meta.withMCtx t.info.mctxAfter <| x t.info.goalsAfter
+
+/-- Run a tactic on the main goal stored in a `TacticInvocation`. -/
+protected def runMetaM (t : TacticInvocation) (x : MVarId → MetaM α) : IO α := do
+ match t.info.goalsBefore.head? with
+ | none => throw <| IO.userError s!"No goals at {← t.pp}"
+ | some g => t.runMetaMGoalsBefore fun _ => do g.withContext <| x g
+
+protected def mainGoal (t : TacticInvocation) : IO Expr :=
+ t.runMetaM (fun g => do instantiateMVars (← g.getType))
+
+protected def formatMainGoal (t : TacticInvocation) : IO Format :=
+ t.runMetaM (fun g => do Meta.ppExpr (← instantiateMVars (← g.getType)))
+
+protected def goalState (t : TacticInvocation) : IO (List Format) := do
+ t.runMetaMGoalsBefore (fun gs => gs.mapM fun g => do Meta.ppGoal g)
+
+protected def goalStateAfter (t : TacticInvocation) : IO (List Format) := do
+ t.runMetaMGoalsAfter (fun gs => gs.mapM fun g => do Meta.ppGoal g)
+
+protected def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
+ t.runMetaM (fun _ => do Meta.ppExpr (← instantiateMVars e))
+
+end TacticInvocation
+
+/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
+partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
+ List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+ match t with
+ | .context inner t => findAllInfo t (inner.mergeIntoOuter? ctx) pred
+ | .node i children =>
+ (if pred i then [(i, ctx, children)] else []) ++ children.toList.bind (fun t => findAllInfo t ctx pred)
+ | _ => []
+
+/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
+each equipped with its relevant `ContextInfo`, and any children info trees. -/
+def collectTacticNodes (t : Elab.InfoTree) : List (Elab.TacticInfo × Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+ let infos := findAllInfo t none fun i => match i with
+ | .ofTacticInfo _ => true
+ | _ => false
+ infos.filterMap fun p => match p with
+ | (.ofTacticInfo i, some ctx, children) => (i, ctx, children)
+ | _ => none
+
+def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
+ collectTacticNodes t |>.map (fun ⟨i, ctx, children⟩ => ⟨i, ctx, children⟩)
+ |>.filter fun i => i.info.isSubstantive
+
+
+end Pantograph.Compile
diff --git a/Pantograph/Compile/Frontend.lean b/Pantograph/Compile/Frontend.lean
new file mode 100644
index 0000000..5cb3e63
--- /dev/null
+++ b/Pantograph/Compile/Frontend.lean
@@ -0,0 +1,86 @@
+import Lean.Parser
+import Lean.Elab.Frontend
+
+open Lean
+
+namespace Lean.FileMap
+
+/-- Extract the range of a `Syntax` expressed as lines and columns. -/
+-- Extracted from the private declaration `Lean.Elab.formatStxRange`,
+-- in `Lean.Elab.InfoTree.Main`.
+protected def stxRange (fileMap : FileMap) (stx : Syntax) : Position × Position :=
+ let pos := stx.getPos?.getD 0
+ let endPos := stx.getTailPos?.getD pos
+ (fileMap.toPosition pos, fileMap.toPosition endPos)
+
+end Lean.FileMap
+namespace Lean.PersistentArray
+
+/--
+Drop the first `n` elements of a `PersistentArray`, returning the results as a `List`.
+-/
+-- We can't remove the `[Inhabited α]` hypotheses here until
+-- `PersistentArray`'s `GetElem` instance also does.
+protected def drop [Inhabited α] (t : PersistentArray α) (n : Nat) : List α :=
+ List.range (t.size - n) |>.map fun i => t.get! (n + i)
+
+end Lean.PersistentArray
+
+
+namespace Pantograph.Compile
+
+structure CompilationStep where
+ fileName : String
+ fileMap : FileMap
+ src : Substring
+ stx : Syntax
+ before : Environment
+ after : Environment
+ msgs : List Message
+ trees : List Elab.InfoTree
+
+
+/--
+Process one command, returning a `CompilationStep` and
+`done : Bool`, indicating whether this was the last command.
+-/
+def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
+ let s := (← get).commandState
+ let before := s.env
+ let done ← Elab.Frontend.processCommand
+ let stx := (← get).commands.back
+ let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
+ let s' := (← get).commandState
+ let after := s'.env
+ let msgs := s'.messages.msgs.drop s.messages.msgs.size
+ let trees := s'.infoState.trees.drop s.infoState.trees.size
+ let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
+ return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
+
+partial def processFile : Elab.Frontend.FrontendM (List CompilationStep) := do
+ let (cmd, done) ← processOneCommand
+ if done then
+ return [cmd]
+ else
+ return cmd :: (← processFile)
+
+
+def findSourcePath (module : Name) : IO System.FilePath := do
+ return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
+
+def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) := unsafe do
+ let file ← IO.FS.readFile (← findSourcePath module)
+ let inputCtx := Parser.mkInputContext file module.toString
+
+ let (header, parserState, messages) ← Parser.parseHeader inputCtx
+ let (env, messages) ← Elab.processHeader header opts messages inputCtx
+ let commandState := Elab.Command.mkState env messages opts
+ processFile.run { inputCtx }
+ |>.run' {
+ commandState := { commandState with infoState.enabled := true },
+ parserState,
+ cmdPos := parserState.pos
+ }
+
+
+end Pantograph.Compile
From 855e7716098667aff52e7374f6b911ba06a08578 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 31 May 2024 16:35:46 -0700
Subject: [PATCH 211/465] feat: Add compilation unit boundary command
---
Pantograph.lean | 16 ++++++++++++----
Pantograph/Compile.lean | 9 +++++----
Pantograph/Protocol.lean | 16 +++++++++++-----
3 files changed, 28 insertions(+), 13 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 42d46a7..4272001 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -45,7 +45,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
- | "compile.tactics" => run compile_tactics
+ | "compile.unit" => run compile_unit
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -192,11 +192,19 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
| .some goalState => runMetaM <| do
return .ok (← goalPrint goalState state.options)
- compile_tactics (args: Protocol.CompileTactics): MainM (CR Protocol.CompileTacticsResult) := do
+ compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
let module := args.module.toName
try
- let result ← Compile.compileAndCollectTacticInvocations module
- return .ok result
+ let steps ← Compile.processSource module
+ let units? := if args.compilationUnits then
+ .some $ steps.map λ step => (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ else
+ .none
+ let invocations? ← if args.invocations then
+ pure $ .some (← Compile.collectTacticsFromCompilation steps)
+ else
+ pure .none
+ return .ok { units?, invocations? }
catch e =>
return .error $ errorI "compile" (← e.toMessageData.toString)
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
index 7ac4d27..6d3f5d9 100644
--- a/Pantograph/Compile.lean
+++ b/Pantograph/Compile.lean
@@ -8,22 +8,23 @@ open Lean
namespace Pantograph.Compile
-def compileAndCollectTacticInvocations (module : Name) : IO Protocol.CompileTacticsResult := do
- let steps ← processSource module
+--def readCompilationUnits (module : Name) : IO Protocol.CompileUnitsResult := do
+-- let steps ← processSource module
+-- return { units := steps.map (·.src.toString) }
+def collectTacticsFromCompilation (steps : List CompilationStep) : IO (List Protocol.InvokedTactic) := do
let infoTrees := steps.bind (·.trees)
let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal
| _ => false
let tactics := tacticInfoTrees.bind collectTactics
IO.println s!"{steps.length} compilation steps, {infoTrees.length} trees found, {tacticInfoTrees.length} tactic trees, {tactics.length} tactics found"
- let invocations : List Protocol.InvokedTactic ← tactics.mapM λ invocation => do
+ tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
let tactic ← invocation.ctx.runMetaM {} do
let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
return t.pretty
return { goalBefore, goalAfter, tactic }
- return { invocations }
end Pantograph.Compile
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 87c511a..8f4f947 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -275,17 +275,23 @@ structure GoalDiag where
printAll: Bool := false
instantiate: Bool := true
-structure CompileTactics where
- module: String
- deriving Lean.FromJson
+/-- Executes the Lean compiler on a single file -/
+structure CompileUnit where
+ module: String
+ -- If set to true, query the string boundaries of compilation units
+ compilationUnits: Bool := false
+ -- If set to true, collect tactic invocations
+ invocations: Bool := false
+ deriving Lean.FromJson
structure InvokedTactic where
goalBefore: String
goalAfter: String
tactic: String
deriving Lean.ToJson
-structure CompileTacticsResult where
- invocations: List InvokedTactic
+structure CompileUnitResult where
+ units?: Option $ List (Nat × Nat)
+ invocations?: Option $ List InvokedTactic
deriving Lean.ToJson
abbrev CR α := Except InteractionError α
From a2c5c7448c38fbc3f04523bc758a35c80bf6e12f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 31 May 2024 20:22:16 -0700
Subject: [PATCH 212/465] chore: Code simplification, version bump
---
Pantograph/Compile.lean | 5 -----
Pantograph/Compile/Elab.lean | 13 +++----------
Pantograph/Version.lean | 2 +-
3 files changed, 4 insertions(+), 16 deletions(-)
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
index 6d3f5d9..15081d9 100644
--- a/Pantograph/Compile.lean
+++ b/Pantograph/Compile.lean
@@ -8,16 +8,12 @@ open Lean
namespace Pantograph.Compile
---def readCompilationUnits (module : Name) : IO Protocol.CompileUnitsResult := do
--- let steps ← processSource module
--- return { units := steps.map (·.src.toString) }
def collectTacticsFromCompilation (steps : List CompilationStep) : IO (List Protocol.InvokedTactic) := do
let infoTrees := steps.bind (·.trees)
let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal
| _ => false
let tactics := tacticInfoTrees.bind collectTactics
- IO.println s!"{steps.length} compilation steps, {infoTrees.length} trees found, {tacticInfoTrees.length} tactic trees, {tactics.length} tactics found"
tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
@@ -26,5 +22,4 @@ def collectTacticsFromCompilation (steps : List CompilationStep) : IO (List Prot
return t.pretty
return { goalBefore, goalAfter, tactic }
-
end Pantograph.Compile
diff --git a/Pantograph/Compile/Elab.lean b/Pantograph/Compile/Elab.lean
index a13a5e0..79833f3 100644
--- a/Pantograph/Compile/Elab.lean
+++ b/Pantograph/Compile/Elab.lean
@@ -109,12 +109,6 @@ protected def runMetaM (t : TacticInvocation) (x : MVarId → MetaM α) : IO α
| none => throw <| IO.userError s!"No goals at {← t.pp}"
| some g => t.runMetaMGoalsBefore fun _ => do g.withContext <| x g
-protected def mainGoal (t : TacticInvocation) : IO Expr :=
- t.runMetaM (fun g => do instantiateMVars (← g.getType))
-
-protected def formatMainGoal (t : TacticInvocation) : IO Format :=
- t.runMetaM (fun g => do Meta.ppExpr (← instantiateMVars (← g.getType)))
-
protected def goalState (t : TacticInvocation) : IO (List Format) := do
t.runMetaMGoalsBefore (fun gs => gs.mapM fun g => do Meta.ppGoal g)
@@ -137,17 +131,16 @@ partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pre
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/
-def collectTacticNodes (t : Elab.InfoTree) : List (Elab.TacticInfo × Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
let infos := findAllInfo t none fun i => match i with
| .ofTacticInfo _ => true
| _ => false
infos.filterMap fun p => match p with
- | (.ofTacticInfo i, some ctx, children) => (i, ctx, children)
+ | (.ofTacticInfo i, some ctx, children) => .some ⟨i, ctx, children⟩
| _ => none
def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
- collectTacticNodes t |>.map (fun ⟨i, ctx, children⟩ => ⟨i, ctx, children⟩)
- |>.filter fun i => i.info.isSubstantive
+ collectTacticNodes t |>.filter fun i => i.info.isSubstantive
end Pantograph.Compile
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 4ab34c4..207b597 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.15"
+def version := "0.2.16"
end Pantograph
From 3c90c94645eca5b8ecdc50773180a3543943d2bd Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 5 Jun 2024 13:45:13 -0700
Subject: [PATCH 213/465] fix: Execute instantiateAll in goal state diag
---
Pantograph/Serial.lean | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index a6c0ece..e12bb7a 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -264,7 +264,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
name := ofName goal.name,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
- target := (← serializeExpression options (← instantiateMVars (← instantiate mvarDecl.type))),
+ target := (← serializeExpression options (← instantiate mvarDecl.type)),
vars := vars.reverse.toArray
}
where
@@ -319,7 +319,7 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
else
pure []
let type ← if options.instantiate
- then instantiateMVars decl.type
+ then instantiateAll decl.type
else pure $ decl.type
let type_sexp ← serializeExpressionSexp type (sanitize := false)
let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
@@ -327,7 +327,7 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
let value ← if options.instantiate
- then instantiateMVars value
+ then instantiateAll value
else pure $ value
pure s!"\n := {← Meta.ppExpr value}"
else
From 6dcff8b1518f8f6fa42095065398b879254fae09 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 5 Jun 2024 15:56:20 -0700
Subject: [PATCH 214/465] fix: Print diag in mvar context
---
Pantograph/Protocol.lean | 1 +
Pantograph/Serial.lean | 10 +++++++---
2 files changed, 8 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index f73c3b0..271d4b7 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -273,6 +273,7 @@ structure GoalDiag where
-- Print all mvars
printAll: Bool := false
instantiate: Bool := true
+ printSexp: Bool := false
abbrev CR α := Except InteractionError α
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index e12bb7a..8f56468 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -311,7 +311,7 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
)
pure $ result ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
where
- printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := do
+ printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := mvarId.withContext do
let resultFVars: List String ←
if options.printContext then
decl.lctx.fvarIdToDecl.toList.mapM (λ (fvarId, decl) =>
@@ -321,8 +321,12 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
let type ← if options.instantiate
then instantiateAll decl.type
else pure $ decl.type
- let type_sexp ← serializeExpressionSexp type (sanitize := false)
- let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type} {type_sexp}"
+ let type_sexp ← if options.printSexp then
+ let sexp ← serializeExpressionSexp type (sanitize := false)
+ pure <| " " ++ sexp
+ else
+ pure ""
+ let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}{type_sexp}"
let resultValue: String ←
if options.printValue then
if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
From 3a534930894490d12248c4335d42cdf3e2baca56 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 5 Jun 2024 16:14:52 -0700
Subject: [PATCH 215/465] feat: Show delayed assignment in goal diag
---
Pantograph/Serial.lean | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 8f56468..5cccb4e 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -329,11 +329,13 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
let resultMain: String := s!"{pref}{mvarId.name}{userNameToString decl.userName}: {← Meta.ppExpr decl.type}{type_sexp}"
let resultValue: String ←
if options.printValue then
- if let Option.some value := (← getMCtx).eAssignment.find? mvarId then
+ if let .some value ← getExprMVarAssignment? mvarId then
let value ← if options.instantiate
then instantiateAll value
else pure $ value
pure s!"\n := {← Meta.ppExpr value}"
+ else if let .some { mvarIdPending, .. } ← getDelayedMVarAssignment? mvarId then
+ pure s!"\n := $ {mvarIdPending.name}"
else
pure ""
else
From 773a0afbd8a354093c9576df7be19f60f75d57df Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 11 Jun 2024 12:44:42 -0700
Subject: [PATCH 216/465] feat: Handling of universe level names in elab
---
Pantograph.lean | 4 +--
Pantograph/Library.lean | 66 ++++++++++++++++++++--------------------
Pantograph/Protocol.lean | 4 +++
Pantograph/Serial.lean | 4 ++-
README.md | 6 ++--
Test/Integration.lean | 2 +-
Test/Serial.lean | 33 +++++++++++---------
7 files changed, 64 insertions(+), 55 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index c637303..e34e8e4 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -71,7 +71,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
- exprEcho args.expr args.type? state.options
+ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
let state ← get
let options := state.options
@@ -94,7 +94,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => goalStartExpr expr
+ | .some expr, .none => goalStartExpr expr (args.levels.getD #[])
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6505fec..f14d8ea 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -34,16 +34,16 @@ def setOptionFromString' (opts : Options) (entry : String) : ExceptT String IO O
end Lean
+open Lean
+
namespace Pantograph
-def defaultTermElabMContext: Lean.Elab.Term.Context := {
- autoBoundImplicit := true,
- declName? := some "_pantograph".toName,
+def defaultTermElabMContext: Elab.Term.Context := {
errToSorry := false
}
-def runMetaM { α } (metaM: Lean.MetaM α): Lean.CoreM α :=
+def runMetaM { α } (metaM: MetaM α): CoreM α :=
metaM.run'
-def runTermElabM { α } (termElabM: Lean.Elab.TermElabM α): Lean.CoreM α :=
+def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
termElabM.run' (ctx := defaultTermElabMContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
@@ -56,13 +56,13 @@ unsafe def initSearch (sp: String): IO Unit := do
/-- Creates a Core.Context object needed to run all monads -/
@[export pantograph_create_core_context]
-def createCoreContext (options: Array String): IO Lean.Core.Context := do
- let options? ← options.foldlM Lean.setOptionFromString' Lean.Options.empty |>.run
+def createCoreContext (options: Array String): IO Core.Context := do
+ let options? ← options.foldlM setOptionFromString' Options.empty |>.run
let options ← match options? with
| .ok options => pure options
| .error e => throw $ IO.userError s!"Options cannot be parsed: {e}"
return {
- currNamespace := Lean.Name.str .anonymous "Aniva"
+ currNamespace := Name.str .anonymous "Aniva"
openDecls := [], -- No 'open' directives needed
fileName := "<Pantograph>",
fileMap := { source := "", positions := #[0] },
@@ -71,7 +71,7 @@ def createCoreContext (options: Array String): IO Lean.Core.Context := do
/-- Creates a Core.State object needed to run all monads -/
@[export pantograph_create_core_state]
-def createCoreState (imports: Array String): IO Lean.Core.State := do
+def createCoreState (imports: Array String): IO Core.State := do
let env ← Lean.importModules
(imports := imports.map (λ str => { module := str.toName, runtimeOnly := false }))
(opts := {})
@@ -79,33 +79,33 @@ def createCoreState (imports: Array String): IO Lean.Core.State := do
return { env := env }
@[export pantograph_env_catalog_m]
-def envCatalog: Lean.CoreM Protocol.EnvCatalogResult :=
+def envCatalog: CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
@[export pantograph_env_inspect_m]
def envInspect (name: String) (value: Bool) (dependency: Bool) (options: @&Protocol.Options):
- Lean.CoreM (Protocol.CR Protocol.EnvInspectResult) :=
+ CoreM (Protocol.CR Protocol.EnvInspectResult) :=
Environment.inspect ({
name, value? := .some value, dependency?:= .some dependency
}: Protocol.EnvInspect) options
@[export pantograph_env_add_m]
def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
- Lean.CoreM (Protocol.CR Protocol.EnvAddResult) :=
+ CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
-def parseElabType (type: String): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
- let env ← Lean.MonadEnv.getEnv
+def parseElabType (type: String): Elab.TermElabM (Protocol.CR Expr) := do
+ let env ← MonadEnv.getEnv
let syn ← match parseTerm env type with
| .error str => return .error $ errorI "parsing" str
| .ok syn => pure syn
match ← elabType syn with
| .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok (← Lean.instantiateMVars expr)
+ | .ok expr => return .ok (← instantiateMVars expr)
/-- This must be a TermElabM since the parsed expr contains extra information -/
-def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.Elab.TermElabM (Protocol.CR Lean.Expr) := do
- let env ← Lean.MonadEnv.getEnv
+def parseElabExpr (expr: String) (expectedType?: Option String := .none): Elab.TermElabM (Protocol.CR Expr) := do
+ let env ← MonadEnv.getEnv
let expectedType? ← match ← expectedType?.mapM parseElabType with
| .none => pure $ .none
| .some (.ok t) => pure $ .some t
@@ -115,17 +115,17 @@ def parseElabExpr (expr: String) (expectedType?: Option String := .none): Lean.E
| .ok syn => pure syn
match ← elabTerm syn expectedType? with
| .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok (← Lean.instantiateMVars expr)
+ | .ok expr => return .ok (← instantiateMVars expr)
@[export pantograph_expr_echo_m]
-def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options):
- Lean.CoreM (Protocol.CR Protocol.ExprEchoResult) :=
- runTermElabM do
+def exprEcho (expr: String) (expectedType?: Option String := .none) (levels: Array String := #[]) (options: @&Protocol.Options := {}):
+ CoreM (Protocol.CR Protocol.ExprEchoResult) :=
+ runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
let expr ← match ← parseElabExpr expr expectedType? with
| .error e => return .error e
| .ok expr => pure expr
try
- let type ← unfoldAuxLemmas (← Lean.Meta.inferType expr)
+ let type ← unfoldAuxLemmas (← Meta.inferType expr)
return .ok {
type := (← serializeExpression options type),
expr := (← serializeExpression options expr)
@@ -134,38 +134,38 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&
return .error $ errorI "typing" (← exception.toMessageData.toString)
@[export pantograph_goal_start_expr_m]
-def goalStartExpr (expr: String): Lean.CoreM (Protocol.CR GoalState) :=
- runTermElabM do
+def goalStartExpr (expr: String) (levels: Array String): CoreM (Protocol.CR GoalState) :=
+ runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
let expr ← match ← parseElabType expr with
| .error e => return .error e
| .ok expr => pure $ expr
return .ok $ ← GoalState.create expr
@[export pantograph_goal_tactic_m]
-def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): Lean.CoreM TacticResult :=
+def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): CoreM TacticResult :=
runTermElabM <| state.tryTactic goalId tactic
@[export pantograph_goal_assign_m]
-def goalAssign (state: GoalState) (goalId: Nat) (expr: String): Lean.CoreM TacticResult :=
+def goalAssign (state: GoalState) (goalId: Nat) (expr: String): CoreM TacticResult :=
runTermElabM <| state.tryAssign goalId expr
@[export pantograph_goal_have_m]
-def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryHave goalId binderName type
@[export pantograph_goal_let_m]
-def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): Lean.CoreM TacticResult :=
+def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type
@[export pantograph_goal_conv_m]
-def goalConv (state: GoalState) (goalId: Nat): Lean.CoreM TacticResult :=
+def goalConv (state: GoalState) (goalId: Nat): CoreM TacticResult :=
runTermElabM <| state.conv goalId
@[export pantograph_goal_conv_exit_m]
-def goalConvExit (state: GoalState): Lean.CoreM TacticResult :=
+def goalConvExit (state: GoalState): CoreM TacticResult :=
runTermElabM <| state.convExit
@[export pantograph_goal_calc_m]
-def goalCalc (state: GoalState) (goalId: Nat) (pred: String): Lean.CoreM TacticResult :=
+def goalCalc (state: GoalState) (goalId: Nat) (pred: String): CoreM TacticResult :=
runTermElabM <| state.tryCalc goalId pred
@[export pantograph_goal_focus]
@@ -181,11 +181,11 @@ def goalContinue (target: GoalState) (branch: GoalState): Except String GoalStat
target.continue branch
@[export pantograph_goal_serialize_m]
-def goalSerialize (state: GoalState) (options: @&Protocol.Options): Lean.CoreM (Array Protocol.Goal) :=
+def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m]
-def goalPrint (state: GoalState) (options: @&Protocol.Options): Lean.CoreM Protocol.GoalPrintResult :=
+def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
runMetaM do
state.restoreMetaM
return {
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 17618fc..0d5da7e 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -101,6 +101,8 @@ structure StatResult where
structure ExprEcho where
expr: String
type?: Option String
+ -- universe levels
+ levels: Option (Array String) := .none
deriving Lean.FromJson
structure ExprEchoResult where
expr: Expression
@@ -198,6 +200,8 @@ abbrev OptionsPrintResult := Options
structure GoalStart where
-- Only one of the fields below may be populated.
expr: Option String -- Directly parse in an expression
+ -- universe levels
+ levels: Option (Array String) := .none
copyFrom: Option String -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure GoalStartResult where
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 950818e..8c16a01 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -1,5 +1,7 @@
/-
-All serialisation functions
+All serialisation functions;
+This replicates the behaviour of `Scope`s in `Lean/Elab/Command.lean` without
+using `Scope`s.
-/
import Lean
diff --git a/README.md b/README.md
index 508d026..c136337 100644
--- a/README.md
+++ b/README.md
@@ -82,8 +82,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
* `stat`: Display resource usage
-* `expr.echo {"expr": <expr>, "type": <optional expected type>}`: Determine the
- type of an expression and format it
+* `expr.echo {"expr": <expr>, "type": <optional expected type>, ["levels": [<levels>]]}`: Determine the
+ type of an expression and format it.
* `env.catalog`: Display a list of all safe Lean symbols in the current environment
* `env.inspect {"name": <name>, "value": <bool>}`: Show the type and package of a
given symbol; If value flag is set, the value is printed or hidden. By default
@@ -91,7 +91,7 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
* `options.print`: Display the current set of options
-* `goal.start {["name": <name>], ["expr": <expr>], ["copyFrom": <symbol>]}`:
+* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 29cb82d..a9ced23 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -35,7 +35,7 @@ def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := d
def test_elab : IO LSpec.TestSeq :=
subroutine_runner [
subroutine_step "expr.echo"
- [("expr", .str "λ {α : Sort (u + 1)} => List α")]
+ [("expr", .str "λ {α : Sort (u + 1)} => List α"), ("levels", .arr #["u"])]
(Lean.toJson ({
type := { pp? := .some "{α : Type u} → Type u" },
expr := { pp? := .some "fun {α} => List α" }
diff --git a/Test/Serial.lean b/Test/Serial.lean
index f55c18f..8819378 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -47,23 +47,26 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
- let entries: List (String × String) := [
- ("λ x: Nat × Bool => x.1", "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
- ("λ x: Array Nat => x.data", "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
+ let entries: List (String × (List Name) × String) := [
+ ("λ x: Nat × Bool => x.1", [], "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
+ ("λ x: Array Nat => x.data", [], "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
-- This tests `autoBoundImplicit`
- ("λ {α : Sort (u + 1)} => List α", "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
+ ("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
+ ("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :implicit)"),
]
- let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (source, target) => do
- let env ← MonadEnv.getEnv
- let s ← match parseTerm env source with
- | .ok s => pure s
- | .error e => return parseFailure e
- let expr ← match (← elabTerm s) with
- | .ok expr => pure expr
- | .error e => return elabFailure e
- let test := LSpec.check source ((← serializeExpressionSexp expr) = target)
- return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
+ entries.foldlM (λ suites (source, levels, target) =>
+ let termElabM := do
+ let env ← MonadEnv.getEnv
+ let s ← match parseTerm env source with
+ | .ok s => pure s
+ | .error e => return parseFailure e
+ let expr ← match (← elabTerm s) with
+ | .ok expr => pure expr
+ | .error e => return elabFailure e
+ return LSpec.check source ((← serializeExpressionSexp expr) = target)
+ let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := defaultTermElabMContext)
+ return LSpec.TestSeq.append suites (← runMetaMSeq env metaM))
+ LSpec.TestSeq.done
def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let entries: List (Expr × String) := [
From b3a60fcea84bb220a68bea045bd1a2d69041f20f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 13 Jun 2024 14:24:22 -0700
Subject: [PATCH 217/465] refactor: Rename TacticExecute to SyntheticTactic
---
Pantograph/Library.lean | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 367d4d7..8036103 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -204,15 +204,16 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Core
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): CoreM TacticResult :=
runTermElabM <| state.tryNoConfuse goalId eq
-inductive TacticExecute where
+inductive SyntheticTactic where
| congruenceArg
| congruenceFun
| congruence
-@[export pantograph_goal_tactic_execute_m]
-def goalTacticExecute (state: GoalState) (goalId: Nat) (tacticExecute: TacticExecute): CoreM TacticResult :=
+/-- Executes a synthetic tactic which has no arguments -/
+@[export pantograph_goal_synthetic_tactic_m]
+def goalSyntheticTactic (state: GoalState) (goalId: Nat) (case: SyntheticTactic): CoreM TacticResult :=
runTermElabM do
state.restoreElabM
- state.execute goalId $ match tacticExecute with
+ state.execute goalId $ match case with
| .congruenceArg => Tactic.congruenceArg
| .congruenceFun => Tactic.congruenceFun
| .congruence => Tactic.congruence
From f80d90ce87dfe6c1561c15aca5ecab1a8c2a1ca7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Jun 2024 11:58:23 -0700
Subject: [PATCH 218/465] fix: Goal diag missing newline character
---
Pantograph/Serial.lean | 12 ++++++------
Test/Tactic/Congruence.lean | 29 +++++++++++++++++++++++++++++
2 files changed, 35 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 159b78e..e729bee 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -307,11 +307,11 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
let goals := goals.toSSet
let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
!(goals.contains mvarId || mvarId == root) && options.printAll)
- |>.mapM (fun (mvarId, decl) => do
- let pref := if goalState.newMVars.contains mvarId then "~" else " "
- printMVar pref mvarId decl
- )
- pure $ result ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
+ |>.mapM (fun (mvarId, decl) => do
+ let pref := if goalState.newMVars.contains mvarId then "~" else " "
+ printMVar pref mvarId decl
+ )
+ pure $ result ++ "\n" ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
where
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := mvarId.withContext do
let resultFVars: List String ←
@@ -337,7 +337,7 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
else pure $ value
pure s!"\n := {← Meta.ppExpr value}"
else if let .some { mvarIdPending, .. } ← getDelayedMVarAssignment? mvarId then
- pure s!"\n := $ {mvarIdPending.name}"
+ pure s!"\n ::= {mvarIdPending.name}"
else
pure ""
else
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 1421263..6e8f547 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -7,6 +7,34 @@ open Pantograph
namespace Pantograph.Test.Tactic.Congruence
+def test_congr_arg_list (env: Environment): IO LSpec.TestSeq :=
+ let expr := "λ {α} (l1 l2 : List α) (h: l1 = l2) => l1.reverse = l2.reverse"
+ runMetaMSeq env do
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let mut tests := LSpec.TestSeq.done
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let (newGoals, test) ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ let test := LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.30"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`f, "?α → List α"),
+ (`h, "?a₁ = ?a₂"),
+ (`conduit, "(?f ?a₁ = ?f ?a₂) = (l1.reverse = l2.reverse)"),
+ ])
+ return (newGoals, test)
+ tests := tests ++ test
+ let f := newGoals.get! 3
+ let h := newGoals.get! 4
+ let c := newGoals.get! 5
+ let results ← f.apply (← parseSentence "List.reverse")
+ tests := tests ++ (LSpec.check "apply" (results.length = 0))
+ tests := tests ++ (LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂"))
+ tests := tests ++ (LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)"))
+ return tests
def test_congr_arg (env: Environment): IO LSpec.TestSeq :=
let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
runMetaMSeq env do
@@ -72,6 +100,7 @@ def test_congr (env: Environment): IO LSpec.TestSeq :=
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
+ ("congrArg List.reverse", test_congr_arg_list env),
("congrArg", test_congr_arg env),
("congrFun", test_congr_fun env),
("congr", test_congr env),
From 8707dbc9bb09f42a6fe8739a0846b84e4941004f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 16 Jun 2024 13:44:57 -0700
Subject: [PATCH 219/465] fix: aux lemmas in env inspect
---
Pantograph/Environment.lean | 15 ++++++++-------
1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index b696c25..d5cdc3d 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -52,21 +52,22 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
| .some false, _ => .none
| .none, .defnInfo _ => info.value?
| .none, _ => .none
+ let type ← unfoldAuxLemmas info.type
+ let value? ← value?.mapM (λ v => unfoldAuxLemmas v)
-- Information common to all symbols
let core := {
- type := ← (serializeExpression options info.type).run',
+ type := ← (serializeExpression options type).run',
isUnsafe := info.isUnsafe,
value? := ← value?.mapM (λ v => serializeExpression 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 => serializeName n)
+ then .some <| type.getUsedConstants.map (λ n => serializeName n)
+ else .none,
+ valueDependency? := if args.dependency?.getD false
+ then value?.map (λ e =>
+ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
else .none,
- valueDependency? := ← if args.dependency?.getD false
- then info.value?.mapM (λ e => do
- let e ← unfoldAuxLemmas e
- pure $ e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
- else pure (.none),
module? := module?
}
let result ← match info with
From 25a7025c254102da74ad89343801719769bc62b4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 23 Jun 2024 15:01:51 -0700
Subject: [PATCH 220/465] feat: Evaluation tactic
---
Pantograph/Goal.lean | 12 ++++++++++++
Pantograph/Tactic.lean | 2 +-
Pantograph/Tactic/Prograde.lean | 22 ++++++++++++++++++++++
3 files changed, 35 insertions(+), 1 deletion(-)
create mode 100644 Pantograph/Tactic/Prograde.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 46888e7..ebe29fb 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -302,6 +302,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
Meta.withNewLocalInstances #[fvar] 0 do
let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
(← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
+ -- FIXME: May be redundant?
let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
goal.assign expr
pure mvarUpstream
@@ -537,5 +538,16 @@ protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: Strin
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.noConfuse recursor)
+protected def GoalState.tryEval (state: GoalState) (goalId: Nat) (binderName: Name) (expr: String) :
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let expr ← match Parser.runParserCategory
+ (env := state.env)
+ (catName := `term)
+ (input := expr)
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ state.execute goalId (tacticM := Tactic.tacticEval binderName expr)
end Pantograph
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 225ad31..094d1f8 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -1,4 +1,4 @@
-
import Pantograph.Tactic.Congruence
import Pantograph.Tactic.MotivatedApply
import Pantograph.Tactic.NoConfuse
+import Pantograph.Tactic.Prograde
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
new file mode 100644
index 0000000..f37a1e5
--- /dev/null
+++ b/Pantograph/Tactic/Prograde.lean
@@ -0,0 +1,22 @@
+/- Prograde (forward) reasoning tactics -/
+
+import Lean
+open Lean
+
+namespace Pantograph.Tactic
+
+def tacticEval (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let nextGoals ← goal.withContext do
+ let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
+ let type ← Meta.inferType expr
+
+ let mvarUpstream ← Meta.withLetDecl binderName type expr λ _ => do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
+ goal.assign mvarUpstream
+ pure mvarUpstream
+ pure [mvarUpstream.mvarId!]
+ Elab.Tactic.setGoals nextGoals
+
+end Pantograph.Tactic
From e282d9f7815e8ea616da07185ae55062527831b4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 11:03:08 -0400
Subject: [PATCH 221/465] test: Evaluation tactic
---
Pantograph/Goal.lean | 2 +-
Pantograph/Serial.lean | 2 +-
Pantograph/Tactic/Prograde.lean | 2 +-
Test/Common.lean | 11 +++++++++
Test/Main.lean | 1 +
Test/Tactic.lean | 1 +
Test/Tactic/Prograde.lean | 42 +++++++++++++++++++++++++++++++++
7 files changed, 58 insertions(+), 3 deletions(-)
create mode 100644 Test/Tactic/Prograde.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index ebe29fb..db73a48 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -548,6 +548,6 @@ protected def GoalState.tryEval (state: GoalState) (goalId: Nat) (binderName: Na
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.execute goalId (tacticM := Tactic.tacticEval binderName expr)
+ state.execute goalId (tacticM := Tactic.evaluate binderName expr)
end Pantograph
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 159b78e..5f08186 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -202,7 +202,7 @@ def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.
}
/-- Adapted from ppGoal -/
-def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
+def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl := .none)
: MetaM Protocol.Goal := do
-- Options for printing; See Meta.ppGoal for details
let showLetValues := true
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index f37a1e5..81dd28c 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -5,7 +5,7 @@ open Lean
namespace Pantograph.Tactic
-def tacticEval (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
+def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← goal.withContext do
let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
diff --git a/Test/Common.lean b/Test/Common.lean
index c656309..e4e1d4c 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -8,6 +8,17 @@ open Lean
namespace Pantograph
+deriving instance Repr for Expr
+-- Use strict equality check for expressions
+--instance : BEq Expr := ⟨Expr.equal⟩
+instance (priority := 80) (x y : Expr) : LSpec.Testable (x.equal y) :=
+ if h : Expr.equal x y then
+ .isTrue h
+ else
+ .isFalse h $ s!"Expected to be equalaaa: '{x.dbgToString}' and '{y.dbgToString}'"
+
+def uniq (n: Nat): Name := .num (.str .anonymous "_uniq") n
+
-- Auxiliary functions
namespace Protocol
def Goal.devolatilizeVars (goal: Goal): Goal :=
diff --git a/Test/Main.lean b/Test/Main.lean
index 31042c5..89c757a 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -52,6 +52,7 @@ def main (args: List String) := do
("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
+ ("Tactic/Prograde", Tactic.Prograde.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
LSpec.lspecIO (← runTestGroup name_filter tests)
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
index 5863ec0..3cb0e40 100644
--- a/Test/Tactic.lean
+++ b/Test/Tactic.lean
@@ -1,3 +1,4 @@
import Test.Tactic.Congruence
import Test.Tactic.MotivatedApply
import Test.Tactic.NoConfuse
+import Test.Tactic.Prograde
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
new file mode 100644
index 0000000..863aca5
--- /dev/null
+++ b/Test/Tactic/Prograde.lean
@@ -0,0 +1,42 @@
+import LSpec
+import Lean
+import Test.Common
+
+open Lean
+open Pantograph
+
+namespace Pantograph.Test.Tactic.Prograde
+
+def test_eval (env: Environment): IO LSpec.TestSeq :=
+ let expr := "forall (p q : Prop) (h: p), And (Or p q) (Or p q)"
+ runMetaMSeq env do
+ let expr ← parseSentence expr
+ Meta.forallTelescope expr $ λ _ body => do
+ let e ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "Or.inl h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let mut tests := LSpec.TestSeq.done
+ -- Apply the tactic
+ let goal ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let target: Expr := mkAnd
+ (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
+ (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
+ let test := LSpec.test "goals before" ((← goal.mvarId!.getType) == target)
+ tests := tests ++ test
+ let tactic := Tactic.evaluate `h2 e
+ let test ← runTermElabMInMeta do
+ let newGoals ← runTacticOnMVar tactic goal.mvarId!
+ pure $ LSpec.test "goals after" ((← newGoals.head!.getType) == target)
+ tests := tests ++ test
+ return tests
+
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("eval", test_eval env),
+ ]
+
+end Pantograph.Test.Tactic.Prograde
From ffbea41f627741e70e2b1d01ac8663b9acd12777 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 15:13:58 -0400
Subject: [PATCH 222/465] feat: Condensed interface
---
Pantograph/Condensed.lean | 42 ++++++++++++++++++++++++++++++
Pantograph/Serial.lean | 54 ++++++++++++++++++++++++++++++++++++---
Test/Common.lean | 11 ++++++++
3 files changed, 104 insertions(+), 3 deletions(-)
create mode 100644 Pantograph/Condensed.lean
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
new file mode 100644
index 0000000..57a8517
--- /dev/null
+++ b/Pantograph/Condensed.lean
@@ -0,0 +1,42 @@
+/- structures for FFI based interface -/
+import Lean
+
+open Lean
+
+namespace Pantograph.Condensed
+
+/-
+These two functions are for user defiend names. For internal names such as
+`_uniq`, it is favourable to use `lean_name_hash_exported` and `lean_name_eq` to
+construct hash maps for Lean names.
+-/
+@[export pantograph_str_to_name]
+def strToName (s: String) : Name := s.toName
+@[export pantograph_name_to_str]
+def nameToStr (s: String) : Name := s.toName
+@[export pantograph_name_is_inaccessible]
+def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName
+
+-- Mirrors Lean's LocalDecl
+structure LocalDecl where
+ -- Default value is for testing
+ fvarId: FVarId := { name := .anonymous }
+ userName: Name
+
+ -- Normalized expression
+ type : Expr
+ value? : Option Expr := .none
+
+structure Goal where
+ mvarId: MVarId := { name := .anonymous }
+ userName: Name := .anonymous
+ context: Array LocalDecl
+ target: Expr
+
+@[export pantograph_goal_is_lhs]
+def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
+
+
+
+
+end Pantograph.Condensed
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index e729bee..2cdf3d6 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -4,10 +4,10 @@ This replicates the behaviour of `Scope`s in `Lean/Elab/Command.lean` without
using `Scope`s.
-/
import Lean
+import Pantograph.Condensed
import Pantograph.Expr
-
-import Pantograph.Protocol
import Pantograph.Goal
+import Pantograph.Protocol
open Lean
@@ -201,6 +201,55 @@ def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.
dependentMVars?,
}
+@[export pantograph_to_condensed_goal]
+def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
+ let options: Protocol.Options := {}
+ let ppAuxDecls := options.printAuxDecls
+ let ppImplDetailHyps := options.printImplementationDetailHyps
+ let mvarDecl ← mvarId.getDecl
+ let lctx := mvarDecl.lctx
+ let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
+ Meta.withLCtx lctx mvarDecl.localInstances do
+ let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
+ match localDecl with
+ | .cdecl _ fvarId userName type _ _ =>
+ let type ← instantiate type
+ return { fvarId, userName, type }
+ | .ldecl _ fvarId userName type value _ _ => do
+ let userName := userName.simpMacroScopes
+ let type ← instantiate type
+ let value ← instantiate value
+ return { fvarId, userName, type, value? := .some value }
+ let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
+ let skip := !ppAuxDecls && localDecl.isAuxDecl ||
+ !ppImplDetailHyps && localDecl.isImplementationDetail
+ if skip then
+ return acc
+ else
+ let var ← ppVar localDecl
+ return var::acc
+ return {
+ mvarId,
+ userName := mvarDecl.userName,
+ context := vars.reverse.toArray,
+ target := ← instantiate mvarDecl.type
+ }
+ where
+ instantiate := instantiateAll
+
+@[export pantograph_goal_state_to_condensed]
+protected def GoalState.toCondensed (state: GoalState):
+ CoreM (Array Condensed.Goal):= do
+ let metaM := do
+ let goals := state.goals.toArray
+ goals.mapM fun goal => do
+ match state.mctx.findDecl? goal with
+ | .some _ =>
+ let serializedGoal ← toCondensedGoal goal
+ pure serializedGoal
+ | .none => throwError s!"Metavariable does not exist in context {goal.name}"
+ metaM.run' (s := state.savedState.term.meta.meta)
+
/-- Adapted from ppGoal -/
def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
: MetaM Protocol.Goal := do
@@ -214,7 +263,6 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
let ppVarNameOnly (localDecl: LocalDecl): MetaM Protocol.Variable := do
match localDecl with
| .cdecl _ fvarId userName _ _ _ =>
- let userName := userName.simpMacroScopes
return {
name := ofName fvarId.name,
userName:= ofName userName.simpMacroScopes,
diff --git a/Test/Common.lean b/Test/Common.lean
index c656309..e4e1d4c 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -8,6 +8,17 @@ open Lean
namespace Pantograph
+deriving instance Repr for Expr
+-- Use strict equality check for expressions
+--instance : BEq Expr := ⟨Expr.equal⟩
+instance (priority := 80) (x y : Expr) : LSpec.Testable (x.equal y) :=
+ if h : Expr.equal x y then
+ .isTrue h
+ else
+ .isFalse h $ s!"Expected to be equalaaa: '{x.dbgToString}' and '{y.dbgToString}'"
+
+def uniq (n: Nat): Name := .num (.str .anonymous "_uniq") n
+
-- Auxiliary functions
namespace Protocol
def Goal.devolatilizeVars (goal: Goal): Goal :=
From 8e78718447456d20b5c54e36384223ffad577bc3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 15:54:55 -0400
Subject: [PATCH 223/465] feat: Extract MetaM context and state from goal
---
Pantograph/Goal.lean | 12 ++++++++++--
1 file changed, 10 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 46888e7..2723c4f 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -63,9 +63,16 @@ protected def GoalState.mctx (state: GoalState): MetavarContext :=
protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
+@[export pantograph_goal_state_meta_context_of_goal]
+protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): Option Meta.Context := do
+ let mvarDecl ← state.mctx.findDecl? mvarId
+ return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances }
+@[export pantograph_goal_state_meta_state]
+protected def GoalState.metaState (state: GoalState): Meta.State :=
+ state.savedState.term.meta.meta
+
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
- let metaM := mvarId.withContext m
- metaM.run' (← read) state.savedState.term.meta.meta
+ mvarId.withContext m |>.run' (← read) state.metaState
protected def GoalState.withParentContext (state: GoalState) (m: MetaM α): MetaM α := do
state.withContext state.parentMVar?.get! m
@@ -82,6 +89,7 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
state.savedState.restore
Elab.Tactic.setGoals [goal]
+
private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
From 58f9d72288d9f2870d5fdecb8afc84d974427cd9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 16:18:31 -0400
Subject: [PATCH 224/465] test: Evaluate tactic context
---
Test/Common.lean | 27 +++++++++++++++++++++------
Test/Tactic/Prograde.lean | 27 ++++++++++++++++++++++++---
2 files changed, 45 insertions(+), 9 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index e4e1d4c..df0edcd 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -1,6 +1,7 @@
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
+import Pantograph.Condensed
import Lean
import LSpec
@@ -10,12 +11,7 @@ namespace Pantograph
deriving instance Repr for Expr
-- Use strict equality check for expressions
---instance : BEq Expr := ⟨Expr.equal⟩
-instance (priority := 80) (x y : Expr) : LSpec.Testable (x.equal y) :=
- if h : Expr.equal x y then
- .isTrue h
- else
- .isFalse h $ s!"Expected to be equalaaa: '{x.dbgToString}' and '{y.dbgToString}'"
+instance : BEq Expr := ⟨Expr.equal⟩
def uniq (n: Nat): Name := .num (.str .anonymous "_uniq") n
@@ -25,6 +21,7 @@ def Goal.devolatilizeVars (goal: Goal): Goal :=
{
goal with
vars := goal.vars.map removeInternalAux,
+
}
where removeInternalAux (v: Variable): Variable :=
{
@@ -47,6 +44,24 @@ deriving instance DecidableEq, Repr for InteractionError
deriving instance DecidableEq, Repr for Option
end Protocol
+namespace Condensed
+
+deriving instance BEq, Repr for LocalDecl
+deriving instance BEq, Repr for Goal
+
+protected def LocalDecl.devolatilize (decl: LocalDecl): LocalDecl :=
+ {
+ decl with fvarId := { name := .anonymous }
+ }
+protected def Goal.devolatilize (goal: Goal): Goal :=
+ {
+ goal with
+ mvarId := { name := .anonymous },
+ context := goal.context.map LocalDecl.devolatilize
+ }
+
+end Condensed
+
def TacticResult.toString : TacticResult → String
| .success state => s!".success ({state.goals.length} goals)"
| .failure messages =>
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 863aca5..d959f4f 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -25,12 +25,33 @@ def test_eval (env: Environment): IO LSpec.TestSeq :=
let target: Expr := mkAnd
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
(mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
- let test := LSpec.test "goals before" ((← goal.mvarId!.getType) == target)
+ let h := .fvar ⟨uniq 8⟩
+ let test := LSpec.test "goals before" ((← toCondensedGoal goal.mvarId!).devolatilize == {
+ context := #[
+ { userName := `p, type := .sort 0 },
+ { userName := `q, type := .sort 0 },
+ { userName := `h, type := h}
+ ],
+ target,
+ })
tests := tests ++ test
let tactic := Tactic.evaluate `h2 e
+ let m := .mvar ⟨uniq 13⟩
let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar tactic goal.mvarId!
- pure $ LSpec.test "goals after" ((← newGoals.head!.getType) == target)
+ let [goal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
+ pure $ LSpec.test "goals after" ((← toCondensedGoal goal).devolatilize == {
+ context := #[
+ { userName := `p, type := .sort 0 },
+ { userName := `q, type := .sort 0 },
+ { userName := `h, type := h},
+ {
+ userName := `h2,
+ type := mkOr h m,
+ value? := .some $ mkApp3 (mkConst `Or.inl) h m (.fvar ⟨uniq 10⟩)
+ }
+ ],
+ target,
+ })
tests := tests ++ test
return tests
From 7acf1ffdf1de629141129a077c5f10405407a81f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 16:58:35 -0400
Subject: [PATCH 225/465] refactor: Move `have` to prograde tactic
---
Pantograph.lean | 2 +-
Pantograph/Compile.lean | 2 +-
Pantograph/Compile/Parse.lean | 14 +++++++
Pantograph/Goal.lean | 72 +++------------------------------
Pantograph/Library.lean | 9 ++++-
Pantograph/Tactic/Prograde.lean | 25 ++++++++++++
6 files changed, 53 insertions(+), 71 deletions(-)
create mode 100644 Pantograph/Compile/Parse.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 097651f..35ab117 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -125,7 +125,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure ( Except.ok (← goalAssign goalState args.goalId expr))
| .none, .none, .some type, .none, .none => do
let binderName := args.binderName?.getD ""
- pure ( Except.ok (← goalHave goalState args.goalId binderName type))
+ pure ( Except.ok (← goalState.tryHave args.goalId binderName type))
| .none, .none, .none, .some pred, .none => do
pure ( Except.ok (← goalCalc goalState args.goalId pred))
| .none, .none, .none, .none, .some true => do
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
index 15081d9..83b463f 100644
--- a/Pantograph/Compile.lean
+++ b/Pantograph/Compile.lean
@@ -2,7 +2,7 @@
import Pantograph.Protocol
import Pantograph.Compile.Frontend
import Pantograph.Compile.Elab
-
+import Pantograph.Compile.Parse
open Lean
diff --git a/Pantograph/Compile/Parse.lean b/Pantograph/Compile/Parse.lean
new file mode 100644
index 0000000..72eb620
--- /dev/null
+++ b/Pantograph/Compile/Parse.lean
@@ -0,0 +1,14 @@
+import Lean
+
+open Lean
+
+namespace Pantograph.Compile
+
+def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
+ return Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := s)
+ (fileName := "<stdin>")
+
+end Pantograph.Compile
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b2f6f53..60a28d6 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -5,6 +5,7 @@ All the functions starting with `try` resume their inner monadic state.
-/
import Pantograph.Protocol
import Pantograph.Tactic
+import Pantograph.Compile.Parse
import Lean
def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
@@ -277,57 +278,6 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
-- Specialized Tactics
-protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryHave
- let type ← match Parser.runParserCategory
- (env := state.env)
- (catName := `term)
- (input := type)
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- let binderName := binderName.toName
- try
- -- Implemented similarly to the intro tactic
- let nextGoals: List MVarId ← goal.withContext do
- let type ← Elab.Term.elabType (stx := type)
- let lctx ← MonadLCtx.getLCtx
-
- -- The branch goal inherits the same context, but with a different type
- let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
-
- -- Create the context for the `upstream` goal
- let fvarId ← mkFreshFVarId
- let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
- let fvar := mkFVar fvarId
- let mvarUpstream ←
- withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
- Meta.withNewLocalInstances #[fvar] 0 do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
- -- FIXME: May be redundant?
- let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
- goal.assign expr
- pure mvarUpstream
-
- pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
- return .success {
- root := state.root,
- savedState := {
- term := ← MonadBacktrack.saveState,
- tactic := { goals := nextGoals }
- },
- newMVars := nextGoals.toSSet,
- parentMVar? := .some goal,
- calcPrevRhs? := .none
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
@@ -527,33 +477,21 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let recursor ← match Parser.runParserCategory
- (env := state.env)
- (catName := `term)
- (input := recursor)
- (fileName := filename) with
+ let recursor ← match (← Compile.parseTermM recursor) with
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.motivatedApply recursor)
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let recursor ← match Parser.runParserCategory
- (env := state.env)
- (catName := `term)
- (input := eq)
- (fileName := filename) with
+ let eq ← match (← Compile.parseTermM eq) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.execute goalId (tacticM := Tactic.noConfuse recursor)
+ state.execute goalId (tacticM := Tactic.noConfuse eq)
protected def GoalState.tryEval (state: GoalState) (goalId: Nat) (binderName: Name) (expr: String) :
Elab.TermElabM TacticResult := do
state.restoreElabM
- let expr ← match Parser.runParserCategory
- (env := state.env)
- (catName := `term)
- (input := expr)
- (fileName := filename) with
+ let expr ← match (← Compile.parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.evaluate binderName expr)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 8036103..aa8bcbc 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -180,8 +180,13 @@ def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): CoreM TacticRe
def goalAssign (state: GoalState) (goalId: Nat) (expr: String): CoreM TacticResult :=
runTermElabM <| state.tryAssign goalId expr
@[export pantograph_goal_have_m]
-def goalHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
- runTermElabM <| state.tryHave goalId binderName type
+protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult := do
+ let type ← match (← Compile.parseTermM type) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ runTermElabM do
+ state.restoreElabM
+ state.execute goalId (Tactic.have_t binderName.toName type)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index 81dd28c..4c525c2 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -19,4 +19,29 @@ def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
pure [mvarUpstream.mvarId!]
Elab.Tactic.setGoals nextGoals
+def have_t (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let nextGoals: List MVarId ← goal.withContext do
+ let type ← Elab.Term.elabType (stx := type)
+ let lctx ← MonadLCtx.getLCtx
+
+ -- The branch goal inherits the same context, but with a different type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
+
+ -- Create the context for the `upstream` goal
+ let fvarId ← mkFreshFVarId
+ let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
+ let fvar := mkFVar fvarId
+ let mvarUpstream ←
+ withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
+ Meta.withNewLocalInstances #[fvar] 0 do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
+ --let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
+ goal.assign mvarUpstream
+ pure mvarUpstream
+
+ pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
+ Elab.Tactic.setGoals nextGoals
+
end Pantograph.Tactic
From 2d2ff24017151bca6f1e466e7a4cf565fc055291 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Jun 2024 17:01:49 -0400
Subject: [PATCH 226/465] feat: FFI interface for `evaluate` tactic
---
Pantograph/Library.lean | 10 +++++++++-
Pantograph/Tactic/Prograde.lean | 2 +-
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index aa8bcbc..71dcdfe 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -186,7 +186,15 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.execute goalId (Tactic.have_t binderName.toName type)
+ state.execute goalId (Tactic.«have» binderName.toName type)
+@[export pantograph_goal_evaluate_m]
+protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult := do
+ let type ← match (← Compile.parseTermM type) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ runTermElabM do
+ state.restoreElabM
+ state.execute goalId (Tactic.evaluate binderName.toName type)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index 4c525c2..59acaf1 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -19,7 +19,7 @@ def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
pure [mvarUpstream.mvarId!]
Elab.Tactic.setGoals nextGoals
-def have_t (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
+def «have» (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals: List MVarId ← goal.withContext do
let type ← Elab.Term.elabType (stx := type)
From fc0d872343d1290c8e6e3e6b63116157abb1d359 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 27 Jun 2024 14:34:21 -0400
Subject: [PATCH 227/465] refactor: Simplify proof test infrastructure
---
Test/Common.lean | 36 +++++-
Test/Proofs.lean | 64 -----------
Test/Tactic/Congruence.lean | 161 ++++++++++++---------------
Test/Tactic/MotivatedApply.lean | 191 +++++++++++++++-----------------
Test/Tactic/NoConfuse.lean | 123 +++++++++-----------
Test/Tactic/Prograde.lean | 152 +++++++++++++++++--------
6 files changed, 349 insertions(+), 378 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index df0edcd..41025f5 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -89,10 +89,12 @@ def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSe
runCoreMSeq env metaM.run'
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
termElabM.run' (ctx := Pantograph.defaultTermElabMContext)
+def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq): IO LSpec.TestSeq :=
+ runMetaMSeq env $ termElabM.run' (ctx := Pantograph.defaultTermElabMContext)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
-def parseSentence (s: String): MetaM Expr := do
+def parseSentence (s: String): Elab.TermElabM Expr := do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
@@ -100,7 +102,7 @@ def parseSentence (s: String): MetaM Expr := do
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
- runTermElabMInMeta $ Elab.Term.elabTerm (stx := recursor) .none
+ Elab.Term.elabTerm (stx := recursor) .none
def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
@@ -110,6 +112,36 @@ def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
let t ← exprToStr (← mvarId.getType)
return (name, t)
+
+-- Monadic testing
+
+abbrev TestT := StateT LSpec.TestSeq
+
+def addTest [Monad m] (test: LSpec.TestSeq): TestT m Unit := do
+ set $ (← get) ++ test
+
+def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
+ Prod.snd <$> t.run LSpec.TestSeq.done
+
+def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
+ IO LSpec.TestSeq :=
+ runTermElabMSeq env $ runTest t
+
+def cdeclOf (userName: Name) (type: Expr): Condensed.LocalDecl :=
+ { userName, type }
+
+def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none):
+ Protocol.Goal :=
+ {
+ userName?,
+ target := { pp? := .some target},
+ vars := (nameType.map fun x => ({
+ userName := x.fst,
+ type? := .some { pp? := .some x.snd },
+ isInaccessible? := .some false
+ })).toArray
+ }
+
end Test
end Pantograph
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9c45138..0603571 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -357,69 +357,6 @@ def test_or_comm: TestM Unit := do
]
}
-def test_have: TestM Unit := do
- let state? ← startProof (.expr "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
- let tactic := "intro p q h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
-
- let expr := "Or.inl (Or.inl h)"
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
-
- let haveBind := "y"
- let haveType := "p ∨ q"
- let state2 ← match ← state1.tryHave (goalId := 0) (binderName := haveBind) (type := haveType) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check s!"have {haveBind}: {haveType}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[
- buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "p ∨ q",
- buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p"), ("y", "p ∨ q")] "(p ∨ q) ∨ p ∨ q"
- ])
-
- let expr := "Or.inl h"
- let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
-
- let state2b ← match state3.continue state2 with
- | .ok state => pure state
- | .error e => do
- addTest $ assertUnreachable e
- return ()
- let expr := "Or.inl y"
- let state4 ← match ← state2b.tryAssign (goalId := 0) (expr := expr) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check s!":= {expr}" ((← state4.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
-
- addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
-
example : ∀ (a b c1 c2: Nat), (b + a) + c1 = (b + a) + c2 → (a + b) + c1 = (b + a) + c2 := by
intro a b c1 c2 h
conv =>
@@ -856,7 +793,6 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Nat.add_comm delta", test_delta_variable),
("arithmetic", test_arith),
("Or.comm", test_or_comm),
- ("have", test_have),
("conv", test_conv),
("calc", test_calc),
("let via assign", test_let false),
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 6e8f547..38c94f3 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -7,103 +7,82 @@ open Pantograph
namespace Pantograph.Test.Tactic.Congruence
-def test_congr_arg_list (env: Environment): IO LSpec.TestSeq :=
+def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let expr := "λ {α} (l1 l2 : List α) (h: l1 = l2) => l1.reverse = l2.reverse"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let mut tests := LSpec.TestSeq.done
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let (newGoals, test) ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
- let test := LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.30"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`f, "?α → List α"),
- (`h, "?a₁ = ?a₂"),
- (`conduit, "(?f ?a₁ = ?f ?a₂) = (l1.reverse = l2.reverse)"),
- ])
- return (newGoals, test)
- tests := tests ++ test
- let f := newGoals.get! 3
- let h := newGoals.get! 4
- let c := newGoals.get! 5
- let results ← f.apply (← parseSentence "List.reverse")
- tests := tests ++ (LSpec.check "apply" (results.length = 0))
- tests := tests ++ (LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂"))
- tests := tests ++ (LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)"))
- return tests
-def test_congr_arg (env: Environment): IO LSpec.TestSeq :=
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.30"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`f, "?α → List α"),
+ (`h, "?a₁ = ?a₂"),
+ (`conduit, "(?f ?a₁ = ?f ?a₂) = (l1.reverse = l2.reverse)"),
+ ])
+ let f := newGoals.get! 3
+ let h := newGoals.get! 4
+ let c := newGoals.get! 5
+ let results ← f.apply (← parseSentence "List.reverse")
+ addTest $ LSpec.check "apply" (results.length = 0)
+ addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
+ addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)")
+def test_congr_arg : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let mut tests := LSpec.TestSeq.done
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.70"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`f, "?α → Nat"),
- (`h, "?a₁ = ?a₂"),
- (`conduit, "(?f ?a₁ = ?f ?a₂) = (n * n = m * m)"),
- ])
- tests := tests ++ test
- return tests
-def test_congr_fun (env: Environment): IO LSpec.TestSeq :=
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.70"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`f, "?α → Nat"),
+ (`h, "?a₁ = ?a₂"),
+ (`conduit, "(?f ?a₁ = ?f ?a₂) = (n * n = m * m)"),
+ ])
+def test_congr_fun : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) => (n + m) + (n + m) = (n + m) * 2"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let mut tests := LSpec.TestSeq.done
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar Tactic.congruenceFun target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.159"),
- (`f₁, "?α → Nat"),
- (`f₂, "?α → Nat"),
- (`h, "?f₁ = ?f₂"),
- (`a, "?α"),
- (`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
- ])
- tests := tests ++ test
- return tests
-def test_congr (env: Environment): IO LSpec.TestSeq :=
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let newGoals ← runTacticOnMVar Tactic.congruenceFun target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.159"),
+ (`f₁, "?α → Nat"),
+ (`f₂, "?α → Nat"),
+ (`h, "?f₁ = ?f₂"),
+ (`a, "?α"),
+ (`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
+ ])
+def test_congr : TestT Elab.TermElabM Unit := do
let expr := "λ (a b: Nat) => a = b"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let mut tests := LSpec.TestSeq.done
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar Tactic.congruence target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.10"),
- (`f₁, "?α → Nat"),
- (`f₂, "?α → Nat"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`h₁, "?f₁ = ?f₂"),
- (`h₂, "?a₁ = ?a₂"),
- (`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
- ])
- tests := tests ++ test
- return tests
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let newGoals ← runTacticOnMVar Tactic.congruence target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
+ [
+ (`α, "Sort ?u.10"),
+ (`f₁, "?α → Nat"),
+ (`f₂, "?α → Nat"),
+ (`a₁, "?α"),
+ (`a₂, "?α"),
+ (`h₁, "?f₁ = ?f₂"),
+ (`h₂, "?a₁ = ?a₂"),
+ (`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
+ ])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("congrArg List.reverse", test_congr_arg_list env),
- ("congrArg", test_congr_arg env),
- ("congrFun", test_congr_fun env),
- ("congr", test_congr env),
- ]
+ ("congrArg List.reverse", test_congr_arg_list),
+ ("congrArg", test_congr_arg),
+ ("congrFun", test_congr_fun),
+ ("congr", test_congr),
+ ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Congruence
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 154e34c..091e309 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -7,82 +7,23 @@ open Pantograph
namespace Pantograph.Test.Tactic.MotivatedApply
-def test_type_extract (env: Environment): IO LSpec.TestSeq :=
- runMetaMSeq env do
- let mut tests := LSpec.TestSeq.done
- let recursor ← parseSentence "@Nat.brecOn"
- let recursorType ← Meta.inferType recursor
- tests := tests ++ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
- (← exprToStr recursorType))
- let info ← match Tactic.getRecursorInformation recursorType with
- | .some info => pure info
- | .none => throwError "Failed to extract recursor info"
- tests := tests ++ LSpec.check "iMotive" (info.iMotive = 2)
- let motiveType := info.getMotiveType
- tests := tests ++ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
- (← exprToStr motiveType))
- return tests
+def test_type_extract : TestT Elab.TermElabM Unit := do
+ let recursor ← parseSentence "@Nat.brecOn"
+ let recursorType ← Meta.inferType recursor
+ addTest $ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
+ (← exprToStr recursorType))
+ let info ← match Tactic.getRecursorInformation recursorType with
+ | .some info => pure info
+ | .none => throwError "Failed to extract recursor info"
+ addTest $ LSpec.check "iMotive" (info.iMotive = 2)
+ let motiveType := info.getMotiveType
+ addTest $ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
+ (← exprToStr motiveType))
-def test_nat_brec_on (env: Environment): IO LSpec.TestSeq :=
+def test_nat_brec_on : TestT Elab.TermElabM Unit := do
let expr := "λ (n t: Nat) => n + 0 = n"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "@Nat.brecOn")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Nat → Prop",
- "Nat",
- "∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.67 = (n + 0 = n)",
- ])
- tests := tests ++ test
- return tests
-
-def test_list_brec_on (env: Environment): IO LSpec.TestSeq :=
- let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "@List.brecOn")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Type ?u.90",
- "List ?m.92 → Prop",
- "List ?m.92",
- "∀ (t : List ?m.92), List.below t → ?motive t",
- "?motive ?m.94 = (l ++ [] = [] ++ l)",
- ])
- tests := tests ++ test
- return tests
-
-def test_partial_motive_instantiation (env: Environment): IO LSpec.TestSeq := do
- let expr := "λ (n t: Nat) => n + 0 = n"
- runMetaMSeq env $ runTermElabMInMeta do
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
let recursor ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
@@ -90,41 +31,83 @@ def test_partial_motive_instantiation (env: Environment): IO LSpec.TestSeq := do
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- let majorId := 67
- tests := tests ++ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Nat → Prop",
- "Nat",
- "∀ (t : Nat), Nat.below t → ?motive t",
- s!"?motive ?m.{majorId} = (n + 0 = n)",
- ]))
- let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
- tests := tests ++ (LSpec.check "goal name" (major.name.toString = s!"_uniq.{majorId}"))
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ let test := LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Nat → Prop",
+ "Nat",
+ "∀ (t : Nat), Nat.below t → ?motive t",
+ "?motive ?m.67 = (n + 0 = n)",
+ ])
+ addTest test
- -- Assign motive to `λ x => x + _`
- let motive_assign ← parseSentence "λ (x: Nat) => @Nat.add x + 0 = _"
- motive.assign motive_assign
+def test_list_brec_on : TestT Elab.TermElabM Unit := do
+ let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "@List.brecOn")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Type ?u.90",
+ "List ?m.92 → Prop",
+ "List ?m.92",
+ "∀ (t : List ?m.92), List.below t → ?motive t",
+ "?motive ?m.94 = (l ++ [] = [] ++ l)",
+ ])
- let test ← conduit.withContext do
- let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
- tests := tests ++ test
+def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
+ let expr := "λ (n t: Nat) => n + 0 = n"
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "@Nat.brecOn")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.motivatedApply recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ let majorId := 67
+ addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
+ [
+ "Nat → Prop",
+ "Nat",
+ "∀ (t : Nat), Nat.below t → ?motive t",
+ s!"?motive ?m.{majorId} = (n + 0 = n)",
+ ]))
+ let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
+ addTest $ (LSpec.check "goal name" (major.name.toString = s!"_uniq.{majorId}"))
- return tests
+ -- Assign motive to `λ x => x + _`
+ let motive_assign ← parseSentence "λ (x: Nat) => @Nat.add x + 0 = _"
+ motive.assign motive_assign
+
+ addTest $ ← conduit.withContext do
+ let t := toString (← Meta.ppExpr $ ← conduit.getType)
+ return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("type_extract", test_type_extract env),
- ("Nat.brecOn", test_nat_brec_on env),
- ("List.brecOn", test_list_brec_on env),
- ("Nat.brecOn partial motive instantiation", test_partial_motive_instantiation env),
- ]
+ ("type_extract", test_type_extract),
+ ("Nat.brecOn", test_nat_brec_on),
+ ("List.brecOn", test_list_brec_on),
+ ("Nat.brecOn partial motive instantiation", test_partial_motive_instantiation),
+ ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.MotivatedApply
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
index c672a0b..cc15198 100644
--- a/Test/Tactic/NoConfuse.lean
+++ b/Test/Tactic/NoConfuse.lean
@@ -7,81 +7,66 @@ open Pantograph
namespace Pantograph.Test.Tactic.NoConfuse
-def test_nat (env: Environment): IO LSpec.TestSeq :=
+def test_nat : TestT Elab.TermElabM Unit := do
let expr := "λ (n: Nat) (h: 0 = n + 1) => False"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.noConfuse recursor
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [])
- tests := tests ++ test
- return tests
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.noConfuse recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
-def test_nat_fail (env: Environment): IO LSpec.TestSeq :=
+def test_nat_fail : TestT Elab.TermElabM Unit := do
let expr := "λ (n: Nat) (h: n = n) => False"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- try
- let tactic := Tactic.noConfuse recursor
- let _ ← runTermElabMInMeta $ runTacticOnMVar tactic target.mvarId!
- tests := tests ++ assertUnreachable "Tactic should fail"
- catch _ =>
- tests := tests ++ LSpec.check "Tactic should fail" true
- return tests
- return tests
-
-def test_list (env: Environment): IO LSpec.TestSeq :=
- let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ try
let tactic := Tactic.noConfuse recursor
- let test ← runTermElabMInMeta do
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- pure $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [])
- tests := tests ++ test
- return tests
+ let _ ← runTacticOnMVar tactic target.mvarId!
+ addTest $ assertUnreachable "Tactic should fail"
+ catch _ =>
+ addTest $ LSpec.check "Tactic should fail" true
+
+def test_list : TestT Elab.TermElabM Unit := do
+ let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
+ let expr ← parseSentence expr
+ Meta.lambdaTelescope expr $ λ _ body => do
+ let recursor ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.noConfuse recursor
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ addTest $ LSpec.check "goals"
+ ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("Nat", test_nat env),
- ("Nat fail", test_nat_fail env),
- ("List", test_list env),
- ]
+ ("Nat", test_nat),
+ ("Nat fail", test_nat_fail),
+ ("List", test_list),
+ ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.NoConfuse
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index d959f4f..5b4da2b 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -7,57 +7,113 @@ open Pantograph
namespace Pantograph.Test.Tactic.Prograde
-def test_eval (env: Environment): IO LSpec.TestSeq :=
+def test_eval : TestT Elab.TermElabM Unit := do
let expr := "forall (p q : Prop) (h: p), And (Or p q) (Or p q)"
- runMetaMSeq env do
- let expr ← parseSentence expr
- Meta.forallTelescope expr $ λ _ body => do
- let e ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "Or.inl h")
- (fileName := filename) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let mut tests := LSpec.TestSeq.done
- -- Apply the tactic
- let goal ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let target: Expr := mkAnd
- (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
- (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
- let h := .fvar ⟨uniq 8⟩
- let test := LSpec.test "goals before" ((← toCondensedGoal goal.mvarId!).devolatilize == {
- context := #[
- { userName := `p, type := .sort 0 },
- { userName := `q, type := .sort 0 },
- { userName := `h, type := h}
- ],
- target,
- })
- tests := tests ++ test
- let tactic := Tactic.evaluate `h2 e
- let m := .mvar ⟨uniq 13⟩
- let test ← runTermElabMInMeta do
- let [goal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
- pure $ LSpec.test "goals after" ((← toCondensedGoal goal).devolatilize == {
- context := #[
- { userName := `p, type := .sort 0 },
- { userName := `q, type := .sort 0 },
- { userName := `h, type := h},
- {
- userName := `h2,
- type := mkOr h m,
- value? := .some $ mkApp3 (mkConst `Or.inl) h m (.fvar ⟨uniq 10⟩)
- }
- ],
- target,
- })
- tests := tests ++ test
- return tests
+ let expr ← parseSentence expr
+ Meta.forallTelescope expr $ λ _ body => do
+ let e ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := "Or.inl h")
+ (fileName := filename) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let goal ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let target: Expr := mkAnd
+ (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
+ (mkOr (.fvar ⟨uniq 8⟩) (.fvar ⟨uniq 9⟩))
+ let h := .fvar ⟨uniq 8⟩
+ addTest $ LSpec.test "goals before" ((← toCondensedGoal goal.mvarId!).devolatilize == {
+ context := #[
+ cdeclOf `p (.sort 0),
+ cdeclOf `q (.sort 0),
+ cdeclOf `h h
+ ],
+ target,
+ })
+ let tactic := Tactic.evaluate `h2 e
+ let m := .mvar ⟨uniq 13⟩
+ let [newGoal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
+ addTest $ LSpec.test "goals after" ((← toCondensedGoal newGoal).devolatilize == {
+ context := #[
+ cdeclOf `p (.sort 0),
+ cdeclOf `q (.sort 0),
+ cdeclOf `h h,
+ {
+ userName := `h2,
+ type := mkOr h m,
+ value? := .some $ mkApp3 (mkConst `Or.inl) h m (.fvar ⟨uniq 10⟩)
+ }
+ ],
+ target,
+ })
+ addTest $ LSpec.test "assign" ((← getExprMVarAssignment? goal.mvarId!) == .some (.mvar newGoal))
+
+def test_have : TestT Elab.TermElabM Unit := do
+ let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
+ let state0 ← GoalState.create rootExpr
+ let tactic := "intro p q h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
+ #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
+
+ let expr := "Or.inl (Or.inl h)"
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals).map (·.devolatilize) =
+ #[])
+
+ let haveBind := "y"
+ let haveType := "p ∨ q"
+ let state2 ← match ← state1.tryHave (goalId := 0) (binderName := haveBind) (type := haveType) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!"have {haveBind}: {haveType}" ((← state2.serializeGoals).map (·.devolatilize) =
+ #[
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "p ∨ q",
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p"), ("y", "p ∨ q")] "(p ∨ q) ∨ p ∨ q"
+ ])
+
+ let expr := "Or.inl h"
+ let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals).map (·.devolatilize) =
+ #[])
+
+ let state2b ← match state3.continue state2 with
+ | .ok state => pure state
+ | .error e => do
+ addTest $ assertUnreachable e
+ return ()
+ let expr := "Or.inl y"
+ let state4 ← match ← state2b.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state4.serializeGoals).map (·.devolatilize) =
+ #[])
+
+ addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("eval", test_eval env),
- ]
+ ("eval", test_eval),
+ ("have", test_have),
+ ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Prograde
From 6ddde2963d484176225fc4c35ddc77fdf7a621a1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 27 Jun 2024 14:51:16 -0400
Subject: [PATCH 228/465] test: Eval instantiate
---
Pantograph/Goal.lean | 7 -----
Pantograph/Library.lean | 6 ++--
Test/Tactic/Prograde.lean | 58 +++++++++++++++++++++++++++++++++++++--
3 files changed, 59 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 60a28d6..68b2aa9 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -488,12 +488,5 @@ protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: Strin
| .ok syn => pure syn
| .error error => return .parseError error
state.execute goalId (tacticM := Tactic.noConfuse eq)
-protected def GoalState.tryEval (state: GoalState) (goalId: Nat) (binderName: Name) (expr: String) :
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let expr ← match (← Compile.parseTermM expr) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- state.execute goalId (tacticM := Tactic.evaluate binderName expr)
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 71dcdfe..e83dcc2 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -188,13 +188,13 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
state.restoreElabM
state.execute goalId (Tactic.«have» binderName.toName type)
@[export pantograph_goal_evaluate_m]
-protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult := do
- let type ← match (← Compile.parseTermM type) with
+protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
+ let expr ← match (← Compile.parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.execute goalId (Tactic.evaluate binderName.toName type)
+ state.execute goalId (Tactic.evaluate binderName.toName expr)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 5b4da2b..15da63e 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -50,7 +50,60 @@ def test_eval : TestT Elab.TermElabM Unit := do
})
addTest $ LSpec.test "assign" ((← getExprMVarAssignment? goal.mvarId!) == .some (.mvar newGoal))
-def test_have : TestT Elab.TermElabM Unit := do
+def test_proof_eval : TestT Elab.TermElabM Unit := do
+ let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
+ let state0 ← GoalState.create rootExpr
+ let tactic := "intro p q h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
+ #[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
+
+ let expr := "Or.inl (Or.inl h)"
+ let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state2.serializeGoals).map (·.devolatilize) =
+ #[])
+
+ let evalBind := "y"
+ let evalExpr := "Or.inl h"
+ let state2 ← match ← state1.tryEvaluate (goalId := 0) (binderName := evalBind) (expr := evalExpr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!"eval {evalBind} := {evalExpr}" ((← state2.serializeGoals).map (·.devolatilize) =
+ #[{
+ target := { pp? := .some "(p ∨ q) ∨ p ∨ q"},
+ vars := #[
+ { userName := "p", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
+ { userName := "q", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
+ { userName := "h", type? := .some { pp? := .some "p" }, isInaccessible? := .some false },
+ { userName := "y",
+ type? := .some { pp? := .some "p ∨ ?m.25" },
+ value? := .some { pp? := .some "Or.inl h" },
+ isInaccessible? := .some false }
+ ]
+ }])
+
+ let expr := "Or.inl y"
+ let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check s!":= {expr}" ((← state3.serializeGoals).map (·.devolatilize) =
+ #[])
+
+ addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
+
+def test_proof_have : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
@@ -113,7 +166,8 @@ def test_have : TestT Elab.TermElabM Unit := do
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("eval", test_eval),
- ("have", test_have),
+ ("Proof eval", test_proof_eval),
+ ("Proof have", test_proof_have),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Prograde
From c404564a2b25f1ee4a0cb611904f944b0321f998 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Jul 2024 19:53:50 -0700
Subject: [PATCH 229/465] chore: Bump Lean version to 4.10.0-rc1
---
Pantograph/Compile/Frontend.lean | 2 +-
Pantograph/Environment.lean | 2 +-
Pantograph/Goal.lean | 9 ++-------
Pantograph/Version.lean | 2 +-
flake.nix | 2 +-
lean-toolchain | 2 +-
6 files changed, 7 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Compile/Frontend.lean b/Pantograph/Compile/Frontend.lean
index 5cb3e63..3dbad85 100644
--- a/Pantograph/Compile/Frontend.lean
+++ b/Pantograph/Compile/Frontend.lean
@@ -52,7 +52,7 @@ def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
let s' := (← get).commandState
let after := s'.env
- let msgs := s'.messages.msgs.drop s.messages.msgs.size
+ let msgs := s'.messages.toList.drop s.messages.toList.length
let trees := s'.infoState.trees.drop s.infoState.trees.size
let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index d5cdc3d..6d91abb 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -132,7 +132,7 @@ def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) :
(hints := Lean.mkReducibilityHintsRegularEx 1)
(safety := Lean.DefinitionSafety.safe)
(all := [])
- let env' ← match env.addDecl constant with
+ let env' ← match env.addDecl (← getOptions) constant with
| .error e => do
let options ← Lean.MonadOptions.getOptions
let desc ← (e.toMessageData options).toString
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 46888e7..8c2324d 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -7,11 +7,6 @@ import Pantograph.Protocol
import Pantograph.Tactic
import Lean
-def Lean.MessageLog.getErrorMessages (log : MessageLog) : MessageLog :=
- {
- msgs := log.msgs.filter fun m => match m.severity with | MessageSeverity.error => true | _ => false
- }
-
namespace Pantograph
open Lean
@@ -178,7 +173,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tacticM: Elab.
try
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
+ let messages := (← getThe Core.State).messages.toArray
let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .failure errors
let nextElabState ← MonadBacktrack.saveState
@@ -223,7 +218,7 @@ protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
goal.checkNotAssigned `GoalState.assign
goal.assign expr
if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.getErrorMessages |>.toList.toArray
+ let messages := (← getThe Core.State).messages.toArray
let errors ← (messages.map (·.data)).mapM fun md => md.toString
return .failure errors
let prevMCtx := state.savedState.term.meta.meta.mctx
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 207b597..f3bcf93 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.16"
+def version := "0.2.17"
end Pantograph
diff --git a/flake.nix b/flake.nix
index ad40a3f..b96d5e2 100644
--- a/flake.nix
+++ b/flake.nix
@@ -6,7 +6,7 @@
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
# Do not follow input's nixpkgs since it could cause build failures
- url = "github:leanprover/lean4?ref=v4.8.0-rc1";
+ url = "github:leanprover/lean4?ref=v4.10.0-rc1";
};
lspec = {
url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
diff --git a/lean-toolchain b/lean-toolchain
index d8a6d7e..d69d1ed 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.8.0-rc1
+leanprover/lean4:v4.10.0-rc1
From 9b1dd0ffda4d9b9122241da31747b15a55e0754d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 6 Jul 2024 19:58:55 -0700
Subject: [PATCH 230/465] chore: Update flake
---
flake.lock | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/flake.lock b/flake.lock
index 1a50363..c803f65 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,16 +42,16 @@
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
- "lastModified": 1714704934,
- "narHash": "sha256-q0kLyIahUXolkSrBZSegPF+R99WAH1YC96JfKoFntDE=",
+ "lastModified": 1719788866,
+ "narHash": "sha256-kB2cp1XJKODXiuiKp7J5OK+PFP+sOSBE5gdVNOKWCPI=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "dcccfb73cb247e9478220375ab7de03f7c67e505",
+ "rev": "3b58e0649156610ce3aeed4f7b5c652340c668d4",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "v4.8.0-rc1",
+ "ref": "v4.10.0-rc1",
"repo": "lean4",
"type": "github"
}
From 193d94e7986fef4779f5ce171616a1bc3ad0d068 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Jul 2024 11:42:02 -0700
Subject: [PATCH 231/465] feat: Expression creation and pretty printing
---
Pantograph/Condensed.lean | 7 +++++++
Pantograph/Library.lean | 7 ++++---
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 57a8517..f6f4cdb 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -17,6 +17,13 @@ def nameToStr (s: String) : Name := s.toName
@[export pantograph_name_is_inaccessible]
def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName
+@[export pantograph_mk_app_meta_m]
+def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
+
+@[export pantograph_pp_expr]
+def ppExpr (e: Expr) := Meta.ppExpr e
+
+
-- Mirrors Lean's LocalDecl
structure LocalDecl where
-- Default value is for testing
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 8036103..eb34614 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -78,9 +78,10 @@ def createCoreState (imports: Array String): IO Core.State := do
(trustLevel := 1)
return { env := env }
-@[export pantograph_create_meta_context]
-def createMetaContext: IO Lean.Meta.Context := do
- return {}
+@[export pantograph_meta_context]
+def metaContext: Lean.Meta.Context := {}
+@[export pantograph_meta_state]
+def metaState: Lean.Meta.State := {}
@[export pantograph_env_catalog_m]
def envCatalog: CoreM Protocol.EnvCatalogResult :=
From 94c7b021f77c02376ad0219cdef97b1a06bc0d1b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 15 Jul 2024 12:22:47 -0700
Subject: [PATCH 232/465] fix: Signature of ppExpr
---
Pantograph/Condensed.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index f6f4cdb..8b3de4f 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -20,8 +20,8 @@ def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName
@[export pantograph_mk_app_meta_m]
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
-@[export pantograph_pp_expr]
-def ppExpr (e: Expr) := Meta.ppExpr e
+@[export pantograph_pp_expr_meta_m]
+def ppExpr (e: Expr): MetaM String := toString<$> Meta.ppExpr e
-- Mirrors Lean's LocalDecl
From eb5ee8c57c395f60c6c7108e629ac248a3625c89 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 22 Jul 2024 17:34:14 -0700
Subject: [PATCH 233/465] feat: Expose TermElab context and state
---
Pantograph/Condensed.lean | 20 ++++++++++++++++----
Pantograph/Library.lean | 7 ++-----
2 files changed, 18 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 8b3de4f..a1688f1 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -13,15 +13,15 @@ construct hash maps for Lean names.
@[export pantograph_str_to_name]
def strToName (s: String) : Name := s.toName
@[export pantograph_name_to_str]
-def nameToStr (s: String) : Name := s.toName
+def nameToStr (s: Name) : String := s.toString
@[export pantograph_name_is_inaccessible]
def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName
-@[export pantograph_mk_app_meta_m]
+@[export pantograph_mk_app_m]
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
-@[export pantograph_pp_expr_meta_m]
-def ppExpr (e: Expr): MetaM String := toString<$> Meta.ppExpr e
+@[export pantograph_pp_expr_m]
+def ppExpr (e: Expr): MetaM String := toString <$> Meta.ppExpr e
-- Mirrors Lean's LocalDecl
@@ -44,6 +44,18 @@ structure Goal where
def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
+-- Functions for creating contexts and states
+@[export pantograph_meta_context]
+def metaContext: Meta.Context := {}
+@[export pantograph_meta_state]
+def metaState: Meta.State := {}
+@[export pantograph_elab_context]
+def elabContext: Meta.Context := {}
+@[export pantograph_elab_state]
+def elabState (levelNames: Array Name): Elab.Term.State := {
+ levelNames := levelNames.toList,
+ }
+
end Pantograph.Condensed
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index eb34614..3bc3cc1 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -78,11 +78,6 @@ def createCoreState (imports: Array String): IO Core.State := do
(trustLevel := 1)
return { env := env }
-@[export pantograph_meta_context]
-def metaContext: Lean.Meta.Context := {}
-@[export pantograph_meta_state]
-def metaState: Lean.Meta.State := {}
-
@[export pantograph_env_catalog_m]
def envCatalog: CoreM Protocol.EnvCatalogResult :=
Environment.catalog ({}: Protocol.EnvCatalog)
@@ -99,6 +94,7 @@ def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
CoreM (Protocol.CR Protocol.EnvAddResult) :=
Environment.addDecl { name, type, value, isTheorem }
+@[export pantograph_parse_elab_type_m]
def parseElabType (type: String): Elab.TermElabM (Protocol.CR Expr) := do
let env ← MonadEnv.getEnv
let syn ← match parseTerm env type with
@@ -109,6 +105,7 @@ def parseElabType (type: String): Elab.TermElabM (Protocol.CR Expr) := do
| .ok expr => return .ok (← instantiateMVars expr)
/-- This must be a TermElabM since the parsed expr contains extra information -/
+@[export pantograph_parse_elab_expr_m]
def parseElabExpr (expr: String) (expectedType?: Option String := .none): Elab.TermElabM (Protocol.CR Expr) := do
let env ← MonadEnv.getEnv
let expectedType? ← match ← expectedType?.mapM parseElabType with
From 431ca4e481fb1856d36ed17f322419ab59ed8e25 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 22 Jul 2024 17:57:01 -0700
Subject: [PATCH 234/465] fix: Move elab context to condensed
---
Pantograph/Condensed.lean | 5 +++--
Pantograph/Library.lean | 6 ++----
Test/Common.lean | 2 +-
Test/Metavar.lean | 2 +-
Test/Proofs.lean | 2 +-
Test/Serial.lean | 4 ++--
6 files changed, 10 insertions(+), 11 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index a1688f1..ac41133 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -50,12 +50,13 @@ def metaContext: Meta.Context := {}
@[export pantograph_meta_state]
def metaState: Meta.State := {}
@[export pantograph_elab_context]
-def elabContext: Meta.Context := {}
+def elabContext: Elab.Term.Context := {
+ errToSorry := false
+ }
@[export pantograph_elab_state]
def elabState (levelNames: Array Name): Elab.Term.State := {
levelNames := levelNames.toList,
}
-
end Pantograph.Condensed
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 3bc3cc1..2f37cfa 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -1,3 +1,4 @@
+import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Protocol
@@ -38,13 +39,10 @@ open Lean
namespace Pantograph
-def defaultTermElabMContext: Elab.Term.Context := {
- errToSorry := false
- }
def runMetaM { α } (metaM: MetaM α): CoreM α :=
metaM.run'
def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
- termElabM.run' (ctx := defaultTermElabMContext) |>.run'
+ termElabM.run' (ctx := Condensed.elabContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
diff --git a/Test/Common.lean b/Test/Common.lean
index e4e1d4c..4b17736 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -73,7 +73,7 @@ def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array
def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSeq :=
runCoreMSeq env metaM.run'
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
- termElabM.run' (ctx := Pantograph.defaultTermElabMContext)
+ termElabM.run' (ctx := Pantograph.Condensed.elabContext)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 0818881..4ac8454 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -67,7 +67,7 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context ← createCoreContext #[]
- let metaM := termElabM.run' (ctx := defaultTermElabMContext)
+ let metaM := termElabM.run' (ctx := Condensed.elabContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 9c45138..51e869d 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -76,7 +76,7 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context ← createCoreContext #[]
- let metaM := termElabM.run' (ctx := defaultTermElabMContext)
+ let metaM := termElabM.run' (ctx := Condensed.elabContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 2d2b9d1..1c00501 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -64,7 +64,7 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
| .ok expr => pure expr
| .error e => return elabFailure e
return LSpec.check source ((← serializeExpressionSexp expr) = target)
- let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := defaultTermElabMContext)
+ let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := Condensed.elabContext)
return LSpec.TestSeq.append suites (← runMetaMSeq env metaM))
LSpec.TestSeq.done
@@ -85,7 +85,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let testCaseName := target.take 10
let test := LSpec.check testCaseName ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- runMetaMSeq env $ termElabM.run' (ctx := defaultTermElabMContext)
+ runMetaMSeq env $ termElabM.run' (ctx := Condensed.elabContext)
-- Instance parsing
def test_instance (env: Environment): IO LSpec.TestSeq :=
From 3b415e8dc12485f7b2b9fa6f54329f6ad598d48f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 23 Jul 2024 05:16:46 -0700
Subject: [PATCH 235/465] chore: Rename exports
---
Pantograph/Expr.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 63331af..8ef0aa6 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -98,7 +98,7 @@ Convert an expression to an equiavlent form with
2. No aux lemmas
3. No assigned mvars
-/
-@[export pantograph_instantiate_all_meta_m]
+@[export pantograph_instantiate_all_m]
def instantiateAll (e: Expr): MetaM Expr := do
let e ← instantiateDelayedMVars e
let e ← unfoldAuxLemmas e
@@ -111,7 +111,7 @@ structure DelayedMVarInvocation where
tail: Array Expr
-- The pending mvar of any delayed assigned mvar must not be assigned in any way.
-@[export pantograph_to_delayed_mvar_invocation_meta_m]
+@[export pantograph_to_delayed_mvar_invocation_m]
def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
let .mvar mvarId := e.getAppFn | return .none
let .some decl ← getDelayedMVarAssignment? mvarId | return .none
From 2682ce5b7b5a7e494d166b20b17852e88bea448a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 23 Jul 2024 11:57:12 -0700
Subject: [PATCH 236/465] refactor: Move condensed functions to condensed
---
Pantograph/Condensed.lean | 58 +++++++++++++++++++++++++++++++++++++--
Pantograph/Serial.lean | 48 --------------------------------
2 files changed, 56 insertions(+), 50 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index ac41133..90fc050 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -1,9 +1,13 @@
/- structures for FFI based interface -/
import Lean
+import Pantograph.Goal
+import Pantograph.Expr
+import Pantograph.Protocol
open Lean
-namespace Pantograph.Condensed
+namespace Pantograph
+namespace Condensed
/-
These two functions are for user defiend names. For internal names such as
@@ -58,5 +62,55 @@ def elabState (levelNames: Array Name): Elab.Term.State := {
levelNames := levelNames.toList,
}
+end Condensed
-end Pantograph.Condensed
+@[export pantograph_to_condensed_goal_m]
+def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
+ let options : Protocol.Options := {}
+ let ppAuxDecls := options.printAuxDecls
+ let ppImplDetailHyps := options.printImplementationDetailHyps
+ let mvarDecl ← mvarId.getDecl
+ let lctx := mvarDecl.lctx
+ let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
+ Meta.withLCtx lctx mvarDecl.localInstances do
+ let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
+ match localDecl with
+ | .cdecl _ fvarId userName type _ _ =>
+ let type ← instantiate type
+ return { fvarId, userName, type }
+ | .ldecl _ fvarId userName type value _ _ => do
+ let userName := userName.simpMacroScopes
+ let type ← instantiate type
+ let value ← instantiate value
+ return { fvarId, userName, type, value? := .some value }
+ let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
+ let skip := !ppAuxDecls && localDecl.isAuxDecl ||
+ !ppImplDetailHyps && localDecl.isImplementationDetail
+ if skip then
+ return acc
+ else
+ let var ← ppVar localDecl
+ return var::acc
+ return {
+ mvarId,
+ userName := mvarDecl.userName,
+ context := vars.reverse.toArray,
+ target := ← instantiate mvarDecl.type
+ }
+ where
+ instantiate := instantiateAll
+
+@[export pantograph_goal_state_to_condensed_m]
+protected def GoalState.toCondensed (state: GoalState):
+ CoreM (Array Condensed.Goal):= do
+ let metaM := do
+ let goals := state.goals.toArray
+ goals.mapM fun goal => do
+ match state.mctx.findDecl? goal with
+ | .some _ =>
+ let serializedGoal ← toCondensedGoal goal
+ pure serializedGoal
+ | .none => throwError s!"Metavariable does not exist in context {goal.name}"
+ metaM.run' (s := state.savedState.term.meta.meta)
+
+end Pantograph
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 2cdf3d6..87353e2 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -201,54 +201,6 @@ def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.
dependentMVars?,
}
-@[export pantograph_to_condensed_goal]
-def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
- let options: Protocol.Options := {}
- let ppAuxDecls := options.printAuxDecls
- let ppImplDetailHyps := options.printImplementationDetailHyps
- let mvarDecl ← mvarId.getDecl
- let lctx := mvarDecl.lctx
- let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
- Meta.withLCtx lctx mvarDecl.localInstances do
- let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
- match localDecl with
- | .cdecl _ fvarId userName type _ _ =>
- let type ← instantiate type
- return { fvarId, userName, type }
- | .ldecl _ fvarId userName type value _ _ => do
- let userName := userName.simpMacroScopes
- let type ← instantiate type
- let value ← instantiate value
- return { fvarId, userName, type, value? := .some value }
- let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
- let skip := !ppAuxDecls && localDecl.isAuxDecl ||
- !ppImplDetailHyps && localDecl.isImplementationDetail
- if skip then
- return acc
- else
- let var ← ppVar localDecl
- return var::acc
- return {
- mvarId,
- userName := mvarDecl.userName,
- context := vars.reverse.toArray,
- target := ← instantiate mvarDecl.type
- }
- where
- instantiate := instantiateAll
-
-@[export pantograph_goal_state_to_condensed]
-protected def GoalState.toCondensed (state: GoalState):
- CoreM (Array Condensed.Goal):= do
- let metaM := do
- let goals := state.goals.toArray
- goals.mapM fun goal => do
- match state.mctx.findDecl? goal with
- | .some _ =>
- let serializedGoal ← toCondensedGoal goal
- pure serializedGoal
- | .none => throwError s!"Metavariable does not exist in context {goal.name}"
- metaM.run' (s := state.savedState.term.meta.meta)
/-- Adapted from ppGoal -/
def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: MetavarDecl) (parentDecl?: Option MetavarDecl)
From bf941cd6862b2658146dbdde9db8079e7e08973e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 27 Jul 2024 17:39:51 -0700
Subject: [PATCH 237/465] feat: Expose parent and root expr functions
---
Pantograph/Goal.lean | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index c441ad9..398386e 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -136,6 +136,7 @@ protected def GoalState.continue (target: GoalState) (branch: GoalState): Except
else
target.resume (goals := branch.goals)
+@[export pantograph_goal_state_root_expr]
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
let expr ← goalState.mctx.eAssignment.find? goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
@@ -146,12 +147,14 @@ protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
else
assert! goalState.goals.isEmpty
return expr
+@[export pantograph_goal_state_parent_expr]
protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
let parent ← goalState.parentMVar?
let expr := goalState.mctx.eAssignment.find! parent
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
-protected def GoalState.assignedExprOf? (goalState: GoalState) (mvar: MVarId): Option Expr := do
+@[export pantograph_goal_state_get_mvar_e_assignment]
+protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId): Option Expr := do
let expr ← goalState.mctx.eAssignment.find? mvar
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
From 9db546349925730b445b6cf66fff29cc9dfcc52c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 27 Jul 2024 18:20:34 -0700
Subject: [PATCH 238/465] feat: Export `GoalState.resume`
---
Pantograph/Goal.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 398386e..b44e8d3 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -108,6 +108,7 @@ protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState
/--
Brings into scope a list of goals
-/
+@[export pantograph_goal_state_resume]
protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except String GoalState :=
if ¬ (goals.all (λ goal => state.mvars.contains goal)) then
let invalid_goals := goals.filter (λ goal => ¬ state.mvars.contains goal) |>.map (·.name.toString)
From 4c81f226d1953aa93c131d5161b397a037f920a2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 28 Jul 2024 13:46:14 -0700
Subject: [PATCH 239/465] feat: Expose environment functions
---
Pantograph/Condensed.lean | 4 +++-
Pantograph/Environment.lean | 22 +++++++++++++++++++---
Pantograph/Expr.lean | 1 +
3 files changed, 23 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 90fc050..8b5c313 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -19,13 +19,15 @@ def strToName (s: String) : Name := s.toName
@[export pantograph_name_to_str]
def nameToStr (s: Name) : String := s.toString
@[export pantograph_name_is_inaccessible]
-def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName
+def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName || n.hasMacroScopes
@[export pantograph_mk_app_m]
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
@[export pantograph_pp_expr_m]
def ppExpr (e: Expr): MetaM String := toString <$> Meta.ppExpr e
+@[export pantograph_get_used_constants]
+def getUsedConstants (e: Expr) := e.getUsedConstants
-- Mirrors Lean's LocalDecl
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 6d91abb..a9b2934 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -7,15 +7,31 @@ open Pantograph
namespace Pantograph.Environment
-def isNameInternal (n: Lean.Name): Bool :=
+@[export pantograph_is_name_internal]
+def isNameInternal (n: Name): Bool :=
-- Returns true if the name is an implementation detail which should not be shown to the user.
isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ n.isAuxLemma ∨ n.hasMacroScopes
where
- isLeanSymbol (name: Lean.Name): Bool := match name.getRoot with
+ isLeanSymbol (name: Name): Bool := match name.getRoot with
| .str _ name => name == "Lean"
| _ => true
-def toCompactSymbolName (n: Lean.Name) (info: Lean.ConstantInfo): String :=
+/-- Catalog all the non-internal names -/
+@[export pantograph_environment_catalog]
+def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name _ =>
+ match isNameInternal name with
+ | true => acc.push name
+ | false => acc)
+
+@[export pantograph_environment_module_of_name]
+def module_of_name (env: Environment) (name: Name): Option Name := do
+ let moduleId ← env.getModuleIdxFor? name
+ return env.allImportedModuleNames.get! moduleId.toNat
+
+@[export pantograph_constant_info_is_unsafe_or_partial]
+def constantInfoIsUnsafeOrPartial (info: ConstantInfo): Bool := info.isUnsafe || info.isPartial
+
+def toCompactSymbolName (n: Name) (info: ConstantInfo): String :=
let pref := match info with
| .axiomInfo _ => "a"
| .defnInfo _ => "d"
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 8ef0aa6..9d8f70c 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -7,6 +7,7 @@ namespace Pantograph
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
+@[export pantograph_unfold_aux_lemmas]
def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
From 29f437f859e3c7fad5a48fdce1fddc106991e586 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 28 Jul 2024 13:58:20 -0700
Subject: [PATCH 240/465] feat: Export GoalState.create
---
Pantograph/Goal.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b44e8d3..6dbe525 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -33,6 +33,7 @@ structure GoalState where
-- WARNING: If using `state with` outside of `calc`, this must be set to `.none`
calcPrevRhs?: Option Expr := .none
+@[export pantograph_goal_state_create_m]
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
-- May be necessary to immediately synthesise all metavariables if we need to leave the elaboration context.
-- See https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Unknown.20universe.20metavariable/near/360130070
From 7b5567d784397c9d2a33b9464b5a1dd75fceb34a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 28 Jul 2024 14:19:47 -0700
Subject: [PATCH 241/465] fix: Name internal order
---
Pantograph/Environment.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index a9b2934..d89486c 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -20,8 +20,8 @@ def isNameInternal (n: Name): Bool :=
@[export pantograph_environment_catalog]
def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name _ =>
match isNameInternal name with
- | true => acc.push name
- | false => acc)
+ | false => acc.push name
+ | true => acc)
@[export pantograph_environment_module_of_name]
def module_of_name (env: Environment) (name: Name): Option Name := do
From 1c9a411d4d89db0bfc38cee2e2d0ff5f61a8c61b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 29 Jul 2024 18:39:22 -0700
Subject: [PATCH 242/465] feat: Export constant info type/value
---
Pantograph/Environment.lean | 11 ++++++++---
1 file changed, 8 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index d89486c..37faf72 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -16,10 +16,10 @@ def isNameInternal (n: Name): Bool :=
| .str _ name => name == "Lean"
| _ => true
-/-- Catalog all the non-internal names -/
+/-- Catalog all the non-internal and safe names -/
@[export pantograph_environment_catalog]
-def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name _ =>
- match isNameInternal name with
+def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name info =>
+ match isNameInternal name || info.isUnsafe with
| false => acc.push name
| true => acc)
@@ -31,6 +31,11 @@ def module_of_name (env: Environment) (name: Name): Option Name := do
@[export pantograph_constant_info_is_unsafe_or_partial]
def constantInfoIsUnsafeOrPartial (info: ConstantInfo): Bool := info.isUnsafe || info.isPartial
+@[export pantograph_constant_info_type]
+def constantInfoType (info: ConstantInfo): CoreM Expr := unfoldAuxLemmas info.type
+@[export pantograph_constant_info_value]
+def constantInfoValue (info: ConstantInfo): CoreM (Option Expr) := info.value?.mapM unfoldAuxLemmas
+
def toCompactSymbolName (n: Name) (info: ConstantInfo): String :=
let pref := match info with
| .axiomInfo _ => "a"
From 3ca52517abe07ecd1c2036eeba4e2ba762299f9f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 30 Jul 2024 13:30:41 -0700
Subject: [PATCH 243/465] feat: Refactor out projToApp
---
Pantograph/Expr.lean | 20 ++++++++++++++++++++
Pantograph/Serial.lean | 13 +++++--------
2 files changed, 25 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index 9d8f70c..cbee9a5 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -4,6 +4,26 @@ open Lean
namespace Pantograph
+structure ProjectionApplication where
+ projector: Name
+ numParams: Nat
+ inner: Expr
+
+@[export pantograph_expr_proj_to_app]
+def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
+ let (typeName, idx, inner) := match e with
+ | .proj typeName idx inner => (typeName, idx, inner)
+ | _ => panic! "Argument must be proj"
+ let ctor := getStructureCtor env typeName
+ let fieldName := getStructureFields env typeName |>.get! idx
+ let projector := getProjFnForField? env typeName fieldName |>.get!
+ {
+ projector,
+ numParams := ctor.numParams,
+ inner,
+ }
+
+
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 87353e2..21bffce 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -168,15 +168,12 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
self inner
- | .proj typeName idx inner => do
+ | .proj _ _ _ => do
let env ← getEnv
- let ctor := getStructureCtor env typeName
- let fieldName := getStructureFields env typeName |>.get! idx
- let projectorName := getProjFnForField? env typeName fieldName |>.get!
-
- let autos := String.intercalate " " (List.replicate ctor.numParams "_")
- let inner ← self inner
- pure s!"((:c {projectorName}) {autos} {inner})"
+ let projApp := exprProjToApp env e
+ let autos := String.intercalate " " (List.replicate projApp.numParams "_")
+ let inner ← self projApp.inner
+ pure s!"((:c {projApp.projector}) {autos} {inner})"
-- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String
| .default => ""
From caa463f41010326d1f7c213ae2614b9fabacb73d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 30 Jul 2024 17:02:41 -0700
Subject: [PATCH 244/465] feat: Export GoalState.goalsArray
---
Pantograph/Expr.lean | 1 -
Pantograph/Goal.lean | 2 ++
Pantograph/Library.lean | 11 -----------
3 files changed, 2 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index cbee9a5..f989575 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -23,7 +23,6 @@ def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
inner,
}
-
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 6dbe525..26a8da1 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -54,6 +54,8 @@ protected def GoalState.isConv (state: GoalState): Bool :=
state.convMVar?.isSome
protected def GoalState.goals (state: GoalState): List MVarId :=
state.savedState.tactic.goals
+@[export pantograph_goal_state_goals]
+protected def GoalState.goalsArray (state: GoalState): Array MVarId := state.goals.toArray
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
protected def GoalState.env (state: GoalState): Environment :=
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 2f37cfa..5aa8f35 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -76,17 +76,6 @@ def createCoreState (imports: Array String): IO Core.State := do
(trustLevel := 1)
return { env := env }
-@[export pantograph_env_catalog_m]
-def envCatalog: CoreM Protocol.EnvCatalogResult :=
- Environment.catalog ({}: Protocol.EnvCatalog)
-
-@[export pantograph_env_inspect_m]
-def envInspect (name: String) (value: Bool) (dependency: Bool) (options: @&Protocol.Options):
- CoreM (Protocol.CR Protocol.EnvInspectResult) :=
- Environment.inspect ({
- name, value? := .some value, dependency?:= .some dependency
- }: Protocol.EnvInspect) options
-
@[export pantograph_env_add_m]
def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
CoreM (Protocol.CR Protocol.EnvAddResult) :=
From abef7a6f0d55de552c3c7297d25ece8121ee931d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 31 Jul 2024 00:00:21 -0700
Subject: [PATCH 245/465] feat: Export fvar names function
---
Pantograph/Goal.lean | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 26a8da1..0e87a12 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -69,6 +69,11 @@ protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): O
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
+@[export pantograph_goal_state_fvar_names_of_goal]
+protected def GoalState.fvarNamesOfGoal (state: GoalState) (mvarId: MVarId): Option (Array FVarId) := do
+ let mvarDecl ← state.mctx.findDecl? mvarId
+ return mvarDecl.lctx.getFVarIds
+
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
From 651afa75f4cb8cbd10c77247e055177c5adeed56 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 2 Aug 2024 19:49:11 -0700
Subject: [PATCH 246/465] feat: Filter in `visibleFVarsOfMVar`
---
Pantograph/Condensed.lean | 14 +++++++++++---
Pantograph/Goal.lean | 10 +++++++---
2 files changed, 18 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 8b5c313..1db3c62 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -66,11 +66,19 @@ def elabState (levelNames: Array Name): Elab.Term.State := {
end Condensed
+-- Get the list of visible (by default) free variables from a goal
+@[export pantograph_visible_fvars_of_mvar]
+protected def visibleFVarsOfMVar (mctx: MetavarContext) (mvarId: MVarId): Option (Array FVarId) := do
+ let mvarDecl ← mctx.findDecl? mvarId
+ let lctx := mvarDecl.lctx
+ return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
+ | some decl => if decl.isAuxDecl ∨ decl.isImplementationDetail then r else r.push decl.fvarId
+ | none => r
+
@[export pantograph_to_condensed_goal_m]
def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
- let options : Protocol.Options := {}
- let ppAuxDecls := options.printAuxDecls
- let ppImplDetailHyps := options.printImplementationDetailHyps
+ let ppAuxDecls := Meta.pp.auxDecls.get (← getOptions)
+ let ppImplDetailHyps := Meta.pp.implementationDetailHyps.get (← getOptions)
let mvarDecl ← mvarId.getDecl
let lctx := mvarDecl.lctx
let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0e87a12..ccb7a3d 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -69,10 +69,14 @@ protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): O
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
-@[export pantograph_goal_state_fvar_names_of_goal]
-protected def GoalState.fvarNamesOfGoal (state: GoalState) (mvarId: MVarId): Option (Array FVarId) := do
+-- Get the list of visible free variables from a goal
+@[export pantograph_goal_state_visible_fvars]
+protected def GoalState.visibleFVars (state: GoalState) (mvarId: MVarId): Option (Array FVarId) := do
let mvarDecl ← state.mctx.findDecl? mvarId
- return mvarDecl.lctx.getFVarIds
+ let lctx := mvarDecl.lctx
+ return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
+ | some decl => if decl.isAuxDecl ∨ decl.isImplementationDetail then r else r.push decl.fvarId
+ | none => r
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
From 2c08ef1e23a3429cefb5aacad19819a92768a847 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 2 Aug 2024 19:53:19 -0700
Subject: [PATCH 247/465] refactor: Remove old `visibleFVars` interface
---
Pantograph/Goal.lean | 9 ---------
1 file changed, 9 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index ccb7a3d..26a8da1 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -69,15 +69,6 @@ protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): O
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
--- Get the list of visible free variables from a goal
-@[export pantograph_goal_state_visible_fvars]
-protected def GoalState.visibleFVars (state: GoalState) (mvarId: MVarId): Option (Array FVarId) := do
- let mvarDecl ← state.mctx.findDecl? mvarId
- let lctx := mvarDecl.lctx
- return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
- | some decl => if decl.isAuxDecl ∨ decl.isImplementationDetail then r else r.push decl.fvarId
- | none => r
-
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
From c0e2a592ea819389bd5a39d289aabdd3d7a26a75 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 2 Aug 2024 21:44:46 -0700
Subject: [PATCH 248/465] feat: Expose `mkAppM'`
---
Pantograph/Condensed.lean | 2 ++
1 file changed, 2 insertions(+)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 1db3c62..fcd70a0 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -23,6 +23,8 @@ def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName || n.hasMacroSco
@[export pantograph_mk_app_m]
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
+@[export pantograph_mk_app_m_expr]
+def mkAppM' (f: Expr) (xs : Array Expr) : MetaM Expr := Meta.mkAppM' f xs
@[export pantograph_pp_expr_m]
def ppExpr (e: Expr): MetaM String := toString <$> Meta.ppExpr e
From 394fb731375785d268184c640cd387f44d76dac4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 2 Aug 2024 22:00:27 -0700
Subject: [PATCH 249/465] feat: Add direct expression to string
---
Pantograph/Condensed.lean | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index fcd70a0..9c20f32 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -23,9 +23,11 @@ def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName || n.hasMacroSco
@[export pantograph_mk_app_m]
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
-@[export pantograph_mk_app_m_expr]
+@[export pantograph_mk_app_expr_m]
def mkAppM' (f: Expr) (xs : Array Expr) : MetaM Expr := Meta.mkAppM' f xs
+@[export pantograph_expr_to_string]
+def exprToString (e: Expr): String := toString e
@[export pantograph_pp_expr_m]
def ppExpr (e: Expr): MetaM String := toString <$> Meta.ppExpr e
@[export pantograph_get_used_constants]
From c9ee31bbfdd215e5ceba960218c8344afd46954e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 2 Aug 2024 22:33:03 -0700
Subject: [PATCH 250/465] feat: Export `mkFun`
---
Pantograph/Condensed.lean | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 9c20f32..8696523 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -25,6 +25,14 @@ def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName || n.hasMacroSco
def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
@[export pantograph_mk_app_expr_m]
def mkAppM' (f: Expr) (xs : Array Expr) : MetaM Expr := Meta.mkAppM' f xs
+-- Copies same function in `Meta/AppBuilder.lean`
+@[export pantograph_mk_fun_m]
+def mkFun (constName : Name) : MetaM (Expr × Expr) := do
+ let cinfo ← getConstInfo constName
+ let us ← cinfo.levelParams.mapM fun _ => Meta.mkFreshLevelMVar
+ let f := mkConst constName us
+ let fType ← Meta.instantiateTypeLevelParams cinfo us
+ return (f, fType)
@[export pantograph_expr_to_string]
def exprToString (e: Expr): String := toString e
From 64269868d518b1211b724a46dc080d6f2f5a4a44 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 4 Aug 2024 17:32:20 -0700
Subject: [PATCH 251/465] feat: Expose project and leanPkgs in flake
---
flake.nix | 1 +
1 file changed, 1 insertion(+)
diff --git a/flake.nix b/flake.nix
index b96d5e2..54a139f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -63,6 +63,7 @@
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
+ inherit project leanPkgs;
default = project.executable;
};
checks = {
From caac70f0cfedca3964f65d2dbd04a8370c5dd97f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 4 Aug 2024 17:52:36 -0700
Subject: [PATCH 252/465] feat: Move non package outputs to dependencies
---
flake.nix | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/flake.nix b/flake.nix
index 54a139f..2b68c0c 100644
--- a/flake.nix
+++ b/flake.nix
@@ -63,9 +63,11 @@
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
- inherit project leanPkgs;
default = project.executable;
};
+ dependencies = {
+ inherit project leanPkgs;
+ };
checks = {
test = pkgs.runCommand "test" {
buildInputs = [ test.executable leanPkgs.lean-all ];
From 0bc7bc58565cceb839c41a11d207e4eeb64a845e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 14 Aug 2024 01:20:56 -0700
Subject: [PATCH 253/465] refactor: Remove export of Lean functions
If the user wishes to use Lean functions, they should add the bindings manually.
---
Pantograph/Condensed.lean | 42 ---------------------------------------
flake.nix | 4 +---
2 files changed, 1 insertion(+), 45 deletions(-)
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index 8696523..c47f882 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -9,39 +9,6 @@ open Lean
namespace Pantograph
namespace Condensed
-/-
-These two functions are for user defiend names. For internal names such as
-`_uniq`, it is favourable to use `lean_name_hash_exported` and `lean_name_eq` to
-construct hash maps for Lean names.
--/
-@[export pantograph_str_to_name]
-def strToName (s: String) : Name := s.toName
-@[export pantograph_name_to_str]
-def nameToStr (s: Name) : String := s.toString
-@[export pantograph_name_is_inaccessible]
-def isInaccessible (n: Name) : Bool := n.isInaccessibleUserName || n.hasMacroScopes
-
-@[export pantograph_mk_app_m]
-def mkAppM (constName : Name) (xs : Array Expr) : MetaM Expr := Meta.mkAppM constName xs
-@[export pantograph_mk_app_expr_m]
-def mkAppM' (f: Expr) (xs : Array Expr) : MetaM Expr := Meta.mkAppM' f xs
--- Copies same function in `Meta/AppBuilder.lean`
-@[export pantograph_mk_fun_m]
-def mkFun (constName : Name) : MetaM (Expr × Expr) := do
- let cinfo ← getConstInfo constName
- let us ← cinfo.levelParams.mapM fun _ => Meta.mkFreshLevelMVar
- let f := mkConst constName us
- let fType ← Meta.instantiateTypeLevelParams cinfo us
- return (f, fType)
-
-@[export pantograph_expr_to_string]
-def exprToString (e: Expr): String := toString e
-@[export pantograph_pp_expr_m]
-def ppExpr (e: Expr): MetaM String := toString <$> Meta.ppExpr e
-@[export pantograph_get_used_constants]
-def getUsedConstants (e: Expr) := e.getUsedConstants
-
-
-- Mirrors Lean's LocalDecl
structure LocalDecl where
-- Default value is for testing
@@ -61,20 +28,11 @@ structure Goal where
@[export pantograph_goal_is_lhs]
def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
-
-- Functions for creating contexts and states
-@[export pantograph_meta_context]
-def metaContext: Meta.Context := {}
-@[export pantograph_meta_state]
-def metaState: Meta.State := {}
@[export pantograph_elab_context]
def elabContext: Elab.Term.Context := {
errToSorry := false
}
-@[export pantograph_elab_state]
-def elabState (levelNames: Array Name): Elab.Term.State := {
- levelNames := levelNames.toList,
- }
end Condensed
diff --git a/flake.nix b/flake.nix
index 2b68c0c..54a139f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -63,10 +63,8 @@
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
- default = project.executable;
- };
- dependencies = {
inherit project leanPkgs;
+ default = project.executable;
};
checks = {
test = pkgs.runCommand "test" {
From e943a4b065cc78c268fcd3ca31ff57d7d3e4b697 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Aug 2024 22:39:40 -0700
Subject: [PATCH 254/465] refactor: Assign into its own tactic
---
Pantograph/Goal.lean | 68 ++++++-----------------------------
Pantograph/Library.lean | 19 ----------
Pantograph/Serial.lean | 6 ++--
Pantograph/Tactic.lean | 1 +
Pantograph/Tactic/Assign.lean | 35 ++++++++++++++++++
Test/Metavar.lean | 4 +--
6 files changed, 52 insertions(+), 81 deletions(-)
create mode 100644 Pantograph/Tactic/Assign.lean
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 26a8da1..136379a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -178,13 +178,14 @@ inductive TacticResult where
-- The given action cannot be executed in the state
| invalidAction (message: String)
-protected def GoalState.execute (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
- Elab.TermElabM TacticResult := do
+/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
+protected def GoalState.executeTactic (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
+ Elab.TermElabM TacticResult := do
state.restoreElabM
let goal ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.execute
+ goal.checkNotAssigned `GoalState.executeTactic
try
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
if (← getThe Core.State).messages.hasErrors then
@@ -204,7 +205,7 @@ protected def GoalState.execute (state: GoalState) (goalId: Nat) (tacticM: Elab.
catch exception =>
return .failure #[← exception.toMessageData.toString]
-/-- Execute tactic on given state -/
+/-- Execute a string tactic on given state -/
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
Elab.TermElabM TacticResult := do
let tactic ← match Parser.runParserCategory
@@ -214,68 +215,19 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
(fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
- state.execute goalId $ Elab.Tactic.evalTactic tactic
-
-/-- Assumes elabM has already been restored. Assumes expr has already typechecked -/
-protected def GoalState.assign (state: GoalState) (goal: MVarId) (expr: Expr):
- Elab.TermElabM TacticResult := do
- let goalType ← goal.getType
- try
- -- For some reason this is needed. One of the unit tests will fail if this isn't here
- let error?: Option String ← goal.withContext do
- let exprType ← Meta.inferType expr
- if ← Meta.isDefEq goalType exprType then
- pure .none
- else do
- return .some s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} != {← Meta.ppExpr goalType}"
- if let .some error := error? then
- return .parseError error
- goal.checkNotAssigned `GoalState.assign
- goal.assign expr
- if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.toArray
- let errors ← (messages.map (·.data)).mapM fun md => md.toString
- return .failure errors
- let prevMCtx := state.savedState.term.meta.meta.mctx
- let nextMCtx ← getMCtx
- -- Generate a list of mvarIds that exist in the parent state; Also test the
- -- assertion that the types have not changed on any mvars.
- let newMVars := newMVarSet prevMCtx nextMCtx
- let nextGoals ← newMVars.toList.filterM (not <$> ·.isAssigned)
- return .success {
- root := state.root,
- savedState := {
- term := ← MonadBacktrack.saveState,
- tactic := { goals := nextGoals }
- },
- newMVars,
- parentMVar? := .some goal,
- calcPrevRhs? := .none
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
+ state.executeTactic goalId $ Elab.Tactic.evalTactic tactic
protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryAssign
let expr ← match Parser.runParserCategory
- (env := state.env)
+ (env := ← MonadEnv.getEnv)
(catName := `term)
(input := expr)
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- let goalType ← goal.getType
- try
- let expr ← goal.withContext $
- Elab.Term.elabTermAndSynthesize (stx := expr) (expectedType? := .some goalType)
- state.assign goal expr
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
+ state.executeTactic goalId $ Tactic.evalAssign expr
-- Specialized Tactics
@@ -535,7 +487,7 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.execute goalId (tacticM := Tactic.motivatedApply recursor)
+ state.executeTactic goalId (tacticM := Tactic.motivatedApply recursor)
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
@@ -546,6 +498,6 @@ protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: Strin
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.execute goalId (tacticM := Tactic.noConfuse recursor)
+ state.executeTactic goalId (tacticM := Tactic.noConfuse recursor)
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 5aa8f35..59197f6 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -154,9 +154,6 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.G
state.withParentContext do
serializeExpression options (← instantiateAll expr)),
}
-@[export pantograph_goal_diag_m]
-def goalDiag (state: GoalState) (diagOptions: Protocol.GoalDiag) : CoreM String :=
- runMetaM $ state.diag diagOptions
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): CoreM TacticResult :=
@@ -189,20 +186,4 @@ def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): Core
def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): CoreM TacticResult :=
runTermElabM <| state.tryNoConfuse goalId eq
-inductive SyntheticTactic where
- | congruenceArg
- | congruenceFun
- | congruence
-/-- Executes a synthetic tactic which has no arguments -/
-@[export pantograph_goal_synthetic_tactic_m]
-def goalSyntheticTactic (state: GoalState) (goalId: Nat) (case: SyntheticTactic): CoreM TacticResult :=
- runTermElabM do
- state.restoreElabM
- state.execute goalId $ match case with
- | .congruenceArg => Tactic.congruenceArg
- | .congruenceFun => Tactic.congruenceFun
- | .congruence => Tactic.congruence
-
-
-
end Pantograph
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 21bffce..6a10309 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -286,7 +286,8 @@ protected def GoalState.serializeGoals
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
/-- Print the metavariables in a readable format -/
-protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag := {}): MetaM String := do
+@[export pantograph_goal_state_diag_m]
+protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState := .none) (options: Protocol.GoalDiag := {}): MetaM String := do
goalState.restoreMetaM
let savedState := goalState.savedState
let goals := savedState.tactic.goals
@@ -305,7 +306,7 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
!(goals.contains mvarId || mvarId == root) && options.printAll)
|>.mapM (fun (mvarId, decl) => do
- let pref := if goalState.newMVars.contains mvarId then "~" else " "
+ let pref := if parentHasMVar mvarId then " " else "~"
printMVar pref mvarId decl
)
pure $ result ++ "\n" ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
@@ -345,5 +346,6 @@ protected def GoalState.diag (goalState: GoalState) (options: Protocol.GoalDiag
userNameToString : Name → String
| .anonymous => ""
| other => s!"[{other}]"
+ parentHasMVar (mvarId: MVarId): Bool := parent?.map (λ state => state.mctx.decls.contains mvarId) |>.getD true
end Pantograph
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 225ad31..8efebc8 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -1,4 +1,5 @@
+import Pantograph.Tactic.Assign
import Pantograph.Tactic.Congruence
import Pantograph.Tactic.MotivatedApply
import Pantograph.Tactic.NoConfuse
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
new file mode 100644
index 0000000..cd9281f
--- /dev/null
+++ b/Pantograph/Tactic/Assign.lean
@@ -0,0 +1,35 @@
+import Lean
+
+open Lean
+
+namespace Pantograph.Tactic
+
+private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
+ mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
+ if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
+ assert! prevMVarDecl.type == mvarDecl.type
+ acc
+ else
+ acc.insert mvarId
+ ) SSet.empty
+def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
+ goal.checkNotAssigned `Pantograph.Tactic.assign
+
+ -- This run of the unifier is critical in resolving mvars in passing
+ let exprType ← Meta.inferType expr
+ let goalType ← goal.getType
+ unless ← Meta.isDefEq goalType exprType do
+ throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
+
+ let nextGoals ← Meta.getMVars expr
+ goal.assign expr
+ nextGoals.toList.filterM (not <$> ·.isAssigned)
+
+def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
+ let goalType ← Elab.Tactic.getMainTarget
+ let expr ← Elab.Term.elabTermAndSynthesize (stx := stx) (expectedType? := .some goalType)
+ let nextGoals ← assign (← Elab.Tactic.getMainGoal) expr
+ Elab.Tactic.setGoals nextGoals
+
+
+end Pantograph.Tactic
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 4ac8454..3849b44 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -198,10 +198,10 @@ def test_proposition_generation: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "Nat → Prop", .some "∀ (x : Nat), ?m.29 x"])
+ #[.some "∀ (x : Nat), ?m.29 x"])
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
- let state3 ← match ← state2.tryAssign (goalId := 1) (expr := "fun x => Eq.refl x") with
+ let state3 ← match ← state2.tryAssign (goalId := 0) (expr := "fun x => Eq.refl x") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
From 7968072097912d26bee25e35637e52f663425d10 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Aug 2024 22:53:42 -0700
Subject: [PATCH 255/465] refactor: Remove the newMVarSet mechanism
This field has ambiguous purpose and does not account for different
types of mvars
---
Pantograph/Goal.lean | 56 ++++++++++++++------------------------------
1 file changed, 18 insertions(+), 38 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0d58fb5..cd29d2a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -22,8 +22,6 @@ structure GoalState where
-- The root hole which is the search target
root: MVarId
- -- New metavariables acquired in this state
- newMVars: SSet MVarId
-- Parent state metavariable source
parentMVar?: Option MVarId
@@ -48,7 +46,6 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
return {
root,
savedState,
- newMVars := SSet.insert .empty root,
parentMVar? := .none,
}
protected def GoalState.isConv (state: GoalState): Bool :=
@@ -89,15 +86,6 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
Elab.Tactic.setGoals [goal]
-private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
- mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
- if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- acc
- else
- acc.insert mvarId
- ) SSet.empty
-
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
let goal ← state.savedState.tactic.goals.get? goalId
return {
@@ -166,6 +154,21 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId)
--- Tactic execution functions ---
+protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
+ : Elab.TermElabM GoalState := do
+ state.restoreElabM
+ unless (← getMCtx).decls.contains mvarId do
+ throwError s!"MVarId is not in context: {mvarId.name}"
+ mvarId.checkNotAssigned `GoalState.step
+ let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [mvarId] }
+ let nextElabState ← MonadBacktrack.saveState
+ return {
+ state with
+ savedState := { term := nextElabState, tactic := newGoals },
+ parentMVar? := .some mvarId,
+ calcPrevRhs? := .none,
+ }
+
/-- Response for executing a tactic -/
inductive TacticResult where
-- Goes to next state
@@ -182,27 +185,12 @@ inductive TacticResult where
/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
Elab.TermElabM TacticResult := do
- state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
+ let mvarId ← match state.savedState.tactic.goals.get? goalId with
| .some goal => pure $ goal
| .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryTacticM
try
- let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
- if (← getThe Core.State).messages.hasErrors then
- let messages := (← getThe Core.State).messages.toArray
- let errors ← (messages.map (·.data)).mapM fun md => md.toString
- return .failure errors
- let nextElabState ← MonadBacktrack.saveState
- let nextMCtx := nextElabState.meta.meta.mctx
- let prevMCtx := state.mctx
- return .success {
- state with
- savedState := { term := nextElabState, tactic := newGoals },
- newMVars := newMVarSet prevMCtx nextMCtx,
- parentMVar? := .some goal,
- calcPrevRhs? := .none,
- }
+ let nextState ← state.step mvarId tacticM
+ return .success nextState
catch exception =>
return .failure #[← exception.toMessageData.toString]
@@ -269,7 +257,6 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str
term := ← MonadBacktrack.saveState,
tactic := { goals := nextGoals }
},
- newMVars := nextGoals.toSSet,
parentMVar? := .some goal,
calcPrevRhs? := .none
}
@@ -296,12 +283,9 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
return (← MonadBacktrack.saveState, convMVar)
try
let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- let prevMCtx := state.mctx
- let nextMCtx := nextSavedState.term.meta.meta.mctx
return .success {
root := state.root,
savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar? := .some goal,
convMVar? := .some (convRhs, goal),
calcPrevRhs? := .none
@@ -335,12 +319,9 @@ protected def GoalState.convExit (state: GoalState):
MonadBacktrack.saveState
try
let nextSavedState ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
- let nextMCtx := nextSavedState.term.meta.meta.mctx
- let prevMCtx := state.savedState.term.meta.meta.mctx
return .success {
root := state.root,
savedState := nextSavedState
- newMVars := newMVarSet prevMCtx nextMCtx,
parentMVar? := .some convGoal,
convMVar? := .none
calcPrevRhs? := .none
@@ -420,7 +401,6 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
term := ← MonadBacktrack.saveState,
tactic := { goals },
},
- newMVars := goals.toSSet,
parentMVar? := .some goal,
calcPrevRhs?
}
From 9b0456a5e0026ac5d8087a78fe3e3d5ff4f9b594 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Aug 2024 23:17:15 -0700
Subject: [PATCH 256/465] refactor: MetaM form of have and let
---
Pantograph/Goal.lean | 37 ++--------------
Pantograph/Library.lean | 2 +-
Pantograph/Tactic/Prograde.lean | 76 ++++++++++++++++++++++++---------
3 files changed, 60 insertions(+), 55 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index cd29d2a..b54c5f7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -156,7 +156,6 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId)
protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
: Elab.TermElabM GoalState := do
- state.restoreElabM
unless (← getMCtx).decls.contains mvarId do
throwError s!"MVarId is not in context: {mvarId.name}"
mvarId.checkNotAssigned `GoalState.step
@@ -197,6 +196,7 @@ protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: El
/-- Execute a string tactic on given state -/
protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
Elab.TermElabM TacticResult := do
+ state.restoreElabM
let tactic ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := if state.isConv then `conv else `tactic)
@@ -223,45 +223,14 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
- goal.checkNotAssigned `GoalState.tryLet
let type ← match Parser.runParserCategory
- (env := state.env)
+ (env := ← MonadEnv.getEnv)
(catName := `term)
(input := type)
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- let binderName := binderName.toName
- try
- -- Implemented similarly to the intro tactic
- let nextGoals: List MVarId ← goal.withContext do
- let type ← Elab.Term.elabType (stx := type)
- let lctx ← MonadLCtx.getLCtx
-
- -- The branch goal inherits the same context, but with a different type
- let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
-
- let upstreamType := .letE binderName type mvarBranch (← goal.getType) false
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- upstreamType (kind := MetavarKind.synthetic) (userName := (← goal.getTag))
-
- goal.assign mvarUpstream
-
- pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
- return .success {
- root := state.root,
- savedState := {
- term := ← MonadBacktrack.saveState,
- tactic := { goals := nextGoals }
- },
- parentMVar? := .some goal,
- calcPrevRhs? := .none
- }
- catch exception =>
- return .failure #[← exception.toMessageData.toString]
+ state.tryTacticM goalId $ Tactic.evalLet binderName.toName type
/-- Enter conv tactic mode -/
protected def GoalState.conv (state: GoalState) (goalId: Nat):
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 4b8cc9d..da2ae5c 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -168,7 +168,7 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.tryTacticM goalId (Tactic.«have» binderName.toName type)
+ state.tryTacticM goalId $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_evaluate_m]
protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
let expr ← match (← Compile.parseTermM expr) with
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index 59acaf1..d6abb16 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -19,29 +19,65 @@ def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
pure [mvarUpstream.mvarId!]
Elab.Tactic.setGoals nextGoals
-def «have» (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
+structure BranchResult where
+ fvarId?: Option FVarId := .none
+ main: MVarId
+ branch: MVarId
+
+def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.have
+ let lctx ← MonadLCtx.getLCtx
+ -- The branch goal inherits the same context, but with a different type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
+
+ -- Create the context for the `upstream` goal
+ let fvarId ← mkFreshFVarId
+ let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
+ let mvarUpstream ←
+ withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
+ Meta.withNewLocalInstances #[.fvar fvarId] 0 do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (← mvarId.getType) (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
+ --let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
+ mvarId.assign mvarUpstream
+ pure mvarUpstream
+
+ return {
+ fvarId? := .some fvarId,
+ main := mvarUpstream.mvarId!,
+ branch := mvarBranch.mvarId!,
+ }
+
+def evalHave (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals: List MVarId ← goal.withContext do
let type ← Elab.Term.elabType (stx := type)
- let lctx ← MonadLCtx.getLCtx
-
- -- The branch goal inherits the same context, but with a different type
- let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
-
- -- Create the context for the `upstream` goal
- let fvarId ← mkFreshFVarId
- let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
- let fvar := mkFVar fvarId
- let mvarUpstream ←
- withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
- Meta.withNewLocalInstances #[fvar] 0 do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
- --let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
- goal.assign mvarUpstream
- pure mvarUpstream
-
- pure [mvarBranch.mvarId!, mvarUpstream.mvarId!]
+ let result ← «have» goal binderName type
+ pure [result.branch, result.main]
Elab.Tactic.setGoals nextGoals
+def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.let
+ let lctx ← MonadLCtx.getLCtx
+
+ -- The branch goal inherits the same context, but with a different type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
+
+ assert! ¬ type.hasLooseBVars
+ let upstreamType := .letE binderName type mvarBranch (← mvarId.getType) false
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ upstreamType (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
+ mvarId.assign mvarUpstream
+
+ return {
+ main := mvarUpstream.mvarId!,
+ branch := mvarBranch.mvarId!,
+ }
+
+def evalLet (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let type ← goal.withContext $ Elab.Term.elabType (stx := type)
+ let result ← «let» goal binderName type
+ Elab.Tactic.setGoals [result.branch, result.main]
+
end Pantograph.Tactic
From 1e7a186bb1d423585630d0370bec8612d6fc73be Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Aug 2024 23:23:17 -0700
Subject: [PATCH 257/465] refactor: MetaM form of define (evaluate)
---
Pantograph/Library.lean | 6 +++---
Pantograph/Tactic/Prograde.lean | 27 +++++++++++++++------------
Test/Tactic/Prograde.lean | 4 ++--
3 files changed, 20 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index da2ae5c..6fff21e 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -169,14 +169,14 @@ protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: St
runTermElabM do
state.restoreElabM
state.tryTacticM goalId $ Tactic.evalHave binderName.toName type
-@[export pantograph_goal_evaluate_m]
-protected def GoalState.tryEvaluate (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
+@[export pantograph_goal_try_define_m]
+protected def GoalState.tryDefine (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
let expr ← match (← Compile.parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.tryTacticM goalId (Tactic.evaluate binderName.toName expr)
+ state.tryTacticM goalId (Tactic.evalDefine binderName.toName expr)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goalId binderName type
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index d6abb16..dd34684 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -5,19 +5,22 @@ open Lean
namespace Pantograph.Tactic
-def evaluate (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
- let goal ← Elab.Tactic.getMainGoal
- let nextGoals ← goal.withContext do
- let expr ← Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
- let type ← Meta.inferType expr
+/-- Introduces a fvar to the current mvar -/
+def define (mvarId: MVarId) (binderName: Name) (expr: Expr): MetaM (FVarId × MVarId) := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.define
+ let type ← Meta.inferType expr
- let mvarUpstream ← Meta.withLetDecl binderName type expr λ _ => do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (← goal.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
- goal.assign mvarUpstream
- pure mvarUpstream
- pure [mvarUpstream.mvarId!]
- Elab.Tactic.setGoals nextGoals
+ Meta.withLetDecl binderName type expr λ fvar => do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (← mvarId.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
+ mvarId.assign mvarUpstream
+ pure (fvar.fvarId!, mvarUpstream.mvarId!)
+
+def evalDefine (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
+ let goal ← Elab.Tactic.getMainGoal
+ let expr ← goal.withContext $ Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
+ let (_, mvarId) ← define goal binderName expr
+ Elab.Tactic.setGoals [mvarId]
structure BranchResult where
fvarId?: Option FVarId := .none
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 15da63e..6b7cd44 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -32,7 +32,7 @@ def test_eval : TestT Elab.TermElabM Unit := do
],
target,
})
- let tactic := Tactic.evaluate `h2 e
+ let tactic := Tactic.evalDefine `h2 e
let m := .mvar ⟨uniq 13⟩
let [newGoal] ← runTacticOnMVar tactic goal.mvarId! | panic! "Incorrect goal number"
addTest $ LSpec.test "goals after" ((← toCondensedGoal newGoal).devolatilize == {
@@ -73,7 +73,7 @@ def test_proof_eval : TestT Elab.TermElabM Unit := do
let evalBind := "y"
let evalExpr := "Or.inl h"
- let state2 ← match ← state1.tryEvaluate (goalId := 0) (binderName := evalBind) (expr := evalExpr) with
+ let state2 ← match ← state1.tryDefine (goalId := 0) (binderName := evalBind) (expr := evalExpr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
From 5b4f8a37ebbbbd435b400af11ce65ec9c96ec428 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 15 Aug 2024 23:41:17 -0700
Subject: [PATCH 258/465] refactor: All Tactic/ tactics into MetaM form
---
Pantograph/Goal.lean | 4 +-
Pantograph/Library.lean | 6 -
Pantograph/Tactic/Congruence.lean | 153 ++++++++++++++------------
Pantograph/Tactic/MotivatedApply.lean | 68 ++++++------
Pantograph/Tactic/NoConfuse.lean | 20 ++--
Test/Tactic/Congruence.lean | 8 +-
Test/Tactic/MotivatedApply.lean | 6 +-
Test/Tactic/NoConfuse.lean | 6 +-
8 files changed, 141 insertions(+), 130 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b54c5f7..9be5164 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -383,13 +383,13 @@ protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recu
let recursor ← match (← Compile.parseTermM recursor) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId (tacticM := Tactic.motivatedApply recursor)
+ state.tryTacticM goalId (tacticM := Tactic.evalMotivatedApply recursor)
protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let eq ← match (← Compile.parseTermM eq) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId (tacticM := Tactic.noConfuse eq)
+ state.tryTacticM goalId (tacticM := Tactic.evalNoConfuse eq)
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 6fff21e..c4ce4ff 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -192,11 +192,5 @@ def goalCalc (state: GoalState) (goalId: Nat) (pred: String): CoreM TacticResult
@[export pantograph_goal_focus]
def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
state.focus goalId
-@[export pantograph_goal_motivated_apply_m]
-def goalMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String): CoreM TacticResult :=
- runTermElabM <| state.tryMotivatedApply goalId recursor
-@[export pantograph_goal_no_confuse_m]
-def goalNoConfuse (state: GoalState) (goalId: Nat) (eq: String): CoreM TacticResult :=
- runTermElabM <| state.tryNoConfuse goalId eq
end Pantograph
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
index bbb9d75..2ff23d2 100644
--- a/Pantograph/Tactic/Congruence.lean
+++ b/Pantograph/Tactic/Congruence.lean
@@ -4,82 +4,95 @@ open Lean
namespace Pantograph.Tactic
-def congruenceArg: Elab.Tactic.TacticM Unit := do
+def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.congruenceArg
+ let target ← mvarId.getType
+ let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let userName := (← mvarId.getDecl).userName
+
+ let u ← Meta.mkFreshLevelMVar
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous α β .default)
+ .synthetic (userName := userName ++ `f)
+ let a₁ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₂)
+ let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
+ .synthetic (userName := userName ++ `h)
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) target
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := userName ++ `conduit)
+ mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
+ let result := [α, a₁, a₂, f, h, conduit]
+ return result.map (·.mvarId!)
+
+def evalCongruenceArg: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- let userName := (← goal.getDecl).userName
+ let nextGoals ← congruenceArg goal
+ Elab.Tactic.setGoals nextGoals
- let nextGoals ← goal.withContext do
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
- let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous α β .default)
- .synthetic (userName := userName ++ `f)
- let a₁ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₂)
- let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
- .synthetic (userName := userName ++ `h)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) (← goal.getType)
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
- goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
- return [α, a₁, a₂, f, h, conduit]
- Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.congruenceFun
+ let target ← mvarId.getType
+ let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let userName := (← mvarId.getDecl).userName
+ let u ← Meta.mkFreshLevelMVar
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let fType := .forallE .anonymous α β .default
+ let f₁ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := userName ++ `f₁)
+ let f₂ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := userName ++ `f₂)
+ let a ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a)
+ let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
+ .synthetic (userName := userName ++ `h)
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) target
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := userName ++ `conduit)
+ mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
+ let result := [α, f₁, f₂, h, a, conduit]
+ return result.map (·.mvarId!)
-def congruenceFun: Elab.Tactic.TacticM Unit := do
+def evalCongruenceFun: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- let userName := (← goal.getDecl).userName
+ let nextGoals ← congruenceFun goal
+ Elab.Tactic.setGoals nextGoals
- let nextGoals ← goal.withContext do
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
- let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₂)
- let a ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a)
- let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
- .synthetic (userName := userName ++ `h)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) (← goal.getType)
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
- goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
- return [α, f₁, f₂, h, a, conduit]
- Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.congruence
+ let target ← mvarId.getType
+ let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let userName := (← mvarId.getDecl).userName
+ let u ← Meta.mkFreshLevelMVar
+ let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
+ .natural (userName := userName ++ `α)
+ let fType := .forallE .anonymous α β .default
+ let f₁ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := userName ++ `f₁)
+ let f₂ ← Meta.mkFreshExprMVar (.some fType)
+ .synthetic (userName := userName ++ `f₂)
+ let a₁ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprMVar (.some α)
+ .synthetic (userName := userName ++ `a₂)
+ let h₁ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
+ .synthetic (userName := userName ++ `h₁)
+ let h₂ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
+ .synthetic (userName := userName ++ `h₂)
+ let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) target
+ let conduit ← Meta.mkFreshExprMVar conduitType
+ .synthetic (userName := userName ++ `conduit)
+ mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
+ let result := [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
+ return result.map (·.mvarId!)
-def congruence: Elab.Tactic.TacticM Unit := do
+def evalCongruence: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
- let .some (β, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
- let userName := (← goal.getDecl).userName
-
- let nextGoals ← goal.withContext do
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
- let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₂)
- let a₁ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₂)
- let h₁ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
- .synthetic (userName := userName ++ `h₁)
- let h₂ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
- .synthetic (userName := userName ++ `h₂)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) (← goal.getType)
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
- goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
- return [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
- Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
+ let nextGoals ← congruence goal
+ Elab.Tactic.setGoals nextGoals
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index f570560..37d0099 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -62,44 +62,44 @@ def collectMotiveArguments (forallBody: Expr): SSet Nat :=
| _ => SSet.empty
/-- Applies a symbol of the type `∀ (motive: α → Sort u) (a: α)..., (motive α)` -/
-def motivatedApply: Elab.Tactic.Tactic := λ stx => do
- let goal ← Elab.Tactic.getMainGoal
- let nextGoals: List MVarId ← goal.withContext do
- let recursor ← Elab.Term.elabTerm (stx := stx) .none
- let recursorType ← Meta.inferType recursor
+def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (List Meta.InductionSubgoal) := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.motivatedApply
+ let recursorType ← Meta.inferType recursor
+ let resultant ← mvarId.getType
- let resultant ← goal.getType
+ let info ← match getRecursorInformation recursorType with
+ | .some info => pure info
+ | .none => throwError "Recursor return type does not correspond with the invocation of a motive: {← Meta.ppExpr recursorType}"
- let info ← match getRecursorInformation recursorType with
- | .some info => pure info
- | .none => throwError "Recursor return type does not correspond with the invocation of a motive: {← Meta.ppExpr recursorType}"
+ let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
+ if i ≥ info.nArgs then
+ return prev
+ else
+ let argType := info.args.get! i
+ -- If `argType` has motive references, its goal needs to be placed in it
+ let argType := argType.instantiateRev prev
+ let bvarIndex := info.nArgs - i - 1
+ let argGoal ← if bvarIndex = info.iMotive then
+ let surrogateMotiveType ← info.surrogateMotiveType prev resultant
+ Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
+ else
+ Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
+ let prev := prev ++ [argGoal]
+ go (i + 1) prev
+ termination_by info.nArgs - i
+ let mut newMVars ← go 0 #[]
- let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
- if i ≥ info.nArgs then
- return prev
- else
- let argType := info.args.get! i
- -- If `argType` has motive references, its goal needs to be placed in it
- let argType := argType.instantiateRev prev
- let bvarIndex := info.nArgs - i - 1
- let argGoal ← if bvarIndex = info.iMotive then
- let surrogateMotiveType ← info.surrogateMotiveType prev resultant
- Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
- else
- Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
- let prev := prev ++ [argGoal]
- go (i + 1) prev
- termination_by info.nArgs - i
- let mut newMVars ← go 0 #[]
+ -- Create the conduit type which proves the result of the motive is equal to the goal
+ let conduitType ← info.conduitType newMVars resultant
+ let goalConduit ← Meta.mkFreshExprMVar conduitType .natural (userName := `conduit)
+ mvarId.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
+ newMVars := newMVars ++ [goalConduit]
- -- Create the conduit type which proves the result of the motive is equal to the goal
- let conduitType ← info.conduitType newMVars resultant
- let goalConduit ← Meta.mkFreshExprMVar conduitType .natural (userName := `conduit)
- goal.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
- newMVars := newMVars ++ [goalConduit]
+ return newMVars.toList.map (λ mvar => { mvarId := mvar.mvarId!})
- let nextGoals := newMVars.toList.map (·.mvarId!)
- pure nextGoals
- Elab.Tactic.setGoals nextGoals
+def evalMotivatedApply : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
+ let recursor ← Elab.Term.elabTerm (stx := stx) .none
+ let nextGoals ← motivatedApply (← Elab.Tactic.getMainGoal) recursor
+ Elab.Tactic.setGoals $ nextGoals.map (·.mvarId)
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/NoConfuse.lean b/Pantograph/Tactic/NoConfuse.lean
index b8bc84e..f4ce78f 100644
--- a/Pantograph/Tactic/NoConfuse.lean
+++ b/Pantograph/Tactic/NoConfuse.lean
@@ -4,15 +4,19 @@ open Lean
namespace Pantograph.Tactic
-def noConfuse: Elab.Tactic.Tactic := λ stx => do
- let goal ← Elab.Tactic.getMainGoal
- goal.withContext do
- let absurd ← Elab.Term.elabTerm (stx := stx) .none
- let noConfusion ← Meta.mkNoConfusion (target := ← goal.getType) (h := absurd)
+def noConfuse (mvarId: MVarId) (h: Expr): MetaM Unit := mvarId.withContext do
+ mvarId.checkNotAssigned `Pantograph.Tactic.noConfuse
+ let target ← mvarId.getType
+ let noConfusion ← Meta.mkNoConfusion (target := target) (h := h)
- unless ← Meta.isDefEq (← Meta.inferType noConfusion) (← goal.getType) do
- throwError "invalid noConfuse call: The resultant type {← Meta.ppExpr $ ← Meta.inferType noConfusion} cannot be unified with {← Meta.ppExpr $ ← goal.getType}"
- goal.assign noConfusion
+ unless ← Meta.isDefEq (← Meta.inferType noConfusion) target do
+ throwError "invalid noConfuse call: The resultant type {← Meta.ppExpr $ ← Meta.inferType noConfusion} cannot be unified with {← Meta.ppExpr target}"
+ mvarId.assign noConfusion
+
+def evalNoConfuse: Elab.Tactic.Tactic := λ stx => do
+ let goal ← Elab.Tactic.getMainGoal
+ let h ← goal.withContext $ Elab.Term.elabTerm (stx := stx) .none
+ noConfuse goal h
Elab.Tactic.setGoals []
end Pantograph.Tactic
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 38c94f3..836041c 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -12,7 +12,7 @@ def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.30"),
@@ -34,7 +34,7 @@ def test_congr_arg : TestT Elab.TermElabM Unit := do
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.congruenceArg target.mvarId!
+ let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.70"),
@@ -49,7 +49,7 @@ def test_congr_fun : TestT Elab.TermElabM Unit := do
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.congruenceFun target.mvarId!
+ let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.159"),
@@ -64,7 +64,7 @@ def test_congr : TestT Elab.TermElabM Unit := do
let expr ← parseSentence expr
Meta.lambdaTelescope expr $ λ _ body => do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.congruence target.mvarId!
+ let newGoals ← runTacticOnMVar Tactic.evalCongruence target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
(`α, "Sort ?u.10"),
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 091e309..4fb05e3 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -33,7 +33,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
+ let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
let test := LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
@@ -57,7 +57,7 @@ def test_list_brec_on : TestT Elab.TermElabM Unit := do
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
+ let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
@@ -81,7 +81,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
Meta.lambdaTelescope expr $ λ _ body => do
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.motivatedApply recursor
+ let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
let majorId := 67
addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
index cc15198..ac277e2 100644
--- a/Test/Tactic/NoConfuse.lean
+++ b/Test/Tactic/NoConfuse.lean
@@ -20,7 +20,7 @@ def test_nat : TestT Elab.TermElabM Unit := do
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.noConfuse recursor
+ let tactic := Tactic.evalNoConfuse recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
@@ -38,7 +38,7 @@ def test_nat_fail : TestT Elab.TermElabM Unit := do
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
try
- let tactic := Tactic.noConfuse recursor
+ let tactic := Tactic.evalNoConfuse recursor
let _ ← runTacticOnMVar tactic target.mvarId!
addTest $ assertUnreachable "Tactic should fail"
catch _ =>
@@ -57,7 +57,7 @@ def test_list : TestT Elab.TermElabM Unit := do
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.noConfuse recursor
+ let tactic := Tactic.evalNoConfuse recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
addTest $ LSpec.check "goals"
((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
From d17b21e282f9f23ac9105d2241e805a1553fde2b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 16 Aug 2024 00:32:34 -0700
Subject: [PATCH 259/465] fix: Use `getMVarsNoDelayed`
---
Pantograph/Tactic/Assign.lean | 11 ++---------
1 file changed, 2 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index cd9281f..af76bfd 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -4,14 +4,6 @@ open Lean
namespace Pantograph.Tactic
-private def newMVarSet (mctxOld: @&MetavarContext) (mctxNew: @&MetavarContext): SSet MVarId :=
- mctxNew.decls.foldl (fun acc mvarId mvarDecl =>
- if let .some prevMVarDecl := mctxOld.decls.find? mvarId then
- assert! prevMVarDecl.type == mvarDecl.type
- acc
- else
- acc.insert mvarId
- ) SSet.empty
def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
goal.checkNotAssigned `Pantograph.Tactic.assign
@@ -21,7 +13,8 @@ def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
unless ← Meta.isDefEq goalType exprType do
throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
- let nextGoals ← Meta.getMVars expr
+ -- FIXME: Use `withCollectingNewGoalsFrom`. Think about how this interacts with elaboration ...
+ let nextGoals ← Meta.getMVarsNoDelayed expr
goal.assign expr
nextGoals.toList.filterM (not <$> ·.isAssigned)
From e1b7eaab12084371bf27d9ae68da0431de8d37b7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 00:47:12 -0700
Subject: [PATCH 260/465] fix: Let tactic not bringing binder into scope
---
Pantograph/Protocol.lean | 2 +-
Pantograph/Serial.lean | 2 +
Pantograph/Tactic/Assign.lean | 9 ++--
Pantograph/Tactic/Prograde.lean | 11 ++--
Test/Metavar.lean | 7 +--
Test/Proofs.lean | 81 +---------------------------
Test/Tactic/Prograde.lean | 93 +++++++++++++++++++++++++++++++++
7 files changed, 113 insertions(+), 92 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 1e4bc06..f954f0d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -51,7 +51,7 @@ structure Variable where
/-- The name displayed to the user -/
userName: String
/-- Does the name contain a dagger -/
- isInaccessible?: Option Bool := .none
+ isInaccessible?: Option Bool := .some false
type?: Option Expression := .none
value?: Option Expression := .none
deriving Lean.ToJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index b353785..9f54bbb 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -215,11 +215,13 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
return {
name := ofName fvarId.name,
userName:= ofName userName.simpMacroScopes,
+ isInaccessible? := .some userName.isInaccessibleUserName
}
| .ldecl _ fvarId userName _ _ _ _ => do
return {
name := ofName fvarId.name,
userName := toString userName.simpMacroScopes,
+ isInaccessible? := .some userName.isInaccessibleUserName
}
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index af76bfd..ea08c48 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -19,9 +19,12 @@ def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
nextGoals.toList.filterM (not <$> ·.isAssigned)
def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
- let goalType ← Elab.Tactic.getMainTarget
- let expr ← Elab.Term.elabTermAndSynthesize (stx := stx) (expectedType? := .some goalType)
- let nextGoals ← assign (← Elab.Tactic.getMainGoal) expr
+ let target ← Elab.Tactic.getMainTarget
+ let (expr, nextGoals) ← Elab.Tactic.elabTermWithHoles stx
+ (expectedType? := .some target)
+ (tagSuffix := .anonymous )
+ (allowNaturalHoles := true)
+ (← Elab.Tactic.getMainGoal).assign expr
Elab.Tactic.setGoals nextGoals
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index dd34684..c67102c 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -64,13 +64,14 @@ def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult
let lctx ← MonadLCtx.getLCtx
-- The branch goal inherits the same context, but with a different type
- let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type
+ let mvarBranch ← Meta.mkFreshExprMVarAt lctx (← Meta.getLocalInstances) type (userName := binderName)
assert! ¬ type.hasLooseBVars
- let upstreamType := .letE binderName type mvarBranch (← mvarId.getType) false
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- upstreamType (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
- mvarId.assign mvarUpstream
+ let mvarUpstream ← Meta.withLetDecl binderName type mvarBranch $ λ fvar => do
+ let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
+ (type := ← mvarId.getType) (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
+ mvarId.assign $ .letE binderName type fvar mvarUpstream (nonDep := false)
+ pure mvarUpstream
return {
main := mvarUpstream.mvarId!,
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 3849b44..65e43a3 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -198,15 +198,16 @@ def test_proposition_generation: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "∀ (x : Nat), ?m.29 x"])
+ #[.some "?m.29 x"])
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
- let state3 ← match ← state2.tryAssign (goalId := 0) (expr := "fun x => Eq.refl x") with
+ let assign := "Eq.refl x"
+ let state3 ← match ← state2.tryAssign (goalId := 0) (expr := assign) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- addTest $ LSpec.check ":= Eq.refl" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
+ addTest $ LSpec.check s!":= {assign}" ((← state3.serializeGoals (options := ← read)).map (·.target.pp?) =
#[])
addTest $ LSpec.test "(3 root)" state3.rootExpr?.isSome
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8e0f78d..d138e4c 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -175,7 +175,7 @@ def test_delta_variable: TestM Unit := do
vars := (nameType.map fun x => ({
userName := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
- isInaccessible? := x.snd.map (λ _ => false)
+ isInaccessible? := .some false,
})).toArray
}
@@ -544,83 +544,6 @@ def test_calc: TestM Unit := do
("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
buildGoal free target userName?
-def test_let (specialized: Bool): TestM Unit := do
- let state? ← startProof (.expr "∀ (a: Nat) (p: Prop), p → p ∨ ¬p")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
- let tactic := "intro a p h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[interiorGoal [] "p ∨ ¬p"])
-
-
- let letType := "Nat"
- let expr := s!"let b: {letType} := _; _"
- let result2 ← match specialized with
- | true => state1.tryLet (goalId := 0) (binderName := "b") (type := letType)
- | false => state1.tryAssign (goalId := 0) (expr := expr)
- let state2 ← match result2 with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let serializedState2 ← state2.serializeGoals (options := ← read)
- addTest $ LSpec.check expr (serializedState2.map (·.devolatilize) =
- #[
- interiorGoal [] letType,
- interiorGoal [] "let b := ?m.20;\np ∨ ¬p"
- ])
- -- Check that the goal mvar ids match up
- addTest $ LSpec.check "(mvarId)" ((serializedState2.map (·.name) |>.get! 0) = "_uniq.20")
-
- let tactic := "exact a"
- let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) = #[])
-
- let state3r ← match state3.continue state2 with
- | .error msg => do
- addTest $ assertUnreachable $ msg
- return ()
- | .ok state => pure state
- addTest $ LSpec.check "(continue)" ((← state3r.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[interiorGoal [] "let b := a;\np ∨ ¬p"])
-
- let tactic := "exact h"
- match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
- | .failure #[message] =>
- addTest $ LSpec.check tactic (message = "type mismatch\n h\nhas type\n p : Prop\nbut is expected to have type\n let b := a;\n p ∨ ¬p : Prop")
- | other => do
- addTest $ assertUnreachable $ other.toString
-
- let tactic := "intro b"
- let state4 ← match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let tactic := "exact Or.inl h"
- let state5 ← match ← state4.tryTactic (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.test "(5 root)" state5.rootExpr?.isSome
- where
- interiorGoal (free: List (String × String)) (target: String) (userName?: Option String := .none) :=
- let free := [("a", "Nat"), ("p", "Prop"), ("h", "p")] ++ free
- buildGoal free target userName?
-
def test_nat_zero_add: TestM Unit := do
let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
let state0 ← match state? with
@@ -795,8 +718,6 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Or.comm", test_or_comm),
("conv", test_conv),
("calc", test_calc),
- ("let via assign", test_let false),
- ("let via tryLet", test_let true),
("Nat.zero_add", test_nat_zero_add),
("Nat.zero_add alt", test_nat_zero_add_alt),
]
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 6b7cd44..5b20011 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -162,12 +162,105 @@ def test_proof_have : TestT Elab.TermElabM Unit := do
addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
+def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
+ let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
+ let state0 ← GoalState.create rootExpr
+ let tactic := "intro a p h"
+ let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state1.serializeGoals).map (·.devolatilize) =
+ #[{
+ target := { pp? := .some mainTarget },
+ vars := interiorVars,
+ }])
+
+ let letType := "Nat"
+ let expr := s!"let b: {letType} := _; _"
+ let result2 ← match specialized with
+ | true => state1.tryLet (goalId := 0) (binderName := "b") (type := letType)
+ | false => state1.tryAssign (goalId := 0) (expr := expr)
+ let state2 ← match result2 with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ let serializedState2 ← state2.serializeGoals
+ let letBindName := if specialized then "b" else "_1"
+ addTest $ LSpec.check expr (serializedState2.map (·.devolatilize) =
+ #[{
+ target := { pp? := .some letType },
+ vars := interiorVars,
+ userName? := .some letBindName
+ },
+ {
+ target := { pp? := .some mainTarget },
+ vars := interiorVars ++ #[{
+ userName := "b",
+ type? := .some { pp? := .some letType },
+ value? := .some { pp? := .some s!"?{letBindName}" },
+ }],
+ userName? := if specialized then .none else .some "_2",
+ }
+ ])
+
+ let tactic := "exact 1"
+ let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.check tactic ((← state3.serializeGoals).map (·.devolatilize) = #[])
+
+ let state3r ← match state3.continue state2 with
+ | .error msg => do
+ addTest $ assertUnreachable $ msg
+ return ()
+ | .ok state => pure state
+ addTest $ LSpec.check "(continue)" ((← state3r.serializeGoals).map (·.devolatilize) =
+ #[
+ {
+ target := { pp? := .some mainTarget },
+ vars := interiorVars ++ #[{
+ userName := "b",
+ type? := .some { pp? := .some "Nat" },
+ value? := .some { pp? := .some "1" },
+ }],
+ userName? := if specialized then .none else .some "_2",
+ }
+ ])
+
+ let tactic := "exact h"
+ match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ | .failure #[message] =>
+ addTest $ LSpec.check tactic (message = s!"type mismatch\n h\nhas type\n a : Prop\nbut is expected to have type\n {mainTarget} : Prop")
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+
+ let tactic := "exact Or.inl (Or.inl h)"
+ let state4 ← match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+ addTest $ LSpec.test "(4 root)" state4.rootExpr?.isSome
+ where
+ mainTarget := "(a ∨ p) ∨ a ∨ p"
+ interiorVars: Array Protocol.Variable := #[
+ { userName := "a", type? := .some { pp? := .some "Prop" }, },
+ { userName := "p", type? := .some { pp? := .some "Prop" }, },
+ { userName := "h", type? := .some { pp? := .some "a" }, }
+ ]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("eval", test_eval),
("Proof eval", test_proof_eval),
("Proof have", test_proof_have),
+ ("let via assign", test_let false),
+ ("let via tryLet", test_let true),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
end Pantograph.Test.Tactic.Prograde
From 0c469027c6ccb84f14c2c097dbc96c2e152cdbc6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 00:50:02 -0700
Subject: [PATCH 261/465] fix: Refactor mvar collection in assign tactic
---
Pantograph/Tactic/Assign.lean | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index ea08c48..acf5d16 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -4,7 +4,8 @@ open Lean
namespace Pantograph.Tactic
-def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
+/-- WARNING: This should be used with a function like `elabTermWithHoles` that properly collects the mvar information from `expr`. -/
+def assign (goal: MVarId) (expr: Expr) (nextGoals: List MVarId): MetaM (List MVarId) := do
goal.checkNotAssigned `Pantograph.Tactic.assign
-- This run of the unifier is critical in resolving mvars in passing
@@ -12,19 +13,18 @@ def assign (goal: MVarId) (expr: Expr): MetaM (List MVarId) := do
let goalType ← goal.getType
unless ← Meta.isDefEq goalType exprType do
throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
-
- -- FIXME: Use `withCollectingNewGoalsFrom`. Think about how this interacts with elaboration ...
- let nextGoals ← Meta.getMVarsNoDelayed expr
goal.assign expr
- nextGoals.toList.filterM (not <$> ·.isAssigned)
+ nextGoals.filterM (not <$> ·.isAssigned)
def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
let target ← Elab.Tactic.getMainTarget
+ let goal ← Elab.Tactic.getMainGoal
+ goal.checkNotAssigned `Pantograph.Tactic.evalAssign
let (expr, nextGoals) ← Elab.Tactic.elabTermWithHoles stx
(expectedType? := .some target)
(tagSuffix := .anonymous )
(allowNaturalHoles := true)
- (← Elab.Tactic.getMainGoal).assign expr
+ goal.assign expr
Elab.Tactic.setGoals nextGoals
From 43e11f1ba3176c94c7a0a8f78a36da6d70aa0be2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 00:53:38 -0700
Subject: [PATCH 262/465] refactor: Always display isInaccessible
---
Pantograph/Protocol.lean | 2 +-
Pantograph/Serial.lean | 8 ++++----
Test/Common.lean | 1 -
Test/Integration.lean | 6 +++---
Test/Metavar.lean | 1 -
Test/Proofs.lean | 16 ++++++----------
Test/Tactic/Prograde.lean | 8 ++++----
7 files changed, 18 insertions(+), 24 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index f954f0d..1a52c8a 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -51,7 +51,7 @@ structure Variable where
/-- The name displayed to the user -/
userName: String
/-- Does the name contain a dagger -/
- isInaccessible?: Option Bool := .some false
+ isInaccessible: Bool := false
type?: Option Expression := .none
value?: Option Expression := .none
deriving Lean.ToJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 9f54bbb..c788be2 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -215,13 +215,13 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
return {
name := ofName fvarId.name,
userName:= ofName userName.simpMacroScopes,
- isInaccessible? := .some userName.isInaccessibleUserName
+ isInaccessible := userName.isInaccessibleUserName
}
| .ldecl _ fvarId userName _ _ _ _ => do
return {
name := ofName fvarId.name,
userName := toString userName.simpMacroScopes,
- isInaccessible? := .some userName.isInaccessibleUserName
+ isInaccessible := userName.isInaccessibleUserName
}
let ppVar (localDecl : LocalDecl) : MetaM Protocol.Variable := do
match localDecl with
@@ -231,7 +231,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
return {
name := ofName fvarId.name,
userName:= ofName userName,
- isInaccessible? := .some userName.isInaccessibleUserName
+ isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
}
| .ldecl _ fvarId userName type val _ _ => do
@@ -245,7 +245,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
return {
name := ofName fvarId.name,
userName:= ofName userName,
- isInaccessible? := .some userName.isInaccessibleUserName
+ isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
value? := value?
}
diff --git a/Test/Common.lean b/Test/Common.lean
index 813e1b3..e572b72 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -138,7 +138,6 @@ def buildGoal (nameType: List (String × String)) (target: String) (userName?: O
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
- isInaccessible? := .some false
})).toArray
}
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9f7ad92..931c9f2 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -85,14 +85,14 @@ def test_tactic : IO LSpec.TestSeq :=
let goal1: Protocol.Goal := {
name := "_uniq.11",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
- vars := #[{ name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}],
+ vars := #[{ name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }}],
}
let goal2: Protocol.Goal := {
name := "_uniq.17",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
- { name := "_uniq.10", userName := "x", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.16", userName := "y", isInaccessible? := .some false, type? := .some { pp? := .some "Prop" }}
+ { name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }},
+ { name := "_uniq.16", userName := "y", type? := .some { pp? := .some "Prop" }}
],
}
subroutine_runner [
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 65e43a3..2fcab28 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -60,7 +60,6 @@ def buildGoal (nameType: List (String × String)) (target: String) (userName?: O
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
- isInaccessible? := .some false
})).toArray
}
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index d138e4c..ba97ad7 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -58,7 +58,6 @@ def buildNamedGoal (name: String) (nameType: List (String × String)) (target: S
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
- isInaccessible? := .some false
})).toArray
}
def buildGoal (nameType: List (String × String)) (target: String) (userName?: Option String := .none):
@@ -69,7 +68,6 @@ def buildGoal (nameType: List (String × String)) (target: String) (userName?: O
vars := (nameType.map fun x => ({
userName := x.fst,
type? := .some { pp? := .some x.snd },
- isInaccessible? := .some false
})).toArray
}
def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq := do
@@ -175,7 +173,6 @@ def test_delta_variable: TestM Unit := do
vars := (nameType.map fun x => ({
userName := x.fst,
type? := x.snd.map (λ type => { pp? := type }),
- isInaccessible? := .some false,
})).toArray
}
@@ -256,9 +253,9 @@ def test_or_comm: TestM Unit := do
name := state1g0,
target := { pp? := .some "q ∨ p" },
vars := #[
- { name := fvP, userName := "p", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
- { name := fvQ, userName := "q", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
- { name := fvH, userName := "h", type? := .some { pp? := .some "p ∨ q" }, isInaccessible? := .some false }
+ { name := fvP, userName := "p", type? := .some { pp? := .some "Prop" } },
+ { name := fvQ, userName := "q", type? := .some { pp? := .some "Prop" } },
+ { name := fvH, userName := "h", type? := .some { pp? := .some "p ∨ q" } }
]
}])
addTest $ LSpec.check "(1 parent)" state1.parentExpr?.isSome
@@ -351,9 +348,9 @@ def test_or_comm: TestM Unit := do
userName? := .some caseName,
target := { pp? := .some "q ∨ p" },
vars := #[
- { userName := "p", type? := .some typeProp, isInaccessible? := .some false },
- { userName := "q", type? := .some typeProp, isInaccessible? := .some false },
- { userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible? := .some true }
+ { userName := "p", type? := .some typeProp },
+ { userName := "q", type? := .some typeProp },
+ { userName := "h✝", type? := .some { pp? := .some varName }, isInaccessible := true }
]
}
@@ -703,7 +700,6 @@ def test_nat_zero_add_alt: TestM Unit := do
name := fvN,
userName := "n",
type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
- isInaccessible? := .some false
}],
}
])
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 5b20011..dd194e7 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -82,13 +82,13 @@ def test_proof_eval : TestT Elab.TermElabM Unit := do
#[{
target := { pp? := .some "(p ∨ q) ∨ p ∨ q"},
vars := #[
- { userName := "p", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
- { userName := "q", type? := .some { pp? := .some "Prop" }, isInaccessible? := .some false },
- { userName := "h", type? := .some { pp? := .some "p" }, isInaccessible? := .some false },
+ { userName := "p", type? := .some { pp? := .some "Prop" } },
+ { userName := "q", type? := .some { pp? := .some "Prop" } },
+ { userName := "h", type? := .some { pp? := .some "p" } },
{ userName := "y",
type? := .some { pp? := .some "p ∨ ?m.25" },
value? := .some { pp? := .some "Or.inl h" },
- isInaccessible? := .some false }
+ }
]
}])
From f87eed817fb28ae72bf0fba863747ad5ff5750e7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 01:59:48 -0700
Subject: [PATCH 263/465] build: Move non-package output to legacyPackages
---
flake.nix | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/flake.nix b/flake.nix
index 54a139f..e062e54 100644
--- a/flake.nix
+++ b/flake.nix
@@ -63,9 +63,11 @@
packages = {
inherit (leanPkgs) lean lean-all;
inherit (project) sharedLib executable;
- inherit project leanPkgs;
default = project.executable;
};
+ legacyPackages = {
+ inherit project leanPkgs;
+ };
checks = {
test = pkgs.runCommand "test" {
buildInputs = [ test.executable leanPkgs.lean-all ];
From 5d43068ec3170c02d4405f2d10762cfc69641671 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 02:07:17 -0700
Subject: [PATCH 264/465] fix: Flake check failure
---
flake.lock | 8 ++++----
flake.nix | 2 +-
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/flake.lock b/flake.lock
index c803f65..e9b7a7b 100644
--- a/flake.lock
+++ b/flake.lock
@@ -91,16 +91,16 @@
"lspec": {
"flake": false,
"locked": {
- "lastModified": 1701971219,
- "narHash": "sha256-HYDRzkT2UaLDrqKNWesh9C4LJNt0JpW0u68wYVj4Byw=",
+ "lastModified": 1722857503,
+ "narHash": "sha256-F9uaymiw1wTCLrJm4n1Bpk3J8jW6poedQzvnnQlZ6Kw=",
"owner": "lurk-lab",
"repo": "LSpec",
- "rev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "rev": "8a51034d049c6a229d88dd62f490778a377eec06",
"type": "github"
},
"original": {
"owner": "lurk-lab",
- "ref": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "ref": "8a51034d049c6a229d88dd62f490778a377eec06",
"repo": "LSpec",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index e062e54..088f306 100644
--- a/flake.nix
+++ b/flake.nix
@@ -9,7 +9,7 @@
url = "github:leanprover/lean4?ref=v4.10.0-rc1";
};
lspec = {
- url = "github:lurk-lab/LSpec?ref=3388be5a1d1390594a74ec469fd54a5d84ff6114";
+ url = "github:lurk-lab/LSpec?ref=8a51034d049c6a229d88dd62f490778a377eec06";
flake = false;
};
};
From 3733c10a4e303ead385b05c968bf3e296480d744 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 17 Aug 2024 16:47:21 -0700
Subject: [PATCH 265/465] refactor: Unify call convention
Induction like tactics should return `Array InductionSubgoal`. Branching
tactics should return their branch first.
---
Pantograph/Tactic/MotivatedApply.lean | 6 +++---
Pantograph/Tactic/Prograde.lean | 6 +++---
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 37d0099..99e499d 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -62,7 +62,7 @@ def collectMotiveArguments (forallBody: Expr): SSet Nat :=
| _ => SSet.empty
/-- Applies a symbol of the type `∀ (motive: α → Sort u) (a: α)..., (motive α)` -/
-def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (List Meta.InductionSubgoal) := mvarId.withContext do
+def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.InductionSubgoal) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.motivatedApply
let recursorType ← Meta.inferType recursor
let resultant ← mvarId.getType
@@ -95,11 +95,11 @@ def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (List Meta.Inductio
mvarId.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
newMVars := newMVars ++ [goalConduit]
- return newMVars.toList.map (λ mvar => { mvarId := mvar.mvarId!})
+ return newMVars.map (λ mvar => { mvarId := mvar.mvarId!})
def evalMotivatedApply : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
let recursor ← Elab.Term.elabTerm (stx := stx) .none
let nextGoals ← motivatedApply (← Elab.Tactic.getMainGoal) recursor
- Elab.Tactic.setGoals $ nextGoals.map (·.mvarId)
+ Elab.Tactic.setGoals $ nextGoals.toList.map (·.mvarId)
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index c67102c..58c6050 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -24,8 +24,8 @@ def evalDefine (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
structure BranchResult where
fvarId?: Option FVarId := .none
- main: MVarId
branch: MVarId
+ main: MVarId
def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.have
@@ -47,8 +47,8 @@ def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResul
return {
fvarId? := .some fvarId,
- main := mvarUpstream.mvarId!,
branch := mvarBranch.mvarId!,
+ main := mvarUpstream.mvarId!,
}
def evalHave (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
@@ -74,8 +74,8 @@ def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult
pure mvarUpstream
return {
- main := mvarUpstream.mvarId!,
branch := mvarBranch.mvarId!,
+ main := mvarUpstream.mvarId!,
}
def evalLet (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
From 76765c913c7b45330ce3bc01c899920ce630eff9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 18 Aug 2024 12:22:59 -0700
Subject: [PATCH 266/465] test: Use `lake test`. Retired `Makefile`
---
Makefile | 20 --------------------
README.md | 11 ++++++++---
lakefile.lean | 5 +++--
3 files changed, 11 insertions(+), 25 deletions(-)
delete mode 100644 Makefile
diff --git a/Makefile b/Makefile
deleted file mode 100644
index 86f9e5b..0000000
--- a/Makefile
+++ /dev/null
@@ -1,20 +0,0 @@
-LIB := ./.lake/build/lib/Pantograph.olean
-EXE := ./.lake/build/bin/pantograph
-SOURCE := $(wildcard *.lean Pantograph/*.lean Pantograph/**/*.lean) lean-toolchain
-
-TEST_EXE := ./.lake/build/bin/test
-TEST_SOURCE := $(wildcard Test/*.lean Test/**/*.lean)
-
-$(LIB) $(EXE): $(SOURCE)
- lake build pantograph
-
-$(TEST_EXE): $(LIB) $(TEST_SOURCE)
- lake build test
-
-test: $(TEST_EXE)
- $(TEST_EXE)
-
-clean:
- lake clean
-
-.PHONY: test clean
diff --git a/README.md b/README.md
index c136337..562f7ac 100644
--- a/README.md
+++ b/README.md
@@ -11,9 +11,9 @@ examine the symbol list of a Lean project for machine learning.
For Nix based workflow, see below.
-Install `elan` and `lake`. Execute
+Install `elan` and `lake`, and run
``` sh
-make
+lake build
```
This builds the executable in `.lake/build/bin/pantograph`.
@@ -146,7 +146,12 @@ A Lean development shell is provided in the Nix flake.
The tests are based on `LSpec`. To run tests,
``` sh
-make test
+lake test
+```
+You can run an individual test by specifying a prefix
+
+``` sh
+lake test -- "Tactic/No Confuse"
```
## Nix based workflow
diff --git a/lakefile.lean b/lakefile.lean
index d7bc630..c68d0db 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -10,7 +10,7 @@ lean_lib Pantograph {
@[default_target]
lean_exe pantograph {
root := `Main
- -- Somehow solves the native symbol not found problem
+ -- Solves the native symbol not found problem
supportInterpreter := true
}
@@ -18,8 +18,9 @@ require LSpec from git
"https://github.com/lurk-lab/LSpec.git" @ "3388be5a1d1390594a74ec469fd54a5d84ff6114"
lean_lib Test {
}
+@[test_driver]
lean_exe test {
root := `Test.Main
- -- Somehow solves the native symbol not found problem
+ -- Solves the native symbol not found problem
supportInterpreter := true
}
From edec0f5733207bba278701ce9a13ed127742bc5b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 26 Aug 2024 13:42:14 -0400
Subject: [PATCH 267/465] feat: Use CoreM for diag monad
---
Pantograph/Serial.lean | 48 ++++++++++++++++++++++--------------------
1 file changed, 25 insertions(+), 23 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index c788be2..93dfb95 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -289,29 +289,31 @@ protected def GoalState.serializeGoals
/-- Print the metavariables in a readable format -/
@[export pantograph_goal_state_diag_m]
-protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState := .none) (options: Protocol.GoalDiag := {}): MetaM String := do
- goalState.restoreMetaM
- let savedState := goalState.savedState
- let goals := savedState.tactic.goals
- let mctx ← getMCtx
- let root := goalState.root
- -- Print the root
- let result: String ← match mctx.decls.find? root with
- | .some decl => printMVar ">" root decl
- | .none => pure s!">{root.name}: ??"
- let resultGoals ← goals.filter (· != root) |>.mapM (fun mvarId =>
- match mctx.decls.find? mvarId with
- | .some decl => printMVar "⊢" mvarId decl
- | .none => pure s!"⊢{mvarId.name}: ??"
- )
- let goals := goals.toSSet
- let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
- !(goals.contains mvarId || mvarId == root) && options.printAll)
- |>.mapM (fun (mvarId, decl) => do
- let pref := if parentHasMVar mvarId then " " else "~"
- printMVar pref mvarId decl
- )
- pure $ result ++ "\n" ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
+protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState := .none) (options: Protocol.GoalDiag := {}): CoreM String := do
+ let metaM: MetaM String := do
+ goalState.restoreMetaM
+ let savedState := goalState.savedState
+ let goals := savedState.tactic.goals
+ let mctx ← getMCtx
+ let root := goalState.root
+ -- Print the root
+ let result: String ← match mctx.decls.find? root with
+ | .some decl => printMVar ">" root decl
+ | .none => pure s!">{root.name}: ??"
+ let resultGoals ← goals.filter (· != root) |>.mapM (fun mvarId =>
+ match mctx.decls.find? mvarId with
+ | .some decl => printMVar "⊢" mvarId decl
+ | .none => pure s!"⊢{mvarId.name}: ??"
+ )
+ let goals := goals.toSSet
+ let resultOthers ← mctx.decls.toList.filter (λ (mvarId, _) =>
+ !(goals.contains mvarId || mvarId == root) && options.printAll)
+ |>.mapM (fun (mvarId, decl) => do
+ let pref := if parentHasMVar mvarId then " " else "~"
+ printMVar pref mvarId decl
+ )
+ pure $ result ++ "\n" ++ (resultGoals.map (· ++ "\n") |> String.join) ++ (resultOthers.map (· ++ "\n") |> String.join)
+ metaM.run' {}
where
printMVar (pref: String) (mvarId: MVarId) (decl: MetavarDecl): MetaM String := mvarId.withContext do
let resultFVars: List String ←
From 8d2cd6dfc737a2ddcd6e89523e9a96f6d547ff7a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 3 Sep 2024 14:15:52 -0700
Subject: [PATCH 268/465] fix: Bindings in prograde tactics
---
Pantograph/Tactic/Prograde.lean | 25 +++++++++--------
Test/Common.lean | 11 ++++++--
Test/Tactic/Prograde.lean | 50 +++++++++++++++++++++++++++------
3 files changed, 64 insertions(+), 22 deletions(-)
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index 58c6050..0b4719f 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -5,22 +5,25 @@ open Lean
namespace Pantograph.Tactic
+private def mkUpstreamMVar (goal: MVarId) : MetaM Expr := do
+ Meta.mkFreshExprSyntheticOpaqueMVar (← goal.getType) (tag := ← goal.getTag)
+
+
/-- Introduces a fvar to the current mvar -/
def define (mvarId: MVarId) (binderName: Name) (expr: Expr): MetaM (FVarId × MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.define
let type ← Meta.inferType expr
Meta.withLetDecl binderName type expr λ fvar => do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (← mvarId.getType) (kind := MetavarKind.synthetic) (userName := .anonymous)
- mvarId.assign mvarUpstream
+ let mvarUpstream ← mkUpstreamMVar mvarId
+ mvarId.assign $ ← Meta.mkLetFVars #[fvar] mvarUpstream
pure (fvar.fvarId!, mvarUpstream.mvarId!)
def evalDefine (binderName: Name) (expr: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let expr ← goal.withContext $ Elab.Term.elabTerm (stx := expr) (expectedType? := .none)
let (_, mvarId) ← define goal binderName expr
- Elab.Tactic.setGoals [mvarId]
+ Elab.Tactic.replaceMainGoal [mvarId]
structure BranchResult where
fvarId?: Option FVarId := .none
@@ -39,10 +42,9 @@ def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResul
let mvarUpstream ←
withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
Meta.withNewLocalInstances #[.fvar fvarId] 0 do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (← mvarId.getType) (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
+ let mvarUpstream ← mkUpstreamMVar mvarId
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
- mvarId.assign mvarUpstream
+ mvarId.assign $ ← Meta.mkLambdaFVars #[.fvar fvarId] mvarUpstream
pure mvarUpstream
return {
@@ -57,7 +59,7 @@ def evalHave (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let type ← Elab.Term.elabType (stx := type)
let result ← «have» goal binderName type
pure [result.branch, result.main]
- Elab.Tactic.setGoals nextGoals
+ Elab.Tactic.replaceMainGoal nextGoals
def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.let
@@ -68,9 +70,8 @@ def «let» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResult
assert! ¬ type.hasLooseBVars
let mvarUpstream ← Meta.withLetDecl binderName type mvarBranch $ λ fvar => do
- let mvarUpstream ← Meta.mkFreshExprMVarAt (← getLCtx) (← Meta.getLocalInstances)
- (type := ← mvarId.getType) (kind := MetavarKind.synthetic) (userName := ← mvarId.getTag)
- mvarId.assign $ .letE binderName type fvar mvarUpstream (nonDep := false)
+ let mvarUpstream ← mkUpstreamMVar mvarId
+ mvarId.assign $ ← Meta.mkLetFVars #[fvar] mvarUpstream
pure mvarUpstream
return {
@@ -82,6 +83,6 @@ def evalLet (binderName: Name) (type: Syntax): Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let type ← goal.withContext $ Elab.Term.elabType (stx := type)
let result ← «let» goal binderName type
- Elab.Tactic.setGoals [result.branch, result.main]
+ Elab.Tactic.replaceMainGoal [result.branch, result.main]
end Pantograph.Tactic
diff --git a/Test/Common.lean b/Test/Common.lean
index e572b72..83f2e7b 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -94,15 +94,22 @@ def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
+def strToTermSyntax [Monad m] [MonadEnv m] (s: String): m Syntax := do
+ let .ok stx := Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := s)
+ (fileName := filename) | panic! s!"Failed to parse {s}"
+ return stx
def parseSentence (s: String): Elab.TermElabM Expr := do
- let recursor ← match Parser.runParserCategory
+ let stx ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
(fileName := filename) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
- Elab.Term.elabTerm (stx := recursor) .none
+ Elab.Term.elabTerm (stx := stx) .none
def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index dd194e7..22b342e 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -7,7 +7,7 @@ open Pantograph
namespace Pantograph.Test.Tactic.Prograde
-def test_eval : TestT Elab.TermElabM Unit := do
+def test_define : TestT Elab.TermElabM Unit := do
let expr := "forall (p q : Prop) (h: p), And (Or p q) (Or p q)"
let expr ← parseSentence expr
Meta.forallTelescope expr $ λ _ body => do
@@ -48,9 +48,10 @@ def test_eval : TestT Elab.TermElabM Unit := do
],
target,
})
- addTest $ LSpec.test "assign" ((← getExprMVarAssignment? goal.mvarId!) == .some (.mvar newGoal))
+ let .some e ← getExprMVarAssignment? goal.mvarId! | panic! "Tactic must assign"
+ addTest $ LSpec.test "assign" e.isLet
-def test_proof_eval : TestT Elab.TermElabM Unit := do
+def test_define_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
@@ -103,7 +104,38 @@ def test_proof_eval : TestT Elab.TermElabM Unit := do
addTest $ LSpec.check "(3 root)" state3.rootExpr?.isSome
-def test_proof_have : TestT Elab.TermElabM Unit := do
+def fun_define_root_expr: ∀ (p: Prop), PProd (Nat → p) Unit → p := by
+ intro p x
+ apply x.fst
+ exact 5
+
+def test_define_root_expr : TestT Elab.TermElabM Unit := do
+ --let rootExpr ← parseSentence "Nat"
+ --let state0 ← GoalState.create rootExpr
+ --let .success state1 ← state0.tryTactic (goalId := 0) "exact 5" | addTest $ assertUnreachable "exact 5"
+ --let .some rootExpr := state1.rootExpr? | addTest $ assertUnreachable "Root expr"
+ --addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "5")
+ let rootExpr ← parseSentence "∀ (p: Prop), PProd (Nat → p) Unit → p"
+ let state0 ← GoalState.create rootExpr
+ let tactic := "intro p x"
+ let .success state1 ← state0.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let binderName := `binder
+ let value := "x.fst"
+ let expr ← state1.goals[0]!.withContext $ strToTermSyntax value
+ let tacticM := Tactic.evalDefine binderName expr
+ let .success state2 ← state1.tryTacticM (goalId := 0) tacticM | addTest $ assertUnreachable s!"define {binderName} := {value}"
+ let tactic := s!"apply {binderName}"
+ let .success state3 ← state2.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let tactic := s!"exact 5"
+ let .success state4 ← state3.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let .some rootExpr := state4.rootExpr? | addTest $ assertUnreachable "Root expr"
+ addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "fun p x =>\n let binder := x.fst;\n binder 5")
+
+--set_option pp.all true
+--#check @PSigma (α := Prop) (β := λ (p: Prop) => p)
+--def test_define_root_expr : TestT Elab.TermElabM Unit := do
+
+def test_have_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
@@ -160,7 +192,8 @@ def test_proof_have : TestT Elab.TermElabM Unit := do
addTest $ LSpec.check s!":= {expr}" ((← state4.serializeGoals).map (·.devolatilize) =
#[])
- addTest $ LSpec.check "(4 root)" state4.rootExpr?.isSome
+ let .some rootExpr := state4.rootExpr? | addTest $ assertUnreachable "Root expr"
+ addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "fun p q h y => Or.inl y")
def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
@@ -256,9 +289,10 @@ def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
- ("eval", test_eval),
- ("Proof eval", test_proof_eval),
- ("Proof have", test_proof_have),
+ ("define", test_define),
+ ("define proof", test_define_proof),
+ ("define root expr", test_define_root_expr),
+ ("have proof", test_have_proof),
("let via assign", test_let false),
("let via tryLet", test_let true),
] |>.map (λ (name, t) => (name, runTestTermElabM env t))
From f8df2599f99b1b77816299ebdeecbff9c5758339 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 3 Sep 2024 14:18:47 -0700
Subject: [PATCH 269/465] fix: Use `replaceMainGoal` instead of `setGoals`
---
Pantograph/Goal.lean | 2 +-
Pantograph/Tactic/Assign.lean | 2 +-
Pantograph/Tactic/Congruence.lean | 6 +++---
Pantograph/Tactic/MotivatedApply.lean | 2 +-
Pantograph/Tactic/NoConfuse.lean | 2 +-
5 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 9be5164..d92a807 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -247,7 +247,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
-- See Lean.Elab.Tactic.Conv.convTarget
let convMVar ← Elab.Tactic.withMainContext do
let (rhs, newGoal) ← Elab.Tactic.Conv.mkConvGoalFor (← Elab.Tactic.getMainTarget)
- Elab.Tactic.setGoals [newGoal.mvarId!]
+ Elab.Tactic.replaceMainGoal [newGoal.mvarId!]
pure rhs.mvarId!
return (← MonadBacktrack.saveState, convMVar)
try
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index acf5d16..8a5b998 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -25,7 +25,7 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
(tagSuffix := .anonymous )
(allowNaturalHoles := true)
goal.assign expr
- Elab.Tactic.setGoals nextGoals
+ Elab.Tactic.replaceMainGoal nextGoals
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
index 2ff23d2..dfb329d 100644
--- a/Pantograph/Tactic/Congruence.lean
+++ b/Pantograph/Tactic/Congruence.lean
@@ -31,7 +31,7 @@ def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
def evalCongruenceArg: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruenceArg goal
- Elab.Tactic.setGoals nextGoals
+ Elab.Tactic.replaceMainGoal nextGoals
def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruenceFun
@@ -60,7 +60,7 @@ def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
def evalCongruenceFun: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruenceFun goal
- Elab.Tactic.setGoals nextGoals
+ Elab.Tactic.replaceMainGoal nextGoals
def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruence
@@ -93,6 +93,6 @@ def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
def evalCongruence: Elab.Tactic.TacticM Unit := do
let goal ← Elab.Tactic.getMainGoal
let nextGoals ← congruence goal
- Elab.Tactic.setGoals nextGoals
+ Elab.Tactic.replaceMainGoal nextGoals
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 99e499d..2c52f12 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -100,6 +100,6 @@ def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.Inducti
def evalMotivatedApply : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
let recursor ← Elab.Term.elabTerm (stx := stx) .none
let nextGoals ← motivatedApply (← Elab.Tactic.getMainGoal) recursor
- Elab.Tactic.setGoals $ nextGoals.toList.map (·.mvarId)
+ Elab.Tactic.replaceMainGoal $ nextGoals.toList.map (·.mvarId)
end Pantograph.Tactic
diff --git a/Pantograph/Tactic/NoConfuse.lean b/Pantograph/Tactic/NoConfuse.lean
index f4ce78f..e9ff459 100644
--- a/Pantograph/Tactic/NoConfuse.lean
+++ b/Pantograph/Tactic/NoConfuse.lean
@@ -17,6 +17,6 @@ def evalNoConfuse: Elab.Tactic.Tactic := λ stx => do
let goal ← Elab.Tactic.getMainGoal
let h ← goal.withContext $ Elab.Term.elabTerm (stx := stx) .none
noConfuse goal h
- Elab.Tactic.setGoals []
+ Elab.Tactic.replaceMainGoal []
end Pantograph.Tactic
From 9c40a839563ce5ae2235469ca473208668f5aa20 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 3 Sep 2024 19:05:16 -0700
Subject: [PATCH 270/465] fix: Instantiate type when detecting `eq`
---
Pantograph/Tactic/Congruence.lean | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
index dfb329d..f72fc0a 100644
--- a/Pantograph/Tactic/Congruence.lean
+++ b/Pantograph/Tactic/Congruence.lean
@@ -7,7 +7,7 @@ namespace Pantograph.Tactic
def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruenceArg
let target ← mvarId.getType
- let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
@@ -36,7 +36,7 @@ def evalCongruenceArg: Elab.Tactic.TacticM Unit := do
def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruenceFun
let target ← mvarId.getType
- let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
@@ -65,7 +65,7 @@ def evalCongruenceFun: Elab.Tactic.TacticM Unit := do
def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
mvarId.checkNotAssigned `Pantograph.Tactic.congruence
let target ← mvarId.getType
- let .some (β, _, _) := target.eq? | throwError "Goal is not an Eq"
+ let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
From 02556f3c790f49f1556d8161257413f9e9e9bb21 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Sep 2024 11:56:06 -0700
Subject: [PATCH 271/465] feat: Expose `GoalState` functions
---
Pantograph.lean | 2 +-
Pantograph/Goal.lean | 12 +++++++-----
Pantograph/Library.lean | 7 -------
3 files changed, 8 insertions(+), 13 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 35ab117..5e96a5e 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -164,7 +164,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .some branchId, .none => do
match state.goalStates.find? branchId with
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
- | .some branch => pure $ goalContinue target branch
+ | .some branch => pure $ target.continue branch
| .none, .some goals =>
pure $ goalResume target goals
| _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index d92a807..408ada1 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -39,15 +39,15 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
--Elab.Term.synthesizeSyntheticMVarsNoPostponing
--let expr ← instantiateMVars expr
- let goal ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
+ let root ← Meta.mkFreshExprMVar expr (kind := MetavarKind.synthetic) (userName := .anonymous)
let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
- let root := goal.mvarId!
- let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root]}
+ let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals := [root.mvarId!]}
return {
- root,
+ root := root.mvarId!,
savedState,
parentMVar? := .none,
}
+@[export pantograph_goal_state_is_conv]
protected def GoalState.isConv (state: GoalState): Bool :=
state.convMVar?.isSome
protected def GoalState.goals (state: GoalState): List MVarId :=
@@ -56,6 +56,7 @@ protected def GoalState.goals (state: GoalState): List MVarId :=
protected def GoalState.goalsArray (state: GoalState): Array MVarId := state.goals.toArray
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
+@[export pantograph_goal_state_env]
protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
@@ -85,7 +86,7 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
state.savedState.restore
Elab.Tactic.setGoals [goal]
-
+@[export pantograph_goal_state_focus]
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
let goal ← state.savedState.tactic.goals.get? goalId
return {
@@ -121,6 +122,7 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
/--
Brings into scope all goals from `branch`
-/
+@[export pantograph_goal_state_continue]
protected def GoalState.continue (target: GoalState) (branch: GoalState): Except String GoalState :=
if !target.goals.isEmpty then
.error s!"Target state has unresolved goals"
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index c4ce4ff..2fd1972 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -134,10 +134,6 @@ def goalStartExpr (expr: String) (levels: Array String): CoreM (Protocol.CR Goal
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
-@[export pantograph_goal_continue]
-def goalContinue (target: GoalState) (branch: GoalState): Except String GoalState :=
- target.continue branch
-
@[export pantograph_goal_serialize_m]
def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array Protocol.Goal) :=
runMetaM <| state.serializeGoals (parent := .none) options
@@ -189,8 +185,5 @@ def goalConvExit (state: GoalState): CoreM TacticResult :=
@[export pantograph_goal_calc_m]
def goalCalc (state: GoalState) (goalId: Nat) (pred: String): CoreM TacticResult :=
runTermElabM <| state.tryCalc goalId pred
-@[export pantograph_goal_focus]
-def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
- state.focus goalId
end Pantograph
From 82d99ccf9bf37106fc76d0b131738cd56fce1f9f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Sep 2024 21:07:12 -0700
Subject: [PATCH 272/465] refactor: Use `MVarId` across the board
---
Pantograph.lean | 91 +++++++++++++++++++++------------------
Pantograph/Goal.lean | 75 ++++++++++++++------------------
Pantograph/Library.lean | 31 ++++++-------
Pantograph/Protocol.lean | 3 ++
Test/Common.lean | 4 +-
Test/Metavar.lean | 22 +++++-----
Test/Proofs.lean | 90 +++++++++++++++++++-------------------
Test/Tactic/Prograde.lean | 40 ++++++++---------
8 files changed, 178 insertions(+), 178 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 35ab117..7cedab8 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,5 +1,6 @@
import Lean.Data.HashMap
import Pantograph.Compile
+import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Library
@@ -23,6 +24,11 @@ abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
+def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
+ metaM.run'
+def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
+ termElabM.run' (ctx := Condensed.elabContext) |>.run'
+
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
@@ -87,6 +93,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
noRepeat := args.noRepeat?.getD options.noRepeat,
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
+ automaticMode := args.automaticMode?.getD options.automaticMode,
}
}
return .ok { }
@@ -95,7 +102,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
let state ← get
let env ← Lean.MonadEnv.getEnv
- let expr?: Except _ GoalState ← runTermElabM (match args.expr, args.copyFrom with
+ let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
| .some expr, .none => goalStartExpr expr (args.levels.getD #[])
| .none, .some copyFrom =>
(match env.find? <| copyFrom.toName with
@@ -114,47 +121,47 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
- match state.goalStates.find? args.stateId with
- | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
- | .some goalState => do
- let nextGoalState?: Except _ GoalState ←
- match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
- | .some tactic, .none, .none, .none, .none => do
- pure ( Except.ok (← goalTactic goalState args.goalId tactic))
- | .none, .some expr, .none, .none, .none => do
- pure ( Except.ok (← goalAssign goalState args.goalId expr))
- | .none, .none, .some type, .none, .none => do
- let binderName := args.binderName?.getD ""
- pure ( Except.ok (← goalState.tryHave args.goalId binderName type))
- | .none, .none, .none, .some pred, .none => do
- pure ( Except.ok (← goalCalc goalState args.goalId pred))
- | .none, .none, .none, .none, .some true => do
- pure ( Except.ok (← goalConv goalState args.goalId))
- | .none, .none, .none, .none, .some false => do
- pure ( Except.ok (← goalConvExit goalState))
- | _, _, _, _, _ => pure (Except.error <|
- errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied")
- match nextGoalState? with
- | .error error => return .error error
- | .ok (.success nextGoalState) =>
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert state.nextId nextGoalState,
- nextId := state.nextId + 1,
- }
- let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
- return .ok {
- nextStateId? := .some nextStateId,
- goals? := .some goals,
- }
- | .ok (.parseError message) =>
- return .ok { parseError? := .some message }
- | .ok (.indexError goalId) =>
- return .error $ errorIndex s!"Invalid goal id index {goalId}"
- | .ok (.invalidAction message) =>
- return .error $ errorI "invalid" message
- | .ok (.failure messages) =>
- return .ok { tacticErrors? := .some messages }
+ let .some goalState := state.goalStates.find? args.stateId |
+ return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ let .some goal := goalState.goals.get? args.goalId |
+ return .error $ errorIndex s!"Invalid goal index {args.goalId}"
+ let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
+ match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
+ | .some tactic, .none, .none, .none, .none => do
+ pure <| Except.ok <| ← goalState.tryTactic goal tactic
+ | .none, .some expr, .none, .none, .none => do
+ pure <| Except.ok <| ← goalState.tryAssign goal expr
+ | .none, .none, .some type, .none, .none => do
+ let binderName := args.binderName?.getD ""
+ pure <| Except.ok <| ← goalState.tryHave goal binderName type
+ | .none, .none, .none, .some pred, .none => do
+ pure <| Except.ok <| ← goalState.tryCalc goal pred
+ | .none, .none, .none, .none, .some true => do
+ pure <| Except.ok <| ← goalState.conv goal
+ | .none, .none, .none, .none, .some false => do
+ pure <| Except.ok <| ← goalState.convExit
+ | _, _, _, _, _ =>
+ let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
+ pure $ Except.error $ error
+ match nextGoalState? with
+ | .error error => return .error error
+ | .ok (.success nextGoalState) =>
+ let nextStateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert state.nextId nextGoalState,
+ nextId := state.nextId + 1,
+ }
+ let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
+ return .ok {
+ nextStateId? := .some nextStateId,
+ goals? := .some goals,
+ }
+ | .ok (.parseError message) =>
+ return .ok { parseError? := .some message }
+ | .ok (.invalidAction message) =>
+ return .error $ errorI "invalid" message
+ | .ok (.failure messages) =>
+ return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
let state ← get
match state.goalStates.find? args.target with
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index d92a807..0df3a4b 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -30,7 +30,7 @@ structure GoalState where
convMVar?: Option (MVarId × MVarId) := .none
-- Previous RHS for calc, so we don't have to repeat it every time
-- WARNING: If using `state with` outside of `calc`, this must be set to `.none`
- calcPrevRhs?: Option Expr := .none
+ calcPrevRhs?: Option (MVarId × Expr) := .none
@[export pantograph_goal_state_create_m]
protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
@@ -147,24 +147,24 @@ protected def GoalState.parentExpr? (goalState: GoalState): Option Expr := do
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
@[export pantograph_goal_state_get_mvar_e_assignment]
-protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvar: MVarId): Option Expr := do
- let expr ← goalState.mctx.eAssignment.find? mvar
+protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarId): Option Expr := do
+ let expr ← goalState.mctx.eAssignment.find? mvarId
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
return expr
--- Tactic execution functions ---
-protected def GoalState.step (state: GoalState) (mvarId: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
+protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
: Elab.TermElabM GoalState := do
- unless (← getMCtx).decls.contains mvarId do
- throwError s!"MVarId is not in context: {mvarId.name}"
- mvarId.checkNotAssigned `GoalState.step
- let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [mvarId] }
+ unless (← getMCtx).decls.contains goal do
+ throwError s!"Goal is not in context: {goal.name}"
+ goal.checkNotAssigned `GoalState.step
+ let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState
return {
state with
savedState := { term := nextElabState, tactic := newGoals },
- parentMVar? := .some mvarId,
+ parentMVar? := .some goal,
calcPrevRhs? := .none,
}
@@ -176,25 +176,20 @@ inductive TacticResult where
| failure (messages: Array String)
-- Could not parse tactic
| parseError (message: String)
- -- The goal index is out of bounds
- | indexError (goalId: Nat)
-- The given action cannot be executed in the state
| invalidAction (message: String)
/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
-protected def GoalState.tryTacticM (state: GoalState) (goalId: Nat) (tacticM: Elab.Tactic.TacticM Unit):
+protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit):
Elab.TermElabM TacticResult := do
- let mvarId ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure $ goal
- | .none => return .indexError goalId
try
- let nextState ← state.step mvarId tacticM
+ let nextState ← state.step goal tacticM
return .success nextState
catch exception =>
return .failure #[← exception.toMessageData.toString]
-/-- Execute a string tactic on given state -/
-protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: String):
+/-- Execute a string tactic on given state. Restores TermElabM -/
+protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let tactic ← match Parser.runParserCategory
@@ -204,9 +199,9 @@ protected def GoalState.tryTactic (state: GoalState) (goalId: Nat) (tactic: Stri
(fileName := filename) with
| .ok stx => pure $ stx
| .error error => return .parseError error
- state.tryTacticM goalId $ Elab.Tactic.evalTactic tactic
+ state.tryTacticM goal $ Elab.Tactic.evalTactic tactic
-protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String):
+protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let expr ← match Parser.runParserCategory
@@ -216,11 +211,11 @@ protected def GoalState.tryAssign (state: GoalState) (goalId: Nat) (expr: String
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId $ Tactic.evalAssign expr
+ state.tryTacticM goal $ Tactic.evalAssign expr
-- Specialized Tactics
-protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String):
+protected def GoalState.tryLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let type ← match Parser.runParserCategory
@@ -230,16 +225,13 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str
(fileName := filename) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId $ Tactic.evalLet binderName.toName type
+ state.tryTacticM goal $ Tactic.evalLet binderName.toName type
/-- Enter conv tactic mode -/
-protected def GoalState.conv (state: GoalState) (goalId: Nat):
+protected def GoalState.conv (state: GoalState) (goal: MVarId):
Elab.TermElabM TacticResult := do
if state.convMVar?.isSome then
return .invalidAction "Already in conv state"
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
goal.checkNotAssigned `GoalState.conv
let tacticM : Elab.Tactic.TacticM (Elab.Tactic.SavedState × MVarId) := do
state.restoreTacticM goal
@@ -298,19 +290,17 @@ protected def GoalState.convExit (state: GoalState):
catch exception =>
return .failure #[← exception.toMessageData.toString]
-protected def GoalState.calcPrevRhsOf? (state: GoalState) (goalId: Nat) :=
- if goalId == 1 then
- state.calcPrevRhs?
+protected def GoalState.calcPrevRhsOf? (state: GoalState) (goal: MVarId): Option Expr := do
+ let (mvarId, rhs ) ← state.calcPrevRhs?
+ if mvarId == goal then
+ .some rhs
else
.none
-protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
+protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
if state.convMVar?.isSome then
return .invalidAction "Cannot initiate `calc` while in `conv` state"
- let goal ← match state.savedState.tactic.goals.get? goalId with
- | .some goal => pure goal
- | .none => return .indexError goalId
let `(term|$pred) ← match Parser.runParserCategory
(env := state.env)
(catName := `term)
@@ -319,9 +309,10 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
| .ok syn => pure syn
| .error error => return .parseError error
goal.checkNotAssigned `GoalState.tryCalc
- let calcPrevRhs? := state.calcPrevRhsOf? goalId
- let target ← instantiateMVars (← goal.getDecl).type
- let tag := (← goal.getDecl).userName
+ let calcPrevRhs? := state.calcPrevRhsOf? goal
+ let decl ← goal.getDecl
+ let target ← instantiateMVars decl.type
+ let tag := decl.userName
try
goal.withContext do
@@ -345,7 +336,7 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
(userName := tag ++ `calc)
let mvarBranch := proof.mvarId!
- let calcPrevRhs? := Option.some rhs
+ let calcPrevRhs? := Option.some (goal, rhs)
let mut proofType ← Meta.inferType proof
let mut remainder := Option.none
@@ -377,19 +368,19 @@ protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
return .failure #[← exception.toMessageData.toString]
-protected def GoalState.tryMotivatedApply (state: GoalState) (goalId: Nat) (recursor: String):
+protected def GoalState.tryMotivatedApply (state: GoalState) (goal: MVarId) (recursor: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let recursor ← match (← Compile.parseTermM recursor) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId (tacticM := Tactic.evalMotivatedApply recursor)
-protected def GoalState.tryNoConfuse (state: GoalState) (goalId: Nat) (eq: String):
+ state.tryTacticM goal (tacticM := Tactic.evalMotivatedApply recursor)
+protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
let eq ← match (← Compile.parseTermM eq) with
| .ok syn => pure syn
| .error error => return .parseError error
- state.tryTacticM goalId (tacticM := Tactic.evalNoConfuse eq)
+ state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index c4ce4ff..2b2f223 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -156,41 +156,38 @@ def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.G
}
@[export pantograph_goal_tactic_m]
-def goalTactic (state: GoalState) (goalId: Nat) (tactic: String): CoreM TacticResult :=
- runTermElabM <| state.tryTactic goalId tactic
+def goalTactic (state: GoalState) (goal: MVarId) (tactic: String): CoreM TacticResult :=
+ runTermElabM <| state.tryTactic goal tactic
@[export pantograph_goal_assign_m]
-def goalAssign (state: GoalState) (goalId: Nat) (expr: String): CoreM TacticResult :=
- runTermElabM <| state.tryAssign goalId expr
+def goalAssign (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult :=
+ runTermElabM <| state.tryAssign goal expr
@[export pantograph_goal_have_m]
-protected def GoalState.tryHave (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult := do
+protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult := do
let type ← match (← Compile.parseTermM type) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.tryTacticM goalId $ Tactic.evalHave binderName.toName type
+ state.tryTacticM goal $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_try_define_m]
-protected def GoalState.tryDefine (state: GoalState) (goalId: Nat) (binderName: String) (expr: String): CoreM TacticResult := do
+protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): CoreM TacticResult := do
let expr ← match (← Compile.parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
- state.tryTacticM goalId (Tactic.evalDefine binderName.toName expr)
+ state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
@[export pantograph_goal_let_m]
-def goalLet (state: GoalState) (goalId: Nat) (binderName: String) (type: String): CoreM TacticResult :=
- runTermElabM <| state.tryLet goalId binderName type
+def goalLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult :=
+ runTermElabM <| state.tryLet goal binderName type
@[export pantograph_goal_conv_m]
-def goalConv (state: GoalState) (goalId: Nat): CoreM TacticResult :=
- runTermElabM <| state.conv goalId
+def goalConv (state: GoalState) (goal: MVarId): CoreM TacticResult :=
+ runTermElabM <| state.conv goal
@[export pantograph_goal_conv_exit_m]
def goalConvExit (state: GoalState): CoreM TacticResult :=
runTermElabM <| state.convExit
@[export pantograph_goal_calc_m]
-def goalCalc (state: GoalState) (goalId: Nat) (pred: String): CoreM TacticResult :=
- runTermElabM <| state.tryCalc goalId pred
-@[export pantograph_goal_focus]
-def goalFocus (state: GoalState) (goalId: Nat): Option GoalState :=
- state.focus goalId
+def goalCalc (state: GoalState) (goal: MVarId) (pred: String): CoreM TacticResult :=
+ runTermElabM <| state.tryCalc goal pred
end Pantograph
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 1a52c8a..223fcfe 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -27,6 +27,8 @@ structure Options where
printAuxDecls: Bool := false
-- See `pp.implementationDetailHyps`
printImplementationDetailHyps: Bool := false
+ -- If this is set to `true`, goals will never go dormant, so you don't have to manage resumption
+ automaticMode: Bool := false
deriving Lean.ToJson
abbrev OptionsT := ReaderT Options
@@ -190,6 +192,7 @@ structure OptionsSet where
noRepeat?: Option Bool
printAuxDecls?: Option Bool
printImplementationDetailHyps?: Option Bool
+ automaticMode?: Option Bool
deriving Lean.FromJson
structure OptionsSetResult where
deriving Lean.ToJson
diff --git a/Test/Common.lean b/Test/Common.lean
index 83f2e7b..2d98aca 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -62,13 +62,15 @@ protected def Goal.devolatilize (goal: Goal): Goal :=
end Condensed
+def GoalState.get! (state: GoalState) (i: Nat): MVarId := state.goals.get! i
+def GoalState.tacticOn (state: GoalState) (goalId: Nat) (tactic: String) := state.tryTactic (state.goals.get! goalId) tactic
+
def TacticResult.toString : TacticResult → String
| .success state => s!".success ({state.goals.length} goals)"
| .failure messages =>
let messages := "\n".intercalate messages.toList
s!".failure {messages}"
| .parseError error => s!".parseError {error}"
- | .indexError index => s!".indexError {index}"
| .invalidAction error => s!".invalidAction {error}"
namespace Test
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 2fcab28..dbaf2cc 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -83,7 +83,7 @@ def test_m_couple: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -92,7 +92,7 @@ def test_m_couple: TestM Unit := do
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
-- Set m to 3
- let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "exact 3") with
+ let state2 ← match ← state1.tacticOn (goalId := 2) (tactic := "exact 3") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -115,7 +115,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -126,7 +126,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ LSpec.check "(metavariables)" (serializedState1.map (·.target.dependentMVars?.get!) =
#[#["_uniq.38"], #["_uniq.38"], #[]])
- let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "exact 2") with
+ let state2 ← match ← state1.tacticOn (goalId := 2) (tactic := "exact 2") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -140,7 +140,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ LSpec.check "exact 2" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ 2", .some "2 ≤ 5"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
- let state3 ← match ← state1b.tryTactic (goalId := 0) (tactic := "simp") with
+ let state3 ← match ← state1b.tacticOn (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -150,7 +150,7 @@ def test_m_couple_simp: TestM Unit := do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
- let state5 ← match ← state4.tryTactic (goalId := 0) (tactic := "simp") with
+ let state5 ← match ← state4.tacticOn (goalId := 0) (tactic := "simp") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -177,7 +177,7 @@ def test_proposition_generation: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply PSigma.mk") with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := "apply PSigma.mk") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -191,7 +191,7 @@ def test_proposition_generation: TestM Unit := do
addTest $ LSpec.test "(1 reference)" (goal1.target.sexp? = .some s!"(:mv {goal2.name})")
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := "λ (x: Nat) => _") with
+ let state2 ← match ← state1.tryAssign (state1.get! 0) (expr := "λ (x: Nat) => _") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -201,7 +201,7 @@ def test_proposition_generation: TestM Unit := do
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
let assign := "Eq.refl x"
- let state3 ← match ← state2.tryAssign (goalId := 0) (expr := assign) with
+ let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := assign) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -220,7 +220,7 @@ def test_partial_continuation: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "apply Nat.le_trans") with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := "apply Nat.le_trans") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -228,7 +228,7 @@ def test_partial_continuation: TestM Unit := do
addTest $ LSpec.check "apply Nat.le_trans" ((← state1.serializeGoals (options := ← read)).map (·.target.pp?) =
#[.some "2 ≤ ?m", .some "?m ≤ 5", .some "Nat"])
- let state2 ← match ← state1.tryTactic (goalId := 2) (tactic := "apply Nat.succ") with
+ let state2 ← match ← state1.tacticOn (goalId := 2) (tactic := "apply Nat.succ") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ba97ad7..1da21ae 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -91,7 +91,7 @@ def test_identity: TestM Unit := do
return ()
let tactic := "intro p h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn 0 tactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -118,7 +118,7 @@ def test_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro n m") with
+ let state1 ← match ← state0.tacticOn 0 "intro n m" with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -126,13 +126,13 @@ def test_nat_add_comm (manual: Bool): TestM Unit := do
addTest $ LSpec.check "intro n m" ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("m", "Nat")] "n + m = m + n"])
- match ← state1.tryTactic (goalId := 0) (tactic := "assumption") with
+ match ← state1.tacticOn 0 "assumption" with
| .failure #[message] =>
addTest $ LSpec.check "assumption" (message = "tactic 'assumption' failed\nn m : Nat\n⊢ n + m = m + n")
| other => do
addTest $ assertUnreachable $ other.toString
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "rw [Nat.add_comm]") with
+ let state2 ← match ← state1.tacticOn 0 "rw [Nat.add_comm]" with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -150,14 +150,14 @@ def test_delta_variable: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := "intro n") with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := "intro n") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "intro n" ((← state1.serializeGoals (parent := state0) options).map (·.devolatilize) =
#[buildGoalSelective [("n", .some "Nat")] "∀ (b : Nat), n + b = b + n"])
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "intro m") with
+ let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := "intro m") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -189,14 +189,14 @@ def test_arith: TestM Unit := do
return ()
let tactic := "intros"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check tactic (state1.goals.length = 1)
addTest $ LSpec.test "(1 root)" state1.rootExpr?.isNone
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
+ let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := "simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.mul_comm, Nat.mul_assoc, Nat.mul_left_comm] at *") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -204,7 +204,7 @@ def test_arith: TestM Unit := do
addTest $ LSpec.check "simp ..." (state2.goals.length = 1)
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let tactic := "assumption"
- let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3 ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -239,7 +239,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(0 root)" state0.rootExpr?.isNone
let tactic := "intro p q h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -265,7 +265,7 @@ def test_or_comm: TestM Unit := do
serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))")
let tactic := "cases h"
- let state2 ← match ← state1.tryTactic (goalId := 0) (tactic := tactic) with
+ let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -289,7 +289,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.test "(2 parent)" (state2parent ==
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
- let state3_1 ← match ← state2.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
+ let state3_1 ← match ← state2.tacticOn (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -298,7 +298,7 @@ def test_or_comm: TestM Unit := do
serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
- let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
+ let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -307,13 +307,13 @@ def test_or_comm: TestM Unit := do
let state4_1parent ← instantiateAll state4_1.parentExpr?.get!
addTest $ LSpec.test "(4_1 parent)" state4_1parent.isFVar
addTest $ LSpec.check "(4_1 root)" state4_1.rootExpr?.isNone
- let state3_2 ← match ← state2.tryTactic (goalId := 1) (tactic := "apply Or.inl") with
+ let state3_2 ← match ← state2.tacticOn (goalId := 1) (tactic := "apply Or.inl") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inl" (state3_2.goals.length = 1)
- let state4_2 ← match ← state3_2.tryTactic (goalId := 0) (tactic := "assumption") with
+ let state4_2 ← match ← state3_2.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -327,13 +327,13 @@ def test_or_comm: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals.get! 0])
- let state3_1 ← match ← state2b.tryTactic (goalId := 0) (tactic := "apply Or.inr") with
+ let state3_1 ← match ← state2b.tacticOn (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
- let state4_1 ← match ← state3_1.tryTactic (goalId := 0) (tactic := "assumption") with
+ let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -372,7 +372,7 @@ def test_conv: TestM Unit := do
return ()
let tactic := "intro a b c1 c2 h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -380,7 +380,7 @@ def test_conv: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[interiorGoal [] "a + b + c1 = b + a + c2"])
- let state2 ← match ← state1.conv (goalId := 0) with
+ let state2 ← match ← state1.conv (state1.get! 0) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -389,7 +389,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "a + b + c1 = b + a + c2" with isConversion := true }])
let convTactic := "rhs"
- let state3R ← match ← state2.tryTactic (goalId := 0) convTactic with
+ let state3R ← match ← state2.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -398,7 +398,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "b + a + c2" with isConversion := true }])
let convTactic := "lhs"
- let state3L ← match ← state2.tryTactic (goalId := 0) convTactic with
+ let state3L ← match ← state2.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -407,7 +407,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "a + b + c1" with isConversion := true }])
let convTactic := "congr"
- let state4 ← match ← state3L.tryTactic (goalId := 0) convTactic with
+ let state4 ← match ← state3L.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -419,7 +419,7 @@ def test_conv: TestM Unit := do
])
let convTactic := "rw [Nat.add_comm]"
- let state5_1 ← match ← state4.tryTactic (goalId := 0) convTactic with
+ let state5_1 ← match ← state4.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -428,7 +428,7 @@ def test_conv: TestM Unit := do
#[{ interiorGoal [] "b + a" with isConversion := true, userName? := .some "a" }])
let convTactic := "rfl"
- let state6_1 ← match ← state5_1.tryTactic (goalId := 0) convTactic with
+ let state6_1 ← match ← state5_1.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -443,7 +443,7 @@ def test_conv: TestM Unit := do
return ()
let convTactic := "rfl"
- let state6 ← match ← state4_1.tryTactic (goalId := 0) convTactic with
+ let state6 ← match ← state4_1.tacticOn (goalId := 0) convTactic with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -458,7 +458,7 @@ def test_conv: TestM Unit := do
return ()
let tactic := "exact h"
- let stateF ← match ← state1_1.tryTactic (goalId := 0) (tactic := tactic) with
+ let stateF ← match ← state1_1.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -485,7 +485,7 @@ def test_calc: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro a b c d h1 h2"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -493,7 +493,7 @@ def test_calc: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[interiorGoal [] "a + b = c + d"])
let pred := "a + b = b + c"
- let state2 ← match ← state1.tryCalc (goalId := 0) (pred := pred) with
+ let state2 ← match ← state1.tryCalc (state1.get! 0) (pred := pred) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -503,11 +503,11 @@ def test_calc: TestM Unit := do
interiorGoal [] "a + b = b + c" (.some "calc"),
interiorGoal [] "b + c = c + d"
])
- addTest $ LSpec.test "(2.0 prev rhs)" (state2.calcPrevRhsOf? 0 |>.isNone)
- addTest $ LSpec.test "(2.1 prev rhs)" (state2.calcPrevRhsOf? 1 |>.isSome)
+ addTest $ LSpec.test "(2.0 prev rhs)" (state2.calcPrevRhsOf? (state2.get! 0) |>.isNone)
+ addTest $ LSpec.test "(2.1 prev rhs)" (state2.calcPrevRhsOf? (state2.get! 1) |>.isSome)
let tactic := "apply h1"
- let state2m ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ let state2m ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -518,7 +518,7 @@ def test_calc: TestM Unit := do
addTest $ expectationFailure "continue" e
return ()
let pred := "_ = c + d"
- let state4 ← match ← state3.tryCalc (goalId := 0) (pred := pred) with
+ let state4 ← match ← state3.tryCalc (state3.get! 0) (pred := pred) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -527,9 +527,9 @@ def test_calc: TestM Unit := do
#[
interiorGoal [] "b + c = c + d" (.some "calc")
])
- addTest $ LSpec.test "(4.0 prev rhs)" (state4.calcPrevRhsOf? 0 |>.isNone)
+ addTest $ LSpec.test "(4.0 prev rhs)" (state4.calcPrevRhsOf? (state4.get! 0) |>.isNone)
let tactic := "apply h2"
- let state4m ← match ← state4.tryTactic (goalId := 0) (tactic := tactic) with
+ let state4m ← match ← state4.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -549,7 +549,7 @@ def test_nat_zero_add: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro n"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -557,7 +557,7 @@ def test_nat_zero_add: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat")] "n + 0 = n"])
let recursor := "@Nat.brecOn"
- let state2 ← match ← state1.tryMotivatedApply (goalId := 0) (recursor := recursor) with
+ let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -571,7 +571,7 @@ def test_nat_zero_add: TestM Unit := do
])
let tactic := "exact n"
- let state3b ← match ← state2.tryTactic (goalId := 1) (tactic := tactic) with
+ let state3b ← match ← state2.tacticOn (goalId := 1) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -584,7 +584,7 @@ def test_nat_zero_add: TestM Unit := do
addTest $ assertUnreachable e
return ()
let tactic := "exact (λ x => x + 0 = x)"
- let state3c ← match ← state2b.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3c ← match ← state2b.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -597,7 +597,7 @@ def test_nat_zero_add: TestM Unit := do
addTest $ assertUnreachable e
return ()
let tactic := "intro t h"
- let state3 ← match ← state2c.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3 ← match ← state2c.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -606,7 +606,7 @@ def test_nat_zero_add: TestM Unit := do
#[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
let tactic := "simp"
- let state3d ← match ← state3.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3d ← match ← state3.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -617,7 +617,7 @@ def test_nat_zero_add: TestM Unit := do
addTest $ assertUnreachable e
return ()
let tactic := "rfl"
- let stateF ← match ← state2d.tryTactic (goalId := 0) (tactic := tactic) with
+ let stateF ← match ← state2d.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -637,7 +637,7 @@ def test_nat_zero_add_alt: TestM Unit := do
addTest $ assertUnreachable "Goal could not parse"
return ()
let tactic := "intro n"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -645,7 +645,7 @@ def test_nat_zero_add_alt: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat")] "n + 0 = n"])
let recursor := "@Nat.brecOn"
- let state2 ← match ← state1.tryMotivatedApply (goalId := 0) (recursor := recursor) with
+ let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -660,7 +660,7 @@ def test_nat_zero_add_alt: TestM Unit := do
])
let tactic := "intro x"
- let state3m ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3m ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -668,7 +668,7 @@ def test_nat_zero_add_alt: TestM Unit := do
addTest $ LSpec.check tactic ((← state3m.serializeGoals (options := ← read)).map (·.devolatilize) =
#[buildGoal [("n", "Nat"), ("x", "Nat")] "Prop" (.some "motive")])
let tactic := "apply Eq"
- let state3m2 ← match ← state3m.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3m2 ← match ← state3m.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 22b342e..132718a 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -55,7 +55,7 @@ def test_define_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -64,7 +64,7 @@ def test_define_proof : TestT Elab.TermElabM Unit := do
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
let expr := "Or.inl (Or.inl h)"
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ let state2 ← match ← state1.tryAssign (state1.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -74,7 +74,7 @@ def test_define_proof : TestT Elab.TermElabM Unit := do
let evalBind := "y"
let evalExpr := "Or.inl h"
- let state2 ← match ← state1.tryDefine (goalId := 0) (binderName := evalBind) (expr := evalExpr) with
+ let state2 ← match ← state1.tryDefine (state1.get! 0) (binderName := evalBind) (expr := evalExpr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -94,7 +94,7 @@ def test_define_proof : TestT Elab.TermElabM Unit := do
}])
let expr := "Or.inl y"
- let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
+ let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -112,22 +112,22 @@ def fun_define_root_expr: ∀ (p: Prop), PProd (Nat → p) Unit → p := by
def test_define_root_expr : TestT Elab.TermElabM Unit := do
--let rootExpr ← parseSentence "Nat"
--let state0 ← GoalState.create rootExpr
- --let .success state1 ← state0.tryTactic (goalId := 0) "exact 5" | addTest $ assertUnreachable "exact 5"
+ --let .success state1 ← state0.tacticOn (goalId := 0) "exact 5" | addTest $ assertUnreachable "exact 5"
--let .some rootExpr := state1.rootExpr? | addTest $ assertUnreachable "Root expr"
--addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "5")
let rootExpr ← parseSentence "∀ (p: Prop), PProd (Nat → p) Unit → p"
let state0 ← GoalState.create rootExpr
let tactic := "intro p x"
- let .success state1 ← state0.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let .success state1 ← state0.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let binderName := `binder
let value := "x.fst"
let expr ← state1.goals[0]!.withContext $ strToTermSyntax value
let tacticM := Tactic.evalDefine binderName expr
- let .success state2 ← state1.tryTacticM (goalId := 0) tacticM | addTest $ assertUnreachable s!"define {binderName} := {value}"
+ let .success state2 ← state1.tryTacticM (state1.get! 0) tacticM | addTest $ assertUnreachable s!"define {binderName} := {value}"
let tactic := s!"apply {binderName}"
- let .success state3 ← state2.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let .success state3 ← state2.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let tactic := s!"exact 5"
- let .success state4 ← state3.tryTactic (goalId := 0) tactic | addTest $ assertUnreachable tactic
+ let .success state4 ← state3.tacticOn (goalId := 0) tactic | addTest $ assertUnreachable tactic
let .some rootExpr := state4.rootExpr? | addTest $ assertUnreachable "Root expr"
addTest $ LSpec.check "root" ((toString $ ← Meta.ppExpr rootExpr) = "fun p x =>\n let binder := x.fst;\n binder 5")
@@ -139,7 +139,7 @@ def test_have_proof : TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro p q h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -148,7 +148,7 @@ def test_have_proof : TestT Elab.TermElabM Unit := do
#[buildGoal [("p", "Prop"), ("q", "Prop"), ("h", "p")] "(p ∨ q) ∨ p ∨ q"])
let expr := "Or.inl (Or.inl h)"
- let state2 ← match ← state1.tryAssign (goalId := 0) (expr := expr) with
+ let state2 ← match ← state1.tryAssign (state1.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -158,7 +158,7 @@ def test_have_proof : TestT Elab.TermElabM Unit := do
let haveBind := "y"
let haveType := "p ∨ q"
- let state2 ← match ← state1.tryHave (goalId := 0) (binderName := haveBind) (type := haveType) with
+ let state2 ← match ← state1.tryHave (state1.get! 0) (binderName := haveBind) (type := haveType) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -170,7 +170,7 @@ def test_have_proof : TestT Elab.TermElabM Unit := do
])
let expr := "Or.inl h"
- let state3 ← match ← state2.tryAssign (goalId := 0) (expr := expr) with
+ let state3 ← match ← state2.tryAssign (state2.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -184,7 +184,7 @@ def test_have_proof : TestT Elab.TermElabM Unit := do
addTest $ assertUnreachable e
return ()
let expr := "Or.inl y"
- let state4 ← match ← state2b.tryAssign (goalId := 0) (expr := expr) with
+ let state4 ← match ← state2b.tryAssign (state2b.get! 0) (expr := expr) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -199,7 +199,7 @@ def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
let rootExpr ← parseSentence "∀ (p q: Prop), p → ((p ∨ q) ∨ (p ∨ q))"
let state0 ← GoalState.create rootExpr
let tactic := "intro a p h"
- let state1 ← match ← state0.tryTactic (goalId := 0) (tactic := tactic) with
+ let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -213,8 +213,8 @@ def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
let letType := "Nat"
let expr := s!"let b: {letType} := _; _"
let result2 ← match specialized with
- | true => state1.tryLet (goalId := 0) (binderName := "b") (type := letType)
- | false => state1.tryAssign (goalId := 0) (expr := expr)
+ | true => state1.tryLet (state1.get! 0) (binderName := "b") (type := letType)
+ | false => state1.tryAssign (state1.get! 0) (expr := expr)
let state2 ← match result2 with
| .success state => pure state
| other => do
@@ -240,7 +240,7 @@ def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
])
let tactic := "exact 1"
- let state3 ← match ← state2.tryTactic (goalId := 0) (tactic := tactic) with
+ let state3 ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
@@ -266,14 +266,14 @@ def test_let (specialized: Bool): TestT Elab.TermElabM Unit := do
])
let tactic := "exact h"
- match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ match ← state3r.tacticOn (goalId := 0) (tactic := tactic) with
| .failure #[message] =>
addTest $ LSpec.check tactic (message = s!"type mismatch\n h\nhas type\n a : Prop\nbut is expected to have type\n {mainTarget} : Prop")
| other => do
addTest $ assertUnreachable $ other.toString
let tactic := "exact Or.inl (Or.inl h)"
- let state4 ← match ← state3r.tryTactic (goalId := 0) (tactic := tactic) with
+ let state4 ← match ← state3r.tacticOn (goalId := 0) (tactic := tactic) with
| .success state => pure state
| other => do
addTest $ assertUnreachable $ other.toString
From 37473b3efbec7be8e103b93ff343ad46dd0f4a35 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Sep 2024 21:30:11 -0700
Subject: [PATCH 273/465] feat: Automatic mode (auto resume)
---
Pantograph.lean | 13 ++++++++++++-
Pantograph/Goal.lean | 24 ++++++++++++++++++++----
2 files changed, 32 insertions(+), 5 deletions(-)
diff --git a/Pantograph.lean b/Pantograph.lean
index 7cedab8..004c63f 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -20,6 +20,7 @@ structure State where
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
+
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
@@ -145,7 +146,17 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure $ Except.error $ error
match nextGoalState? with
| .error error => return .error error
- | .ok (.success nextGoalState) =>
+ | .ok (.success nextGoalState) => do
+ let nextGoalState ← match state.options.automaticMode, args.conv? with
+ | true, .none => do
+ let .ok result := nextGoalState.resume goalState.goals | throwError "Resuming known goals"
+ pure result
+ | true, .some true => pure nextGoalState
+ | true, .some false => do
+ let .some (_, _, dormantGoals) := goalState.convMVar? | throwError "If conv exit succeeded this should not fail"
+ let .ok result := nextGoalState.resume dormantGoals | throwError "Resuming known goals"
+ pure result
+ | false, _ => pure nextGoalState
let nextStateId := state.nextId
set { state with
goalStates := state.goalStates.insert state.nextId nextGoalState,
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0df3a4b..7486103 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -27,7 +27,8 @@ structure GoalState where
parentMVar?: Option MVarId
-- Existence of this field shows that we are currently in `conv` mode.
- convMVar?: Option (MVarId × MVarId) := .none
+ -- (convRhs, goal, dormant)
+ convMVar?: Option (MVarId × MVarId × List MVarId) := .none
-- Previous RHS for calc, so we don't have to repeat it every time
-- WARNING: If using `state with` outside of `calc`, this must be set to `.none`
calcPrevRhs?: Option (MVarId × Expr) := .none
@@ -97,6 +98,20 @@ protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState
calcPrevRhs? := .none,
}
+/-- Immediately bring all parent goals back into scope. Used in automatic mode -/
+@[export pantograph_goal_state_immediate_resume_parent]
+protected def GoalState.immediateResume (state: GoalState) (parent: GoalState): GoalState :=
+ -- Prune parents solved goals
+ let mctx := state.mctx
+ let parentGoals := parent.goals.filter $ λ goal => mctx.eAssignment.contains goal
+ {
+ state with
+ savedState := {
+ state.savedState with
+ tactic := { goals := state.goals ++ parentGoals },
+ },
+ }
+
/--
Brings into scope a list of goals
-/
@@ -116,7 +131,6 @@ protected def GoalState.resume (state: GoalState) (goals: List MVarId): Except S
term := state.savedState.term,
tactic := { goals := unassigned },
},
- calcPrevRhs? := .none,
}
/--
Brings into scope all goals from `branch`
@@ -244,11 +258,13 @@ protected def GoalState.conv (state: GoalState) (goal: MVarId):
return (← MonadBacktrack.saveState, convMVar)
try
let (nextSavedState, convRhs) ← tacticM { elaborator := .anonymous } |>.run' state.savedState.tactic
+ -- Other goals are now dormant
+ let otherGoals := state.goals.filter $ λ g => g != goal
return .success {
root := state.root,
savedState := nextSavedState
parentMVar? := .some goal,
- convMVar? := .some (convRhs, goal),
+ convMVar? := .some (convRhs, goal, otherGoals),
calcPrevRhs? := .none
}
catch exception =>
@@ -257,7 +273,7 @@ protected def GoalState.conv (state: GoalState) (goal: MVarId):
/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
- let (convRhs, convGoal) ← match state.convMVar? with
+ let (convRhs, convGoal, _) ← match state.convMVar? with
| .some mvar => pure mvar
| .none => return .invalidAction "Not in conv state"
let tacticM : Elab.Tactic.TacticM Elab.Tactic.SavedState:= do
From e2ad6ce6b3d2f57670313a0a975a3389d46a439f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Sep 2024 21:32:02 -0700
Subject: [PATCH 274/465] doc: Documentation for automatic mode
---
README.md | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/README.md b/README.md
index 562f7ac..8bda1ef 100644
--- a/README.md
+++ b/README.md
@@ -90,6 +90,10 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
only the values of definitions are printed.
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
+
+ One particular option for interest for machine learning researchers is the automatic mode.
+ `options.set { "automaticMode": true }`. This makes Pantograph act like
+ LeanDojo, with no resumption necessary to manage your goals.
* `options.print`: Display the current set of options
* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
From a7b30af36b7cf45182e6d4413018f7febcfd0396 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Sep 2024 22:01:36 -0700
Subject: [PATCH 275/465] refactor: Refactor REPL out of main library
fix: Calc previous rhs not found bug
---
Main.lean | 1 +
Pantograph.lean | 223 +-----------------------------------------
Pantograph/Goal.lean | 10 +-
Repl.lean | 223 ++++++++++++++++++++++++++++++++++++++++++
Test/Integration.lean | 2 +
flake.nix | 30 ++++--
lakefile.lean | 5 +-
7 files changed, 257 insertions(+), 237 deletions(-)
create mode 100644 Repl.lean
diff --git a/Main.lean b/Main.lean
index de73033..eb5240d 100644
--- a/Main.lean
+++ b/Main.lean
@@ -4,6 +4,7 @@ import Lean.Environment
import Pantograph.Version
import Pantograph.Library
import Pantograph
+import Repl
-- Main IO functions
open Pantograph
diff --git a/Pantograph.lean b/Pantograph.lean
index 004c63f..09327e8 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,4 +1,3 @@
-import Lean.Data.HashMap
import Pantograph.Compile
import Pantograph.Condensed
import Pantograph.Environment
@@ -6,224 +5,4 @@ import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
import Pantograph.Serial
-
-namespace Pantograph
-
-structure Context where
- imports: List String
-
-/-- Stores state of the REPL -/
-structure State where
- options: Protocol.Options := {}
- nextId: Nat := 0
- goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
-
-/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
-
--- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
--- certain monadic features in `MainM`
-abbrev CR α := Except Protocol.InteractionError α
-
-def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
- metaM.run'
-def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
- termElabM.run' (ctx := Condensed.elabContext) |>.run'
-
-def execute (command: Protocol.Command): MainM Lean.Json := do
- let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
- match Lean.fromJson? command.payload with
- | .ok args => do
- match (← comm args) with
- | .ok result => return Lean.toJson result
- | .error ierror => return Lean.toJson ierror
- | .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
- match command.cmd with
- | "reset" => run reset
- | "stat" => run stat
- | "expr.echo" => run expr_echo
- | "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
- | "goal.tactic" => run goal_tactic
- | "goal.continue" => run goal_continue
- | "goal.delete" => run goal_delete
- | "goal.print" => run goal_print
- | "compile.unit" => run compile_unit
- | cmd =>
- let error: Protocol.InteractionError :=
- errorCommand s!"Unknown command {cmd}"
- return Lean.toJson error
- where
- errorCommand := errorI "command"
- errorIndex := errorI "index"
- -- Command Functions
- reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
- let state ← get
- let nGoals := state.goalStates.size
- set { state with nextId := 0, goalStates := Lean.HashMap.empty }
- return .ok { nGoals }
- stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
- let state ← get
- let nGoals := state.goalStates.size
- return .ok { nGoals }
- env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
- let result ← Environment.catalog args
- return .ok result
- env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
- let state ← get
- 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
- exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
- options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
- let state ← get
- let options := state.options
- set { state with
- options := {
- -- FIXME: This should be replaced with something more elegant
- printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
- printExprPretty := args.printExprPretty?.getD options.printExprPretty,
- printExprAST := args.printExprAST?.getD options.printExprAST,
- printDependentMVars := args.printDependentMVars?.getD options.printDependentMVars,
- noRepeat := args.noRepeat?.getD options.noRepeat,
- printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
- printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
- automaticMode := args.automaticMode?.getD options.automaticMode,
- }
- }
- return .ok { }
- options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
- return .ok (← get).options
- goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
- let state ← get
- let env ← Lean.MonadEnv.getEnv
- let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
- | .some expr, .none => goalStartExpr expr (args.levels.getD #[])
- | .none, .some copyFrom =>
- (match env.find? <| copyFrom.toName with
- | .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
- | .some cInfo => return .ok (← GoalState.create cInfo.type))
- | _, _ =>
- return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
- match expr? with
- | .error error => return .error error
- | .ok goalState =>
- let stateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert stateId goalState,
- nextId := state.nextId + 1
- }
- return .ok { stateId, root := goalState.root.name.toString }
- goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
- let state ← get
- let .some goalState := state.goalStates.find? args.stateId |
- return .error $ errorIndex s!"Invalid state index {args.stateId}"
- let .some goal := goalState.goals.get? args.goalId |
- return .error $ errorIndex s!"Invalid goal index {args.goalId}"
- let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
- match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
- | .some tactic, .none, .none, .none, .none => do
- pure <| Except.ok <| ← goalState.tryTactic goal tactic
- | .none, .some expr, .none, .none, .none => do
- pure <| Except.ok <| ← goalState.tryAssign goal expr
- | .none, .none, .some type, .none, .none => do
- let binderName := args.binderName?.getD ""
- pure <| Except.ok <| ← goalState.tryHave goal binderName type
- | .none, .none, .none, .some pred, .none => do
- pure <| Except.ok <| ← goalState.tryCalc goal pred
- | .none, .none, .none, .none, .some true => do
- pure <| Except.ok <| ← goalState.conv goal
- | .none, .none, .none, .none, .some false => do
- pure <| Except.ok <| ← goalState.convExit
- | _, _, _, _, _ =>
- let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
- pure $ Except.error $ error
- match nextGoalState? with
- | .error error => return .error error
- | .ok (.success nextGoalState) => do
- let nextGoalState ← match state.options.automaticMode, args.conv? with
- | true, .none => do
- let .ok result := nextGoalState.resume goalState.goals | throwError "Resuming known goals"
- pure result
- | true, .some true => pure nextGoalState
- | true, .some false => do
- let .some (_, _, dormantGoals) := goalState.convMVar? | throwError "If conv exit succeeded this should not fail"
- let .ok result := nextGoalState.resume dormantGoals | throwError "Resuming known goals"
- pure result
- | false, _ => pure nextGoalState
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert state.nextId nextGoalState,
- nextId := state.nextId + 1,
- }
- let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
- return .ok {
- nextStateId? := .some nextStateId,
- goals? := .some goals,
- }
- | .ok (.parseError message) =>
- return .ok { parseError? := .some message }
- | .ok (.invalidAction message) =>
- return .error $ errorI "invalid" message
- | .ok (.failure messages) =>
- return .ok { tacticErrors? := .some messages }
- goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
- let state ← get
- match state.goalStates.find? args.target with
- | .none => return .error $ errorIndex s!"Invalid state index {args.target}"
- | .some target => do
- let nextState? ← match args.branch?, args.goals? with
- | .some branchId, .none => do
- match state.goalStates.find? branchId with
- | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
- | .some branch => pure $ goalContinue target branch
- | .none, .some goals =>
- pure $ goalResume target goals
- | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
- match nextState? with
- | .error error => return .error <| errorI "structure" error
- | .ok nextGoalState =>
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert nextStateId nextGoalState,
- nextId := state.nextId + 1
- }
- let goals ← goalSerialize nextGoalState (options := state.options)
- return .ok {
- nextStateId,
- goals,
- }
- goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
- let state ← get
- let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
- set { state with goalStates }
- return .ok {}
- goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
- let state ← get
- match state.goalStates.find? args.stateId with
- | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
- | .some goalState => runMetaM <| do
- return .ok (← goalPrint goalState state.options)
- compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
- let module := args.module.toName
- try
- let steps ← Compile.processSource module
- let units? := if args.compilationUnits then
- .some $ steps.map λ step => (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
- else
- .none
- let invocations? ← if args.invocations then
- pure $ .some (← Compile.collectTacticsFromCompilation steps)
- else
- pure .none
- return .ok { units?, invocations? }
- catch e =>
- return .error $ errorI "compile" (← e.toMessageData.toString)
-
-end Pantograph
+import Pantograph.Version
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 7486103..225b8ac 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -307,7 +307,7 @@ protected def GoalState.convExit (state: GoalState):
return .failure #[← exception.toMessageData.toString]
protected def GoalState.calcPrevRhsOf? (state: GoalState) (goal: MVarId): Option Expr := do
- let (mvarId, rhs ) ← state.calcPrevRhs?
+ let (mvarId, rhs) ← state.calcPrevRhs?
if mvarId == goal then
.some rhs
else
@@ -352,9 +352,8 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
(userName := tag ++ `calc)
let mvarBranch := proof.mvarId!
- let calcPrevRhs? := Option.some (goal, rhs)
let mut proofType ← Meta.inferType proof
- let mut remainder := Option.none
+ let mut remainder? := Option.none
-- The calc tactic either solves the main goal or leaves another relation.
-- Replace the main goal, and save the new goal if necessary
@@ -367,10 +366,11 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
let lastStepGoal ← Meta.mkFreshExprSyntheticOpaqueMVar lastStep tag
(proof, proofType) ← Elab.Term.mkCalcTrans proof proofType lastStepGoal lastStep
unless ← Meta.isDefEq proofType target do throwFailed
- remainder := .some lastStepGoal.mvarId!
+ remainder? := .some lastStepGoal.mvarId!
goal.assign proof
- let goals := [ mvarBranch ] ++ remainder.toList
+ let goals := [ mvarBranch ] ++ remainder?.toList
+ let calcPrevRhs? := remainder?.map $ λ g => (g, rhs)
return .success {
root := state.root,
savedState := {
diff --git a/Repl.lean b/Repl.lean
new file mode 100644
index 0000000..da594e3
--- /dev/null
+++ b/Repl.lean
@@ -0,0 +1,223 @@
+import Lean.Data.HashMap
+import Pantograph
+
+namespace Pantograph
+
+structure Context where
+ imports: List String
+
+/-- Stores state of the REPL -/
+structure State where
+ options: Protocol.Options := {}
+ nextId: Nat := 0
+ goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
+
+/-- Main state monad for executing commands -/
+abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
+
+-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
+-- certain monadic features in `MainM`
+abbrev CR α := Except Protocol.InteractionError α
+
+def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
+ metaM.run'
+def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
+ termElabM.run' (ctx := Condensed.elabContext) |>.run'
+
+def execute (command: Protocol.Command): MainM Lean.Json := do
+ let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
+ match Lean.fromJson? command.payload with
+ | .ok args => do
+ match (← comm args) with
+ | .ok result => return Lean.toJson result
+ | .error ierror => return Lean.toJson ierror
+ | .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
+ match command.cmd with
+ | "reset" => run reset
+ | "stat" => run stat
+ | "expr.echo" => run expr_echo
+ | "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
+ | "goal.tactic" => run goal_tactic
+ | "goal.continue" => run goal_continue
+ | "goal.delete" => run goal_delete
+ | "goal.print" => run goal_print
+ | "compile.unit" => run compile_unit
+ | cmd =>
+ let error: Protocol.InteractionError :=
+ errorCommand s!"Unknown command {cmd}"
+ return Lean.toJson error
+ where
+ errorCommand := errorI "command"
+ errorIndex := errorI "index"
+ -- Command Functions
+ reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
+ let state ← get
+ let nGoals := state.goalStates.size
+ set { state with nextId := 0, goalStates := Lean.HashMap.empty }
+ return .ok { nGoals }
+ stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
+ let state ← get
+ let nGoals := state.goalStates.size
+ return .ok { nGoals }
+ env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
+ let result ← Environment.catalog args
+ return .ok result
+ env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
+ let state ← get
+ 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
+ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
+ options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
+ let state ← get
+ let options := state.options
+ set { state with
+ options := {
+ -- FIXME: This should be replaced with something more elegant
+ printJsonPretty := args.printJsonPretty?.getD options.printJsonPretty,
+ printExprPretty := args.printExprPretty?.getD options.printExprPretty,
+ printExprAST := args.printExprAST?.getD options.printExprAST,
+ printDependentMVars := args.printDependentMVars?.getD options.printDependentMVars,
+ noRepeat := args.noRepeat?.getD options.noRepeat,
+ printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
+ printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
+ automaticMode := args.automaticMode?.getD options.automaticMode,
+ }
+ }
+ return .ok { }
+ options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
+ return .ok (← get).options
+ goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
+ let state ← get
+ let env ← Lean.MonadEnv.getEnv
+ let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
+ | .some expr, .none => goalStartExpr expr (args.levels.getD #[])
+ | .none, .some copyFrom =>
+ (match env.find? <| copyFrom.toName with
+ | .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
+ | .some cInfo => return .ok (← GoalState.create cInfo.type))
+ | _, _ =>
+ return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
+ match expr? with
+ | .error error => return .error error
+ | .ok goalState =>
+ let stateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert stateId goalState,
+ nextId := state.nextId + 1
+ }
+ return .ok { stateId, root := goalState.root.name.toString }
+ goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
+ let state ← get
+ let .some goalState := state.goalStates.find? args.stateId |
+ return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ let .some goal := goalState.goals.get? args.goalId |
+ return .error $ errorIndex s!"Invalid goal index {args.goalId}"
+ let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
+ match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
+ | .some tactic, .none, .none, .none, .none => do
+ pure <| Except.ok <| ← goalState.tryTactic goal tactic
+ | .none, .some expr, .none, .none, .none => do
+ pure <| Except.ok <| ← goalState.tryAssign goal expr
+ | .none, .none, .some type, .none, .none => do
+ let binderName := args.binderName?.getD ""
+ pure <| Except.ok <| ← goalState.tryHave goal binderName type
+ | .none, .none, .none, .some pred, .none => do
+ pure <| Except.ok <| ← goalState.tryCalc goal pred
+ | .none, .none, .none, .none, .some true => do
+ pure <| Except.ok <| ← goalState.conv goal
+ | .none, .none, .none, .none, .some false => do
+ pure <| Except.ok <| ← goalState.convExit
+ | _, _, _, _, _ =>
+ let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
+ pure $ Except.error $ error
+ match nextGoalState? with
+ | .error error => return .error error
+ | .ok (.success nextGoalState) => do
+ let nextGoalState ← match state.options.automaticMode, args.conv? with
+ | true, .none => do
+ let .ok result := nextGoalState.resume goalState.goals | throwError "Resuming known goals"
+ pure result
+ | true, .some true => pure nextGoalState
+ | true, .some false => do
+ let .some (_, _, dormantGoals) := goalState.convMVar? | throwError "If conv exit succeeded this should not fail"
+ let .ok result := nextGoalState.resume dormantGoals | throwError "Resuming known goals"
+ pure result
+ | false, _ => pure nextGoalState
+ let nextStateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert state.nextId nextGoalState,
+ nextId := state.nextId + 1,
+ }
+ let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
+ return .ok {
+ nextStateId? := .some nextStateId,
+ goals? := .some goals,
+ }
+ | .ok (.parseError message) =>
+ return .ok { parseError? := .some message }
+ | .ok (.invalidAction message) =>
+ return .error $ errorI "invalid" message
+ | .ok (.failure messages) =>
+ return .ok { tacticErrors? := .some messages }
+ goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
+ let state ← get
+ match state.goalStates.find? args.target with
+ | .none => return .error $ errorIndex s!"Invalid state index {args.target}"
+ | .some target => do
+ let nextState? ← match args.branch?, args.goals? with
+ | .some branchId, .none => do
+ match state.goalStates.find? branchId with
+ | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
+ | .some branch => pure $ goalContinue target branch
+ | .none, .some goals =>
+ pure $ goalResume target goals
+ | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
+ match nextState? with
+ | .error error => return .error <| errorI "structure" error
+ | .ok nextGoalState =>
+ let nextStateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert nextStateId nextGoalState,
+ nextId := state.nextId + 1
+ }
+ let goals ← goalSerialize nextGoalState (options := state.options)
+ return .ok {
+ nextStateId,
+ goals,
+ }
+ goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
+ let state ← get
+ let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
+ set { state with goalStates }
+ return .ok {}
+ goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
+ let state ← get
+ match state.goalStates.find? args.stateId with
+ | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ | .some goalState => runMetaM <| do
+ return .ok (← goalPrint goalState state.options)
+ compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
+ let module := args.module.toName
+ try
+ let steps ← Compile.processSource module
+ let units? := if args.compilationUnits then
+ .some $ steps.map λ step => (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ else
+ .none
+ let invocations? ← if args.invocations then
+ pure $ .some (← Compile.collectTacticsFromCompilation steps)
+ else
+ pure .none
+ return .ok { units?, invocations? }
+ catch e =>
+ return .error $ errorI "compile" (← e.toMessageData.toString)
+
+end Pantograph
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 931c9f2..3ccff81 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -2,6 +2,8 @@
-/
import LSpec
import Pantograph
+import Repl
+
namespace Pantograph.Test.Integration
open Pantograph
diff --git a/flake.nix b/flake.nix
index 088f306..70c84b5 100644
--- a/flake.nix
+++ b/flake.nix
@@ -37,14 +37,25 @@
};
project = leanPkgs.buildLeanPackage {
name = "Pantograph";
- roots = [ "Main" "Pantograph" ];
- src = pkgs.lib.cleanSourceWith {
+ roots = [ "Pantograph" ];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.;
filter = path: type:
!(pkgs.lib.hasInfix "/Test/" path) &&
!(pkgs.lib.hasSuffix ".md" path) &&
- !(pkgs.lib.hasSuffix "Makefile" path);
- };
+ !(pkgs.lib.hasSuffix "Repl.lean" path);
+ });
+ };
+ repl = leanPkgs.buildLeanPackage {
+ name = "Repl";
+ roots = [ "Main" "Repl" ];
+ deps = [ project ];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "/Test/" path) &&
+ !(pkgs.lib.hasSuffix ".md" path);
+ });
};
test = leanPkgs.buildLeanPackage {
name = "Test";
@@ -52,18 +63,19 @@
# root begins (e.g. `import Test.Environment` and not `import
# Environment`) and thats where `lakefile.lean` resides.
roots = [ "Test.Main" ];
- deps = [ lspecLib project ];
- src = pkgs.lib.cleanSourceWith {
+ deps = [ lspecLib repl ];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
src = ./.;
filter = path: type:
!(pkgs.lib.hasInfix "Pantograph" path);
- };
+ });
};
in rec {
packages = {
inherit (leanPkgs) lean lean-all;
- inherit (project) sharedLib executable;
- default = project.executable;
+ inherit (project) sharedLib;
+ inherit (repl) executable;
+ default = repl.executable;
};
legacyPackages = {
inherit project leanPkgs;
diff --git a/lakefile.lean b/lakefile.lean
index c68d0db..e29fa0e 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -4,11 +4,14 @@ open Lake DSL
package pantograph
lean_lib Pantograph {
+ roots := #[`Pantograph]
defaultFacets := #[LeanLib.sharedFacet]
}
+lean_lib Repl {
+}
@[default_target]
-lean_exe pantograph {
+lean_exe repl {
root := `Main
-- Solves the native symbol not found problem
supportInterpreter := true
From 9b3eef35ec40a09bba7140ecfc04dafddbd92c27 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Sep 2024 22:22:19 -0700
Subject: [PATCH 276/465] fix: Forgot to include the current goals in resume
---
Repl.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index da594e3..08533b0 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -143,12 +143,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .ok (.success nextGoalState) => do
let nextGoalState ← match state.options.automaticMode, args.conv? with
| true, .none => do
- let .ok result := nextGoalState.resume goalState.goals | throwError "Resuming known goals"
+ let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) | throwError "Resuming known goals"
pure result
| true, .some true => pure nextGoalState
| true, .some false => do
let .some (_, _, dormantGoals) := goalState.convMVar? | throwError "If conv exit succeeded this should not fail"
- let .ok result := nextGoalState.resume dormantGoals | throwError "Resuming known goals"
+ let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) | throwError "Resuming known goals"
pure result
| false, _ => pure nextGoalState
let nextStateId := state.nextId
From 8394e1b4682be29ca8ff167bb3aa25314f3508e2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 7 Sep 2024 13:47:55 -0700
Subject: [PATCH 277/465] feat: Expose `conv` and `calc` tactics
---
Pantograph/Goal.lean | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 408ada1..1c2bf8d 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -235,6 +235,7 @@ protected def GoalState.tryLet (state: GoalState) (goalId: Nat) (binderName: Str
state.tryTacticM goalId $ Tactic.evalLet binderName.toName type
/-- Enter conv tactic mode -/
+@[export pantograph_goal_state_conv_m]
protected def GoalState.conv (state: GoalState) (goalId: Nat):
Elab.TermElabM TacticResult := do
if state.convMVar?.isSome then
@@ -265,6 +266,7 @@ protected def GoalState.conv (state: GoalState) (goalId: Nat):
return .failure #[← exception.toMessageData.toString]
/-- Exit from `conv` mode. Resumes all goals before the mode starts and applys the conv -/
+@[export pantograph_goal_state_conv_exit_m]
protected def GoalState.convExit (state: GoalState):
Elab.TermElabM TacticResult := do
let (convRhs, convGoal) ← match state.convMVar? with
@@ -305,6 +307,8 @@ protected def GoalState.calcPrevRhsOf? (state: GoalState) (goalId: Nat) :=
state.calcPrevRhs?
else
.none
+
+@[export pantograph_goal_state_try_calc_m]
protected def GoalState.tryCalc (state: GoalState) (goalId: Nat) (pred: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
From 4042ec707ee8a0eaec685c9b71812d62bc120d59 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 7 Sep 2024 13:54:52 -0700
Subject: [PATCH 278/465] refactor: Use `Meta.mapMetaM`
---
Pantograph/Goal.lean | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 1c2bf8d..0109204 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -71,10 +71,10 @@ protected def GoalState.metaState (state: GoalState): Meta.State :=
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
-protected def GoalState.withParentContext (state: GoalState) (m: MetaM α): MetaM α := do
- state.withContext state.parentMVar?.get! m
-protected def GoalState.withRootContext (state: GoalState) (m: MetaM α): MetaM α := do
- state.withContext state.root m
+protected def GoalState.withParentContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
+ Meta.mapMetaM <| state.withContext state.parentMVar?.get!
+protected def GoalState.withRootContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
+ Meta.mapMetaM <| state.withContext state.root
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
From 68dac4c951c1b6eddfa2044daffed26f9cea7fae Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 7 Sep 2024 13:55:41 -0700
Subject: [PATCH 279/465] chore: Version bump to 0.2.18
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index f3bcf93..ed33cbb 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.17"
+def version := "0.2.18"
end Pantograph
From e4d53733d008bbda48c7d3513ac901fb4c3f3f12 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 7 Sep 2024 14:03:29 -0700
Subject: [PATCH 280/465] feat: Simplify repl
---
Repl.lean | 53 +++++++++++++++++++++++++----------------------------
1 file changed, 25 insertions(+), 28 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index 08533b0..a916f3f 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -169,30 +169,28 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
let state ← get
- match state.goalStates.find? args.target with
- | .none => return .error $ errorIndex s!"Invalid state index {args.target}"
- | .some target => do
- let nextState? ← match args.branch?, args.goals? with
- | .some branchId, .none => do
- match state.goalStates.find? branchId with
- | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
- | .some branch => pure $ goalContinue target branch
- | .none, .some goals =>
- pure $ goalResume target goals
- | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
- match nextState? with
- | .error error => return .error <| errorI "structure" error
- | .ok nextGoalState =>
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert nextStateId nextGoalState,
- nextId := state.nextId + 1
- }
- let goals ← goalSerialize nextGoalState (options := state.options)
- return .ok {
- nextStateId,
- goals,
- }
+ let .some target := state.goalStates.find? args.target | return .error $ errorIndex s!"Invalid state index {args.target}"
+ let nextState? ← match args.branch?, args.goals? with
+ | .some branchId, .none => do
+ match state.goalStates.find? branchId with
+ | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
+ | .some branch => pure $ goalContinue target branch
+ | .none, .some goals =>
+ pure $ goalResume target goals
+ | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
+ match nextState? with
+ | .error error => return .error <| errorI "structure" error
+ | .ok nextGoalState =>
+ let nextStateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert nextStateId nextGoalState,
+ nextId := state.nextId + 1
+ }
+ let goals ← goalSerialize nextGoalState (options := state.options)
+ return .ok {
+ nextStateId,
+ goals,
+ }
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
let state ← get
let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
@@ -200,10 +198,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
- match state.goalStates.find? args.stateId with
- | .none => return .error $ errorIndex s!"Invalid state index {args.stateId}"
- | .some goalState => runMetaM <| do
- return .ok (← goalPrint goalState state.options)
+ let .some goalState := state.goalStates.find? args.stateId | return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ let result ← runMetaInMainM <| goalPrint goalState state.options
+ return .ok result
compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
let module := args.module.toName
try
From f11c5ebaa331804284549091abf9377820e8bb0a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 7 Sep 2024 14:11:04 -0700
Subject: [PATCH 281/465] doc: Add GPL License
---
LICENSE | 674 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 674 insertions(+)
create mode 100644 LICENSE
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..f288702
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ <program> Copyright (C) <year> <name of author>
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<https://www.gnu.org/licenses/>.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
From 7c49fcff2760e8df7dbdb1c9189a3a8c4ac872c3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Sep 2024 11:53:10 -0700
Subject: [PATCH 282/465] refactor: Un-export two field accessor functions
User should use `lean_ctor_get`
---
Pantograph/Goal.lean | 2 --
1 file changed, 2 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 0109204..beba847 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -56,7 +56,6 @@ protected def GoalState.goals (state: GoalState): List MVarId :=
protected def GoalState.goalsArray (state: GoalState): Array MVarId := state.goals.toArray
protected def GoalState.mctx (state: GoalState): MetavarContext :=
state.savedState.term.meta.meta.mctx
-@[export pantograph_goal_state_env]
protected def GoalState.env (state: GoalState): Environment :=
state.savedState.term.meta.core.env
@@ -64,7 +63,6 @@ protected def GoalState.env (state: GoalState): Environment :=
protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): Option Meta.Context := do
let mvarDecl ← state.mctx.findDecl? mvarId
return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances }
-@[export pantograph_goal_state_meta_state]
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
From 25bb96460455a29630a6ac86af389a0eefd07101 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Sep 2024 11:57:39 -0700
Subject: [PATCH 283/465] test: Automatic mode testing
refactor: Simplified integration test structure
---
Test/Integration.lean | 224 ++++++++++++++++++++++--------------------
Test/Main.lean | 2 +-
2 files changed, 121 insertions(+), 105 deletions(-)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 3ccff81..b82962b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -3,40 +3,23 @@
import LSpec
import Pantograph
import Repl
+import Test.Common
namespace Pantograph.Test.Integration
open Pantograph
-def subroutine_named_step (name cmd: String) (payload: List (String × Lean.Json))
- (expected: Lean.Json): MainM LSpec.TestSeq := do
- let result ← execute { cmd := cmd, payload := Lean.Json.mkObj payload }
- return LSpec.test name (toString result = toString expected)
-def subroutine_step (cmd: String) (payload: List (String × Lean.Json))
- (expected: Lean.Json): MainM LSpec.TestSeq := subroutine_named_step cmd cmd payload expected
+def step { α } [Lean.ToJson α] (cmd: String) (payload: List (String × Lean.Json))
+ (expected: α) (name? : Option String := .none): MainM LSpec.TestSeq := do
+ let payload := Lean.Json.mkObj payload
+ let name := name?.getD s!"{cmd} {payload.compress}"
+ let result ← execute { cmd, payload }
+ return LSpec.test name (toString result = toString (Lean.toJson expected))
-def subroutine_runner (steps: List (MainM LSpec.TestSeq)): IO LSpec.TestSeq := do
- -- Setup the environment for execution
- let env ← Lean.importModules
- (imports := #[{module := Lean.Name.str .anonymous "Init", runtimeOnly := false }])
- (opts := {})
- (trustLevel := 1)
- let context: Context := {
- imports := ["Init"]
- }
- let coreContext: Lean.Core.Context ← createCoreContext #[]
- let commands: MainM LSpec.TestSeq :=
- steps.foldlM (λ suite step => do
- let result ← step
- return suite ++ result) LSpec.TestSeq.done
- try
- let coreM := commands.run context |>.run' {}
- return Prod.fst $ (← coreM.toIO coreContext { env := env })
- catch ex =>
- return LSpec.check s!"Uncaught IO exception: {ex.toString}" false
+abbrev Test := List (MainM LSpec.TestSeq)
-def test_elab : IO LSpec.TestSeq :=
- subroutine_runner [
- subroutine_step "expr.echo"
+def test_elab : Test :=
+ [
+ step "expr.echo"
[("expr", .str "λ {α : Sort (u + 1)} => List α"), ("levels", .arr #["u"])]
(Lean.toJson ({
type := { pp? := .some "{α : Type u} → Type u" },
@@ -44,46 +27,33 @@ def test_elab : IO LSpec.TestSeq :=
}: Protocol.ExprEchoResult)),
]
-def test_option_modify : IO LSpec.TestSeq :=
+def test_option_modify : Test :=
let pp? := Option.some "∀ (n : Nat), n + 1 = n.succ"
let sexp? := Option.some "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"
let module? := Option.some "Init.Data.Nat.Basic"
let options: Protocol.Options := {}
- subroutine_runner [
- subroutine_step "env.inspect"
- [("name", .str "Nat.add_one")]
- (Lean.toJson ({
- type := { pp? }, module? }:
- Protocol.EnvInspectResult)),
- subroutine_step "options.set"
- [("printExprAST", .bool true)]
- (Lean.toJson ({ }:
- Protocol.OptionsSetResult)),
- subroutine_step "env.inspect"
- [("name", .str "Nat.add_one")]
- (Lean.toJson ({
- type := { pp?, sexp? }, module? }:
- Protocol.EnvInspectResult)),
- subroutine_step "options.print"
- []
- (Lean.toJson ({ options with printExprAST := true }:
- Protocol.Options))
+ [
+ step "env.inspect" [("name", .str "Nat.add_one")]
+ ({ type := { pp? }, module? }: Protocol.EnvInspectResult),
+ step "options.set" [("printExprAST", .bool true)]
+ ({ }: Protocol.OptionsSetResult),
+ step "env.inspect" [("name", .str "Nat.add_one")]
+ ({ type := { pp?, sexp? }, module? }: Protocol.EnvInspectResult),
+ step "options.print" []
+ ({ options with printExprAST := true }: Protocol.Options),
]
-def test_malformed_command : IO LSpec.TestSeq :=
+def test_malformed_command : Test :=
let invalid := "invalid"
- subroutine_runner [
- subroutine_named_step "Invalid command" invalid
- [("name", .str "Nat.add_one")]
- (Lean.toJson ({
- error := "command", desc := s!"Unknown command {invalid}"}:
- Protocol.InteractionError)),
- subroutine_named_step "JSON Deserialization" "expr.echo"
- [(invalid, .str "Random garbage data")]
- (Lean.toJson ({
- error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected"}:
- Protocol.InteractionError))
+ [
+ step invalid [("name", .str "Nat.add_one")]
+ ({ error := "command", desc := s!"Unknown command {invalid}" }: Protocol.InteractionError)
+ (name? := .some "Invalid Command"),
+ step "expr.echo" [(invalid, .str "Random garbage data")]
+ ({ error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected" }:
+ Protocol.InteractionError)
+ (name? := .some "JSON Deserialization")
]
-def test_tactic : IO LSpec.TestSeq :=
+def test_tactic : Test :=
let goal1: Protocol.Goal := {
name := "_uniq.11",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
@@ -97,77 +67,123 @@ def test_tactic : IO LSpec.TestSeq :=
{ name := "_uniq.16", userName := "y", type? := .some { pp? := .some "Prop" }}
],
}
- subroutine_runner [
- subroutine_step "goal.start"
- [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
- (Lean.toJson ({stateId := 0, root := "_uniq.9"}:
- Protocol.GoalStartResult)),
- subroutine_step "goal.tactic"
- [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
- (Lean.toJson ({
- nextStateId? := .some 1,
- goals? := #[goal1],
- }:
- Protocol.GoalTacticResult)),
- subroutine_step "goal.print"
- [("stateId", .num 1)]
- (Lean.toJson ({
- parent? := .some { pp? := .some "fun x => ?m.12 x" },
- }:
- Protocol.GoalPrintResult)),
- subroutine_step "goal.tactic"
- [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
- (Lean.toJson ({
- nextStateId? := .some 2,
- goals? := #[goal2],
- }:
- Protocol.GoalTacticResult))
+ [
+ step "goal.start" [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
+ ({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
+ step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
+ ({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
+ step "goal.print" [("stateId", .num 1)]
+ ({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
+ step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
+ ({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
+ ]
+def test_automatic_mode (automatic: Bool): Test :=
+ let varsPQ := #[
+ { name := "_uniq.10", userName := "p", type? := .some { pp? := .some "Prop" }},
+ { name := "_uniq.13", userName := "q", type? := .some { pp? := .some "Prop" }}
+ ]
+ let goal1: Protocol.Goal := {
+ name := "_uniq.17",
+ target := { pp? := .some "q ∨ p" },
+ vars := varsPQ ++ #[
+ { name := "_uniq.16", userName := "h", type? := .some { pp? := .some "p ∨ q" }}
+ ],
+ }
+ let goal2l: Protocol.Goal := {
+ name := "_uniq.59",
+ userName? := .some "inl",
+ target := { pp? := .some "q ∨ p" },
+ vars := varsPQ ++ #[
+ { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
+ ],
+ }
+ let goal2r: Protocol.Goal := {
+ name := "_uniq.72",
+ userName? := .some "inr",
+ target := { pp? := .some "q ∨ p" },
+ vars := varsPQ ++ #[
+ { name := "_uniq.60", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true}
+ ],
+ }
+ let goal3l: Protocol.Goal := {
+ name := "_uniq.78",
+ userName? := .some "inl.h",
+ target := { pp? := .some "p" },
+ vars := varsPQ ++ #[
+ { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
+ ],
+ }
+ [
+ step "options.set" [("automaticMode", .bool automatic)]
+ ({}: Protocol.OptionsSetResult),
+ step "goal.start" [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
+ ({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
+ step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro p q h")]
+ ({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
+ step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "cases h")]
+ ({ nextStateId? := .some 2, goals? := #[goal2l, goal2r], }: Protocol.GoalTacticResult),
+ let goals? := if automatic then #[goal3l, goal2r] else #[goal3l]
+ step "goal.tactic" [("stateId", .num 2), ("goalId", .num 0), ("tactic", .str "apply Or.inr")]
+ ({ nextStateId? := .some 3, goals?, }: Protocol.GoalTacticResult),
]
-def test_env_add_inspect : IO LSpec.TestSeq :=
+def test_env_add_inspect : Test :=
let name1 := "Pantograph.mystery"
let name2 := "Pantograph.mystery2"
- subroutine_runner [
- subroutine_step "env.add"
+ [
+ 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 ({
+ ({}: Protocol.EnvAddResult),
+ step "env.inspect" [("name", .str name1)]
+ ({
value? := .some { pp? := .some "fun a b => a ∨ b" },
type := { pp? := .some "Prop → Prop → Prop" },
}:
- Protocol.EnvInspectResult)),
- subroutine_step "env.add"
+ Protocol.EnvInspectResult),
+ 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 ({
+ ({}: Protocol.EnvAddResult),
+ step "env.inspect" [("name", .str name2)]
+ ({
value? := .some { pp? := .some "fun a => ↑a + 1" },
type := { pp? := .some "Nat → Int" },
}:
- Protocol.EnvInspectResult))
+ Protocol.EnvInspectResult)
]
-def suite: List (String × IO LSpec.TestSeq) :=
- [
- ("Elab", test_elab),
- ("Option modify", test_option_modify),
+def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
+ -- Setup the environment for execution
+ let context: Context := {
+ imports := ["Init"]
+ }
+ let commands: MainM LSpec.TestSeq :=
+ steps.foldlM (λ suite step => do
+ let result ← step
+ return suite ++ result) LSpec.TestSeq.done
+ runCoreMSeq env <| commands.run context |>.run' {}
+
+
+def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
+ let tests := [
+ ("expr.echo", test_elab),
+ ("options.set options.print", test_option_modify),
("Malformed command", test_malformed_command),
("Tactic", test_tactic),
+ ("Manual Mode", test_automatic_mode false),
+ ("Automatic Mode", test_automatic_mode true),
("env.add env.inspect", test_env_add_inspect),
]
+ tests.map (fun (name, test) => (name, runTest env test))
end Pantograph.Test.Integration
diff --git a/Test/Main.lean b/Test/Main.lean
index 89c757a..6da6640 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -44,7 +44,7 @@ def main (args: List String) := do
let suites: List (String × List (String × IO LSpec.TestSeq)) := [
("Environment", Environment.suite),
- ("Integration", Integration.suite),
+ ("Integration", Integration.suite env_default),
("Library", Library.suite env_default),
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
From 860344f9c504d3c86d679ea9ef43e306e26a964e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Sep 2024 13:44:46 -0700
Subject: [PATCH 284/465] refactor: Factor out `FrontendM` driver
---
Pantograph/Compile/Elab.lean | 2 +-
Pantograph/Compile/Frontend.lean | 16 +++++++++++-----
2 files changed, 12 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Compile/Elab.lean b/Pantograph/Compile/Elab.lean
index 79833f3..2ded0f1 100644
--- a/Pantograph/Compile/Elab.lean
+++ b/Pantograph/Compile/Elab.lean
@@ -1,4 +1,4 @@
-
+/- Adapted from https://github.com/semorrison/lean-training-data -/
import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
diff --git a/Pantograph/Compile/Frontend.lean b/Pantograph/Compile/Frontend.lean
index 3dbad85..640f5fa 100644
--- a/Pantograph/Compile/Frontend.lean
+++ b/Pantograph/Compile/Frontend.lean
@@ -29,6 +29,9 @@ end Lean.PersistentArray
namespace Pantograph.Compile
+
+abbrev FrontendM := Elab.Frontend.FrontendM
+
structure CompilationStep where
fileName : String
fileMap : FileMap
@@ -44,7 +47,7 @@ structure CompilationStep where
Process one command, returning a `CompilationStep` and
`done : Bool`, indicating whether this was the last command.
-/
-def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
+def processOneCommand: FrontendM (CompilationStep × Bool) := do
let s := (← get).commandState
let before := s.env
let done ← Elab.Frontend.processCommand
@@ -57,30 +60,33 @@ def processOneCommand: Elab.Frontend.FrontendM (CompilationStep × Bool) := do
let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
-partial def processFile : Elab.Frontend.FrontendM (List CompilationStep) := do
+partial def collectCompilationSteps : FrontendM (List CompilationStep) := do
let (cmd, done) ← processOneCommand
if done then
return [cmd]
else
- return cmd :: (← processFile)
+ return cmd :: (← collectCompilationSteps)
def findSourcePath (module : Name) : IO System.FilePath := do
return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
-def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) := unsafe do
+def runFrontendMInFile { α } (module : Name) (opts : Options := {}) (m : FrontendM α): IO α := unsafe do
let file ← IO.FS.readFile (← findSourcePath module)
let inputCtx := Parser.mkInputContext file module.toString
let (header, parserState, messages) ← Parser.parseHeader inputCtx
let (env, messages) ← Elab.processHeader header opts messages inputCtx
let commandState := Elab.Command.mkState env messages opts
- processFile.run { inputCtx }
+ m.run { inputCtx }
|>.run' {
commandState := { commandState with infoState.enabled := true },
parserState,
cmdPos := parserState.pos
}
+def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) :=
+ runFrontendMInFile module opts collectCompilationSteps
+
end Pantograph.Compile
From 5e99237e091757e1dab76a9db012df6b9ada4b8d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Sep 2024 14:13:39 -0700
Subject: [PATCH 285/465] fix: Tactics should produce `.syntheticOpaque` goals
---
Pantograph/Tactic/Congruence.lean | 80 +++++++++++++--------------
Pantograph/Tactic/MotivatedApply.lean | 7 ++-
Test/Tactic/Congruence.lean | 2 +-
3 files changed, 45 insertions(+), 44 deletions(-)
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
index f72fc0a..0f6d80d 100644
--- a/Pantograph/Tactic/Congruence.lean
+++ b/Pantograph/Tactic/Congruence.lean
@@ -11,19 +11,19 @@ def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
- let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous α β .default)
- .synthetic (userName := userName ++ `f)
- let a₁ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₂)
- let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
- .synthetic (userName := userName ++ `h)
+ let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
+ (tag := userName ++ `α)
+ let f ← Meta.mkFreshExprSyntheticOpaqueMVar (.forallE .anonymous α β .default)
+ (tag := userName ++ `f)
+ let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
+ (tag := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
+ (tag := userName ++ `a₂)
+ let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
+ (tag := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) target
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
+ let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
+ (tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
let result := [α, a₁, a₂, f, h, conduit]
return result.map (·.mvarId!)
@@ -39,20 +39,20 @@ def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
+ let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
+ (tag := userName ++ `α)
let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₂)
- let a ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a)
- let h ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
- .synthetic (userName := userName ++ `h)
+ let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
+ (tag := userName ++ `f₁)
+ let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
+ (tag := userName ++ `f₂)
+ let a ← Meta.mkFreshExprSyntheticOpaqueMVar α
+ (tag := userName ++ `a)
+ let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
+ (tag := userName ++ `h)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) target
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
+ let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
+ (tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
let result := [α, f₁, f₂, h, a, conduit]
return result.map (·.mvarId!)
@@ -68,24 +68,24 @@ def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
let userName := (← mvarId.getDecl).userName
let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprMVar (.some $ mkSort u)
- .natural (userName := userName ++ `α)
+ let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
+ (tag := userName ++ `α)
let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprMVar (.some fType)
- .synthetic (userName := userName ++ `f₂)
- let a₁ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprMVar (.some α)
- .synthetic (userName := userName ++ `a₂)
- let h₁ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq f₁ f₂)
- .synthetic (userName := userName ++ `h₁)
- let h₂ ← Meta.mkFreshExprMVar (.some $ ← Meta.mkEq a₁ a₂)
- .synthetic (userName := userName ++ `h₂)
+ let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
+ (tag := userName ++ `f₁)
+ let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
+ (tag := userName ++ `f₂)
+ let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
+ (tag := userName ++ `a₁)
+ let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
+ (tag := userName ++ `a₂)
+ let h₁ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
+ (tag := userName ++ `h₁)
+ let h₂ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
+ (tag := userName ++ `h₂)
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) target
- let conduit ← Meta.mkFreshExprMVar conduitType
- .synthetic (userName := userName ++ `conduit)
+ let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
+ (tag := userName ++ `conduit)
mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
let result := [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
return result.map (·.mvarId!)
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
index 2c52f12..993d287 100644
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ b/Pantograph/Tactic/MotivatedApply.lean
@@ -66,6 +66,7 @@ def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.Inducti
mvarId.checkNotAssigned `Pantograph.Tactic.motivatedApply
let recursorType ← Meta.inferType recursor
let resultant ← mvarId.getType
+ let tag ← mvarId.getTag
let info ← match getRecursorInformation recursorType with
| .some info => pure info
@@ -81,9 +82,9 @@ def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.Inducti
let bvarIndex := info.nArgs - i - 1
let argGoal ← if bvarIndex = info.iMotive then
let surrogateMotiveType ← info.surrogateMotiveType prev resultant
- Meta.mkFreshExprMVar surrogateMotiveType .syntheticOpaque (userName := `motive)
+ Meta.mkFreshExprSyntheticOpaqueMVar surrogateMotiveType (tag := tag ++ `motive)
else
- Meta.mkFreshExprMVar argType .syntheticOpaque (userName := .anonymous)
+ Meta.mkFreshExprSyntheticOpaqueMVar argType (tag := .anonymous)
let prev := prev ++ [argGoal]
go (i + 1) prev
termination_by info.nArgs - i
@@ -91,7 +92,7 @@ def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.Inducti
-- Create the conduit type which proves the result of the motive is equal to the goal
let conduitType ← info.conduitType newMVars resultant
- let goalConduit ← Meta.mkFreshExprMVar conduitType .natural (userName := `conduit)
+ let goalConduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType (tag := `conduit)
mvarId.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
newMVars := newMVars ++ [goalConduit]
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 836041c..180c2f4 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -25,7 +25,7 @@ def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let f := newGoals.get! 3
let h := newGoals.get! 4
let c := newGoals.get! 5
- let results ← f.apply (← parseSentence "List.reverse")
+ let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse")
addTest $ LSpec.check "apply" (results.length = 0)
addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)")
From 8e3241c02ab65660169cdcb436883e27bd81e2b6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Sep 2024 15:02:43 -0700
Subject: [PATCH 286/465] refactor: Move all frontend functions to `Frontend`
---
Main.lean | 2 +-
Pantograph.lean | 2 +-
Pantograph/Compile.lean | 25 ----------------
Pantograph/Compile/Parse.lean | 14 ---------
Pantograph/Condensed.lean | 1 -
Pantograph/Frontend.lean | 4 +++
.../Frontend.lean => Frontend/Basic.lean} | 30 +++++++++++++------
Pantograph/{Compile => Frontend}/Elab.lean | 20 +++++++++++--
Pantograph/Goal.lean | 18 -----------
Pantograph/Library.lean | 20 +++++++++++--
Pantograph/Protocol.lean | 5 ++--
Pantograph/Serial.lean | 7 +++++
Repl.lean | 23 +++++++-------
Test/Integration.lean | 4 +--
14 files changed, 86 insertions(+), 89 deletions(-)
delete mode 100644 Pantograph/Compile.lean
delete mode 100644 Pantograph/Compile/Parse.lean
create mode 100644 Pantograph/Frontend.lean
rename Pantograph/{Compile/Frontend.lean => Frontend/Basic.lean} (78%)
rename Pantograph/{Compile => Frontend}/Elab.lean (86%)
diff --git a/Main.lean b/Main.lean
index eb5240d..2959a64 100644
--- a/Main.lean
+++ b/Main.lean
@@ -7,7 +7,7 @@ import Pantograph
import Repl
-- Main IO functions
-open Pantograph
+open Pantograph.Repl
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
def parseCommand (s: String): Except String Protocol.Command := do
diff --git a/Pantograph.lean b/Pantograph.lean
index 09327e8..292efb9 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,6 +1,6 @@
-import Pantograph.Compile
import Pantograph.Condensed
import Pantograph.Environment
+import Pantograph.Frontend
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
diff --git a/Pantograph/Compile.lean b/Pantograph/Compile.lean
deleted file mode 100644
index 83b463f..0000000
--- a/Pantograph/Compile.lean
+++ /dev/null
@@ -1,25 +0,0 @@
-/- Adapted from lean-training-data by semorrison -/
-import Pantograph.Protocol
-import Pantograph.Compile.Frontend
-import Pantograph.Compile.Elab
-import Pantograph.Compile.Parse
-
-open Lean
-
-namespace Pantograph.Compile
-
-def collectTacticsFromCompilation (steps : List CompilationStep) : IO (List Protocol.InvokedTactic) := do
- let infoTrees := steps.bind (·.trees)
- let tacticInfoTrees := infoTrees.bind λ tree => tree.filter λ
- | info@(.ofTacticInfo _) => info.isOriginal
- | _ => false
- let tactics := tacticInfoTrees.bind collectTactics
- tactics.mapM λ invocation => do
- let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
- let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
- let tactic ← invocation.ctx.runMetaM {} do
- let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
- return t.pretty
- return { goalBefore, goalAfter, tactic }
-
-end Pantograph.Compile
diff --git a/Pantograph/Compile/Parse.lean b/Pantograph/Compile/Parse.lean
deleted file mode 100644
index 72eb620..0000000
--- a/Pantograph/Compile/Parse.lean
+++ /dev/null
@@ -1,14 +0,0 @@
-import Lean
-
-open Lean
-
-namespace Pantograph.Compile
-
-def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
- return Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := s)
- (fileName := "<stdin>")
-
-end Pantograph.Compile
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
index c47f882..125b69c 100644
--- a/Pantograph/Condensed.lean
+++ b/Pantograph/Condensed.lean
@@ -2,7 +2,6 @@
import Lean
import Pantograph.Goal
import Pantograph.Expr
-import Pantograph.Protocol
open Lean
diff --git a/Pantograph/Frontend.lean b/Pantograph/Frontend.lean
new file mode 100644
index 0000000..ffeeec5
--- /dev/null
+++ b/Pantograph/Frontend.lean
@@ -0,0 +1,4 @@
+/- Adapted from lean-training-data by semorrison -/
+import Pantograph.Protocol
+import Pantograph.Frontend.Basic
+import Pantograph.Frontend.Elab
diff --git a/Pantograph/Compile/Frontend.lean b/Pantograph/Frontend/Basic.lean
similarity index 78%
rename from Pantograph/Compile/Frontend.lean
rename to Pantograph/Frontend/Basic.lean
index 640f5fa..55f8e93 100644
--- a/Pantograph/Compile/Frontend.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -27,8 +27,7 @@ protected def drop [Inhabited α] (t : PersistentArray α) (n : Nat) : List α :
end Lean.PersistentArray
-namespace Pantograph.Compile
-
+namespace Pantograph.Frontend
abbrev FrontendM := Elab.Frontend.FrontendM
@@ -47,6 +46,7 @@ structure CompilationStep where
Process one command, returning a `CompilationStep` and
`done : Bool`, indicating whether this was the last command.
-/
+@[export pantograph_frontend_process_one_command_m]
def processOneCommand: FrontendM (CompilationStep × Bool) := do
let s := (← get).commandState
let before := s.env
@@ -67,26 +67,38 @@ partial def collectCompilationSteps : FrontendM (List CompilationStep) := do
else
return cmd :: (← collectCompilationSteps)
-
def findSourcePath (module : Name) : IO System.FilePath := do
return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
-def runFrontendMInFile { α } (module : Name) (opts : Options := {}) (m : FrontendM α): IO α := unsafe do
+@[export pantograph_create_frontend_context_state_from_file_m]
+unsafe def createFrontendContextStateFromFile (module : Name) (opts : Options := {})
+ : IO (Elab.Frontend.Context × Elab.Frontend.State) := do
let file ← IO.FS.readFile (← findSourcePath module)
let inputCtx := Parser.mkInputContext file module.toString
let (header, parserState, messages) ← Parser.parseHeader inputCtx
let (env, messages) ← Elab.processHeader header opts messages inputCtx
let commandState := Elab.Command.mkState env messages opts
- m.run { inputCtx }
- |>.run' {
+ let context: Elab.Frontend.Context := { inputCtx }
+ let state: Elab.Frontend.State := {
commandState := { commandState with infoState.enabled := true },
parserState,
cmdPos := parserState.pos
}
+ return (context, state)
-def processSource (module : Name) (opts : Options := {}) : IO (List CompilationStep) :=
- runFrontendMInFile module opts collectCompilationSteps
+partial def mapCompilationSteps { α } (f: CompilationStep → IO α) : FrontendM (List α) := do
+ let (cmd, done) ← processOneCommand
+ let result ← f cmd
+ if done then
+ return [result]
+ else
+ return result :: (← mapCompilationSteps f)
+
+def runFrontendMInFile { α } (module : Name) (opts : Options := {}) (m : FrontendM α): IO α := unsafe do
+ let (context, state) ← createFrontendContextStateFromFile module opts
+ m.run context |>.run' state
-end Pantograph.Compile
+
+end Pantograph.Frontend
diff --git a/Pantograph/Compile/Elab.lean b/Pantograph/Frontend/Elab.lean
similarity index 86%
rename from Pantograph/Compile/Elab.lean
rename to Pantograph/Frontend/Elab.lean
index 2ded0f1..e29d8f9 100644
--- a/Pantograph/Compile/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -3,7 +3,8 @@ import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
-import Pantograph.Compile.Frontend
+import Pantograph.Protocol
+import Pantograph.Frontend.Basic
open Lean
@@ -75,7 +76,7 @@ partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
end Lean.Elab.InfoTree
-namespace Pantograph.Compile
+namespace Pantograph.Frontend
-- Info tree filtering functions
@@ -142,5 +143,18 @@ def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
collectTacticNodes t |>.filter fun i => i.info.isSubstantive
+@[export pantograph_frontend_collect_tactics_from_compilation_step_m]
+def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protocol.InvokedTactic) := do
+ let tacticInfoTrees := step.trees.bind λ tree => tree.filter λ
+ | info@(.ofTacticInfo _) => info.isOriginal
+ | _ => false
+ let tactics := tacticInfoTrees.bind collectTactics
+ tactics.mapM λ invocation => do
+ let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
+ let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
+ let tactic ← invocation.ctx.runMetaM {} do
+ let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
+ return t.pretty
+ return { goalBefore, goalAfter, tactic }
-end Pantograph.Compile
+end Pantograph.Frontend
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index f248923..b4a6fc7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -3,9 +3,7 @@ Functions for handling metavariables
All the functions starting with `try` resume their inner monadic state.
-/
-import Pantograph.Protocol
import Pantograph.Tactic
-import Pantograph.Compile.Parse
import Lean
@@ -385,20 +383,4 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
catch exception =>
return .failure #[← exception.toMessageData.toString]
-
-protected def GoalState.tryMotivatedApply (state: GoalState) (goal: MVarId) (recursor: String):
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let recursor ← match (← Compile.parseTermM recursor) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- state.tryTacticM goal (tacticM := Tactic.evalMotivatedApply recursor)
-protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: String):
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let eq ← match (← Compile.parseTermM eq) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
-
end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 2f31042..23a2046 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -159,7 +159,7 @@ def goalAssign (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticRes
runTermElabM <| state.tryAssign goal expr
@[export pantograph_goal_have_m]
protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult := do
- let type ← match (← Compile.parseTermM type) with
+ let type ← match (← parseTermM type) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
@@ -167,12 +167,28 @@ protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: S
state.tryTacticM goal $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_try_define_m]
protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): CoreM TacticResult := do
- let expr ← match (← Compile.parseTermM expr) with
+ let expr ← match (← parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
runTermElabM do
state.restoreElabM
state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
+@[export pantograph_goal_try_motivated_apply_m]
+protected def GoalState.tryMotivatedApply (state: GoalState) (goal: MVarId) (recursor: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let recursor ← match (← parseTermM recursor) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ state.tryTacticM goal (tacticM := Tactic.evalMotivatedApply recursor)
+@[export pantograph_goal_try_no_confuse_m]
+protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: String):
+ Elab.TermElabM TacticResult := do
+ state.restoreElabM
+ let eq ← match (← parseTermM eq) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goal binderName type
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 223fcfe..74da216 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -286,8 +286,6 @@ structure GoalDiag where
/-- Executes the Lean compiler on a single file -/
structure CompileUnit where
module: String
- -- If set to true, query the string boundaries of compilation units
- compilationUnits: Bool := false
-- If set to true, collect tactic invocations
invocations: Bool := false
deriving Lean.FromJson
@@ -297,7 +295,8 @@ structure InvokedTactic where
tactic: String
deriving Lean.ToJson
structure CompileUnitResult where
- units?: Option $ List (Nat × Nat)
+ -- String boundaries of compilation units
+ units: List (Nat × Nat)
invocations?: Option $ List InvokedTactic
deriving Lean.ToJson
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 93dfb95..3a9efa4 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -26,6 +26,13 @@ def parseTerm (env: Environment) (s: String): Except String Syntax :=
(input := s)
(fileName := "<stdin>")
+def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
+ return Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := s)
+ (fileName := "<stdin>")
+
/-- Parse a syntax object. May generate additional metavariables! -/
def elabType (syn: Syntax): Elab.TermElabM (Except String Expr) := do
try
diff --git a/Repl.lean b/Repl.lean
index ef77d56..cd5bfe7 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -1,7 +1,7 @@
import Lean.Data.HashMap
import Pantograph
-namespace Pantograph
+namespace Pantograph.Repl
structure Context where
imports: List String
@@ -204,17 +204,20 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
let module := args.module.toName
try
- let steps ← Compile.processSource module
- let units? := if args.compilationUnits then
- .some $ steps.map λ step => (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ let li ← Frontend.runFrontendMInFile module {} <| Frontend.mapCompilationSteps λ step => do
+ let unitBoundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ let tacticInvocations ← if args.invocations then
+ Frontend.collectTacticsFromCompilationStep step
+ else
+ pure []
+ return (unitBoundary, tacticInvocations)
+ let units := li.map λ (unit, _) => unit
+ let invocations? := if args.invocations then
+ .some $ li.bind λ (_, invocations) => invocations
else
.none
- let invocations? ← if args.invocations then
- pure $ .some (← Compile.collectTacticsFromCompilation steps)
- else
- pure .none
- return .ok { units?, invocations? }
+ return .ok { units, invocations? }
catch e =>
return .error $ errorI "compile" (← e.toMessageData.toString)
-end Pantograph
+end Pantograph.Repl
diff --git a/Test/Integration.lean b/Test/Integration.lean
index b82962b..e9eec76 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -6,13 +6,13 @@ import Repl
import Test.Common
namespace Pantograph.Test.Integration
-open Pantograph
+open Pantograph.Repl
def step { α } [Lean.ToJson α] (cmd: String) (payload: List (String × Lean.Json))
(expected: α) (name? : Option String := .none): MainM LSpec.TestSeq := do
let payload := Lean.Json.mkObj payload
let name := name?.getD s!"{cmd} {payload.compress}"
- let result ← execute { cmd, payload }
+ let result ← Repl.execute { cmd, payload }
return LSpec.test name (toString result = toString (Lean.toJson expected))
abbrev Test := List (MainM LSpec.TestSeq)
From 08fb53c0209a27fcfce95d738ab896e92b382625 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 10:18:20 -0700
Subject: [PATCH 287/465] test: Frontend process testing
---
Pantograph/Frontend/Basic.lean | 55 +++++++++++++++++++---------------
Pantograph/Protocol.lean | 12 +++++---
Repl.lean | 23 ++++++++++----
Test/Integration.lean | 33 ++++++++++++++++++++
4 files changed, 90 insertions(+), 33 deletions(-)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 55f8e93..79d3ea1 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -60,24 +60,45 @@ def processOneCommand: FrontendM (CompilationStep × Bool) := do
let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
-partial def collectCompilationSteps : FrontendM (List CompilationStep) := do
+partial def mapCompilationSteps { α } (f: CompilationStep → IO α) : FrontendM (List α) := do
let (cmd, done) ← processOneCommand
if done then
- return [cmd]
+ if cmd.src.isEmpty then
+ return []
+ else
+ return [← f cmd]
else
- return cmd :: (← collectCompilationSteps)
+ return (← f cmd) :: (← mapCompilationSteps f)
+
+@[export pantograph_frontend_find_source_path_m]
def findSourcePath (module : Name) : IO System.FilePath := do
return System.FilePath.mk ((← findOLean module).toString.replace ".lake/build/lib/" "") |>.withExtension "lean"
-@[export pantograph_create_frontend_context_state_from_file_m]
-unsafe def createFrontendContextStateFromFile (module : Name) (opts : Options := {})
- : IO (Elab.Frontend.Context × Elab.Frontend.State) := do
- let file ← IO.FS.readFile (← findSourcePath module)
- let inputCtx := Parser.mkInputContext file module.toString
+/--
+Use with
+```lean
+let m: FrontendM α := ...
+let (context, state) ← createContextStateFromFile ...
+m.run context |>.run' state
+```
+-/
+@[export pantograph_frontend_create_context_state_from_file_m]
+def createContextStateFromFile
+ (file : String) -- Content of the file
+ (fileName : String := "<anonymous>")
+ (env? : Option Lean.Environment := .none) -- If set to true, assume there's no header.
+ (opts : Options := {})
+ : IO (Elab.Frontend.Context × Elab.Frontend.State) := unsafe do
+ --let file ← IO.FS.readFile (← findSourcePath module)
+ let inputCtx := Parser.mkInputContext file fileName
- let (header, parserState, messages) ← Parser.parseHeader inputCtx
- let (env, messages) ← Elab.processHeader header opts messages inputCtx
+ let (env, parserState, messages) ← match env? with
+ | .some env => pure (env, {}, .empty)
+ | .none =>
+ let (header, parserState, messages) ← Parser.parseHeader inputCtx
+ let (env, messages) ← Elab.processHeader header opts messages inputCtx
+ pure (env, parserState, messages)
let commandState := Elab.Command.mkState env messages opts
let context: Elab.Frontend.Context := { inputCtx }
let state: Elab.Frontend.State := {
@@ -87,18 +108,4 @@ unsafe def createFrontendContextStateFromFile (module : Name) (opts : Options :=
}
return (context, state)
-partial def mapCompilationSteps { α } (f: CompilationStep → IO α) : FrontendM (List α) := do
- let (cmd, done) ← processOneCommand
- let result ← f cmd
- if done then
- return [result]
- else
- return result :: (← mapCompilationSteps f)
-
-def runFrontendMInFile { α } (module : Name) (opts : Options := {}) (m : FrontendM α): IO α := unsafe do
- let (context, state) ← createFrontendContextStateFromFile module opts
- m.run context |>.run' state
-
-
-
end Pantograph.Frontend
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 74da216..12a75a2 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -284,20 +284,24 @@ structure GoalDiag where
/-- Executes the Lean compiler on a single file -/
-structure CompileUnit where
- module: String
+structure FrontendProcess where
+ -- One of these two must be supplied: Either supply the file name or the content.
+ fileName?: Option String := .none
+ file?: Option String := .none
-- If set to true, collect tactic invocations
invocations: Bool := false
+ -- If set to true, collect `sorry`s
+ sorrys: Bool := false
deriving Lean.FromJson
structure InvokedTactic where
goalBefore: String
goalAfter: String
tactic: String
deriving Lean.ToJson
-structure CompileUnitResult where
+structure FrontendProcessResult where
-- String boundaries of compilation units
units: List (Nat × Nat)
- invocations?: Option $ List InvokedTactic
+ invocations?: Option (List InvokedTactic) := .none
deriving Lean.ToJson
abbrev CR α := Except InteractionError α
diff --git a/Repl.lean b/Repl.lean
index cd5bfe7..2f92eb8 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -46,7 +46,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
- | "compile.unit" => run compile_unit
+ | "frontend.process" => run frontend_process
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
@@ -201,16 +201,29 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let .some goalState := state.goalStates.find? args.stateId | return .error $ errorIndex s!"Invalid state index {args.stateId}"
let result ← runMetaInMainM <| goalPrint goalState state.options
return .ok result
- compile_unit (args: Protocol.CompileUnit): MainM (CR Protocol.CompileUnitResult) := do
- let module := args.module.toName
+ frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
try
- let li ← Frontend.runFrontendMInFile module {} <| Frontend.mapCompilationSteps λ step => do
+ let (fileName, file) ← match args.fileName?, args.file? with
+ | .some fileName, .none => do
+ let file ← IO.FS.readFile fileName
+ pure (fileName, file)
+ | .none, .some file =>
+ pure ("<anonymous>", file)
+ | _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
+ let env?: Option Lean.Environment ← if args.fileName?.isSome then
+ pure .none
+ else do
+ let env ← Lean.MonadEnv.getEnv
+ pure <| .some env
+ let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
+ let m := Frontend.mapCompilationSteps λ step => do
let unitBoundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
let tacticInvocations ← if args.invocations then
Frontend.collectTacticsFromCompilationStep step
else
pure []
return (unitBoundary, tacticInvocations)
+ let li ← m.run context |>.run' state
let units := li.map λ (unit, _) => unit
let invocations? := if args.invocations then
.some $ li.bind λ (_, invocations) => invocations
@@ -218,6 +231,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
.none
return .ok { units, invocations? }
catch e =>
- return .error $ errorI "compile" (← e.toMessageData.toString)
+ return .error $ errorI "frontend" (← e.toMessageData.toString)
end Pantograph.Repl
diff --git a/Test/Integration.lean b/Test/Integration.lean
index e9eec76..3681d4e 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -161,6 +161,38 @@ def test_env_add_inspect : Test :=
Protocol.EnvInspectResult)
]
+example : ∀ (p: Prop), p → p := by
+ intro p h
+ exact h
+
+def test_frontend_process : Test :=
+ [
+ let file := "example : ∀ (p: Prop), p → p := by\n intro p h\n exact h"
+ let goal1 := "p : Prop\nh : p\n⊢ p"
+ step "frontend.process"
+ [
+ ("file", .str file),
+ ("invocations", .bool true),
+ ("sorrys", .bool false),
+ ]
+ ({
+ units := [(0, file.utf8ByteSize)],
+ invocations? := .some [
+ {
+ goalBefore := "⊢ ∀ (p : Prop), p → p",
+ goalAfter := goal1,
+ tactic := "intro p h",
+ },
+ {
+ goalBefore := goal1 ,
+ goalAfter := "",
+ tactic := "exact h",
+ },
+ ]
+ }: Protocol.FrontendProcessResult),
+ ]
+
+
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
-- Setup the environment for execution
let context: Context := {
@@ -182,6 +214,7 @@ def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
("Manual Mode", test_automatic_mode false),
("Automatic Mode", test_automatic_mode true),
("env.add env.inspect", test_env_add_inspect),
+ ("frontend.process", test_frontend_process),
]
tests.map (fun (name, test) => (name, runTest env test))
From 4f5950ed7878f17de50d9b535b3bd030f1965af8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 12:26:46 -0700
Subject: [PATCH 288/465] feat: Convert holes to goals
---
Pantograph/Frontend/Elab.lean | 29 ++++++++++++++++++++--
Pantograph/Goal.lean | 11 +++++++++
Pantograph/Protocol.lean | 1 +
Repl.lean | 45 +++++++++++++++++++++++------------
Test/Integration.lean | 33 ++++++++++++++++++++++++-
5 files changed, 101 insertions(+), 18 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index e29d8f9..8deac23 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -5,6 +5,7 @@ import Lean.Elab.InfoTree
import Pantograph.Protocol
import Pantograph.Frontend.Basic
+import Pantograph.Goal
open Lean
@@ -132,7 +133,7 @@ partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pre
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/
-def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
+private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
let infos := findAllInfo t none fun i => match i with
| .ofTacticInfo _ => true
| _ => false
@@ -153,8 +154,32 @@ def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protoc
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
let tactic ← invocation.ctx.runMetaM {} do
- let t ← Lean.PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
+ let t ← PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
return t.pretty
return { goalBefore, goalAfter, tactic }
+private def collectSorrysInTree (t : Elab.InfoTree) : List Elab.TermInfo :=
+ let infos := findAllInfo t none fun i => match i with
+ | .ofTermInfo { expectedType?, expr, stx, .. } =>
+ expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
+ | _ => false
+ infos.filterMap fun p => match p with
+ | (.ofTermInfo i, _, _) => .some i
+ | _ => none
+
+@[export pantograph_frontend_collect_sorrys_m]
+def collectSorrys (step: CompilationStep) : List Elab.TermInfo :=
+ step.trees.bind collectSorrysInTree
+
+@[export pantograph_frontend_sorrys_to_goal_state]
+def sorrysToGoalState (sorrys : List Elab.TermInfo) : MetaM GoalState := do
+ assert! !sorrys.isEmpty
+ let goals ← sorrys.mapM λ termInfo => Meta.withLCtx termInfo.lctx #[] do
+ let type := termInfo.expectedType?.get!
+ let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
+ return mvar.mvarId!
+ GoalState.createFromMVars goals (root := { name := .anonymous })
+
+
+
end Pantograph.Frontend
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b4a6fc7..79e3004 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -46,6 +46,15 @@ protected def GoalState.create (expr: Expr): Elab.TermElabM GoalState := do
savedState,
parentMVar? := .none,
}
+@[export pantograph_goal_state_create_from_mvars_m]
+protected def GoalState.createFromMVars (goals: List MVarId) (root: MVarId): MetaM GoalState := do
+ let savedStateMonad: Elab.Tactic.TacticM Elab.Tactic.SavedState := MonadBacktrack.saveState
+ let savedState ← savedStateMonad { elaborator := .anonymous } |>.run' { goals } |>.run' {}
+ return {
+ root,
+ savedState,
+ parentMVar? := .none,
+ }
@[export pantograph_goal_state_is_conv]
protected def GoalState.isConv (state: GoalState): Bool :=
state.convMVar?.isSome
@@ -143,6 +152,8 @@ protected def GoalState.continue (target: GoalState) (branch: GoalState): Except
@[export pantograph_goal_state_root_expr]
protected def GoalState.rootExpr? (goalState: GoalState): Option Expr := do
+ if goalState.root.name == .anonymous then
+ .none
let expr ← goalState.mctx.eAssignment.find? goalState.root
let (expr, _) := instantiateMVarsCore (mctx := goalState.mctx) (e := expr)
if expr.hasExprMVar then
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 12a75a2..26cae09 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -302,6 +302,7 @@ structure FrontendProcessResult where
-- String boundaries of compilation units
units: List (Nat × Nat)
invocations?: Option (List InvokedTactic) := .none
+ goalStates?: Option (List (Nat × Array Goal)) := .none
deriving Lean.ToJson
abbrev CR α := Except InteractionError α
diff --git a/Repl.lean b/Repl.lean
index 2f92eb8..1277e73 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -54,6 +54,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
where
errorCommand := errorI "command"
errorIndex := errorI "index"
+ newGoalState (goalState: GoalState) : MainM Nat := do
+ let state ← get
+ let stateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert stateId goalState,
+ nextId := state.nextId + 1
+ }
+ return stateId
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -95,7 +103,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
return .ok (← get).options
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
- let state ← get
let env ← Lean.MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
| .some expr, .none => goalStartExpr expr (args.levels.getD #[])
@@ -108,11 +115,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match expr? with
| .error error => return .error error
| .ok goalState =>
- let stateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert stateId goalState,
- nextId := state.nextId + 1
- }
+ let stateId ← newGoalState goalState
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
@@ -151,11 +154,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) | throwError "Resuming known goals"
pure result
| false, _ => pure nextGoalState
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert state.nextId nextGoalState,
- nextId := state.nextId + 1,
- }
+ let nextStateId ← newGoalState nextGoalState
let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
return .ok {
nextStateId? := .some nextStateId,
@@ -202,6 +201,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let result ← runMetaInMainM <| goalPrint goalState state.options
return .ok result
frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
+ let options := (← get).options
try
let (fileName, file) ← match args.fileName?, args.file? with
| .some fileName, .none => do
@@ -222,14 +222,29 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Frontend.collectTacticsFromCompilationStep step
else
pure []
- return (unitBoundary, tacticInvocations)
+ let sorrys := if args.sorrys then
+ Frontend.collectSorrys step
+ else
+ []
+ return (unitBoundary, tacticInvocations, sorrys)
let li ← m.run context |>.run' state
- let units := li.map λ (unit, _) => unit
+ let units := li.map λ (unit, _, _) => unit
let invocations? := if args.invocations then
- .some $ li.bind λ (_, invocations) => invocations
+ .some $ li.bind λ (_, invocations, _) => invocations
else
.none
- return .ok { units, invocations? }
+ let goalStates? ← if args.sorrys then do
+ let stateIds ← li.filterMapM λ (_, _, sorrys) => do
+ if sorrys.isEmpty then
+ return .none
+ let goalState ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
+ let stateId ← newGoalState goalState
+ let goals ← goalSerialize goalState options
+ return .some (stateId, goals)
+ pure $ .some stateIds
+ else
+ pure .none
+ return .ok { units, invocations?, goalStates? }
catch e =>
return .error $ errorI "frontend" (← e.toMessageData.toString)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 3681d4e..4a8e418 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -192,6 +192,36 @@ def test_frontend_process : Test :=
}: Protocol.FrontendProcessResult),
]
+example : 1 + 2 = 3 := rfl
+example (p: Prop): p → p := by simp
+
+def test_frontend_process_sorry : Test :=
+ let solved := "example : 1 + 2 = 3 := rfl\n"
+ let withSorry := "example (p: Prop): p → p := sorry"
+ [
+ let file := s!"{solved}{withSorry}"
+ let goal1: Protocol.Goal := {
+ name := "_uniq.1",
+ target := { pp? := .some "p → p" },
+ vars := #[{ name := "_uniq.168", userName := "p", type? := .some { pp? := .some "Prop" }}],
+ }
+ step "frontend.process"
+ [
+ ("file", .str file),
+ ("invocations", .bool false),
+ ("sorrys", .bool true),
+ ]
+ ({
+ units := [
+ (0, solved.utf8ByteSize),
+ (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
+ ],
+ goalStates? := [
+ (0, #[goal1]),
+ ]
+ }: Protocol.FrontendProcessResult),
+ ]
+
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
-- Setup the environment for execution
@@ -214,7 +244,8 @@ def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
("Manual Mode", test_automatic_mode false),
("Automatic Mode", test_automatic_mode true),
("env.add env.inspect", test_env_add_inspect),
- ("frontend.process", test_frontend_process),
+ ("frontend.process invocation", test_frontend_process),
+ ("frontend.process sorry", test_frontend_process_sorry),
]
tests.map (fun (name, test) => (name, runTest env test))
From 762a139e7800bc08bc27c2f6a9aa3ba8365fcf44 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 12:30:32 -0700
Subject: [PATCH 289/465] feat: Export frontend functions
---
Pantograph/Frontend/Basic.lean | 1 +
Pantograph/Frontend/Elab.lean | 1 +
2 files changed, 2 insertions(+)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 79d3ea1..933424c 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -8,6 +8,7 @@ namespace Lean.FileMap
/-- Extract the range of a `Syntax` expressed as lines and columns. -/
-- Extracted from the private declaration `Lean.Elab.formatStxRange`,
-- in `Lean.Elab.InfoTree.Main`.
+@[export pantograph_frontend_stx_range]
protected def stxRange (fileMap : FileMap) (stx : Syntax) : Position × Position :=
let pos := stx.getPos?.getD 0
let endPos := stx.getTailPos?.getD pos
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 8deac23..2ff9a2e 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -88,6 +88,7 @@ structure TacticInvocation where
namespace TacticInvocation
/-- Return the range of the tactic, as a pair of file positions. -/
+@[export pantograph_frontend_tactic_invocation_range]
protected def range (t : TacticInvocation) : Position × Position := t.ctx.fileMap.stxRange t.info.stx
/-- Pretty print a tactic. -/
From 9f0de0957e54dbeaa94d06bbf0f4c5620429f817 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 12:39:32 -0700
Subject: [PATCH 290/465] doc: Update documentation for frontend command
---
README.md | 74 ++++++++++++++++++++++++++++++-------------------------
1 file changed, 41 insertions(+), 33 deletions(-)
diff --git a/README.md b/README.md
index 8bda1ef..27af323 100644
--- a/README.md
+++ b/README.md
@@ -9,30 +9,17 @@ examine the symbol list of a Lean project for machine learning.
## Installation
-For Nix based workflow, see below.
+For Nix users, run
+``` sh
+nix build .#{sharedLib,executable}
+```
+to build either the shared library or executable.
Install `elan` and `lake`, and run
``` sh
lake build
```
-This builds the executable in `.lake/build/bin/pantograph`.
-
-To use Pantograph in a project environment, setup the `LEAN_PATH` environment
-variable so it contains the library path of lean libraries. The libraries must
-be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
-the environment might be setup like this:
-
-``` sh
-LIB="../lib"
-LIB_MATHLIB="$LIB/mathlib4/lake-packages"
-export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib"
-
-LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
-```
-The `$LEAN_PATH` executable of any project can be extracted by
-``` sh
-lake env printenv LEAN_PATH
-```
+This builds the executable in `.lake/build/bin/pantograph-repl`.
## Executable Usage
@@ -90,10 +77,10 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
only the values of definitions are printed.
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
-
+
One particular option for interest for machine learning researchers is the automatic mode.
`options.set { "automaticMode": true }`. This makes Pantograph act like
- LeanDojo, with no resumption necessary to manage your goals.
+ gym, with no resumption necessary to manage your goals.
* `options.print`: Display the current set of options
* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
@@ -113,6 +100,10 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
- `{ "goals": <names> }`: Resume the given goals
* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state
+* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
+ <bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
+ either the tactic invocations (`"invocations": true`) or the sorrys into goal
+ states (`"sorrys": true`)
### Errors
@@ -129,6 +120,25 @@ Common error forms:
input of another is broken. For example, attempting to query a symbol not
existing in the library or indexing into a non-existent proof state.
+### Project Environment
+
+To use Pantograph in a project environment, setup the `LEAN_PATH` environment
+variable so it contains the library path of lean libraries. The libraries must
+be built in advance. For example, if `mathlib4` is stored at `../lib/mathlib4`,
+the environment might be setup like this:
+
+``` sh
+LIB="../lib"
+LIB_MATHLIB="$LIB/mathlib4/lake-packages"
+export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib"
+
+LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
+```
+The `$LEAN_PATH` executable of any project can be extracted by
+``` sh
+lake env printenv LEAN_PATH
+```
+
### Troubleshooting
If lean encounters stack overflow problems when printing catalog, execute this before running lean:
@@ -142,13 +152,22 @@ ulimit -s unlimited
with `Pantograph` which mirrors the REPL commands above. It is recommended to
call Pantograph via this FFI since it provides a tremendous speed up.
+The executable can be used as-is, but linking against the shared library
+requires the presence of `lean-all`.
+
+Inject any project path via the `pantograph_init_search` function.
+
## Developing
A Lean development shell is provided in the Nix flake.
### Testing
-The tests are based on `LSpec`. To run tests,
+The tests are based on `LSpec`. To run tests, use either
+``` sh
+nix flake check
+```
+or
``` sh
lake test
```
@@ -157,14 +176,3 @@ You can run an individual test by specifying a prefix
``` sh
lake test -- "Tactic/No Confuse"
```
-
-## Nix based workflow
-
-The included Nix flake provides build targets for `sharedLib` and `executable`.
-The executable can be used as-is, but linking against the shared library
-requires the presence of `lean-all`.
-
-To run tests:
-``` sh
-nix flake check
-```
From 9075ded885ce03a70a05e562c6dba3789f03ac93 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 17:29:43 -0700
Subject: [PATCH 291/465] feat: Set `automaticMode` to true by default
---
Pantograph/Protocol.lean | 2 +-
README.md | 12 ++++++++----
2 files changed, 9 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 223fcfe..e88efa3 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -28,7 +28,7 @@ structure Options where
-- See `pp.implementationDetailHyps`
printImplementationDetailHyps: Bool := false
-- If this is set to `true`, goals will never go dormant, so you don't have to manage resumption
- automaticMode: Bool := false
+ automaticMode: Bool := true
deriving Lean.ToJson
abbrev OptionsT := ReaderT Options
diff --git a/README.md b/README.md
index 8bda1ef..06ae690 100644
--- a/README.md
+++ b/README.md
@@ -90,10 +90,11 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
only the values of definitions are printed.
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
-
- One particular option for interest for machine learning researchers is the automatic mode.
- `options.set { "automaticMode": true }`. This makes Pantograph act like
- LeanDojo, with no resumption necessary to manage your goals.
+
+ One particular option for interest for machine learning researchers is the
+ automatic mode (flag: `"automaticMode"`). By default it is turned on, with
+ all goals automatically resuming. This makes Pantograph act like a gym,
+ with no resumption necessary to manage your goals.
* `options.print`: Display the current set of options
* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
@@ -142,6 +143,9 @@ ulimit -s unlimited
with `Pantograph` which mirrors the REPL commands above. It is recommended to
call Pantograph via this FFI since it provides a tremendous speed up.
+Note that there isn't a 1-1 correspondence between executable (REPL) commands
+and library functions.
+
## Developing
A Lean development shell is provided in the Nix flake.
From fe8b259e4f09817bf4b2df269d87e836d10155cf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 17:37:59 -0700
Subject: [PATCH 292/465] feat: Set root when there's just one mvar
---
Pantograph/Frontend/Elab.lean | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 2ff9a2e..4d6afe4 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -179,7 +179,11 @@ def sorrysToGoalState (sorrys : List Elab.TermInfo) : MetaM GoalState := do
let type := termInfo.expectedType?.get!
let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
return mvar.mvarId!
- GoalState.createFromMVars goals (root := { name := .anonymous })
+ let root := match goals with
+ | [] => panic! "This function cannot be called on an empty list"
+ | [g] => g
+ | _ => { name := .anonymous }
+ GoalState.createFromMVars goals root
From bec84f857bd4f80064213fa5646bef4699191290 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Sep 2024 18:43:34 -0700
Subject: [PATCH 293/465] fix: repl build failure
---
Main.lean | 15 +++++++--------
1 file changed, 7 insertions(+), 8 deletions(-)
diff --git a/Main.lean b/Main.lean
index 2959a64..b866711 100644
--- a/Main.lean
+++ b/Main.lean
@@ -1,16 +1,15 @@
import Lean.Data.Json
import Lean.Environment
-import Pantograph.Version
-import Pantograph.Library
import Pantograph
import Repl
-- Main IO functions
open Pantograph.Repl
+open Pantograph.Protocol
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
-def parseCommand (s: String): Except String Protocol.Command := do
+def parseCommand (s: String): Except String Command := do
let s := s.trim
match s.get? 0 with
| .some '{' => -- Parse in Json mode
@@ -30,7 +29,7 @@ partial def loop : MainM Unit := do
if command.trim.length = 0 then return ()
match parseCommand command with
| .error error =>
- let error := Lean.toJson ({ error := "command", desc := error }: Protocol.InteractionError)
+ let error := Lean.toJson ({ error := "command", desc := error }: InteractionError)
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
@@ -46,15 +45,15 @@ unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
-- Separate imports and options
if args == ["--version"] then do
- println! s!"{version}"
+ println! s!"{Pantograph.version}"
return
- initSearch ""
+ Pantograph.initSearch ""
let coreContext ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
- |>.toArray |> createCoreContext
+ |>.toArray |> Pantograph.createCoreContext
let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
- let coreState ← createCoreState imports.toArray
+ let coreState ← Pantograph.createCoreState imports.toArray
let context: Context := {
imports
}
From 18cd1d038819fbb9f8985648aaf3554049822b5e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 2 Oct 2024 22:22:20 -0700
Subject: [PATCH 294/465] fix: Extracting sorrys from sketches
---
Pantograph/Frontend/Elab.lean | 96 +++++++++++++++++++++++++++++++----
Test/Frontend.lean | 55 ++++++++++++++++++++
Test/Main.lean | 2 +
3 files changed, 142 insertions(+), 11 deletions(-)
create mode 100644 Test/Frontend.lean
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 4d6afe4..ec86df3 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -159,26 +159,100 @@ def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protoc
return t.pretty
return { goalBefore, goalAfter, tactic }
-private def collectSorrysInTree (t : Elab.InfoTree) : List Elab.TermInfo :=
+private def collectSorrysInTree (t : Elab.InfoTree) : List Elab.Info :=
let infos := findAllInfo t none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
- expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
+ expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
+ | .ofTacticInfo { stx, .. } =>
+ -- The `sorry` term is distinct from the `sorry` tactic
+ stx.isOfKind `Lean.Parser.Tactic.tacticSorry
| _ => false
- infos.filterMap fun p => match p with
- | (.ofTermInfo i, _, _) => .some i
- | _ => none
+ infos.map fun (i, _, _) => i
+-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
-def collectSorrys (step: CompilationStep) : List Elab.TermInfo :=
+def collectSorrys (step: CompilationStep) : List Elab.Info :=
step.trees.bind collectSorrysInTree
-@[export pantograph_frontend_sorrys_to_goal_state]
-def sorrysToGoalState (sorrys : List Elab.TermInfo) : MetaM GoalState := do
- assert! !sorrys.isEmpty
- let goals ← sorrys.mapM λ termInfo => Meta.withLCtx termInfo.lctx #[] do
+
+namespace MetaTranslate
+
+structure Context where
+ sourceMCtx : MetavarContext := {}
+ sourceLCtx : LocalContext := {}
+
+/-
+Monadic state for translating a frozen meta state. The underlying `MetaM`
+operates in the "target" context and state.
+-/
+abbrev MetaTranslateM := ReaderT Context MetaM
+
+def getSourceLCtx : MetaTranslateM LocalContext := do pure (← read).sourceLCtx
+def getSourceMCtx : MetaTranslateM MetavarContext := do pure (← read).sourceMCtx
+
+private def translateExpr (expr: Expr) : MetaTranslateM Expr := do
+ let (expr, _) := instantiateMVarsCore (mctx := ← getSourceMCtx) expr
+ return expr
+
+def translateLocalDecl (frozenLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
+ let fvarId ← mkFreshFVarId
+ match frozenLocalDecl with
+ | .cdecl index _ userName type bi kind =>
+ return .cdecl index fvarId userName type bi kind
+ | .ldecl index _ userName type value nonDep kind =>
+ return .ldecl index fvarId userName type value nonDep kind
+
+def translateMVarId (mvarId: MVarId) : MetaTranslateM MVarId := do
+ let shadowDecl := (← getSourceMCtx).findDecl? mvarId |>.get!
+ let target ← translateExpr shadowDecl.type
+ let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := shadowDecl.lctx }) do
+ let lctx ← MonadLCtx.getLCtx
+ let lctx ← (← getSourceLCtx).foldlM (λ lctx frozenLocalDecl => do
+ let localDecl ← translateLocalDecl frozenLocalDecl
+ let lctx := lctx.addDecl localDecl
+ pure lctx
+ ) lctx
+ withTheReader Meta.Context (fun ctx => { ctx with lctx }) do
+ Meta.mkFreshExprSyntheticOpaqueMVar target
+ return mvar.mvarId!
+
+def translateTermInfo (termInfo: Elab.TermInfo) : MetaM MVarId := do
+ let trM : MetaTranslateM MVarId := do
let type := termInfo.expectedType?.get!
- let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
+ let lctx ← getSourceLCtx
+ let mvar ← withTheReader Meta.Context (fun ctx => { ctx with lctx }) do
+ Meta.mkFreshExprSyntheticOpaqueMVar type
return mvar.mvarId!
+ trM.run { sourceLCtx := termInfo.lctx }
+
+
+def translateTacticInfoBefore (tacticInfo: Elab.TacticInfo) : MetaM (List MVarId) := do
+ let trM : MetaTranslateM (List MVarId) := do
+ tacticInfo.goalsBefore.mapM translateMVarId
+ trM.run { sourceMCtx := tacticInfo.mctxBefore }
+
+
+end MetaTranslate
+
+export MetaTranslate (MetaTranslateM)
+
+/--
+Since we cannot directly merge `MetavarContext`s, we have to get creative. This
+function duplicates frozen mvars in term and tactic info nodes, and add them to
+the current `MetavarContext`.
+-/
+@[export pantograph_frontend_sorrys_to_goal_state]
+def sorrysToGoalState (sorrys : List Elab.Info) : MetaM GoalState := do
+ assert! !sorrys.isEmpty
+ let goals ← sorrys.mapM λ info => Meta.withLCtx info.lctx #[] do
+ match info with
+ | .ofTermInfo termInfo => do
+ let mvarId ← MetaTranslate.translateTermInfo termInfo
+ return [mvarId]
+ | .ofTacticInfo tacticInfo => do
+ MetaTranslate.translateTacticInfoBefore tacticInfo
+ | _ => panic! "Invalid info"
+ let goals := goals.bind id
let root := match goals with
| [] => panic! "This function cannot be called on an empty list"
| [g] => g
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
new file mode 100644
index 0000000..ac347e6
--- /dev/null
+++ b/Test/Frontend.lean
@@ -0,0 +1,55 @@
+import LSpec
+import Pantograph
+import Repl
+import Test.Common
+
+open Lean Pantograph
+namespace Pantograph.Test.Frontend
+
+def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
+ let filename := "<anonymous>"
+ let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
+ let m := Frontend.mapCompilationSteps λ step => do
+ return Frontend.collectSorrys step
+ let li ← m.run context |>.run' state
+ let goalStates ← li.filterMapM λ sorrys => do
+ if sorrys.isEmpty then
+ return .none
+ let goalState ← Frontend.sorrysToGoalState sorrys
+ return .some goalState
+ return goalStates
+
+def test_multiple_sorries_in_proof : TestT MetaM Unit := do
+ let sketch := "
+theorem plus_n_Sm_proved_formal_sketch : ∀ n m : Nat, n + (m + 1) = (n + m) + 1 := by
+ have h_nat_add_succ: ∀ n m : Nat, n = m := sorry
+ sorry
+ "
+ let goalStates ← (collectSorrysFromSource sketch).run' {}
+ let [goalState] := goalStates | panic! "Illegal number of states"
+ addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})) = #[
+ {
+ name := "_uniq.1",
+ target := { pp? := "∀ (n m : Nat), n = m" },
+ vars := #[
+ ]
+ },
+ {
+ name := "_uniq.4",
+ target := { pp? := "∀ (n m : Nat), n + (m + 1) = n + m + 1" },
+ vars := #[{
+ name := "_uniq.3",
+ userName := "h_nat_add_succ",
+ type? := .some { pp? := "∀ (n m : Nat), n = m" },
+ }],
+ }
+ ])
+
+
+def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
+ let tests := [
+ ("multiple_sorrys_in_proof", test_multiple_sorries_in_proof),
+ ]
+ tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
+
+end Pantograph.Test.Frontend
diff --git a/Test/Main.lean b/Test/Main.lean
index 6da6640..0fde5fa 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,5 +1,6 @@
import LSpec
import Test.Environment
+import Test.Frontend
import Test.Integration
import Test.Library
import Test.Metavar
@@ -44,6 +45,7 @@ def main (args: List String) := do
let suites: List (String × List (String × IO LSpec.TestSeq)) := [
("Environment", Environment.suite),
+ ("Frontend", Frontend.suite env_default),
("Integration", Integration.suite env_default),
("Library", Library.suite env_default),
("Metavar", Metavar.suite env_default),
From 143cd289bbc4ea93f0889cf05737c3b6f90a51df Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 3 Oct 2024 01:29:46 -0700
Subject: [PATCH 295/465] fix: Extraction of sorry's from nested tactics
---
Pantograph/Frontend/Elab.lean | 135 ++++++++++++++++++++++++----------
Test/Frontend.lean | 96 ++++++++++++++++++++++--
Test/Integration.lean | 4 +-
3 files changed, 187 insertions(+), 48 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index ec86df3..2e0c14e 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -124,12 +124,12 @@ protected def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
end TacticInvocation
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
-partial def findAllInfo (t : Elab.InfoTree) (ctx : Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
+partial def findAllInfo (t : Elab.InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
- | .context inner t => findAllInfo t (inner.mergeIntoOuter? ctx) pred
+ | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
| .node i children =>
- (if pred i then [(i, ctx, children)] else []) ++ children.toList.bind (fun t => findAllInfo t ctx pred)
+ (if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
| _ => []
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
@@ -159,7 +159,11 @@ def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protoc
return t.pretty
return { goalBefore, goalAfter, tactic }
-private def collectSorrysInTree (t : Elab.InfoTree) : List Elab.Info :=
+structure InfoWithContext where
+ info: Elab.Info
+ context?: Option Elab.ContextInfo := .none
+
+private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
let infos := findAllInfo t none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
@@ -167,11 +171,11 @@ private def collectSorrysInTree (t : Elab.InfoTree) : List Elab.Info :=
-- The `sorry` term is distinct from the `sorry` tactic
stx.isOfKind `Lean.Parser.Tactic.tacticSorry
| _ => false
- infos.map fun (i, _, _) => i
+ infos.map fun (info, context?, _) => { info, context? }
-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
-def collectSorrys (step: CompilationStep) : List Elab.Info :=
+def collectSorrys (step: CompilationStep) : List InfoWithContext :=
step.trees.bind collectSorrysInTree
@@ -181,55 +185,106 @@ structure Context where
sourceMCtx : MetavarContext := {}
sourceLCtx : LocalContext := {}
+structure State where
+ -- Stores mapping from old to new mvar/fvars
+ mvarMap: HashMap MVarId MVarId := {}
+ fvarMap: HashMap FVarId FVarId := {}
+
/-
Monadic state for translating a frozen meta state. The underlying `MetaM`
operates in the "target" context and state.
-/
-abbrev MetaTranslateM := ReaderT Context MetaM
+abbrev MetaTranslateM := ReaderT Context StateRefT State MetaM
def getSourceLCtx : MetaTranslateM LocalContext := do pure (← read).sourceLCtx
def getSourceMCtx : MetaTranslateM MetavarContext := do pure (← read).sourceMCtx
+def addTranslatedFVar (src dst: FVarId) : MetaTranslateM Unit := do
+ let state ← get
+ set { state with fvarMap := state.fvarMap.insert src dst }
+def addTranslatedMVar (src dst: MVarId) : MetaTranslateM Unit := do
+ let state ← get
+ set { state with mvarMap := state.mvarMap.insert src dst }
-private def translateExpr (expr: Expr) : MetaTranslateM Expr := do
- let (expr, _) := instantiateMVarsCore (mctx := ← getSourceMCtx) expr
- return expr
+def resetFVarMap : MetaTranslateM Unit := do
+ let state ← get
+ set { state with fvarMap := {} }
-def translateLocalDecl (frozenLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
+private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
+ let (srcExpr, _) := instantiateMVarsCore (mctx := ← getSourceMCtx) srcExpr
+ --IO.println s!"Transform src: {srcExpr}"
+ let result ← Core.transform srcExpr λ e => do
+ let state ← get
+ match e with
+ | .fvar fvarId =>
+ let .some fvarId' := state.fvarMap.find? fvarId | panic! s!"FVar id not registered: {fvarId.name}"
+ return .done $ .fvar fvarId'
+ | .mvar mvarId => do
+ match state.mvarMap.find? mvarId with
+ | .some mvarId' => do
+ return .done $ .mvar mvarId'
+ | .none => do
+ --let t := (← getSourceMCtx).findDecl? mvarId |>.get!.type
+ --let t' ← translateExpr t
+ let mvar' ← Meta.mkFreshExprMVar .none
+ addTranslatedMVar mvarId mvar'.mvarId!
+ return .done mvar'
+ | _ => return .continue
+ try
+ Meta.check result
+ catch ex =>
+ panic! s!"Check failed: {← ex.toMessageData.toString}"
+ return result
+
+def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
let fvarId ← mkFreshFVarId
- match frozenLocalDecl with
- | .cdecl index _ userName type bi kind =>
- return .cdecl index fvarId userName type bi kind
- | .ldecl index _ userName type value nonDep kind =>
- return .ldecl index fvarId userName type value nonDep kind
+ addTranslatedFVar srcLocalDecl.fvarId fvarId
+ match srcLocalDecl with
+ | .cdecl index _ userName type bi kind => do
+ --IO.println s!"[CD] {userName} {toString type}"
+ return .cdecl index fvarId userName (← translateExpr type) bi kind
+ | .ldecl index _ userName type value nonDep kind => do
+ --IO.println s!"[LD] {toString type} := {toString value}"
+ return .ldecl index fvarId userName (← translateExpr type) (← translateExpr value) nonDep kind
-def translateMVarId (mvarId: MVarId) : MetaTranslateM MVarId := do
- let shadowDecl := (← getSourceMCtx).findDecl? mvarId |>.get!
- let target ← translateExpr shadowDecl.type
- let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := shadowDecl.lctx }) do
- let lctx ← MonadLCtx.getLCtx
- let lctx ← (← getSourceLCtx).foldlM (λ lctx frozenLocalDecl => do
- let localDecl ← translateLocalDecl frozenLocalDecl
- let lctx := lctx.addDecl localDecl
- pure lctx
- ) lctx
- withTheReader Meta.Context (fun ctx => { ctx with lctx }) do
- Meta.mkFreshExprSyntheticOpaqueMVar target
+def translateLCtx : MetaTranslateM LocalContext := do
+ resetFVarMap
+ (← getSourceLCtx).foldlM (λ lctx srcLocalDecl => do
+ let localDecl ← Meta.withLCtx lctx #[] do translateLocalDecl srcLocalDecl
+ pure $ lctx.addDecl localDecl
+ ) (← MonadLCtx.getLCtx)
+
+
+def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
+ let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
+ let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
+ let lctx' ← translateLCtx
+ Meta.withLCtx lctx' #[] do
+ let target' ← translateExpr srcDecl.type
+ Meta.mkFreshExprSyntheticOpaqueMVar target'
+ addTranslatedMVar srcMVarId mvar.mvarId!
return mvar.mvarId!
-def translateTermInfo (termInfo: Elab.TermInfo) : MetaM MVarId := do
+def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
+ : MetaM MVarId := do
let trM : MetaTranslateM MVarId := do
let type := termInfo.expectedType?.get!
- let lctx ← getSourceLCtx
- let mvar ← withTheReader Meta.Context (fun ctx => { ctx with lctx }) do
- Meta.mkFreshExprSyntheticOpaqueMVar type
+ let lctx' ← translateLCtx
+ let mvar ← Meta.withLCtx lctx' #[] do
+ let type' ← translateExpr type
+ Meta.mkFreshExprSyntheticOpaqueMVar type'
return mvar.mvarId!
- trM.run { sourceLCtx := termInfo.lctx }
+ trM.run {
+ sourceMCtx := context?.map (·.mctx) |>.getD {},
+ sourceLCtx := termInfo.lctx } |>.run' {}
-def translateTacticInfoBefore (tacticInfo: Elab.TacticInfo) : MetaM (List MVarId) := do
+def translateMVarFromTacticInfoBefore (tacticInfo : Elab.TacticInfo) (_context? : Option Elab.ContextInfo)
+ : MetaM (List MVarId) := do
let trM : MetaTranslateM (List MVarId) := do
tacticInfo.goalsBefore.mapM translateMVarId
- trM.run { sourceMCtx := tacticInfo.mctxBefore }
+ trM.run {
+ sourceMCtx := tacticInfo.mctxBefore
+ } |>.run' {}
end MetaTranslate
@@ -242,15 +297,15 @@ function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
-/
@[export pantograph_frontend_sorrys_to_goal_state]
-def sorrysToGoalState (sorrys : List Elab.Info) : MetaM GoalState := do
+def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty
- let goals ← sorrys.mapM λ info => Meta.withLCtx info.lctx #[] do
- match info with
+ let goals ← sorrys.mapM λ i => do
+ match i.info with
| .ofTermInfo termInfo => do
- let mvarId ← MetaTranslate.translateTermInfo termInfo
+ let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
return [mvarId]
| .ofTacticInfo tacticInfo => do
- MetaTranslate.translateTacticInfoBefore tacticInfo
+ MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
| _ => panic! "Invalid info"
let goals := goals.bind id
let root := match goals with
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index ac347e6..c186503 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -19,7 +19,7 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
return .some goalState
return goalStates
-def test_multiple_sorries_in_proof : TestT MetaM Unit := do
+def test_multiple_sorrys_in_proof : TestT MetaM Unit := do
let sketch := "
theorem plus_n_Sm_proved_formal_sketch : ∀ n m : Nat, n + (m + 1) = (n + m) + 1 := by
have h_nat_add_succ: ∀ n m : Nat, n = m := sorry
@@ -27,28 +27,112 @@ theorem plus_n_Sm_proved_formal_sketch : ∀ n m : Nat, n + (m + 1) = (n + m) +
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
let [goalState] := goalStates | panic! "Illegal number of states"
- addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})) = #[
+ addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
- name := "_uniq.1",
target := { pp? := "∀ (n m : Nat), n = m" },
vars := #[
]
},
{
- name := "_uniq.4",
target := { pp? := "∀ (n m : Nat), n + (m + 1) = n + m + 1" },
vars := #[{
- name := "_uniq.3",
userName := "h_nat_add_succ",
type? := .some { pp? := "∀ (n m : Nat), n = m" },
}],
}
])
+def test_sorry_in_middle: TestT MetaM Unit := do
+ let sketch := "
+example : ∀ (n m: Nat), n + m = m + n := by
+ intros n m
+ sorry
+ "
+ let goalStates ← (collectSorrysFromSource sketch).run' {}
+ let [goalState] := goalStates | panic! s!"Illegal number of states: {goalStates.length}"
+ addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ {
+ target := { pp? := "n + m = m + n" },
+ vars := #[{
+ userName := "n",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "m",
+ type? := .some { pp? := "Nat" },
+ }
+ ],
+ }
+ ])
+
+def test_sorry_in_induction : TestT MetaM Unit := do
+ let sketch := "
+example : ∀ (n m: Nat), n + m = m + n := by
+ intros n m
+ induction n with
+ | zero =>
+ have h1 : 0 + m = m := sorry
+ sorry
+ | succ n ih =>
+ have h2 : n + m = m := sorry
+ sorry
+ "
+ let goalStates ← (collectSorrysFromSource sketch).run' {}
+ let [goalState] := goalStates | panic! s!"Illegal number of states: {goalStates.length}"
+ addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ {
+ target := { pp? := "0 + m = m" },
+ vars := #[{
+ userName := "m",
+ type? := .some { pp? := "Nat" },
+ }]
+ },
+ {
+ target := { pp? := "0 + m = m + 0" },
+ vars := #[{
+ userName := "m",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "h1",
+ type? := .some { pp? := "0 + m = m" },
+ }]
+ },
+ {
+ target := { pp? := "n + m = m" },
+ vars := #[{
+ userName := "m",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "n",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "ih",
+ type? := .some { pp? := "n + m = m + n" },
+ }]
+ },
+ {
+ target := { pp? := "n + 1 + m = m + (n + 1)" },
+ vars := #[{
+ userName := "m",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "n",
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "ih",
+ type? := .some { pp? := "n + m = m + n" },
+ }, {
+ userName := "h2",
+ type? := .some { pp? := "n + m = m" },
+ }]
+ }
+ ])
+
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
- ("multiple_sorrys_in_proof", test_multiple_sorries_in_proof),
+ ("multiple_sorrys_in_proof", test_multiple_sorrys_in_proof),
+ ("sorry_in_middle", test_sorry_in_middle),
+ ("sorry_in_induction", test_sorry_in_induction),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 4a8e418..b3d49fe 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -201,9 +201,9 @@ def test_frontend_process_sorry : Test :=
[
let file := s!"{solved}{withSorry}"
let goal1: Protocol.Goal := {
- name := "_uniq.1",
+ name := "_uniq.6",
target := { pp? := .some "p → p" },
- vars := #[{ name := "_uniq.168", userName := "p", type? := .some { pp? := .some "Prop" }}],
+ vars := #[{ name := "_uniq.4", userName := "p", type? := .some { pp? := .some "Prop" }}],
}
step "frontend.process"
[
From 530a1a1a97273314bd7b01c542ce686a366aa0b9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 3 Oct 2024 11:35:54 -0700
Subject: [PATCH 296/465] fix: Extracting `sorry`s from coupled goals
---
Pantograph/Expr.lean | 87 ++++++++---------
Pantograph/Frontend.lean | 2 +-
Pantograph/Frontend/Elab.lean | 118 +---------------------
Pantograph/Frontend/MetaTranslate.lean | 129 +++++++++++++++++++++++++
Test/Frontend.lean | 49 ++++++++--
5 files changed, 221 insertions(+), 164 deletions(-)
create mode 100644 Pantograph/Frontend/MetaTranslate.lean
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index f989575..ad064a7 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -60,53 +60,54 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
-- nested mvars.
mvarId.setKind .syntheticOpaque
- let lctx ← MonadLCtx.getLCtx
- if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
- let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
- | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
- | .none => acc) []
- panic! s!"Local context variable violation: {violations}"
+ mvarId.withContext do
+ let lctx ← MonadLCtx.getLCtx
+ if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
+ let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
+ | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
+ | .none => acc) []
+ panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
- if let .some assign ← getExprMVarAssignment? mvarId then
- --IO.println s!"{padding}├A ?{mvarId.name}"
- assert! !(← mvarId.isDelayedAssigned)
- return .visit (mkAppN assign args)
- else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
- --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
- --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
+ if let .some assign ← getExprMVarAssignment? mvarId then
+ --IO.println s!"{padding}├A ?{mvarId.name}"
+ assert! !(← mvarId.isDelayedAssigned)
+ return .visit (mkAppN assign args)
+ else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
+ --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
- if args.size < fvars.size then
- throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments Begin"
- let args ← args.mapM self
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments End"
- if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
- --IO.println s!"{padding}├T1"
- let result := mkAppN f args
+ if args.size < fvars.size then
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments End"
+ if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
+ --IO.println s!"{padding}├T1"
+ let result := mkAppN f args
+ return .done result
+
+ let pending ← mvarIdPending.withContext do
+ let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
+ --IO.println s!"{padding}├Pre: {inner}"
+ pure <| (← inner.abstractM fvars).instantiateRev args
+
+ -- Tail arguments
+ let result := mkAppRange pending fvars.size args.size args
+ --IO.println s!"{padding}├MD {result}"
return .done result
+ else
+ assert! !(← mvarId.isAssigned)
+ assert! !(← mvarId.isDelayedAssigned)
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments End"
- let pending ← mvarIdPending.withContext do
- let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
- --IO.println s!"{padding}├Pre: {inner}"
- pure <| (← inner.abstractM fvars).instantiateRev args
-
- -- Tail arguments
- let result := mkAppRange pending fvars.size args.size args
- --IO.println s!"{padding}├MD {result}"
- return .done result
- else
- assert! !(← mvarId.isAssigned)
- assert! !(← mvarId.isDelayedAssigned)
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments Begin"
- let args ← args.mapM self
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments End"
-
- --IO.println s!"{padding}├M ?{mvarId.name}"
- return .done (mkAppN f args))
+ --IO.println s!"{padding}├M ?{mvarId.name}"
+ return .done (mkAppN f args))
--IO.println s!"{padding}└Result {result}"
return result
where
diff --git a/Pantograph/Frontend.lean b/Pantograph/Frontend.lean
index ffeeec5..fd91823 100644
--- a/Pantograph/Frontend.lean
+++ b/Pantograph/Frontend.lean
@@ -1,4 +1,4 @@
/- Adapted from lean-training-data by semorrison -/
-import Pantograph.Protocol
import Pantograph.Frontend.Basic
import Pantograph.Frontend.Elab
+import Pantograph.Frontend.MetaTranslate
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 2e0c14e..2036aea 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -3,9 +3,10 @@ import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
-import Pantograph.Protocol
import Pantograph.Frontend.Basic
+import Pantograph.Frontend.MetaTranslate
import Pantograph.Goal
+import Pantograph.Protocol
open Lean
@@ -179,117 +180,6 @@ def collectSorrys (step: CompilationStep) : List InfoWithContext :=
step.trees.bind collectSorrysInTree
-namespace MetaTranslate
-
-structure Context where
- sourceMCtx : MetavarContext := {}
- sourceLCtx : LocalContext := {}
-
-structure State where
- -- Stores mapping from old to new mvar/fvars
- mvarMap: HashMap MVarId MVarId := {}
- fvarMap: HashMap FVarId FVarId := {}
-
-/-
-Monadic state for translating a frozen meta state. The underlying `MetaM`
-operates in the "target" context and state.
--/
-abbrev MetaTranslateM := ReaderT Context StateRefT State MetaM
-
-def getSourceLCtx : MetaTranslateM LocalContext := do pure (← read).sourceLCtx
-def getSourceMCtx : MetaTranslateM MetavarContext := do pure (← read).sourceMCtx
-def addTranslatedFVar (src dst: FVarId) : MetaTranslateM Unit := do
- let state ← get
- set { state with fvarMap := state.fvarMap.insert src dst }
-def addTranslatedMVar (src dst: MVarId) : MetaTranslateM Unit := do
- let state ← get
- set { state with mvarMap := state.mvarMap.insert src dst }
-
-def resetFVarMap : MetaTranslateM Unit := do
- let state ← get
- set { state with fvarMap := {} }
-
-private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
- let (srcExpr, _) := instantiateMVarsCore (mctx := ← getSourceMCtx) srcExpr
- --IO.println s!"Transform src: {srcExpr}"
- let result ← Core.transform srcExpr λ e => do
- let state ← get
- match e with
- | .fvar fvarId =>
- let .some fvarId' := state.fvarMap.find? fvarId | panic! s!"FVar id not registered: {fvarId.name}"
- return .done $ .fvar fvarId'
- | .mvar mvarId => do
- match state.mvarMap.find? mvarId with
- | .some mvarId' => do
- return .done $ .mvar mvarId'
- | .none => do
- --let t := (← getSourceMCtx).findDecl? mvarId |>.get!.type
- --let t' ← translateExpr t
- let mvar' ← Meta.mkFreshExprMVar .none
- addTranslatedMVar mvarId mvar'.mvarId!
- return .done mvar'
- | _ => return .continue
- try
- Meta.check result
- catch ex =>
- panic! s!"Check failed: {← ex.toMessageData.toString}"
- return result
-
-def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
- let fvarId ← mkFreshFVarId
- addTranslatedFVar srcLocalDecl.fvarId fvarId
- match srcLocalDecl with
- | .cdecl index _ userName type bi kind => do
- --IO.println s!"[CD] {userName} {toString type}"
- return .cdecl index fvarId userName (← translateExpr type) bi kind
- | .ldecl index _ userName type value nonDep kind => do
- --IO.println s!"[LD] {toString type} := {toString value}"
- return .ldecl index fvarId userName (← translateExpr type) (← translateExpr value) nonDep kind
-
-def translateLCtx : MetaTranslateM LocalContext := do
- resetFVarMap
- (← getSourceLCtx).foldlM (λ lctx srcLocalDecl => do
- let localDecl ← Meta.withLCtx lctx #[] do translateLocalDecl srcLocalDecl
- pure $ lctx.addDecl localDecl
- ) (← MonadLCtx.getLCtx)
-
-
-def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
- let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
- let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
- let lctx' ← translateLCtx
- Meta.withLCtx lctx' #[] do
- let target' ← translateExpr srcDecl.type
- Meta.mkFreshExprSyntheticOpaqueMVar target'
- addTranslatedMVar srcMVarId mvar.mvarId!
- return mvar.mvarId!
-
-def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
- : MetaM MVarId := do
- let trM : MetaTranslateM MVarId := do
- let type := termInfo.expectedType?.get!
- let lctx' ← translateLCtx
- let mvar ← Meta.withLCtx lctx' #[] do
- let type' ← translateExpr type
- Meta.mkFreshExprSyntheticOpaqueMVar type'
- return mvar.mvarId!
- trM.run {
- sourceMCtx := context?.map (·.mctx) |>.getD {},
- sourceLCtx := termInfo.lctx } |>.run' {}
-
-
-def translateMVarFromTacticInfoBefore (tacticInfo : Elab.TacticInfo) (_context? : Option Elab.ContextInfo)
- : MetaM (List MVarId) := do
- let trM : MetaTranslateM (List MVarId) := do
- tacticInfo.goalsBefore.mapM translateMVarId
- trM.run {
- sourceMCtx := tacticInfo.mctxBefore
- } |>.run' {}
-
-
-end MetaTranslate
-
-export MetaTranslate (MetaTranslateM)
/--
Since we cannot directly merge `MetavarContext`s, we have to get creative. This
@@ -299,7 +189,7 @@ the current `MetavarContext`.
@[export pantograph_frontend_sorrys_to_goal_state]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty
- let goals ← sorrys.mapM λ i => do
+ let goalsM := sorrys.mapM λ i => do
match i.info with
| .ofTermInfo termInfo => do
let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
@@ -307,7 +197,7 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
| .ofTacticInfo tacticInfo => do
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
| _ => panic! "Invalid info"
- let goals := goals.bind id
+ let goals := (← goalsM.run {} |>.run' {}).bind id
let root := match goals with
| [] => panic! "This function cannot be called on an empty list"
| [g] => g
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
new file mode 100644
index 0000000..82f8dfc
--- /dev/null
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -0,0 +1,129 @@
+import Lean.Meta
+
+open Lean
+
+namespace Pantograph.Frontend
+
+namespace MetaTranslate
+
+structure Context where
+ sourceMCtx : MetavarContext := {}
+ sourceLCtx : LocalContext := {}
+
+abbrev FVarMap := HashMap FVarId FVarId
+
+structure State where
+ -- Stores mapping from old to new mvar/fvars
+ mvarMap: HashMap MVarId MVarId := {}
+ fvarMap: HashMap FVarId FVarId := {}
+
+/-
+Monadic state for translating a frozen meta state. The underlying `MetaM`
+operates in the "target" context and state.
+-/
+abbrev MetaTranslateM := ReaderT Context StateRefT State MetaM
+
+def getSourceLCtx : MetaTranslateM LocalContext := do pure (← read).sourceLCtx
+def getSourceMCtx : MetaTranslateM MetavarContext := do pure (← read).sourceMCtx
+def addTranslatedFVar (src dst: FVarId) : MetaTranslateM Unit := do
+ modifyGet λ state => ((), { state with fvarMap := state.fvarMap.insert src dst })
+def addTranslatedMVar (src dst: MVarId) : MetaTranslateM Unit := do
+ modifyGet λ state => ((), { state with mvarMap := state.mvarMap.insert src dst })
+
+def saveFVarMap : MetaTranslateM FVarMap := do
+ return (← get).fvarMap
+def restoreFVarMap (map: FVarMap) : MetaTranslateM Unit := do
+ modifyGet λ state => ((), { state with fvarMap := map })
+def resetFVarMap : MetaTranslateM Unit := do
+ modifyGet λ state => ((), { state with fvarMap := {} })
+
+mutual
+private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
+ let sourceMCtx ← getSourceMCtx
+ let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
+ --IO.println s!"Transform src: {srcExpr}"
+ let result ← Core.transform srcExpr λ e => do
+ let state ← get
+ match e with
+ | .fvar fvarId =>
+ let .some fvarId' := state.fvarMap.find? fvarId | panic! s!"FVar id not registered: {fvarId.name}"
+ assert! (← getLCtx).contains fvarId'
+ return .done $ .fvar fvarId'
+ | .mvar mvarId => do
+ assert! !(sourceMCtx.dAssignment.contains mvarId)
+ assert! !(sourceMCtx.eAssignment.contains mvarId)
+ match state.mvarMap.find? mvarId with
+ | .some mvarId' => do
+ return .done $ .mvar mvarId'
+ | .none => do
+ -- Entering another LCtx, must save the current one
+ let fvarMap ← saveFVarMap
+ let mvarId' ← translateMVarId mvarId
+ restoreFVarMap fvarMap
+ return .done $ .mvar mvarId'
+ | _ => return .continue
+ Meta.check result
+ return result
+
+partial def translateLocalInstance (srcInstance: LocalInstance) : MetaTranslateM LocalInstance := do
+ return {
+ className := srcInstance.className,
+ fvar := ← translateExpr srcInstance.fvar
+ }
+partial def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalDecl := do
+ let fvarId ← mkFreshFVarId
+ addTranslatedFVar srcLocalDecl.fvarId fvarId
+ match srcLocalDecl with
+ | .cdecl index _ userName type bi kind => do
+ --IO.println s!"[CD] {userName} {toString type}"
+ return .cdecl index fvarId userName (← translateExpr type) bi kind
+ | .ldecl index _ userName type value nonDep kind => do
+ --IO.println s!"[LD] {toString type} := {toString value}"
+ return .ldecl index fvarId userName (← translateExpr type) (← translateExpr value) nonDep kind
+
+partial def translateLCtx : MetaTranslateM LocalContext := do
+ resetFVarMap
+ (← getSourceLCtx).foldlM (λ lctx srcLocalDecl => do
+ let localDecl ← Meta.withLCtx lctx #[] do translateLocalDecl srcLocalDecl
+ pure $ lctx.addDecl localDecl
+ ) (← MonadLCtx.getLCtx)
+
+partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
+ if let .some mvarId' := (← get).mvarMap.find? srcMVarId then
+ return mvarId'
+ let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
+ let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
+ let lctx' ← translateLCtx
+ let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
+ Meta.withLCtx lctx' localInstances' do
+ let target' ← translateExpr srcDecl.type
+ Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
+ addTranslatedMVar srcMVarId mvar.mvarId!
+ return mvar.mvarId!
+end
+
+def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
+ : MetaTranslateM MVarId := do
+ withTheReader Context (λ ctx => { ctx with
+ sourceMCtx := context?.map (·.mctx) |>.getD {},
+ sourceLCtx := termInfo.lctx,
+ }) do
+ let type := termInfo.expectedType?.get!
+ let lctx' ← translateLCtx
+ let mvar ← Meta.withLCtx lctx' #[] do
+ let type' ← translateExpr type
+ Meta.mkFreshExprSyntheticOpaqueMVar type'
+ return mvar.mvarId!
+
+
+def translateMVarFromTacticInfoBefore (tacticInfo : Elab.TacticInfo) (_context? : Option Elab.ContextInfo)
+ : MetaTranslateM (List MVarId) := do
+ withTheReader Context (λ ctx => { ctx with sourceMCtx := tacticInfo.mctxBefore }) do
+ tacticInfo.goalsBefore.mapM translateMVarId
+
+
+end MetaTranslate
+
+export MetaTranslate (MetaTranslateM)
+
+end Pantograph.Frontend
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index c186503..b09ef81 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -26,8 +26,8 @@ theorem plus_n_Sm_proved_formal_sketch : ∀ n m : Nat, n + (m + 1) = (n + m) +
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
- let [goalState] := goalStates | panic! "Illegal number of states"
- addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ let [goalState] := goalStates | panic! "Incorrect number of states"
+ addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "∀ (n m : Nat), n = m" },
vars := #[
@@ -49,8 +49,8 @@ example : ∀ (n m: Nat), n + m = m + n := by
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
- let [goalState] := goalStates | panic! s!"Illegal number of states: {goalStates.length}"
- addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "n + m = m + n" },
vars := #[{
@@ -77,8 +77,8 @@ example : ∀ (n m: Nat), n + m = m + n := by
sorry
"
let goalStates ← (collectSorrysFromSource sketch).run' {}
- let [goalState] := goalStates | panic! s!"Illegal number of states: {goalStates.length}"
- addTest $ LSpec.check "plus_n_Sm" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
{
target := { pp? := "0 + m = m" },
vars := #[{
@@ -87,6 +87,7 @@ example : ∀ (n m: Nat), n + m = m + n := by
}]
},
{
+ userName? := .some "zero",
target := { pp? := "0 + m = m + 0" },
vars := #[{
userName := "m",
@@ -110,6 +111,7 @@ example : ∀ (n m: Nat), n + m = m + n := by
}]
},
{
+ userName? := .some "succ",
target := { pp? := "n + 1 + m = m + (n + 1)" },
vars := #[{
userName := "m",
@@ -127,12 +129,47 @@ example : ∀ (n m: Nat), n + m = m + n := by
}
])
+def test_sorry_in_coupled: TestT MetaM Unit := do
+ let sketch := "
+example : ∀ (y: Nat), ∃ (x: Nat), y + 1 = x := by
+ intro y
+ apply Exists.intro
+ case h => sorry
+ case w => sorry
+ "
+ let goalStates ← (collectSorrysFromSource sketch).run' {}
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ {
+ target := { pp? := "y + 1 = ?w" },
+ vars := #[{
+ userName := "y",
+ type? := .some { pp? := "Nat" },
+ }
+ ],
+ },
+ {
+ userName? := .some "w",
+ target := { pp? := "Nat" },
+ vars := #[{
+ userName := "y✝",
+ isInaccessible := true,
+ type? := .some { pp? := "Nat" },
+ }, {
+ userName := "y",
+ type? := .some { pp? := "Nat" },
+ }
+ ],
+ }
+ ])
+
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("multiple_sorrys_in_proof", test_multiple_sorrys_in_proof),
("sorry_in_middle", test_sorry_in_middle),
("sorry_in_induction", test_sorry_in_induction),
+ ("sorry_in_coupled", test_sorry_in_coupled),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
From a03eeddc9bea63caf91b20bdbbbd4cf9e5133b79 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 3 Oct 2024 11:46:09 -0700
Subject: [PATCH 297/465] fix: Variable duplication in nested translation
---
Pantograph/Frontend/MetaTranslate.lean | 22 +++++++++++++---------
Test/Frontend.lean | 4 ----
2 files changed, 13 insertions(+), 13 deletions(-)
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index 82f8dfc..1a12029 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -83,21 +83,25 @@ partial def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalD
partial def translateLCtx : MetaTranslateM LocalContext := do
resetFVarMap
+ let lctx ← MonadLCtx.getLCtx
+ assert! lctx.isEmpty
(← getSourceLCtx).foldlM (λ lctx srcLocalDecl => do
- let localDecl ← Meta.withLCtx lctx #[] do translateLocalDecl srcLocalDecl
+ let localDecl ← Meta.withLCtx lctx #[] do
+ translateLocalDecl srcLocalDecl
pure $ lctx.addDecl localDecl
- ) (← MonadLCtx.getLCtx)
+ ) lctx
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
if let .some mvarId' := (← get).mvarMap.find? srcMVarId then
return mvarId'
- let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
- let mvar ← withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
- let lctx' ← translateLCtx
- let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
- Meta.withLCtx lctx' localInstances' do
- let target' ← translateExpr srcDecl.type
- Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
+ let mvar ← Meta.withLCtx .empty #[] do
+ let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
+ withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
+ let lctx' ← translateLCtx
+ let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
+ Meta.withLCtx lctx' localInstances' do
+ let target' ← translateExpr srcDecl.type
+ Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
addTranslatedMVar srcMVarId mvar.mvarId!
return mvar.mvarId!
end
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index b09ef81..68d961b 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -152,10 +152,6 @@ example : ∀ (y: Nat), ∃ (x: Nat), y + 1 = x := by
userName? := .some "w",
target := { pp? := "Nat" },
vars := #[{
- userName := "y✝",
- isInaccessible := true,
- type? := .some { pp? := "Nat" },
- }, {
userName := "y",
type? := .some { pp? := "Nat" },
}
From d0321e72ddb477a5eea1ebee346c5ee00512d22e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 5 Oct 2024 14:49:17 -0700
Subject: [PATCH 298/465] feat: Add message diagnostics to frontend.process
---
Pantograph/Frontend/Basic.lean | 8 +++++++
Pantograph/Protocol.lean | 13 +++++++---
Repl.lean | 43 +++++++++++++++++-----------------
Test/Integration.lean | 43 ++++++++++++++++++----------------
4 files changed, 63 insertions(+), 44 deletions(-)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 933424c..1074a94 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -42,6 +42,14 @@ structure CompilationStep where
msgs : List Message
trees : List Elab.InfoTree
+namespace CompilationStep
+
+@[export pantograph_frontend_compilation_step_message_strings_m]
+def messageStrings (step: CompilationStep) : IO (Array String) := do
+ List.toArray <$> step.msgs.mapM (·.toString)
+
+end CompilationStep
+
/--
Process one command, returning a `CompilationStep` and
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index abfeede..acc2681 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -298,11 +298,18 @@ structure InvokedTactic where
goalAfter: String
tactic: String
deriving Lean.ToJson
-structure FrontendProcessResult where
+
+structure CompilationUnit where
-- String boundaries of compilation units
- units: List (Nat × Nat)
+ boundary: (Nat × Nat)
+ -- Tactic invocations
invocations?: Option (List InvokedTactic) := .none
- goalStates?: Option (List (Nat × Array Goal)) := .none
+ goalStateId?: Option Nat := .none
+ goals: Array Goal := #[]
+ messages: Array String := #[]
+ deriving Lean.ToJson
+structure FrontendProcessResult where
+ units: List CompilationUnit
deriving Lean.ToJson
abbrev CR α := Except InteractionError α
diff --git a/Repl.lean b/Repl.lean
index 1277e73..7597164 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -216,35 +216,36 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let env ← Lean.MonadEnv.getEnv
pure <| .some env
let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
- let m := Frontend.mapCompilationSteps λ step => do
- let unitBoundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
- let tacticInvocations ← if args.invocations then
- Frontend.collectTacticsFromCompilationStep step
+ let frontendM := Frontend.mapCompilationSteps λ step => do
+ let boundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ let invocations?: Option (List Protocol.InvokedTactic) ← if args.invocations then
+ let invocations ← Frontend.collectTacticsFromCompilationStep step
+ pure $ .some invocations
else
- pure []
+ pure .none
let sorrys := if args.sorrys then
Frontend.collectSorrys step
else
[]
- return (unitBoundary, tacticInvocations, sorrys)
- let li ← m.run context |>.run' state
- let units := li.map λ (unit, _, _) => unit
- let invocations? := if args.invocations then
- .some $ li.bind λ (_, invocations, _) => invocations
- else
- .none
- let goalStates? ← if args.sorrys then do
- let stateIds ← li.filterMapM λ (_, _, sorrys) => do
- if sorrys.isEmpty then
- return .none
+ let messages ← step.messageStrings
+ return (boundary, invocations?, sorrys, messages)
+ let li ← frontendM.run context |>.run' state
+ let units ← li.mapM λ (boundary, invocations?, sorrys, messages) => do
+ let (goalStateId?, goals) ← if sorrys.isEmpty then do
+ pure (.none, #[])
+ else do
let goalState ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
let stateId ← newGoalState goalState
let goals ← goalSerialize goalState options
- return .some (stateId, goals)
- pure $ .some stateIds
- else
- pure .none
- return .ok { units, invocations?, goalStates? }
+ pure (.some stateId, goals)
+ return {
+ boundary,
+ invocations?,
+ goalStateId?,
+ goals,
+ messages,
+ }
+ return .ok { units }
catch e =>
return .error $ errorI "frontend" (← e.toMessageData.toString)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index b3d49fe..413ed1c 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -176,19 +176,21 @@ def test_frontend_process : Test :=
("sorrys", .bool false),
]
({
- units := [(0, file.utf8ByteSize)],
- invocations? := .some [
- {
- goalBefore := "⊢ ∀ (p : Prop), p → p",
- goalAfter := goal1,
- tactic := "intro p h",
- },
- {
- goalBefore := goal1 ,
- goalAfter := "",
- tactic := "exact h",
- },
- ]
+ units := [{
+ boundary := (0, file.utf8ByteSize),
+ invocations? := .some [
+ {
+ goalBefore := "⊢ ∀ (p : Prop), p → p",
+ goalAfter := goal1,
+ tactic := "intro p h",
+ },
+ {
+ goalBefore := goal1 ,
+ goalAfter := "",
+ tactic := "exact h",
+ },
+ ]
+ }],
}: Protocol.FrontendProcessResult),
]
@@ -212,13 +214,14 @@ def test_frontend_process_sorry : Test :=
("sorrys", .bool true),
]
({
- units := [
- (0, solved.utf8ByteSize),
- (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
- ],
- goalStates? := [
- (0, #[goal1]),
- ]
+ units := [{
+ boundary := (0, solved.utf8ByteSize),
+ }, {
+ boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
+ goalStateId? := .some 0,
+ goals := #[goal1],
+ messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
+ }],
}: Protocol.FrontendProcessResult),
]
From c3076cbb7d8c5b4c536c902f5639eea1f873ad24 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 6 Oct 2024 16:10:18 -0700
Subject: [PATCH 299/465] chore: Update Lean to v4.12.0
---
Pantograph/Expr.lean | 5 +++--
Pantograph/Frontend/MetaTranslate.lean | 13 +++++++------
Repl.lean | 25 +++++++++++++++----------
flake.nix | 4 ++--
lake-manifest.json | 9 +++++----
lakefile.lean | 2 +-
lean-toolchain | 2 +-
7 files changed, 34 insertions(+), 26 deletions(-)
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
index ad064a7..a13ffec 100644
--- a/Pantograph/Expr.lean
+++ b/Pantograph/Expr.lean
@@ -1,4 +1,5 @@
import Lean
+import Std.Data.HashMap
open Lean
@@ -144,10 +145,10 @@ def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := d
assert! args.size ≥ decl.fvars.size
assert! !(← mvarIdPending.isAssigned)
assert! !(← mvarIdPending.isDelayedAssigned)
- let fvarArgMap: HashMap FVarId Expr := HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
+ let fvarArgMap: Std.HashMap FVarId Expr := Std.HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
let fvarId := localDecl.fvarId
- let a := fvarArgMap.find? fvarId
+ let a := fvarArgMap[fvarId]?
return acc ++ [(fvarId, a)]
assert! decl.fvars.all (λ fvar => mvarDecl.lctx.findFVar? fvar |>.isSome)
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index 1a12029..2586486 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -1,4 +1,5 @@
import Lean.Meta
+import Std.Data.HashMap
open Lean
@@ -10,12 +11,12 @@ structure Context where
sourceMCtx : MetavarContext := {}
sourceLCtx : LocalContext := {}
-abbrev FVarMap := HashMap FVarId FVarId
+abbrev FVarMap := Std.HashMap FVarId FVarId
structure State where
-- Stores mapping from old to new mvar/fvars
- mvarMap: HashMap MVarId MVarId := {}
- fvarMap: HashMap FVarId FVarId := {}
+ mvarMap: Std.HashMap MVarId MVarId := {}
+ fvarMap: Std.HashMap FVarId FVarId := {}
/-
Monadic state for translating a frozen meta state. The underlying `MetaM`
@@ -46,13 +47,13 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let state ← get
match e with
| .fvar fvarId =>
- let .some fvarId' := state.fvarMap.find? fvarId | panic! s!"FVar id not registered: {fvarId.name}"
+ let .some fvarId' := state.fvarMap[fvarId]? | panic! s!"FVar id not registered: {fvarId.name}"
assert! (← getLCtx).contains fvarId'
return .done $ .fvar fvarId'
| .mvar mvarId => do
assert! !(sourceMCtx.dAssignment.contains mvarId)
assert! !(sourceMCtx.eAssignment.contains mvarId)
- match state.mvarMap.find? mvarId with
+ match state.mvarMap[mvarId]? with
| .some mvarId' => do
return .done $ .mvar mvarId'
| .none => do
@@ -92,7 +93,7 @@ partial def translateLCtx : MetaTranslateM LocalContext := do
) lctx
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
- if let .some mvarId' := (← get).mvarMap.find? srcMVarId then
+ if let .some mvarId' := (← get).mvarMap[srcMVarId]? then
return mvarId'
let mvar ← Meta.withLCtx .empty #[] do
let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
diff --git a/Repl.lean b/Repl.lean
index 7597164..f36f8b6 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -1,4 +1,4 @@
-import Lean.Data.HashMap
+import Std.Data.HashMap
import Pantograph
namespace Pantograph.Repl
@@ -10,7 +10,7 @@ structure Context where
structure State where
options: Protocol.Options := {}
nextId: Nat := 0
- goalStates: Lean.HashMap Nat GoalState := Lean.HashMap.empty
+ goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
@@ -66,7 +66,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
let nGoals := state.goalStates.size
- set { state with nextId := 0, goalStates := Lean.HashMap.empty }
+ set { state with nextId := 0, goalStates := .empty }
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -119,7 +119,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
let state ← get
- let .some goalState := state.goalStates.find? args.stateId |
+ let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
let .some goal := goalState.goals.get? args.goalId |
return .error $ errorIndex s!"Invalid goal index {args.goalId}"
@@ -146,12 +146,15 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .ok (.success nextGoalState) => do
let nextGoalState ← match state.options.automaticMode, args.conv? with
| true, .none => do
- let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) | throwError "Resuming known goals"
+ let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) |
+ throwError "Resuming known goals"
pure result
| true, .some true => pure nextGoalState
| true, .some false => do
- let .some (_, _, dormantGoals) := goalState.convMVar? | throwError "If conv exit succeeded this should not fail"
- let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) | throwError "Resuming known goals"
+ let .some (_, _, dormantGoals) := goalState.convMVar? |
+ throwError "If conv exit succeeded this should not fail"
+ let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) |
+ throwError "Resuming known goals"
pure result
| false, _ => pure nextGoalState
let nextStateId ← newGoalState nextGoalState
@@ -168,10 +171,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
let state ← get
- let .some target := state.goalStates.find? args.target | return .error $ errorIndex s!"Invalid state index {args.target}"
+ let .some target := state.goalStates[args.target]? |
+ return .error $ errorIndex s!"Invalid state index {args.target}"
let nextState? ← match args.branch?, args.goals? with
| .some branchId, .none => do
- match state.goalStates.find? branchId with
+ match state.goalStates[branchId]? with
| .none => return .error $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
@@ -197,7 +201,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
let state ← get
- let .some goalState := state.goalStates.find? args.stateId | return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ let .some goalState := state.goalStates[args.stateId]? |
+ return .error $ errorIndex s!"Invalid state index {args.stateId}"
let result ← runMetaInMainM <| goalPrint goalState state.options
return .ok result
frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
diff --git a/flake.nix b/flake.nix
index 70c84b5..50729cb 100644
--- a/flake.nix
+++ b/flake.nix
@@ -6,10 +6,10 @@
flake-parts.url = "github:hercules-ci/flake-parts";
lean = {
# Do not follow input's nixpkgs since it could cause build failures
- url = "github:leanprover/lean4?ref=v4.10.0-rc1";
+ url = "github:leanprover/lean4?ref=v4.12.0";
};
lspec = {
- url = "github:lurk-lab/LSpec?ref=8a51034d049c6a229d88dd62f490778a377eec06";
+ url = "github:lenianiva/LSpec?ref=c492cecd0bc473e2f9c8b94d545d02cc0056034f";
flake = false;
};
};
diff --git a/lake-manifest.json b/lake-manifest.json
index 6ebbbe5..e1545af 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,13 +1,14 @@
-{"version": 7,
+{"version": "1.1.0",
"packagesDir": ".lake/packages",
"packages":
- [{"url": "https://github.com/lurk-lab/LSpec.git",
+ [{"url": "https://github.com/lenianiva/LSpec.git",
"type": "git",
"subDir": null,
- "rev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "scope": "",
+ "rev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"name": "LSpec",
"manifestFile": "lake-manifest.json",
- "inputRev": "3388be5a1d1390594a74ec469fd54a5d84ff6114",
+ "inputRev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"inherited": false,
"configFile": "lakefile.lean"}],
"name": "pantograph",
diff --git a/lakefile.lean b/lakefile.lean
index e29fa0e..2aa3986 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -18,7 +18,7 @@ lean_exe repl {
}
require LSpec from git
- "https://github.com/lurk-lab/LSpec.git" @ "3388be5a1d1390594a74ec469fd54a5d84ff6114"
+ "https://github.com/lenianiva/LSpec.git" @ "c492cecd0bc473e2f9c8b94d545d02cc0056034f"
lean_lib Test {
}
@[test_driver]
diff --git a/lean-toolchain b/lean-toolchain
index d69d1ed..8998520 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.10.0-rc1
+leanprover/lean4:v4.12.0
From 8d774d32813218ddbde55487f156c25cee4fd7b7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 4 Oct 2024 12:58:16 -0700
Subject: [PATCH 300/465] feat: Remove most filters on catalog
---
Pantograph/Environment.lean | 10 +++-------
Test/Environment.lean | 2 +-
2 files changed, 4 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 37faf72..ef4a40e 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -10,16 +10,12 @@ namespace Pantograph.Environment
@[export pantograph_is_name_internal]
def isNameInternal (n: Name): Bool :=
-- Returns true if the name is an implementation detail which should not be shown to the user.
- isLeanSymbol n ∨ (Lean.privateToUserName? n |>.map isLeanSymbol |>.getD false) ∨ n.isAuxLemma ∨ n.hasMacroScopes
- where
- isLeanSymbol (name: Name): Bool := match name.getRoot with
- | .str _ name => name == "Lean"
- | _ => true
+ n.isAuxLemma ∨ n.hasMacroScopes
/-- Catalog all the non-internal and safe names -/
@[export pantograph_environment_catalog]
-def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name info =>
- match isNameInternal name || info.isUnsafe with
+def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[]) (λ acc name _ =>
+ match isNameInternal name with
| false => acc.push name
| true => acc)
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 631ea54..6b418f7 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -33,7 +33,7 @@ def test_catalog: IO LSpec.TestSeq := do
def test_symbol_visibility: IO LSpec.TestSeq := do
let entries: List (Name × Bool) := [
("Nat.add_comm".toName, false),
- ("Lean.Name".toName, true),
+ ("foo.bla.Init.Data.List.Basic.2.1.Init.Lean.Expr._hyg.4".toName, true),
("Init.Data.Nat.Basic._auxLemma.4".toName, true),
]
let suite := entries.foldl (λ suites (symbol, target) =>
From 9119f47a8f2d1d281975c30a7301a734fbd4eecf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 5 Oct 2024 10:29:20 -0700
Subject: [PATCH 301/465] chore: Remove more thin wrappers
---
Pantograph/Environment.lean | 8 --------
1 file changed, 8 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index ef4a40e..040d801 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -24,14 +24,6 @@ def module_of_name (env: Environment) (name: Name): Option Name := do
let moduleId ← env.getModuleIdxFor? name
return env.allImportedModuleNames.get! moduleId.toNat
-@[export pantograph_constant_info_is_unsafe_or_partial]
-def constantInfoIsUnsafeOrPartial (info: ConstantInfo): Bool := info.isUnsafe || info.isPartial
-
-@[export pantograph_constant_info_type]
-def constantInfoType (info: ConstantInfo): CoreM Expr := unfoldAuxLemmas info.type
-@[export pantograph_constant_info_value]
-def constantInfoValue (info: ConstantInfo): CoreM (Option Expr) := info.value?.mapM unfoldAuxLemmas
-
def toCompactSymbolName (n: Name) (info: ConstantInfo): String :=
let pref := match info with
| .axiomInfo _ => "a"
From c3494edc750f776689d25c0cd59a3b718583145a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 6 Oct 2024 16:46:39 -0700
Subject: [PATCH 302/465] fix: Flake build
---
flake.lock | 135 +++++++++++++----------------------------------------
flake.nix | 2 +-
2 files changed, 34 insertions(+), 103 deletions(-)
diff --git a/flake.lock b/flake.lock
index e9b7a7b..1e07c88 100644
--- a/flake.lock
+++ b/flake.lock
@@ -36,111 +36,74 @@
"lean": {
"inputs": {
"flake-utils": "flake-utils",
- "lean4-mode": "lean4-mode",
- "nix": "nix",
- "nixpkgs": "nixpkgs_2",
+ "nixpkgs": "nixpkgs",
+ "nixpkgs-cadical": "nixpkgs-cadical",
"nixpkgs-old": "nixpkgs-old"
},
"locked": {
- "lastModified": 1719788866,
- "narHash": "sha256-kB2cp1XJKODXiuiKp7J5OK+PFP+sOSBE5gdVNOKWCPI=",
+ "lastModified": 1727749878,
+ "narHash": "sha256-O2Egyh2D0TfQWzQKfHUeAh7qAjMfeLVwXwGUw5QqcvE=",
"owner": "leanprover",
"repo": "lean4",
- "rev": "3b58e0649156610ce3aeed4f7b5c652340c668d4",
+ "rev": "dc2533473114eb8656439ff2b9335209784aa640",
"type": "github"
},
"original": {
"owner": "leanprover",
- "ref": "v4.10.0-rc1",
+ "ref": "v4.12.0",
"repo": "lean4",
"type": "github"
}
},
- "lean4-mode": {
- "flake": false,
- "locked": {
- "lastModified": 1676498134,
- "narHash": "sha256-u3WvyKxOViZG53hkb8wd2/Og6muTecbh+NdflIgVeyk=",
- "owner": "leanprover",
- "repo": "lean4-mode",
- "rev": "2c6ef33f476fdf5eb5e4fa4fa023ba8b11372440",
- "type": "github"
- },
- "original": {
- "owner": "leanprover",
- "repo": "lean4-mode",
- "type": "github"
- }
- },
- "lowdown-src": {
- "flake": false,
- "locked": {
- "lastModified": 1633514407,
- "narHash": "sha256-Dw32tiMjdK9t3ETl5fzGrutQTzh2rufgZV4A/BbxuD4=",
- "owner": "kristapsdz",
- "repo": "lowdown",
- "rev": "d2c2b44ff6c27b936ec27358a2653caaef8f73b8",
- "type": "github"
- },
- "original": {
- "owner": "kristapsdz",
- "repo": "lowdown",
- "type": "github"
- }
- },
"lspec": {
"flake": false,
"locked": {
- "lastModified": 1722857503,
- "narHash": "sha256-F9uaymiw1wTCLrJm4n1Bpk3J8jW6poedQzvnnQlZ6Kw=",
- "owner": "lurk-lab",
+ "lastModified": 1728255812,
+ "narHash": "sha256-ZMqbvCqR/gHXRuIkuo7b0Yp9N1vOQR7xnrcy/SeIBoQ=",
+ "owner": "lenianiva",
"repo": "LSpec",
- "rev": "8a51034d049c6a229d88dd62f490778a377eec06",
+ "rev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"type": "github"
},
"original": {
- "owner": "lurk-lab",
- "ref": "8a51034d049c6a229d88dd62f490778a377eec06",
+ "owner": "lenianiva",
+ "ref": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
"repo": "LSpec",
"type": "github"
}
},
- "nix": {
- "inputs": {
- "lowdown-src": "lowdown-src",
- "nixpkgs": "nixpkgs",
- "nixpkgs-regression": "nixpkgs-regression"
- },
- "locked": {
- "lastModified": 1657097207,
- "narHash": "sha256-SmeGmjWM3fEed3kQjqIAO8VpGmkC2sL1aPE7kKpK650=",
- "owner": "NixOS",
- "repo": "nix",
- "rev": "f6316b49a0c37172bca87ede6ea8144d7d89832f",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "repo": "nix",
- "type": "github"
- }
- },
"nixpkgs": {
"locked": {
- "lastModified": 1653988320,
- "narHash": "sha256-ZaqFFsSDipZ6KVqriwM34T739+KLYJvNmCWzErjAg7c=",
+ "lastModified": 1686089707,
+ "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
"owner": "NixOS",
"repo": "nixpkgs",
- "rev": "2fa57ed190fd6c7c746319444f34b5917666e5c1",
+ "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
"type": "github"
},
"original": {
"owner": "NixOS",
- "ref": "nixos-22.05-small",
+ "ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
+ "nixpkgs-cadical": {
+ "locked": {
+ "lastModified": 1722221733,
+ "narHash": "sha256-sga9SrrPb+pQJxG1ttJfMPheZvDOxApFfwXCFO0H9xw=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
+ "type": "github"
+ }
+ },
"nixpkgs-lib": {
"locked": {
"dir": "lib",
@@ -176,39 +139,7 @@
"type": "github"
}
},
- "nixpkgs-regression": {
- "locked": {
- "lastModified": 1643052045,
- "narHash": "sha256-uGJ0VXIhWKGXxkeNnq4TvV3CIOkUJ3PAoLZ3HMzNVMw=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "215d4d0fd80ca5163643b03a33fde804a29cc1e2",
- "type": "github"
- }
- },
"nixpkgs_2": {
- "locked": {
- "lastModified": 1686089707,
- "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "ref": "nixpkgs-unstable",
- "repo": "nixpkgs",
- "type": "github"
- }
- },
- "nixpkgs_3": {
"locked": {
"lastModified": 1711703276,
"narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
@@ -229,7 +160,7 @@
"flake-parts": "flake-parts",
"lean": "lean",
"lspec": "lspec",
- "nixpkgs": "nixpkgs_3"
+ "nixpkgs": "nixpkgs_2"
}
}
},
diff --git a/flake.nix b/flake.nix
index 50729cb..f1d4a46 100644
--- a/flake.nix
+++ b/flake.nix
@@ -29,7 +29,7 @@
"x86_64-darwin"
];
perSystem = { system, pkgs, ... }: let
- leanPkgs = lean.packages.${system};
+ leanPkgs = lean.packages.${system}.deprecated;
lspecLib = leanPkgs.buildLeanPackage {
name = "LSpec";
roots = [ "Main" "LSpec" ];
From 2e1276c21c9a3c16cc8319b19b06d9e39571fb5e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Oct 2024 00:15:30 -0700
Subject: [PATCH 303/465] chore: Update LSpec dependency
---
flake.lock | 10 +++++-----
flake.nix | 2 +-
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/flake.lock b/flake.lock
index 1e07c88..dc83369 100644
--- a/flake.lock
+++ b/flake.lock
@@ -58,16 +58,16 @@
"lspec": {
"flake": false,
"locked": {
- "lastModified": 1728255812,
+ "lastModified": 1728279187,
"narHash": "sha256-ZMqbvCqR/gHXRuIkuo7b0Yp9N1vOQR7xnrcy/SeIBoQ=",
- "owner": "lenianiva",
+ "owner": "argumentcomputer",
"repo": "LSpec",
- "rev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
+ "rev": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
"type": "github"
},
"original": {
- "owner": "lenianiva",
- "ref": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
+ "owner": "argumentcomputer",
+ "ref": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
"repo": "LSpec",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index f1d4a46..d4c903f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -9,7 +9,7 @@
url = "github:leanprover/lean4?ref=v4.12.0";
};
lspec = {
- url = "github:lenianiva/LSpec?ref=c492cecd0bc473e2f9c8b94d545d02cc0056034f";
+ url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
flake = false;
};
};
From 5e776a1b49e02e5ecc75d7011ac488fcc2b514ce Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Oct 2024 00:17:31 -0700
Subject: [PATCH 304/465] feat: Catch and print IO errors
---
Main.lean | 15 ++++++++++-----
1 file changed, 10 insertions(+), 5 deletions(-)
diff --git a/Main.lean b/Main.lean
index b866711..16f2e6a 100644
--- a/Main.lean
+++ b/Main.lean
@@ -33,11 +33,16 @@ partial def loop : MainM Unit := do
-- Using `Lean.Json.compress` here to prevent newline
IO.println error.compress
| .ok command =>
- let ret ← execute command
- let str := match state.options.printJsonPretty with
- | true => ret.pretty
- | false => ret.compress
- IO.println str
+ try
+ let ret ← execute command
+ let str := match state.options.printJsonPretty with
+ | true => ret.pretty
+ | false => ret.compress
+ IO.println str
+ catch e =>
+ let message ← e.toMessageData.toString
+ let error := Lean.toJson ({ error := "io", desc := message }: InteractionError)
+ IO.println error.compress
loop
From 05d0b7739ac12d8b031d8b0451fc74f79c8a7e08 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Oct 2024 00:45:45 -0700
Subject: [PATCH 305/465] feat: Catch IO errors in json format
---
Main.lean | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/Main.lean b/Main.lean
index 16f2e6a..be01ff6 100644
--- a/Main.lean
+++ b/Main.lean
@@ -41,7 +41,7 @@ partial def loop : MainM Unit := do
IO.println str
catch e =>
let message ← e.toMessageData.toString
- let error := Lean.toJson ({ error := "io", desc := message }: InteractionError)
+ let error := Lean.toJson ({ error := "main", desc := message }: InteractionError)
IO.println error.compress
loop
@@ -50,7 +50,7 @@ unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
-- Separate imports and options
if args == ["--version"] then do
- println! s!"{Pantograph.version}"
+ IO.println s!"{Pantograph.version}"
return
Pantograph.initSearch ""
@@ -67,5 +67,6 @@ unsafe def main (args: List String): IO Unit := do
IO.println "ready."
discard <| coreM.toIO coreContext coreState
catch ex =>
- IO.println "Uncaught IO exception"
- IO.println ex.toString
+ let message := ex.toString
+ let error := Lean.toJson ({ error := "io", desc := message }: InteractionError)
+ IO.println error.compress
From 420e863756b7de85497d45463be780cad883b213 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Oct 2024 10:32:16 -0700
Subject: [PATCH 306/465] fix: Delayed mvars in MetaTranslate
---
Pantograph/Frontend/Elab.lean | 9 +++++----
Pantograph/Frontend/MetaTranslate.lean | 17 ++++++++++++-----
2 files changed, 17 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 2036aea..6245877 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -168,9 +168,10 @@ private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
let infos := findAllInfo t none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
- | .ofTacticInfo { stx, .. } =>
+ | .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic
- stx.isOfKind `Lean.Parser.Tactic.tacticSorry
+ let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
+ isSorry ∧ !goalsBefore.isEmpty
| _ => false
infos.map fun (info, context?, _) => { info, context? }
@@ -197,9 +198,9 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
| .ofTacticInfo tacticInfo => do
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
| _ => panic! "Invalid info"
- let goals := (← goalsM.run {} |>.run' {}).bind id
+ let goals := List.join (← goalsM.run {} |>.run' {})
let root := match goals with
- | [] => panic! "This function cannot be called on an empty list"
+ | [] => panic! "No MVars generated"
| [g] => g
| _ => { name := .anonymous }
GoalState.createFromMVars goals root
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index 2586486..9b64a43 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -41,6 +41,7 @@ def resetFVarMap : MetaTranslateM Unit := do
mutual
private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let sourceMCtx ← getSourceMCtx
+ -- We want to create as few mvars as possible
let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
--IO.println s!"Transform src: {srcExpr}"
let result ← Core.transform srcExpr λ e => do
@@ -51,7 +52,7 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
assert! (← getLCtx).contains fvarId'
return .done $ .fvar fvarId'
| .mvar mvarId => do
- assert! !(sourceMCtx.dAssignment.contains mvarId)
+ -- Must not be assigned
assert! !(sourceMCtx.eAssignment.contains mvarId)
match state.mvarMap[mvarId]? with
| .some mvarId' => do
@@ -95,16 +96,22 @@ partial def translateLCtx : MetaTranslateM LocalContext := do
partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
if let .some mvarId' := (← get).mvarMap[srcMVarId]? then
return mvarId'
- let mvar ← Meta.withLCtx .empty #[] do
+ let mvarId' ← Meta.withLCtx .empty #[] do
let srcDecl := (← getSourceMCtx).findDecl? srcMVarId |>.get!
withTheReader Context (λ ctx => { ctx with sourceLCtx := srcDecl.lctx }) do
let lctx' ← translateLCtx
let localInstances' ← srcDecl.localInstances.mapM translateLocalInstance
Meta.withLCtx lctx' localInstances' do
let target' ← translateExpr srcDecl.type
- Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
- addTranslatedMVar srcMVarId mvar.mvarId!
- return mvar.mvarId!
+ let mvar' ← Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
+ let mvarId' := mvar'.mvarId!
+ if let .some { fvars, mvarIdPending }:= (← getSourceMCtx).getDelayedMVarAssignmentExp srcMVarId then
+ let fvars' ← fvars.mapM translateExpr
+ let mvarIdPending' ← translateMVarId mvarIdPending
+ assignDelayedMVar mvarId' fvars' mvarIdPending'
+ pure mvarId'
+ addTranslatedMVar srcMVarId mvarId'
+ return mvarId'
end
def translateMVarFromTermInfo (termInfo : Elab.TermInfo) (context? : Option Elab.ContextInfo)
From 0e8c9f890b1bf4746a9ba5a6e24b7a38a896f994 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Oct 2024 14:28:35 -0700
Subject: [PATCH 307/465] fix: Translate fvars in pending context
---
Pantograph/Frontend/MetaTranslate.lean | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index 9b64a43..68e4d49 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -106,8 +106,9 @@ partial def translateMVarId (srcMVarId: MVarId) : MetaTranslateM MVarId := do
let mvar' ← Meta.mkFreshExprMVar target' srcDecl.kind srcDecl.userName
let mvarId' := mvar'.mvarId!
if let .some { fvars, mvarIdPending }:= (← getSourceMCtx).getDelayedMVarAssignmentExp srcMVarId then
- let fvars' ← fvars.mapM translateExpr
+ -- Map the fvars in the pending context.
let mvarIdPending' ← translateMVarId mvarIdPending
+ let fvars' ← mvarIdPending'.withContext $ fvars.mapM translateExpr
assignDelayedMVar mvarId' fvars' mvarIdPending'
pure mvarId'
addTranslatedMVar srcMVarId mvarId'
From 641f8c38830f112e0fe7d2a7666fc368002f182e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 9 Oct 2024 15:49:10 -0700
Subject: [PATCH 308/465] fix: Translate level mvars
---
Pantograph/Frontend/MetaTranslate.lean | 22 ++++++++++++++++++++++
1 file changed, 22 insertions(+)
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index 68e4d49..bd3568d 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -39,6 +39,25 @@ def resetFVarMap : MetaTranslateM Unit := do
modifyGet λ state => ((), { state with fvarMap := {} })
mutual
+private partial def translateLevel (srcLevel: Level) : MetaTranslateM Level := do
+ let sourceMCtx ← getSourceMCtx
+ let (_, level) := instantiateLevelMVarsImp sourceMCtx srcLevel
+ match level with
+ | .zero => return .zero
+ | .succ inner => do
+ let inner' ← translateLevel inner
+ return .succ inner'
+ | .max l1 l2 => do
+ let l1' ← translateLevel l1
+ let l2' ← translateLevel l2
+ return .max l1' l2'
+ | .imax l1 l2 => do
+ let l1' ← translateLevel l1
+ let l2' ← translateLevel l2
+ return .imax l1' l2'
+ | .param p => return .param p
+ | .mvar _ =>
+ Meta.mkFreshLevelMVar
private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let sourceMCtx ← getSourceMCtx
-- We want to create as few mvars as possible
@@ -63,6 +82,9 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let mvarId' ← translateMVarId mvarId
restoreFVarMap fvarMap
return .done $ .mvar mvarId'
+ | .sort level => do
+ let level' ← translateLevel level
+ return .done $ .sort level'
| _ => return .continue
Meta.check result
return result
From 645d9c9250bf306bdf13d085a222ce03de8aa836 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 12 Oct 2024 16:17:21 -0700
Subject: [PATCH 309/465] feat: Let tactic in REPL
---
Pantograph/Protocol.lean | 1 +
Repl.lean | 19 +++++++++++--------
2 files changed, 12 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index acc2681..2ba073e 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -219,6 +219,7 @@ structure GoalTactic where
tactic?: Option String := .none
expr?: Option String := .none
have?: Option String := .none
+ let?: Option String := .none
calc?: Option String := .none
-- true to enter `conv`, `false` to exit. In case of exit the `goalId` is ignored.
conv?: Option Bool := .none
diff --git a/Repl.lean b/Repl.lean
index f36f8b6..3f30e3d 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -124,21 +124,24 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let .some goal := goalState.goals.get? args.goalId |
return .error $ errorIndex s!"Invalid goal index {args.goalId}"
let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
- match args.tactic?, args.expr?, args.have?, args.calc?, args.conv? with
- | .some tactic, .none, .none, .none, .none => do
+ match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv? with
+ | .some tactic, .none, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryTactic goal tactic
- | .none, .some expr, .none, .none, .none => do
+ | .none, .some expr, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryAssign goal expr
- | .none, .none, .some type, .none, .none => do
+ | .none, .none, .some type, .none, .none, .none => do
let binderName := args.binderName?.getD ""
pure <| Except.ok <| ← goalState.tryHave goal binderName type
- | .none, .none, .none, .some pred, .none => do
+ | .none, .none, .none, .some type, .none, .none => do
+ let binderName := args.binderName?.getD ""
+ pure <| Except.ok <| ← goalState.tryLet goal binderName type
+ | .none, .none, .none, .none, .some pred, .none => do
pure <| Except.ok <| ← goalState.tryCalc goal pred
- | .none, .none, .none, .none, .some true => do
+ | .none, .none, .none, .none, .none, .some true => do
pure <| Except.ok <| ← goalState.conv goal
- | .none, .none, .none, .none, .some false => do
+ | .none, .none, .none, .none, .none, .some false => do
pure <| Except.ok <| ← goalState.convExit
- | _, _, _, _, _ =>
+ | _, _, _, _, _, _ =>
let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
pure $ Except.error $ error
match nextGoalState? with
From 5a2ae880f4be4b4ea440ffad03d276253fc324d1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 12 Oct 2024 16:46:44 -0700
Subject: [PATCH 310/465] feat: Capture environment in drafting
---
Repl.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index f36f8b6..8734f0e 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -233,9 +233,9 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
else
[]
let messages ← step.messageStrings
- return (boundary, invocations?, sorrys, messages)
+ return (step.before, boundary, invocations?, sorrys, messages)
let li ← frontendM.run context |>.run' state
- let units ← li.mapM λ (boundary, invocations?, sorrys, messages) => do
+ let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages) => Lean.withEnv env do
let (goalStateId?, goals) ← if sorrys.isEmpty then do
pure (.none, #[])
else do
From 946e688dec66caca5896e4963a9004f6673ac7d3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 12 Oct 2024 16:52:36 -0700
Subject: [PATCH 311/465] test(frontend): Environment capture
---
Test/Frontend.lean | 23 +++++++++++++++++++++--
1 file changed, 21 insertions(+), 2 deletions(-)
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 68d961b..015cfa8 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -10,9 +10,9 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
- return Frontend.collectSorrys step
+ return (step.before, Frontend.collectSorrys step)
let li ← m.run context |>.run' state
- let goalStates ← li.filterMapM λ sorrys => do
+ let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
if sorrys.isEmpty then
return .none
let goalState ← Frontend.sorrysToGoalState sorrys
@@ -159,6 +159,24 @@ example : ∀ (y: Nat), ∃ (x: Nat), y + 1 = x := by
}
])
+def test_environment_capture: TestT MetaM Unit := do
+ let sketch := "
+def mystery (n: Nat) := n + 1
+
+example (n: Nat) : mystery n + 1 = n + 2 := sorry
+ "
+ let goalStates ← (collectSorrysFromSource sketch).run' {}
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ addTest $ LSpec.check "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize) = #[
+ {
+ target := { pp? := "mystery n + 1 = n + 2" },
+ vars := #[{
+ userName := "n",
+ type? := .some { pp? := "Nat" },
+ }],
+ }
+ ])
+
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
@@ -166,6 +184,7 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_middle", test_sorry_in_middle),
("sorry_in_induction", test_sorry_in_induction),
("sorry_in_coupled", test_sorry_in_coupled),
+ ("environment_capture", test_environment_capture),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
From d23f99fd44802ad688ba89b357a64cf8098345cc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 14 Oct 2024 21:16:41 -0700
Subject: [PATCH 312/465] feat: Update Lean4 upstream to unofficial flake
---
flake.lock | 98 +++++++++++++++++++++++++++---------------------------
flake.nix | 9 ++---
2 files changed, 52 insertions(+), 55 deletions(-)
diff --git a/flake.lock b/flake.lock
index dc83369..5bd2d47 100644
--- a/flake.lock
+++ b/flake.lock
@@ -19,12 +19,15 @@
}
},
"flake-utils": {
+ "inputs": {
+ "systems": "systems"
+ },
"locked": {
- "lastModified": 1656928814,
- "narHash": "sha256-RIFfgBuKz6Hp89yRr7+NR5tzIAbn52h8vT6vXkYjZoM=",
+ "lastModified": 1726560853,
+ "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=",
"owner": "numtide",
"repo": "flake-utils",
- "rev": "7e2a3b3dfd9af950a856d66b0a7d01e3c18aa249",
+ "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a",
"type": "github"
},
"original": {
@@ -34,12 +37,7 @@
}
},
"lean": {
- "inputs": {
- "flake-utils": "flake-utils",
- "nixpkgs": "nixpkgs",
- "nixpkgs-cadical": "nixpkgs-cadical",
- "nixpkgs-old": "nixpkgs-old"
- },
+ "flake": false,
"locked": {
"lastModified": 1727749878,
"narHash": "sha256-O2Egyh2D0TfQWzQKfHUeAh7qAjMfeLVwXwGUw5QqcvE=",
@@ -55,6 +53,26 @@
"type": "github"
}
},
+ "lean4-nix": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "lean": "lean",
+ "nixpkgs": "nixpkgs"
+ },
+ "locked": {
+ "lastModified": 1728965016,
+ "narHash": "sha256-DB1k6zpRp6KMuSQm/JcuyherqJ2n39CaGhfiEbA8VNI=",
+ "owner": "lenianiva",
+ "repo": "lean4-nix",
+ "rev": "e18ea1c5035e35db56e080ad4311a40fd1a75eea",
+ "type": "github"
+ },
+ "original": {
+ "owner": "lenianiva",
+ "repo": "lean4-nix",
+ "type": "github"
+ }
+ },
"lspec": {
"flake": false,
"locked": {
@@ -74,36 +92,20 @@
},
"nixpkgs": {
"locked": {
- "lastModified": 1686089707,
- "narHash": "sha256-LTNlJcru2qJ0XhlhG9Acp5KyjB774Pza3tRH0pKIb3o=",
- "owner": "NixOS",
+ "lastModified": 1728500571,
+ "narHash": "sha256-dOymOQ3AfNI4Z337yEwHGohrVQb4yPODCW9MDUyAc4w=",
+ "owner": "nixos",
"repo": "nixpkgs",
- "rev": "af21c31b2a1ec5d361ed8050edd0303c31306397",
+ "rev": "d51c28603def282a24fa034bcb007e2bcb5b5dd0",
"type": "github"
},
"original": {
- "owner": "NixOS",
- "ref": "nixpkgs-unstable",
+ "owner": "nixos",
+ "ref": "nixos-24.05",
"repo": "nixpkgs",
"type": "github"
}
},
- "nixpkgs-cadical": {
- "locked": {
- "lastModified": 1722221733,
- "narHash": "sha256-sga9SrrPb+pQJxG1ttJfMPheZvDOxApFfwXCFO0H9xw=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "12bf09802d77264e441f48e25459c10c93eada2e",
- "type": "github"
- }
- },
"nixpkgs-lib": {
"locked": {
"dir": "lib",
@@ -122,23 +124,6 @@
"type": "github"
}
},
- "nixpkgs-old": {
- "flake": false,
- "locked": {
- "lastModified": 1581379743,
- "narHash": "sha256-i1XCn9rKuLjvCdu2UeXKzGLF6IuQePQKFt4hEKRU5oc=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "34c7eb7545d155cc5b6f499b23a7cb1c96ab4d59",
- "type": "github"
- },
- "original": {
- "owner": "NixOS",
- "ref": "nixos-19.03",
- "repo": "nixpkgs",
- "type": "github"
- }
- },
"nixpkgs_2": {
"locked": {
"lastModified": 1711703276,
@@ -158,10 +143,25 @@
"root": {
"inputs": {
"flake-parts": "flake-parts",
- "lean": "lean",
+ "lean4-nix": "lean4-nix",
"lspec": "lspec",
"nixpkgs": "nixpkgs_2"
}
+ },
+ "systems": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
}
},
"root": "root",
diff --git a/flake.nix b/flake.nix
index d4c903f..a573368 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,10 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean = {
- # Do not follow input's nixpkgs since it could cause build failures
- url = "github:leanprover/lean4?ref=v4.12.0";
- };
+ lean4-nix.url = "github:lenianiva/lean4-nix";
lspec = {
url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
flake = false;
@@ -18,7 +15,7 @@
self,
nixpkgs,
flake-parts,
- lean,
+ lean4-nix,
lspec,
...
} : flake-parts.lib.mkFlake { inherit inputs; } {
@@ -29,7 +26,7 @@
"x86_64-darwin"
];
perSystem = { system, pkgs, ... }: let
- leanPkgs = lean.packages.${system}.deprecated;
+ leanPkgs = lean4-nix.packages.${system};
lspecLib = leanPkgs.buildLeanPackage {
name = "LSpec";
roots = [ "Main" "LSpec" ];
From 8fe4c78c2aea194869bb7b4b7e61087b6374ff66 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 21 Oct 2024 09:59:13 -0700
Subject: [PATCH 313/465] doc: Change license to Apache2
---
LICENSE | 864 +++++++++++++-------------------------------------------
1 file changed, 190 insertions(+), 674 deletions(-)
diff --git a/LICENSE b/LICENSE
index f288702..34f63a3 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,674 +1,190 @@
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU General Public License is a free, copyleft license for
-software and other kinds of works.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-the GNU General Public License is intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users. We, the Free Software Foundation, use the
-GNU General Public License for most of our software; it applies also to
-any other work released this way by its authors. You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- To protect your rights, we need to prevent others from denying you
-these rights or asking you to surrender the rights. Therefore, you have
-certain responsibilities if you distribute copies of the software, or if
-you modify it: responsibilities to respect the freedom of others.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must pass on to the recipients the same
-freedoms that you received. You must make sure that they, too, receive
-or can get the source code. And you must show them these terms so they
-know their rights.
-
- Developers that use the GNU GPL protect your rights with two steps:
-(1) assert copyright on the software, and (2) offer you this License
-giving you legal permission to copy, distribute and/or modify it.
-
- For the developers' and authors' protection, the GPL clearly explains
-that there is no warranty for this free software. For both users' and
-authors' sake, the GPL requires that modified versions be marked as
-changed, so that their problems will not be attributed erroneously to
-authors of previous versions.
-
- Some devices are designed to deny users access to install or run
-modified versions of the software inside them, although the manufacturer
-can do so. This is fundamentally incompatible with the aim of
-protecting users' freedom to change the software. The systematic
-pattern of such abuse occurs in the area of products for individuals to
-use, which is precisely where it is most unacceptable. Therefore, we
-have designed this version of the GPL to prohibit the practice for those
-products. If such problems arise substantially in other domains, we
-stand ready to extend this provision to those domains in future versions
-of the GPL, as needed to protect the freedom of users.
-
- Finally, every program is threatened constantly by software patents.
-States should not allow patents to restrict development and use of
-software on general-purpose computers, but in those that do, we wish to
-avoid the special danger that patents applied to a free program could
-make it effectively proprietary. To prevent this, the GPL assures that
-patents cannot be used to render the program non-free.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Use with the GNU Affero General Public License.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU Affero General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the special requirements of the GNU Affero General Public License,
-section 13, concerning interaction through a network will apply to the
-combination as such.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
- If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
-
- <program> Copyright (C) <year> <name of author>
- This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, your program's commands
-might be different; for a GUI interface, you would use an "about box".
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU GPL, see
-<https://www.gnu.org/licenses/>.
-
- The GNU General Public License does not permit incorporating your program
-into proprietary programs. If your program is a subroutine library, you
-may consider it more useful to permit linking proprietary applications with
-the library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License. But first, please read
-<https://www.gnu.org/licenses/why-not-lgpl.html>.
+ Apache License
+ Version 2.0, January 2004
+ http://www.apache.org/licenses/
+
+ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+ 1. Definitions.
+
+ "License" shall mean the terms and conditions for use, reproduction,
+ and distribution as defined by Sections 1 through 9 of this document.
+
+ "Licensor" shall mean the copyright owner or entity authorized by
+ the copyright owner that is granting the License.
+
+ "Legal Entity" shall mean the union of the acting entity and all
+ other entities that control, are controlled by, or are under common
+ control with that entity. For the purposes of this definition,
+ "control" means (i) the power, direct or indirect, to cause the
+ direction or management of such entity, whether by contract or
+ otherwise, or (ii) ownership of fifty percent (50%) or more of the
+ outstanding shares, or (iii) beneficial ownership of such entity.
+
+ "You" (or "Your") shall mean an individual or Legal Entity
+ exercising permissions granted by this License.
+
+ "Source" form shall mean the preferred form for making modifications,
+ including but not limited to software source code, documentation
+ source, and configuration files.
+
+ "Object" form shall mean any form resulting from mechanical
+ transformation or translation of a Source form, including but
+ not limited to compiled object code, generated documentation,
+ and conversions to other media types.
+
+ "Work" shall mean the work of authorship, whether in Source or
+ Object form, made available under the License, as indicated by a
+ copyright notice that is included in or attached to the work
+ (an example is provided in the Appendix below).
+
+ "Derivative Works" shall mean any work, whether in Source or Object
+ form, that is based on (or derived from) the Work and for which the
+ editorial revisions, annotations, elaborations, or other modifications
+ represent, as a whole, an original work of authorship. For the purposes
+ of this License, Derivative Works shall not include works that remain
+ separable from, or merely link (or bind by name) to the interfaces of,
+ the Work and Derivative Works thereof.
+
+ "Contribution" shall mean any work of authorship, including
+ the original version of the Work and any modifications or additions
+ to that Work or Derivative Works thereof, that is intentionally
+ submitted to Licensor for inclusion in the Work by the copyright owner
+ or by an individual or Legal Entity authorized to submit on behalf of
+ the copyright owner. For the purposes of this definition, "submitted"
+ means any form of electronic, verbal, or written communication sent
+ to the Licensor or its representatives, including but not limited to
+ communication on electronic mailing lists, source code control systems,
+ and issue tracking systems that are managed by, or on behalf of, the
+ Licensor for the purpose of discussing and improving the Work, but
+ excluding communication that is conspicuously marked or otherwise
+ designated in writing by the copyright owner as "Not a Contribution."
+
+ "Contributor" shall mean Licensor and any individual or Legal Entity
+ on behalf of whom a Contribution has been received by Licensor and
+ subsequently incorporated within the Work.
+
+ 2. Grant of Copyright License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ copyright license to reproduce, prepare Derivative Works of,
+ publicly display, publicly perform, sublicense, and distribute the
+ Work and such Derivative Works in Source or Object form.
+
+ 3. Grant of Patent License. Subject to the terms and conditions of
+ this License, each Contributor hereby grants to You a perpetual,
+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+ (except as stated in this section) patent license to make, have made,
+ use, offer to sell, sell, import, and otherwise transfer the Work,
+ where such license applies only to those patent claims licensable
+ by such Contributor that are necessarily infringed by their
+ Contribution(s) alone or by combination of their Contribution(s)
+ with the Work to which such Contribution(s) was submitted. If You
+ institute patent litigation against any entity (including a
+ cross-claim or counterclaim in a lawsuit) alleging that the Work
+ or a Contribution incorporated within the Work constitutes direct
+ or contributory patent infringement, then any patent licenses
+ granted to You under this License for that Work shall terminate
+ as of the date such litigation is filed.
+
+ 4. Redistribution. You may reproduce and distribute copies of the
+ Work or Derivative Works thereof in any medium, with or without
+ modifications, and in Source or Object form, provided that You
+ meet the following conditions:
+
+ (a) You must give any other recipients of the Work or
+ Derivative Works a copy of this License; and
+
+ (b) You must cause any modified files to carry prominent notices
+ stating that You changed the files; and
+
+ (c) You must retain, in the Source form of any Derivative Works
+ that You distribute, all copyright, patent, trademark, and
+ attribution notices from the Source form of the Work,
+ excluding those notices that do not pertain to any part of
+ the Derivative Works; and
+
+ (d) If the Work includes a "NOTICE" text file as part of its
+ distribution, then any Derivative Works that You distribute must
+ include a readable copy of the attribution notices contained
+ within such NOTICE file, excluding those notices that do not
+ pertain to any part of the Derivative Works, in at least one
+ of the following places: within a NOTICE text file distributed
+ as part of the Derivative Works; within the Source form or
+ documentation, if provided along with the Derivative Works; or,
+ within a display generated by the Derivative Works, if and
+ wherever such third-party notices normally appear. The contents
+ of the NOTICE file are for informational purposes only and
+ do not modify the License. You may add Your own attribution
+ notices within Derivative Works that You distribute, alongside
+ or as an addendum to the NOTICE text from the Work, provided
+ that such additional attribution notices cannot be construed
+ as modifying the License.
+
+ You may add Your own copyright statement to Your modifications and
+ may provide additional or different license terms and conditions
+ for use, reproduction, or distribution of Your modifications, or
+ for any such Derivative Works as a whole, provided Your use,
+ reproduction, and distribution of the Work otherwise complies with
+ the conditions stated in this License.
+
+ 5. Submission of Contributions. Unless You explicitly state otherwise,
+ any Contribution intentionally submitted for inclusion in the Work
+ by You to the Licensor shall be under the terms and conditions of
+ this License, without any additional terms or conditions.
+ Notwithstanding the above, nothing herein shall supersede or modify
+ the terms of any separate license agreement you may have executed
+ with Licensor regarding such Contributions.
+
+ 6. Trademarks. This License does not grant permission to use the trade
+ names, trademarks, service marks, or product names of the Licensor,
+ except as required for reasonable and customary use in describing the
+ origin of the Work and reproducing the content of the NOTICE file.
+
+ 7. Disclaimer of Warranty. Unless required by applicable law or
+ agreed to in writing, Licensor provides the Work (and each
+ Contributor provides its Contributions) on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+ implied, including, without limitation, any warranties or conditions
+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+ PARTICULAR PURPOSE. You are solely responsible for determining the
+ appropriateness of using or redistributing the Work and assume any
+ risks associated with Your exercise of permissions under this License.
+
+ 8. Limitation of Liability. In no event and under no legal theory,
+ whether in tort (including negligence), contract, or otherwise,
+ unless required by applicable law (such as deliberate and grossly
+ negligent acts) or agreed to in writing, shall any Contributor be
+ liable to You for damages, including any direct, indirect, special,
+ incidental, or consequential damages of any character arising as a
+ result of this License or out of the use or inability to use the
+ Work (including but not limited to damages for loss of goodwill,
+ work stoppage, computer failure or malfunction, or any and all
+ other commercial damages or losses), even if such Contributor
+ has been advised of the possibility of such damages.
+
+ 9. Accepting Warranty or Additional Liability. While redistributing
+ the Work or Derivative Works thereof, You may choose to offer,
+ and charge a fee for, acceptance of support, warranty, indemnity,
+ or other liability obligations and/or rights consistent with this
+ License. However, in accepting such obligations, You may act only
+ on Your own behalf and on Your sole responsibility, not on behalf
+ of any other Contributor, and only if You agree to indemnify,
+ defend, and hold each Contributor harmless for any liability
+ incurred by, or claims asserted against, such Contributor by reason
+ of your accepting any such warranty or additional liability.
+
+ END OF TERMS AND CONDITIONS
+
+ Copyright 2024 Leni Aniva
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
From 23efed960b890ad2c8bc8e87ad30c6f539e05c40 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 26 Oct 2024 13:49:03 -0700
Subject: [PATCH 314/465] chore: Update `lean4-nix`
---
flake.lock | 103 ++++++++++++++++++++---------------------------------
flake.nix | 24 +++++++------
2 files changed, 52 insertions(+), 75 deletions(-)
diff --git a/flake.lock b/flake.lock
index 5bd2d47..7617c3a 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1709336216,
- "narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
+ "lastModified": 1727826117,
+ "narHash": "sha256-K5ZLCyfO/Zj9mPFldf3iwS6oZStJcU4tSpiXTMYaaL0=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
+ "rev": "3d04084d54bedc3d6b8b736c70ef449225c361b1",
"type": "github"
},
"original": {
@@ -18,53 +18,35 @@
"type": "github"
}
},
- "flake-utils": {
+ "flake-parts_2": {
"inputs": {
- "systems": "systems"
+ "nixpkgs-lib": "nixpkgs-lib_2"
},
"locked": {
- "lastModified": 1726560853,
- "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=",
- "owner": "numtide",
- "repo": "flake-utils",
- "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a",
+ "lastModified": 1727826117,
+ "narHash": "sha256-K5ZLCyfO/Zj9mPFldf3iwS6oZStJcU4tSpiXTMYaaL0=",
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "rev": "3d04084d54bedc3d6b8b736c70ef449225c361b1",
"type": "github"
},
"original": {
- "owner": "numtide",
- "repo": "flake-utils",
- "type": "github"
- }
- },
- "lean": {
- "flake": false,
- "locked": {
- "lastModified": 1727749878,
- "narHash": "sha256-O2Egyh2D0TfQWzQKfHUeAh7qAjMfeLVwXwGUw5QqcvE=",
- "owner": "leanprover",
- "repo": "lean4",
- "rev": "dc2533473114eb8656439ff2b9335209784aa640",
- "type": "github"
- },
- "original": {
- "owner": "leanprover",
- "ref": "v4.12.0",
- "repo": "lean4",
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
"type": "github"
}
},
"lean4-nix": {
"inputs": {
- "flake-utils": "flake-utils",
- "lean": "lean",
+ "flake-parts": "flake-parts_2",
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1728965016,
- "narHash": "sha256-DB1k6zpRp6KMuSQm/JcuyherqJ2n39CaGhfiEbA8VNI=",
+ "lastModified": 1729966280,
+ "narHash": "sha256-8G0n9POJW2zITB1m2h9+0GHA6lNlfsd2kssEqYLfK/U=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "e18ea1c5035e35db56e080ad4311a40fd1a75eea",
+ "rev": "169dfe5e5db6038801ecfdbe4391cb14c5e8d454",
"type": "github"
},
"original": {
@@ -108,34 +90,40 @@
},
"nixpkgs-lib": {
"locked": {
- "dir": "lib",
- "lastModified": 1709237383,
- "narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
- "owner": "NixOS",
- "repo": "nixpkgs",
- "rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
- "type": "github"
+ "lastModified": 1727825735,
+ "narHash": "sha256-0xHYkMkeLVQAMa7gvkddbPqpxph+hDzdu1XdGPJR+Os=",
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
},
"original": {
- "dir": "lib",
- "owner": "NixOS",
- "ref": "nixos-unstable",
- "repo": "nixpkgs",
- "type": "github"
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
+ }
+ },
+ "nixpkgs-lib_2": {
+ "locked": {
+ "lastModified": 1727825735,
+ "narHash": "sha256-0xHYkMkeLVQAMa7gvkddbPqpxph+hDzdu1XdGPJR+Os=",
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
+ },
+ "original": {
+ "type": "tarball",
+ "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
}
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1711703276,
- "narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
+ "lastModified": 1729691686,
+ "narHash": "sha256-BAuPWW+9fa1moZTU+jFh+1cUtmsuF8asgzFwejM4wac=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "d8fe5e6c92d0d190646fb9f1056741a229980089",
+ "rev": "32e940c7c420600ef0d1ef396dc63b04ee9cad37",
"type": "github"
},
"original": {
"owner": "nixos",
- "ref": "nixos-unstable",
+ "ref": "nixos-24.05",
"repo": "nixpkgs",
"type": "github"
}
@@ -147,21 +135,6 @@
"lspec": "lspec",
"nixpkgs": "nixpkgs_2"
}
- },
- "systems": {
- "locked": {
- "lastModified": 1681028828,
- "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
- "owner": "nix-systems",
- "repo": "default",
- "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
- "type": "github"
- },
- "original": {
- "owner": "nix-systems",
- "repo": "default",
- "type": "github"
- }
}
},
"root": "root",
diff --git a/flake.nix b/flake.nix
index a573368..a2d0263 100644
--- a/flake.nix
+++ b/flake.nix
@@ -2,7 +2,7 @@
description = "Pantograph";
inputs = {
- nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
+ nixpkgs.url = "github:nixos/nixpkgs/nixos-24.05";
flake-parts.url = "github:hercules-ci/flake-parts";
lean4-nix.url = "github:lenianiva/lean4-nix";
lspec = {
@@ -26,13 +26,16 @@
"x86_64-darwin"
];
perSystem = { system, pkgs, ... }: let
- leanPkgs = lean4-nix.packages.${system};
- lspecLib = leanPkgs.buildLeanPackage {
+ pkgs = import nixpkgs {
+ inherit system;
+ overlays = [ lean4-nix.tags."v4.12.0" ];
+ };
+ lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
roots = [ "Main" "LSpec" ];
src = "${lspec}";
};
- project = leanPkgs.buildLeanPackage {
+ project = pkgs.lean.buildLeanPackage {
name = "Pantograph";
roots = [ "Pantograph" ];
src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
@@ -43,7 +46,7 @@
!(pkgs.lib.hasSuffix "Repl.lean" path);
});
};
- repl = leanPkgs.buildLeanPackage {
+ repl = pkgs.lean.buildLeanPackage {
name = "Repl";
roots = [ "Main" "Repl" ];
deps = [ project ];
@@ -54,7 +57,7 @@
!(pkgs.lib.hasSuffix ".md" path);
});
};
- test = leanPkgs.buildLeanPackage {
+ test = pkgs.lean.buildLeanPackage {
name = "Test";
# NOTE: The src directory must be ./. since that is where the import
# root begins (e.g. `import Test.Environment` and not `import
@@ -69,24 +72,25 @@
};
in rec {
packages = {
- inherit (leanPkgs) lean lean-all;
+ inherit (pkgs.lean) lean lean-all;
inherit (project) sharedLib;
inherit (repl) executable;
default = repl.executable;
};
legacyPackages = {
- inherit project leanPkgs;
+ inherit project;
+ leanPkgs = pkgs.lean;
};
checks = {
test = pkgs.runCommand "test" {
- buildInputs = [ test.executable leanPkgs.lean-all ];
+ buildInputs = [ test.executable pkgs.lean.lean-all ];
} ''
#export LEAN_SRC_PATH="${./.}"
${test.executable}/bin/test > $out
'';
};
devShells.default = pkgs.mkShell {
- buildInputs = [ leanPkgs.lean-all leanPkgs.lean ];
+ buildInputs = [ pkgs.lean.lean-all pkgs.lean.lean ];
};
};
};
From b99fecdb504ca6b4ea3bfb26674cd22a6b927906 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 26 Oct 2024 17:52:37 -0700
Subject: [PATCH 315/465] chore: Update `lean4-nix`
---
flake.lock | 6 +++---
flake.nix | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/flake.lock b/flake.lock
index 7617c3a..6bf8405 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1729966280,
- "narHash": "sha256-8G0n9POJW2zITB1m2h9+0GHA6lNlfsd2kssEqYLfK/U=",
+ "lastModified": 1729990097,
+ "narHash": "sha256-3RUciZy/VMbyp9v1f8oba/oQ8bWWVh2+1wsuUah3ryE=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "169dfe5e5db6038801ecfdbe4391cb14c5e8d454",
+ "rev": "6919763f186c7b0d39907203a649078ff3a4eb71",
"type": "github"
},
"original": {
diff --git a/flake.nix b/flake.nix
index a2d0263..2c1a76e 100644
--- a/flake.nix
+++ b/flake.nix
@@ -28,7 +28,7 @@
perSystem = { system, pkgs, ... }: let
pkgs = import nixpkgs {
inherit system;
- overlays = [ lean4-nix.tags."v4.12.0" ];
+ overlays = [ (lean4-nix.readToolchainFile ./lean-toolchain) ];
};
lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
From d7c95907804dcb673dd6b8f208af4369b65bed4f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 5 Nov 2024 14:37:06 -0800
Subject: [PATCH 316/465] feat: Extract used constants from invocation
---
Pantograph/Frontend/Elab.lean | 15 ++++++++++++++-
Pantograph/Protocol.lean | 3 +++
Test/Integration.lean | 12 +++++++-----
3 files changed, 24 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 6245877..ceecfae 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -122,6 +122,13 @@ protected def goalStateAfter (t : TacticInvocation) : IO (List Format) := do
protected def ppExpr (t : TacticInvocation) (e : Expr) : IO Format :=
t.runMetaM (fun _ => do Meta.ppExpr (← instantiateMVars e))
+protected def usedConstants (t: TacticInvocation) : NameSet :=
+ let info := t.info
+ info.goalsBefore
+ |>.filterMap info.mctxAfter.getExprAssignmentCore?
+ |>.map Expr.getUsedConstantsAsSet
+ |>.foldl .union .empty
+
end TacticInvocation
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
@@ -158,7 +165,13 @@ def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protoc
let tactic ← invocation.ctx.runMetaM {} do
let t ← PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
return t.pretty
- return { goalBefore, goalAfter, tactic }
+ let usedConstants := invocation.usedConstants.toArray.map λ n => n.toString
+ return {
+ goalBefore,
+ goalAfter,
+ tactic,
+ usedConstants,
+ }
structure InfoWithContext where
info: Elab.Info
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 2ba073e..86a7b4d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -298,6 +298,9 @@ structure InvokedTactic where
goalBefore: String
goalAfter: String
tactic: String
+
+ -- List of used constants
+ usedConstants: Array String
deriving Lean.ToJson
structure CompilationUnit where
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 413ed1c..9fb86b7 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -167,8 +167,8 @@ example : ∀ (p: Prop), p → p := by
def test_frontend_process : Test :=
[
- let file := "example : ∀ (p: Prop), p → p := by\n intro p h\n exact h"
- let goal1 := "p : Prop\nh : p\n⊢ p"
+ let file := "example : ∀ (p q: Prop), p → p ∨ q := by\n intro p q h\n exact Or.inl h"
+ let goal1 := "p q : Prop\nh : p\n⊢ p ∨ q"
step "frontend.process"
[
("file", .str file),
@@ -180,14 +180,16 @@ def test_frontend_process : Test :=
boundary := (0, file.utf8ByteSize),
invocations? := .some [
{
- goalBefore := "⊢ ∀ (p : Prop), p → p",
+ goalBefore := "⊢ ∀ (p q : Prop), p → p ∨ q",
goalAfter := goal1,
- tactic := "intro p h",
+ tactic := "intro p q h",
+ usedConstants := #[],
},
{
goalBefore := goal1 ,
goalAfter := "",
- tactic := "exact h",
+ tactic := "exact Or.inl h",
+ usedConstants := #["Or.inl"],
},
]
}],
From 1c4f38e5eb76fd3442f4b3042e836c9027d1d6c7 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Nov 2024 13:04:00 -0800
Subject: [PATCH 317/465] refactor: Rename {Serial,Delate}.lean
---
Pantograph.lean | 2 +-
Pantograph/{Serial.lean => Delate.lean} | 0
Pantograph/Environment.lean | 2 +-
Pantograph/Library.lean | 2 +-
Test/{Serial.lean => Delate.lean} | 6 +++---
Test/Environment.lean | 2 +-
Test/Main.lean | 4 ++--
Test/Metavar.lean | 2 +-
Test/Proofs.lean | 2 +-
9 files changed, 11 insertions(+), 11 deletions(-)
rename Pantograph/{Serial.lean => Delate.lean} (100%)
rename Test/{Serial.lean => Delate.lean} (98%)
diff --git a/Pantograph.lean b/Pantograph.lean
index 292efb9..72c4906 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -4,5 +4,5 @@ import Pantograph.Frontend
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
-import Pantograph.Serial
+import Pantograph.Delate
import Pantograph.Version
diff --git a/Pantograph/Serial.lean b/Pantograph/Delate.lean
similarity index 100%
rename from Pantograph/Serial.lean
rename to Pantograph/Delate.lean
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 040d801..87e3a2f 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -1,5 +1,5 @@
import Pantograph.Protocol
-import Pantograph.Serial
+import Pantograph.Delate
import Lean
open Lean
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 23a2046..8a5db24 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -2,7 +2,7 @@ import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Protocol
-import Pantograph.Serial
+import Pantograph.Delate
import Pantograph.Version
import Lean
diff --git a/Test/Serial.lean b/Test/Delate.lean
similarity index 98%
rename from Test/Serial.lean
rename to Test/Delate.lean
index 1c00501..57411e8 100644
--- a/Test/Serial.lean
+++ b/Test/Delate.lean
@@ -1,10 +1,10 @@
import LSpec
-import Pantograph.Serial
+import Pantograph.Delate
import Test.Common
import Lean
open Lean
-namespace Pantograph.Test.Serial
+namespace Pantograph.Test.Delate
open Pantograph
@@ -106,4 +106,4 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Instance", test_instance env),
]
-end Pantograph.Test.Serial
+end Pantograph.Test.Delate
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 6b418f7..79d04ed 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -1,5 +1,5 @@
import LSpec
-import Pantograph.Serial
+import Pantograph.Delate
import Pantograph.Environment
import Test.Common
import Lean
diff --git a/Test/Main.lean b/Test/Main.lean
index 0fde5fa..25bb0d9 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -5,7 +5,7 @@ import Test.Integration
import Test.Library
import Test.Metavar
import Test.Proofs
-import Test.Serial
+import Test.Delate
import Test.Tactic
-- Test running infrastructure
@@ -50,7 +50,7 @@ def main (args: List String) := do
("Library", Library.suite env_default),
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
- ("Serial", Serial.suite env_default),
+ ("Delate", Delate.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index dbaf2cc..84860b3 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -1,6 +1,6 @@
import LSpec
import Pantograph.Goal
-import Pantograph.Serial
+import Pantograph.Delate
import Test.Common
import Lean
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 1da21ae..437bb64 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -3,7 +3,7 @@ Tests pertaining to goals with no interdependencies
-/
import LSpec
import Pantograph.Goal
-import Pantograph.Serial
+import Pantograph.Delate
import Test.Common
namespace Pantograph.Test.Proofs
From 0d570276816185df141518e66a74b5f9292975c3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Nov 2024 13:05:48 -0800
Subject: [PATCH 318/465] refactor: Merge Condensed into Delate
---
Pantograph.lean | 1 -
Pantograph/Condensed.lean | 95 ---------------------------------------
Pantograph/Delate.lean | 85 ++++++++++++++++++++++++++++++++++-
Pantograph/Library.lean | 1 -
Test/Common.lean | 1 -
5 files changed, 84 insertions(+), 99 deletions(-)
delete mode 100644 Pantograph/Condensed.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 72c4906..bad5f2a 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,4 +1,3 @@
-import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Frontend
import Pantograph.Goal
diff --git a/Pantograph/Condensed.lean b/Pantograph/Condensed.lean
deleted file mode 100644
index 125b69c..0000000
--- a/Pantograph/Condensed.lean
+++ /dev/null
@@ -1,95 +0,0 @@
-/- structures for FFI based interface -/
-import Lean
-import Pantograph.Goal
-import Pantograph.Expr
-
-open Lean
-
-namespace Pantograph
-namespace Condensed
-
--- Mirrors Lean's LocalDecl
-structure LocalDecl where
- -- Default value is for testing
- fvarId: FVarId := { name := .anonymous }
- userName: Name
-
- -- Normalized expression
- type : Expr
- value? : Option Expr := .none
-
-structure Goal where
- mvarId: MVarId := { name := .anonymous }
- userName: Name := .anonymous
- context: Array LocalDecl
- target: Expr
-
-@[export pantograph_goal_is_lhs]
-def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
-
--- Functions for creating contexts and states
-@[export pantograph_elab_context]
-def elabContext: Elab.Term.Context := {
- errToSorry := false
- }
-
-end Condensed
-
--- Get the list of visible (by default) free variables from a goal
-@[export pantograph_visible_fvars_of_mvar]
-protected def visibleFVarsOfMVar (mctx: MetavarContext) (mvarId: MVarId): Option (Array FVarId) := do
- let mvarDecl ← mctx.findDecl? mvarId
- let lctx := mvarDecl.lctx
- return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
- | some decl => if decl.isAuxDecl ∨ decl.isImplementationDetail then r else r.push decl.fvarId
- | none => r
-
-@[export pantograph_to_condensed_goal_m]
-def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
- let ppAuxDecls := Meta.pp.auxDecls.get (← getOptions)
- let ppImplDetailHyps := Meta.pp.implementationDetailHyps.get (← getOptions)
- let mvarDecl ← mvarId.getDecl
- let lctx := mvarDecl.lctx
- let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
- Meta.withLCtx lctx mvarDecl.localInstances do
- let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
- match localDecl with
- | .cdecl _ fvarId userName type _ _ =>
- let type ← instantiate type
- return { fvarId, userName, type }
- | .ldecl _ fvarId userName type value _ _ => do
- let userName := userName.simpMacroScopes
- let type ← instantiate type
- let value ← instantiate value
- return { fvarId, userName, type, value? := .some value }
- let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
- let skip := !ppAuxDecls && localDecl.isAuxDecl ||
- !ppImplDetailHyps && localDecl.isImplementationDetail
- if skip then
- return acc
- else
- let var ← ppVar localDecl
- return var::acc
- return {
- mvarId,
- userName := mvarDecl.userName,
- context := vars.reverse.toArray,
- target := ← instantiate mvarDecl.type
- }
- where
- instantiate := instantiateAll
-
-@[export pantograph_goal_state_to_condensed_m]
-protected def GoalState.toCondensed (state: GoalState):
- CoreM (Array Condensed.Goal):= do
- let metaM := do
- let goals := state.goals.toArray
- goals.mapM fun goal => do
- match state.mctx.findDecl? goal with
- | .some _ =>
- let serializedGoal ← toCondensedGoal goal
- pure serializedGoal
- | .none => throwError s!"Metavariable does not exist in context {goal.name}"
- metaM.run' (s := state.savedState.term.meta.meta)
-
-end Pantograph
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 3a9efa4..c5954f0 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -4,7 +4,6 @@ This replicates the behaviour of `Scope`s in `Lean/Elab/Command.lean` without
using `Scope`s.
-/
import Lean
-import Pantograph.Condensed
import Pantograph.Expr
import Pantograph.Goal
import Pantograph.Protocol
@@ -14,7 +13,91 @@ open Lean
-- Symbol processing functions --
namespace Pantograph
+namespace Condensed
+-- Mirrors Lean's LocalDecl
+structure LocalDecl where
+ -- Default value is for testing
+ fvarId: FVarId := { name := .anonymous }
+ userName: Name
+
+ -- Normalized expression
+ type : Expr
+ value? : Option Expr := .none
+
+structure Goal where
+ mvarId: MVarId := { name := .anonymous }
+ userName: Name := .anonymous
+ context: Array LocalDecl
+ target: Expr
+
+@[export pantograph_goal_is_lhs]
+def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
+
+-- Functions for creating contexts and states
+@[export pantograph_elab_context]
+def elabContext: Elab.Term.Context := {
+ errToSorry := false
+ }
+
+end Condensed
+
+-- Get the list of visible (by default) free variables from a goal
+@[export pantograph_visible_fvars_of_mvar]
+protected def visibleFVarsOfMVar (mctx: MetavarContext) (mvarId: MVarId): Option (Array FVarId) := do
+ let mvarDecl ← mctx.findDecl? mvarId
+ let lctx := mvarDecl.lctx
+ return lctx.decls.foldl (init := #[]) fun r decl? => match decl? with
+ | some decl => if decl.isAuxDecl ∨ decl.isImplementationDetail then r else r.push decl.fvarId
+ | none => r
+
+@[export pantograph_to_condensed_goal_m]
+def toCondensedGoal (mvarId: MVarId): MetaM Condensed.Goal := do
+ let ppAuxDecls := Meta.pp.auxDecls.get (← getOptions)
+ let ppImplDetailHyps := Meta.pp.implementationDetailHyps.get (← getOptions)
+ let mvarDecl ← mvarId.getDecl
+ let lctx := mvarDecl.lctx
+ let lctx := lctx.sanitizeNames.run' { options := (← getOptions) }
+ Meta.withLCtx lctx mvarDecl.localInstances do
+ let ppVar (localDecl : LocalDecl) : MetaM Condensed.LocalDecl := do
+ match localDecl with
+ | .cdecl _ fvarId userName type _ _ =>
+ let type ← instantiate type
+ return { fvarId, userName, type }
+ | .ldecl _ fvarId userName type value _ _ => do
+ let userName := userName.simpMacroScopes
+ let type ← instantiate type
+ let value ← instantiate value
+ return { fvarId, userName, type, value? := .some value }
+ let vars ← lctx.foldlM (init := []) fun acc (localDecl : LocalDecl) => do
+ let skip := !ppAuxDecls && localDecl.isAuxDecl ||
+ !ppImplDetailHyps && localDecl.isImplementationDetail
+ if skip then
+ return acc
+ else
+ let var ← ppVar localDecl
+ return var::acc
+ return {
+ mvarId,
+ userName := mvarDecl.userName,
+ context := vars.reverse.toArray,
+ target := ← instantiate mvarDecl.type
+ }
+ where
+ instantiate := instantiateAll
+
+@[export pantograph_goal_state_to_condensed_m]
+protected def GoalState.toCondensed (state: GoalState):
+ CoreM (Array Condensed.Goal):= do
+ let metaM := do
+ let goals := state.goals.toArray
+ goals.mapM fun goal => do
+ match state.mctx.findDecl? goal with
+ | .some _ =>
+ let serializedGoal ← toCondensedGoal goal
+ pure serializedGoal
+ | .none => throwError s!"Metavariable does not exist in context {goal.name}"
+ metaM.run' (s := state.savedState.term.meta.meta)
--- Input Functions ---
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 8a5db24..a082f4b 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -1,4 +1,3 @@
-import Pantograph.Condensed
import Pantograph.Environment
import Pantograph.Goal
import Pantograph.Protocol
diff --git a/Test/Common.lean b/Test/Common.lean
index 2d98aca..3670cba 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -1,7 +1,6 @@
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
-import Pantograph.Condensed
import Lean
import LSpec
From 70f86f6e93856ee7e57ed6c0e24c184fd66d0615 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Nov 2024 14:34:15 -0800
Subject: [PATCH 319/465] doc: Update delation documentation
---
Pantograph/Delate.lean | 4 +---
1 file changed, 1 insertion(+), 3 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index c5954f0..a4f20d7 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -1,7 +1,5 @@
/-
-All serialisation functions;
-This replicates the behaviour of `Scope`s in `Lean/Elab/Command.lean` without
-using `Scope`s.
+This file handles "Delation": The conversion of Kernel view into Search view.
-/
import Lean
import Pantograph.Expr
From ee8063e1f524894e196a5d13cb138568bb7e039a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Nov 2024 14:41:24 -0800
Subject: [PATCH 320/465] refactor: Merge all Delation functions
---
Pantograph.lean | 3 +-
Pantograph/Delate.lean | 197 +++++++++++++++++++++++++++++-------
Pantograph/Elab.lean | 40 ++++++++
Pantograph/Environment.lean | 3 +-
Pantograph/Expr.lean | 162 -----------------------------
Pantograph/Library.lean | 2 +-
Repl.lean | 2 +-
Test/Common.lean | 4 +-
Test/Delate.lean | 4 +-
Test/Metavar.lean | 2 +-
Test/Proofs.lean | 2 +-
11 files changed, 210 insertions(+), 211 deletions(-)
create mode 100644 Pantograph/Elab.lean
delete mode 100644 Pantograph/Expr.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index bad5f2a..822824c 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -1,7 +1,8 @@
+import Pantograph.Delate
+import Pantograph.Elab
import Pantograph.Environment
import Pantograph.Frontend
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
-import Pantograph.Delate
import Pantograph.Version
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index a4f20d7..be17729 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -2,7 +2,7 @@
This file handles "Delation": The conversion of Kernel view into Search view.
-/
import Lean
-import Pantograph.Expr
+import Std.Data.HashMap
import Pantograph.Goal
import Pantograph.Protocol
@@ -11,6 +11,163 @@ open Lean
-- Symbol processing functions --
namespace Pantograph
+
+structure ProjectionApplication where
+ projector: Name
+ numParams: Nat
+ inner: Expr
+
+@[export pantograph_expr_proj_to_app]
+def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
+ let (typeName, idx, inner) := match e with
+ | .proj typeName idx inner => (typeName, idx, inner)
+ | _ => panic! "Argument must be proj"
+ let ctor := getStructureCtor env typeName
+ let fieldName := getStructureFields env typeName |>.get! idx
+ let projector := getProjFnForField? env typeName fieldName |>.get!
+ {
+ projector,
+ numParams := ctor.numParams,
+ inner,
+ }
+
+def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
+
+/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
+@[export pantograph_unfold_aux_lemmas]
+def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
+ Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+
+/--
+Force the instantiation of delayed metavariables even if they cannot be fully
+instantiated. This is used during resumption to provide diagnostic data about
+the current goal.
+
+Since Lean 4 does not have an `Expr` constructor corresponding to delayed
+metavariables, any delayed metavariables must be recursively handled by this
+function to ensure that nested delayed metavariables can be properly processed.
+The caveat is this recursive call will lead to infinite recursion if a loop
+between metavariable assignment exists.
+
+This function ensures any metavariable in the result is either
+1. Delayed assigned with its pending mvar not assigned in any form
+2. Not assigned (delay or not)
+ -/
+partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
+ --let padding := String.join $ List.replicate level "│ "
+ --IO.println s!"{padding}Starting {toString eOrig}"
+ let mut result ← Meta.transform (← instantiateMVars eOrig)
+ (pre := fun e => e.withApp fun f args => do
+ let .mvar mvarId := f | return .continue
+ --IO.println s!"{padding}├V {e}"
+ let mvarDecl ← mvarId.getDecl
+
+ -- This is critical to maintaining the interdependency of metavariables.
+ -- Without setting `.syntheticOpaque`, Lean's metavariable elimination
+ -- system will not make the necessary delayed assigned mvars in case of
+ -- nested mvars.
+ mvarId.setKind .syntheticOpaque
+
+ mvarId.withContext do
+ let lctx ← MonadLCtx.getLCtx
+ if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
+ let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
+ | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
+ | .none => acc) []
+ panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
+
+ if let .some assign ← getExprMVarAssignment? mvarId then
+ --IO.println s!"{padding}├A ?{mvarId.name}"
+ assert! !(← mvarId.isDelayedAssigned)
+ return .visit (mkAppN assign args)
+ else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
+ --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
+
+ if args.size < fvars.size then
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ --IO.println s!"{padding}├── Arguments End"
+ if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
+ --IO.println s!"{padding}├T1"
+ let result := mkAppN f args
+ return .done result
+
+ let pending ← mvarIdPending.withContext do
+ let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
+ --IO.println s!"{padding}├Pre: {inner}"
+ pure <| (← inner.abstractM fvars).instantiateRev args
+
+ -- Tail arguments
+ let result := mkAppRange pending fvars.size args.size args
+ --IO.println s!"{padding}├MD {result}"
+ return .done result
+ else
+ assert! !(← mvarId.isAssigned)
+ assert! !(← mvarId.isDelayedAssigned)
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments Begin"
+ let args ← args.mapM self
+ --if !args.isEmpty then
+ -- IO.println s!"{padding}├── Arguments End"
+
+ --IO.println s!"{padding}├M ?{mvarId.name}"
+ return .done (mkAppN f args))
+ --IO.println s!"{padding}└Result {result}"
+ return result
+ where
+ self e := instantiateDelayedMVars e --(level := level + 1)
+
+/--
+Convert an expression to an equiavlent form with
+1. No nested delayed assigned mvars
+2. No aux lemmas
+3. No assigned mvars
+ -/
+@[export pantograph_instantiate_all_m]
+def instantiateAll (e: Expr): MetaM Expr := do
+ let e ← instantiateDelayedMVars e
+ let e ← unfoldAuxLemmas e
+ return e
+
+structure DelayedMVarInvocation where
+ mvarIdPending: MVarId
+ args: Array (FVarId × (Option Expr))
+ -- Extra arguments applied to the result of this substitution
+ tail: Array Expr
+
+-- The pending mvar of any delayed assigned mvar must not be assigned in any way.
+@[export pantograph_to_delayed_mvar_invocation_m]
+def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
+ let .mvar mvarId := e.getAppFn | return .none
+ let .some decl ← getDelayedMVarAssignment? mvarId | return .none
+ let mvarIdPending := decl.mvarIdPending
+ let mvarDecl ← mvarIdPending.getDecl
+ -- Print the function application e. See Lean's `withOverApp`
+ let args := e.getAppArgs
+
+ assert! args.size ≥ decl.fvars.size
+ assert! !(← mvarIdPending.isAssigned)
+ assert! !(← mvarIdPending.isDelayedAssigned)
+ let fvarArgMap: Std.HashMap FVarId Expr := Std.HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
+ let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
+ let fvarId := localDecl.fvarId
+ let a := fvarArgMap[fvarId]?
+ return acc ++ [(fvarId, a)]
+
+ assert! decl.fvars.all (λ fvar => mvarDecl.lctx.findFVar? fvar |>.isSome)
+
+ return .some {
+ mvarIdPending,
+ args := subst.toArray,
+ tail := args.toList.drop decl.fvars.size |>.toArray,
+ }
+
+-- Condensed representation
+
namespace Condensed
-- Mirrors Lean's LocalDecl
@@ -32,12 +189,6 @@ structure Goal where
@[export pantograph_goal_is_lhs]
def isLHS (g: Goal) : Bool := isLHSGoal? g.target |>.isSome
--- Functions for creating contexts and states
-@[export pantograph_elab_context]
-def elabContext: Elab.Term.Context := {
- errToSorry := false
- }
-
end Condensed
-- Get the list of visible (by default) free variables from a goal
@@ -97,38 +248,6 @@ protected def GoalState.toCondensed (state: GoalState):
| .none => throwError s!"Metavariable does not exist in context {goal.name}"
metaM.run' (s := state.savedState.term.meta.meta)
---- Input Functions ---
-
-/-- Read syntax object from string -/
-def parseTerm (env: Environment) (s: String): Except String Syntax :=
- Parser.runParserCategory
- (env := env)
- (catName := `term)
- (input := s)
- (fileName := "<stdin>")
-
-def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
- return Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := s)
- (fileName := "<stdin>")
-
-/-- Parse a syntax object. May generate additional metavariables! -/
-def elabType (syn: Syntax): Elab.TermElabM (Except String Expr) := do
- try
- let expr ← Elab.Term.elabType syn
- return .ok expr
- catch ex => return .error (← ex.toMessageData.toString)
-def elabTerm (syn: Syntax) (expectedType? : Option Expr := .none): Elab.TermElabM (Except String Expr) := do
- try
- let expr ← Elab.Term.elabTerm (stx := syn) expectedType?
- return .ok expr
- catch ex => return .error (← ex.toMessageData.toString)
-
-
---- Output Functions ---
-
def typeExprToBound (expr: Expr): MetaM Protocol.BoundExpression := do
Meta.forallTelescope expr fun arr body => do
let binders ← arr.mapM fun fvar => do
diff --git a/Pantograph/Elab.lean b/Pantograph/Elab.lean
new file mode 100644
index 0000000..3c3b3cd
--- /dev/null
+++ b/Pantograph/Elab.lean
@@ -0,0 +1,40 @@
+import Lean
+open Lean
+
+namespace Pantograph
+
+-- Functions for creating contexts and states
+@[export pantograph_default_elab_context]
+def defaultElabContext: Elab.Term.Context := {
+ errToSorry := false
+ }
+
+/-- Read syntax object from string -/
+def parseTerm (env: Environment) (s: String): Except String Syntax :=
+ Parser.runParserCategory
+ (env := env)
+ (catName := `term)
+ (input := s)
+ (fileName := "<stdin>")
+
+def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do
+ return Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := s)
+ (fileName := "<stdin>")
+
+/-- Parse a syntax object. May generate additional metavariables! -/
+def elabType (syn: Syntax): Elab.TermElabM (Except String Expr) := do
+ try
+ let expr ← Elab.Term.elabType syn
+ return .ok expr
+ catch ex => return .error (← ex.toMessageData.toString)
+def elabTerm (syn: Syntax) (expectedType? : Option Expr := .none): Elab.TermElabM (Except String Expr) := do
+ try
+ let expr ← Elab.Term.elabTerm (stx := syn) expectedType?
+ return .ok expr
+ catch ex => return .error (← ex.toMessageData.toString)
+
+
+end Pantograph
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 87e3a2f..40b3386 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -1,5 +1,6 @@
-import Pantograph.Protocol
import Pantograph.Delate
+import Pantograph.Elab
+import Pantograph.Protocol
import Lean
open Lean
diff --git a/Pantograph/Expr.lean b/Pantograph/Expr.lean
deleted file mode 100644
index a13ffec..0000000
--- a/Pantograph/Expr.lean
+++ /dev/null
@@ -1,162 +0,0 @@
-import Lean
-import Std.Data.HashMap
-
-open Lean
-
-namespace Pantograph
-
-structure ProjectionApplication where
- projector: Name
- numParams: Nat
- inner: Expr
-
-@[export pantograph_expr_proj_to_app]
-def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
- let (typeName, idx, inner) := match e with
- | .proj typeName idx inner => (typeName, idx, inner)
- | _ => panic! "Argument must be proj"
- let ctor := getStructureCtor env typeName
- let fieldName := getStructureFields env typeName |>.get! idx
- let projector := getProjFnForField? env typeName fieldName |>.get!
- {
- projector,
- numParams := ctor.numParams,
- inner,
- }
-
-def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
-
-/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-@[export pantograph_unfold_aux_lemmas]
-def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
- Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
-
-/--
-Force the instantiation of delayed metavariables even if they cannot be fully
-instantiated. This is used during resumption to provide diagnostic data about
-the current goal.
-
-Since Lean 4 does not have an `Expr` constructor corresponding to delayed
-metavariables, any delayed metavariables must be recursively handled by this
-function to ensure that nested delayed metavariables can be properly processed.
-The caveat is this recursive call will lead to infinite recursion if a loop
-between metavariable assignment exists.
-
-This function ensures any metavariable in the result is either
-1. Delayed assigned with its pending mvar not assigned in any form
-2. Not assigned (delay or not)
- -/
-partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
- --let padding := String.join $ List.replicate level "│ "
- --IO.println s!"{padding}Starting {toString eOrig}"
- let mut result ← Meta.transform (← instantiateMVars eOrig)
- (pre := fun e => e.withApp fun f args => do
- let .mvar mvarId := f | return .continue
- --IO.println s!"{padding}├V {e}"
- let mvarDecl ← mvarId.getDecl
-
- -- This is critical to maintaining the interdependency of metavariables.
- -- Without setting `.syntheticOpaque`, Lean's metavariable elimination
- -- system will not make the necessary delayed assigned mvars in case of
- -- nested mvars.
- mvarId.setKind .syntheticOpaque
-
- mvarId.withContext do
- let lctx ← MonadLCtx.getLCtx
- if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
- let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
- | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
- | .none => acc) []
- panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
-
- if let .some assign ← getExprMVarAssignment? mvarId then
- --IO.println s!"{padding}├A ?{mvarId.name}"
- assert! !(← mvarId.isDelayedAssigned)
- return .visit (mkAppN assign args)
- else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
- --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
- --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
-
- if args.size < fvars.size then
- throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments Begin"
- let args ← args.mapM self
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments End"
- if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
- --IO.println s!"{padding}├T1"
- let result := mkAppN f args
- return .done result
-
- let pending ← mvarIdPending.withContext do
- let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
- --IO.println s!"{padding}├Pre: {inner}"
- pure <| (← inner.abstractM fvars).instantiateRev args
-
- -- Tail arguments
- let result := mkAppRange pending fvars.size args.size args
- --IO.println s!"{padding}├MD {result}"
- return .done result
- else
- assert! !(← mvarId.isAssigned)
- assert! !(← mvarId.isDelayedAssigned)
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments Begin"
- let args ← args.mapM self
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments End"
-
- --IO.println s!"{padding}├M ?{mvarId.name}"
- return .done (mkAppN f args))
- --IO.println s!"{padding}└Result {result}"
- return result
- where
- self e := instantiateDelayedMVars e --(level := level + 1)
-
-/--
-Convert an expression to an equiavlent form with
-1. No nested delayed assigned mvars
-2. No aux lemmas
-3. No assigned mvars
- -/
-@[export pantograph_instantiate_all_m]
-def instantiateAll (e: Expr): MetaM Expr := do
- let e ← instantiateDelayedMVars e
- let e ← unfoldAuxLemmas e
- return e
-
-structure DelayedMVarInvocation where
- mvarIdPending: MVarId
- args: Array (FVarId × (Option Expr))
- -- Extra arguments applied to the result of this substitution
- tail: Array Expr
-
--- The pending mvar of any delayed assigned mvar must not be assigned in any way.
-@[export pantograph_to_delayed_mvar_invocation_m]
-def toDelayedMVarInvocation (e: Expr): MetaM (Option DelayedMVarInvocation) := do
- let .mvar mvarId := e.getAppFn | return .none
- let .some decl ← getDelayedMVarAssignment? mvarId | return .none
- let mvarIdPending := decl.mvarIdPending
- let mvarDecl ← mvarIdPending.getDecl
- -- Print the function application e. See Lean's `withOverApp`
- let args := e.getAppArgs
-
- assert! args.size ≥ decl.fvars.size
- assert! !(← mvarIdPending.isAssigned)
- assert! !(← mvarIdPending.isDelayedAssigned)
- let fvarArgMap: Std.HashMap FVarId Expr := Std.HashMap.ofList $ (decl.fvars.map (·.fvarId!) |>.zip args).toList
- let subst ← mvarDecl.lctx.foldlM (init := []) λ acc localDecl => do
- let fvarId := localDecl.fvarId
- let a := fvarArgMap[fvarId]?
- return acc ++ [(fvarId, a)]
-
- assert! decl.fvars.all (λ fvar => mvarDecl.lctx.findFVar? fvar |>.isSome)
-
- return .some {
- mvarIdPending,
- args := subst.toArray,
- tail := args.toList.drop decl.fvars.size |>.toArray,
- }
-
-end Pantograph
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index a082f4b..20c7c9b 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -41,7 +41,7 @@ namespace Pantograph
def runMetaM { α } (metaM: MetaM α): CoreM α :=
metaM.run'
def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
- termElabM.run' (ctx := Condensed.elabContext) |>.run'
+ termElabM.run' (ctx := defaultElabContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
diff --git a/Repl.lean b/Repl.lean
index 7e8f0e4..041c0a6 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -22,7 +22,7 @@ abbrev CR α := Except Protocol.InteractionError α
def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
metaM.run'
def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
- termElabM.run' (ctx := Condensed.elabContext) |>.run'
+ termElabM.run' (ctx := defaultElabContext) |>.run'
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
diff --git a/Test/Common.lean b/Test/Common.lean
index 3670cba..3998293 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -89,9 +89,9 @@ def runCoreMSeq (env: Environment) (coreM: CoreM LSpec.TestSeq) (options: Array
def runMetaMSeq (env: Environment) (metaM: MetaM LSpec.TestSeq): IO LSpec.TestSeq :=
runCoreMSeq env metaM.run'
def runTermElabMInMeta { α } (termElabM: Lean.Elab.TermElabM α): Lean.MetaM α :=
- termElabM.run' (ctx := Condensed.elabContext)
+ termElabM.run' (ctx := defaultElabContext)
def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq): IO LSpec.TestSeq :=
- runMetaMSeq env $ termElabM.run' (ctx := Condensed.elabContext)
+ runMetaMSeq env $ termElabM.run' (ctx := defaultElabContext)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
diff --git a/Test/Delate.lean b/Test/Delate.lean
index 57411e8..227ab24 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -64,7 +64,7 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
| .ok expr => pure expr
| .error e => return elabFailure e
return LSpec.check source ((← serializeExpressionSexp expr) = target)
- let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := Condensed.elabContext)
+ let metaM := (Elab.Term.withLevelNames levels termElabM).run' (ctx := defaultElabContext)
return LSpec.TestSeq.append suites (← runMetaMSeq env metaM))
LSpec.TestSeq.done
@@ -85,7 +85,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
let testCaseName := target.take 10
let test := LSpec.check testCaseName ((← serializeExpressionSexp expr) = target)
return LSpec.TestSeq.append suites test) LSpec.TestSeq.done
- runMetaMSeq env $ termElabM.run' (ctx := Condensed.elabContext)
+ runMetaMSeq env $ termElabM.run' (ctx := defaultElabContext)
-- Instance parsing
def test_instance (env: Environment): IO LSpec.TestSeq :=
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 84860b3..506e963 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -66,7 +66,7 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context ← createCoreContext #[]
- let metaM := termElabM.run' (ctx := Condensed.elabContext)
+ let metaM := termElabM.run' (ctx := defaultElabContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 437bb64..8e3e2a2 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -74,7 +74,7 @@ def proofRunner (env: Lean.Environment) (tests: TestM Unit): IO LSpec.TestSeq :=
let termElabM := tests.run LSpec.TestSeq.done |>.run {} -- with default options
let coreContext: Lean.Core.Context ← createCoreContext #[]
- let metaM := termElabM.run' (ctx := Condensed.elabContext)
+ let metaM := termElabM.run' (ctx := defaultElabContext)
let coreM := metaM.run'
match ← (coreM.run' coreContext { env := env }).toBaseIO with
| .error exception =>
From 495ea1ac144f524fe585979f7561470010599180 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 8 Nov 2024 14:49:49 -0800
Subject: [PATCH 321/465] feat: Environment pickling
---
Pantograph.lean | 1 +
Pantograph/Environment.lean | 4 +-
Pantograph/Serial.lean | 75 +++++++++++++++++++++++++++++++++++++
3 files changed, 79 insertions(+), 1 deletion(-)
create mode 100644 Pantograph/Serial.lean
diff --git a/Pantograph.lean b/Pantograph.lean
index 822824c..2c334b6 100644
--- a/Pantograph.lean
+++ b/Pantograph.lean
@@ -5,4 +5,5 @@ import Pantograph.Frontend
import Pantograph.Goal
import Pantograph.Library
import Pantograph.Protocol
+import Pantograph.Serial
import Pantograph.Version
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 40b3386..ad21284 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -1,7 +1,9 @@
import Pantograph.Delate
import Pantograph.Elab
import Pantograph.Protocol
-import Lean
+import Pantograph.Serial
+import Lean.Environment
+import Lean.Replay
open Lean
open Pantograph
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
new file mode 100644
index 0000000..c6aecae
--- /dev/null
+++ b/Pantograph/Serial.lean
@@ -0,0 +1,75 @@
+import Lean.Environment
+import Lean.Replay
+import Std.Data.HashMap
+
+/-!
+Input/Output functions
+
+# Pickling and unpickling objects
+
+By abusing `saveModuleData` and `readModuleData` we can pickle and unpickle objects to disk.
+-/
+
+open Lean
+
+namespace Pantograph
+
+/--
+Save an object to disk.
+If you need to write multiple objects from within a single declaration,
+you will need to provide a unique `key` for each.
+-/
+def pickle {α : Type} (path : System.FilePath) (x : α) (key : Name := by exact decl_name%) : IO Unit :=
+ saveModuleData path key (unsafe unsafeCast x)
+
+/--
+Load an object from disk.
+Note: The returned `CompactedRegion` can be used to free the memory behind the value
+of type `α`, using `CompactedRegion.free` (which is only safe once all references to the `α` are
+released). Ignoring the `CompactedRegion` results in the data being leaked.
+Use `withUnpickle` to call `CompactedRegion.free` automatically.
+
+This function is unsafe because the data being loaded may not actually have type `α`, and this
+may cause crashes or other bad behavior.
+-/
+unsafe def unpickle (α : Type) (path : System.FilePath) : IO (α × CompactedRegion) := do
+ let (x, region) ← readModuleData path
+ pure (unsafeCast x, region)
+
+/-- Load an object from disk and run some continuation on it, freeing memory afterwards. -/
+unsafe def withUnpickle [Monad m] [MonadLiftT IO m] {α β : Type}
+ (path : System.FilePath) (f : α → m β) : m β := do
+ let (x, region) ← unpickle α path
+ let r ← f x
+ region.free
+ pure r
+end Pantograph
+
+namespace Lean.Environment
+
+/--
+Pickle an `Environment` to disk.
+
+We only store:
+* the list of imports
+* the new constants from `Environment.constants`
+and when unpickling, we build a fresh `Environment` from the imports,
+and then add the new constants.
+-/
+@[export pantograph_env_pickle_m]
+def pickle (env : Environment) (path : System.FilePath) : IO Unit :=
+ Pantograph.pickle path (env.header.imports, env.constants.map₂)
+
+/--
+Unpickle an `Environment` from disk.
+
+We construct a fresh `Environment` with the relevant imports,
+and then replace the new constants.
+-/
+@[export pantograph_env_unpickle_m]
+def unpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
+ let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path
+ let env ← importModules imports {} 0
+ return (← env.replay (Std.HashMap.ofList map₂.toList), region)
+
+end Lean.Environment
From 2790553180384fbed97d7707178f8dc72d95b1bb Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 13 Nov 2024 19:50:31 -0800
Subject: [PATCH 322/465] feat: Environment save/load commands
---
Pantograph/Protocol.lean | 6 +++++
Pantograph/Serial.lean | 10 +++-----
Repl.lean | 54 ++++++++++++++++++++++++++--------------
3 files changed, 45 insertions(+), 25 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 2ba073e..08c67ef 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -183,6 +183,12 @@ structure EnvAdd where
structure EnvAddResult where
deriving Lean.ToJson
+structure EnvSaveLoad where
+ path: System.FilePath
+ deriving Lean.FromJson
+structure EnvSaveLoadResult where
+ deriving Lean.ToJson
+
/-- Set options; See `Options` struct above for meanings -/
structure OptionsSet where
printJsonPretty?: Option Bool
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index c6aecae..2f04bdb 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -1,5 +1,6 @@
import Lean.Environment
import Lean.Replay
+import Init.System.IOError
import Std.Data.HashMap
/-!
@@ -43,9 +44,6 @@ unsafe def withUnpickle [Monad m] [MonadLiftT IO m] {α β : Type}
let r ← f x
region.free
pure r
-end Pantograph
-
-namespace Lean.Environment
/--
Pickle an `Environment` to disk.
@@ -57,7 +55,7 @@ and when unpickling, we build a fresh `Environment` from the imports,
and then add the new constants.
-/
@[export pantograph_env_pickle_m]
-def pickle (env : Environment) (path : System.FilePath) : IO Unit :=
+def env_pickle (env : Environment) (path : System.FilePath) : IO Unit :=
Pantograph.pickle path (env.header.imports, env.constants.map₂)
/--
@@ -67,9 +65,9 @@ We construct a fresh `Environment` with the relevant imports,
and then replace the new constants.
-/
@[export pantograph_env_unpickle_m]
-def unpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
+def env_unpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path
let env ← importModules imports {} 0
return (← env.replay (Std.HashMap.ofList map₂.toList), region)
-end Lean.Environment
+end Pantograph
diff --git a/Repl.lean b/Repl.lean
index 041c0a6..e162f05 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -24,6 +24,7 @@ def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
termElabM.run' (ctx := defaultElabContext) |>.run'
+/-- Main loop command of the REPL -/
def execute (command: Protocol.Command): MainM Lean.Json := do
let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
match Lean.fromJson? command.payload with
@@ -32,28 +33,35 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| .ok result => return Lean.toJson result
| .error ierror => return Lean.toJson ierror
| .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
- match command.cmd with
- | "reset" => run reset
- | "stat" => run stat
- | "expr.echo" => run expr_echo
- | "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
- | "goal.tactic" => run goal_tactic
- | "goal.continue" => run goal_continue
- | "goal.delete" => run goal_delete
- | "goal.print" => run goal_print
- | "frontend.process" => run frontend_process
- | cmd =>
- let error: Protocol.InteractionError :=
- errorCommand s!"Unknown command {cmd}"
- return Lean.toJson error
+ try
+ match command.cmd with
+ | "reset" => run reset
+ | "stat" => run stat
+ | "expr.echo" => run expr_echo
+ | "env.catalog" => run env_catalog
+ | "env.inspect" => run env_inspect
+ | "env.add" => run env_add
+ | "env.save" => run env_save
+ | "env.load" => run env_load
+ | "options.set" => run options_set
+ | "options.print" => run options_print
+ | "goal.start" => run goal_start
+ | "goal.tactic" => run goal_tactic
+ | "goal.continue" => run goal_continue
+ | "goal.delete" => run goal_delete
+ | "goal.print" => run goal_print
+ | "frontend.process" => run frontend_process
+ | cmd =>
+ let error: Protocol.InteractionError :=
+ errorCommand s!"Unknown command {cmd}"
+ return Lean.toJson error
+ catch ex => do
+ let error ← ex.toMessageData.toString
+ return Lean.toJson $ errorIO error
where
errorCommand := errorI "command"
errorIndex := errorI "index"
+ errorIO := errorI "io"
newGoalState (goalState: GoalState) : MainM Nat := do
let state ← get
let stateId := state.nextId
@@ -80,6 +88,14 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.inspect args state.options
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
Environment.addDecl args
+ env_save (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
+ let env ← Lean.MonadEnv.getEnv
+ env_pickle env args.path
+ return .ok {}
+ env_load (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
+ let (env, _) ← env_unpickle args.path
+ Lean.setEnv env
+ return .ok {}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
From e5d0459956fccc783f110e95f444a6a63ea0c3e2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Nov 2024 22:16:45 -0800
Subject: [PATCH 323/465] fix: Flake Build failure on x86_64-darwin
---
flake.lock | 26 +++++++++++++-------------
1 file changed, 13 insertions(+), 13 deletions(-)
diff --git a/flake.lock b/flake.lock
index 6bf8405..aa249ec 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1727826117,
- "narHash": "sha256-K5ZLCyfO/Zj9mPFldf3iwS6oZStJcU4tSpiXTMYaaL0=",
+ "lastModified": 1730504689,
+ "narHash": "sha256-hgmguH29K2fvs9szpq2r3pz2/8cJd2LPS+b4tfNFCwE=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "3d04084d54bedc3d6b8b736c70ef449225c361b1",
+ "rev": "506278e768c2a08bec68eb62932193e341f55c90",
"type": "github"
},
"original": {
@@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1729990097,
- "narHash": "sha256-3RUciZy/VMbyp9v1f8oba/oQ8bWWVh2+1wsuUah3ryE=",
+ "lastModified": 1731611044,
+ "narHash": "sha256-R90CqNyZ5Q3kzQF8WBq/HtBHoo/JLGowtwfSUB5gx44=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "6919763f186c7b0d39907203a649078ff3a4eb71",
+ "rev": "870085d710e81760b976ef0c52c287cf185cb885",
"type": "github"
},
"original": {
@@ -90,14 +90,14 @@
},
"nixpkgs-lib": {
"locked": {
- "lastModified": 1727825735,
- "narHash": "sha256-0xHYkMkeLVQAMa7gvkddbPqpxph+hDzdu1XdGPJR+Os=",
+ "lastModified": 1730504152,
+ "narHash": "sha256-lXvH/vOfb4aGYyvFmZK/HlsNsr/0CVWlwYvo2rxJk3s=",
"type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
+ "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
},
"original": {
"type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
+ "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
}
},
"nixpkgs-lib_2": {
@@ -114,11 +114,11 @@
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1729691686,
- "narHash": "sha256-BAuPWW+9fa1moZTU+jFh+1cUtmsuF8asgzFwejM4wac=",
+ "lastModified": 1731386116,
+ "narHash": "sha256-lKA770aUmjPHdTaJWnP3yQ9OI1TigenUqVC3wweqZuI=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "32e940c7c420600ef0d1ef396dc63b04ee9cad37",
+ "rev": "689fed12a013f56d4c4d3f612489634267d86529",
"type": "github"
},
"original": {
From 0ee7d575709f6e08cabb54db8460d0249a57ba2f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 14 Nov 2024 22:51:25 -0800
Subject: [PATCH 324/465] feat: Expose iTree for LSP Configuration
---
flake.nix | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flake.nix b/flake.nix
index 2c1a76e..91901d8 100644
--- a/flake.nix
+++ b/flake.nix
@@ -73,7 +73,7 @@
in rec {
packages = {
inherit (pkgs.lean) lean lean-all;
- inherit (project) sharedLib;
+ inherit (project) sharedLib iTree;
inherit (repl) executable;
default = repl.executable;
};
From f9d31597ec485ba08109f45753807f38b8e347f9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Nov 2024 14:56:51 -0800
Subject: [PATCH 325/465] chore: Update lean4-nix
---
flake.lock | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/flake.lock b/flake.lock
index aa249ec..f40dde9 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1731611044,
- "narHash": "sha256-R90CqNyZ5Q3kzQF8WBq/HtBHoo/JLGowtwfSUB5gx44=",
+ "lastModified": 1731711316,
+ "narHash": "sha256-s5u+A2/Ea9gPveB5wwVM5dWW0NST6kamDsTeovGuLEs=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "870085d710e81760b976ef0c52c287cf185cb885",
+ "rev": "136fc6057c48de970579e960b62421e9c295b67d",
"type": "github"
},
"original": {
From af256123f39990bb4cadd6f8d3333f3bb044a69a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Nov 2024 23:29:37 -0800
Subject: [PATCH 326/465] doc: Update icon
---
doc/icon.svg | 184 +++++++++++++++++++++++++++++++++++++--------------
1 file changed, 134 insertions(+), 50 deletions(-)
diff --git a/doc/icon.svg b/doc/icon.svg
index 394b412..eb26a19 100644
--- a/doc/icon.svg
+++ b/doc/icon.svg
@@ -4,17 +4,17 @@
<svg
width="256"
height="256"
- viewBox="0 0 55.900957 55.900957"
+ viewBox="0 0 67.733332 67.733333"
version="1.1"
- id="svg21534"
- xml:space="preserve"
- inkscape:version="1.2.2 (b0a8486541, 2022-12-01)"
+ id="svg1"
sodipodi:docname="icon.svg"
+ inkscape:version="1.3.2 (091e20ef0f, 2023-11-25, custom)"
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
xmlns="http://www.w3.org/2000/svg"
- xmlns:svg="http://www.w3.org/2000/svg"><sodipodi:namedview
- id="namedview21536"
+ xmlns:svg="http://www.w3.org/2000/svg">
+ <sodipodi:namedview
+ id="namedview1"
pagecolor="#ffffff"
bordercolor="#111111"
borderopacity="1"
@@ -23,51 +23,135 @@
inkscape:pagecheckerboard="1"
inkscape:deskcolor="#d1d1d1"
inkscape:document-units="px"
- showgrid="true"
- inkscape:zoom="5.1754899"
- inkscape:cx="158.82554"
- inkscape:cy="91.682142"
- inkscape:window-width="3777"
- inkscape:window-height="2093"
+ showguides="true"
+ inkscape:zoom="5.1882633"
+ inkscape:cx="81.819286"
+ inkscape:cy="132.22151"
+ inkscape:window-width="3774"
+ inkscape:window-height="2126"
inkscape:window-x="0"
inkscape:window-y="0"
inkscape:window-maximized="1"
- inkscape:current-layer="layer1"><inkscape:grid
- type="xygrid"
- id="grid23833"
- spacingx="3.4938098"
- spacingy="3.4938098"
- empspacing="4" /></sodipodi:namedview><defs
- id="defs21531" /><g
- inkscape:label="Layer 1"
+ inkscape:current-layer="layer2">
+ <sodipodi:guide
+ position="33.866666,69.8437"
+ orientation="-1,0"
+ id="guide1"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="-27.673679,33.866666"
+ orientation="0,1"
+ id="guide2"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="16.933333,29.94582"
+ orientation="-1,0"
+ id="guide3"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="50.799999,37.44627"
+ orientation="-1,0"
+ id="guide4"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="31.336956,16.933333"
+ orientation="0,1"
+ id="guide5"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="24.528038,25.4"
+ orientation="0,1"
+ id="guide6"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="33.866666,50.799999"
+ orientation="0,1"
+ id="guide7"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="32.770414,55.033333"
+ orientation="0,1"
+ id="guide8"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ <sodipodi:guide
+ position="25.347689,33.866666"
+ orientation="1,0"
+ id="guide9"
+ inkscape:locked="false" />
+ <sodipodi:guide
+ position="25.347689,42.333333"
+ orientation="0,1"
+ id="guide10"
+ inkscape:locked="false"
+ inkscape:label=""
+ inkscape:color="rgb(0,134,229)" />
+ </sodipodi:namedview>
+ <defs
+ id="defs1" />
+ <g
inkscape:groupmode="layer"
- id="layer1"><rect
- style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1.78013;stroke-miterlimit:3.4;stroke-dasharray:none"
- id="rect26805"
- width="11.502316"
- height="2.2512667"
- x="33.344425"
- y="7.6690259"
- ry="0.28140834"
- rx="0.47926313" /><path
- style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
- d="m 35.764667,9.9513013 c 0,0 -26.8581417,13.7987337 -28.0863506,14.9501437 -1.250042,1.171878 3.2347846,3.945325 3.2347846,3.945325 l 21.34979,14.934062 6.624567,0.453105 -27.599216,-17.304358 c 0,0 -0.603209,-0.08927 -0.600411,-0.762283 0.0028,-0.673015 27.32022,-16.4227356 27.32022,-16.4227356 z"
- id="path27381"
- sodipodi:nodetypes="csccccscc" /><path
- style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
- d="M 10.97848,26.985751 40.537772,9.7943227 41.921795,9.7005084 11.210626,27.421377 Z"
- id="path27479" /><path
- style="fill:#3e3e3e;stroke:none;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;fill-opacity:1"
- d="m 7.0509847,25.522367 c -0.8266141,1.386819 -2.4011783,4.48805 -2.4706357,4.90223 -0.069458,0.414182 0.4434324,0.513474 0.8491061,0.757041 C 5.835129,31.425204 19.33424,43.917182 19.33424,43.917182 l 0.324562,-0.539228 c 0,0 -14.2055729,-12.369493 -14.0644435,-12.868167 0.1411292,-0.498672 3.544896,-3.777392 3.544896,-3.777392 L 7.4596884,25.117508 Z"
- id="path27481" /><rect
- style="fill:#3e3e3e;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:2.11692;stroke-miterlimit:3.4;stroke-dasharray:none;stroke-opacity:1"
- id="rect27483"
- width="36.38942"
- height="3.6217353"
- x="13.953447"
- y="43.009739"
- rx="0.43672624"
- ry="0.43672624" /><path
- style="fill:none;stroke:#000000;stroke-width:0.218363px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
- d="M -2.1119274,7.666599 H 64.179192"
- id="path27487" /></g></svg>
+ id="layer4"
+ inkscape:label="bg" />
+ <g
+ inkscape:groupmode="layer"
+ id="layer1"
+ inkscape:label="Circle">
+ <path
+ id="path1"
+ style="fill:#666b98;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.0191989;stroke-miterlimit:3.4;fill-opacity:1"
+ d="M 33.866666 0.009818522 A 33.857067 33.857067 0 0 0 0.009818522 33.866666 A 33.857067 33.857067 0 0 0 33.866666 67.723514 A 33.857067 33.857067 0 0 0 67.723514 33.866666 A 33.857067 33.857067 0 0 0 33.866666 0.009818522 z M 33.866666 4.2416015 A 29.624933 29.624933 0 0 1 63.491731 33.866666 A 29.624933 29.624933 0 0 1 33.866666 63.491731 A 29.624933 29.624933 0 0 1 4.2416015 33.866666 A 29.624933 29.624933 0 0 1 33.866666 4.2416015 z " />
+ </g>
+ <g
+ inkscape:groupmode="layer"
+ id="layer2"
+ inkscape:label="Pantograph-Core">
+ <rect
+ style="fill:#666b98;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.01905;stroke-miterlimit:3.4"
+ id="rect8"
+ width="16.942858"
+ height="4.2257233"
+ x="33.866665"
+ y="12.7"
+ rx="0.58070719"
+ ry="0.34097314" />
+ <rect
+ style="fill:#666b98;fill-opacity:1;fill-rule:evenodd;stroke:#ffffff;stroke-width:0.01905;stroke-miterlimit:3.4"
+ id="rect1"
+ width="33.885715"
+ height="8.4211359"
+ x="16.933332"
+ y="42.333332"
+ rx="0.58070719"
+ ry="0.34097314" />
+ <path
+ style="fill:#666b98;fill-opacity:1;stroke:none;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
+ d="m 42.338095,16.925724 -16.990406,8.474275 13.121218,16.923808 -4.602241,0.0095 -4.254289,0.0015 -8.564029,-16.934789 17.310554,-8.464751 z"
+ id="path10"
+ sodipodi:nodetypes="cccccccc" />
+ <path
+ style="fill:none;stroke:#666b98;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
+ d="M 46.53445,16.925724 26.018901,26.73418"
+ id="path11" />
+ <path
+ style="fill:none;stroke:#666b98;stroke-width:0.264583px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
+ d="m 21.048348,25.399999 4.352167,16.934808"
+ id="path12"
+ sodipodi:nodetypes="cc" />
+ </g>
+</svg>
From ce3af887be2594e9b5a80532982fd6cc9c652909 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 15 Nov 2024 23:36:28 -0800
Subject: [PATCH 327/465] doc: Rationale document
---
README.md | 2 ++
doc/rationale.md | 30 ++++++++++++++++++++++++++++++
2 files changed, 32 insertions(+)
create mode 100644 doc/rationale.md
diff --git a/README.md b/README.md
index 04213ae..7b5060f 100644
--- a/README.md
+++ b/README.md
@@ -7,6 +7,8 @@ A Machine-to-Machine interaction system for Lean 4.
Pantograph provides interfaces to execute proofs, construct expressions, and
examine the symbol list of a Lean project for machine learning.
+See [documentations][doc/] for design rationale and references.
+
## Installation
For Nix users, run
diff --git a/doc/rationale.md b/doc/rationale.md
new file mode 100644
index 0000000..87c1606
--- /dev/null
+++ b/doc/rationale.md
@@ -0,0 +1,30 @@
+# Design Rationale
+
+A great problem in machine learning is to use ML agents to automatically prove
+mathematical theorems. This sort of proof necessarily involves *search*.
+Compatibility for search is the main reason for creating Pantograph. The Lean 4
+LSP interface is not conducive to search. Pantograph is designed with this in
+mind. It emphasizes the difference between 3 views of a proof:
+
+- **Presentation View**: The view of a written, polished proof. e.g. Mathlib and
+ math papers are almost always written in this form.
+- **Search View**: The view of a proof exploration trajectory. This is not
+ explicitly supported by Lean LSP.
+- **Kernel View**: The proof viewed as a set of metavariables.
+
+Pantograph enables proof agents to operate on the search view.
+
+## Name
+
+The name Pantograph is a pun. It means two things
+- A pantograph is an instrument for copying down writing. As an agent explores
+ the vast proof search space, Pantograph records the current state to ensure
+ the proof is sound.
+- A pantograph is also an equipment for an electric train. It supplies power to
+ a locomotive. In comparison the (relatively) simple Pantograph software powers
+ theorem proving projects.
+
+## References
+
+* [Pantograph Paper](https://arxiv.org/abs/2410.16429)
+
From 5d676154f1ba1c0cdb542c9feb8d583c89643fcb Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 16 Nov 2024 21:27:40 -0800
Subject: [PATCH 328/465] doc: Fix documentation link
---
README.md | 13 ++++++++-----
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/README.md b/README.md
index 7b5060f..bfd391b 100644
--- a/README.md
+++ b/README.md
@@ -7,7 +7,7 @@ A Machine-to-Machine interaction system for Lean 4.
Pantograph provides interfaces to execute proofs, construct expressions, and
examine the symbol list of a Lean project for machine learning.
-See [documentations][doc/] for design rationale and references.
+See [documentations](doc/) for design rationale and references.
## Installation
@@ -17,7 +17,9 @@ nix build .#{sharedLib,executable}
```
to build either the shared library or executable.
-Install `elan` and `lake`, and run
+Install `lake` and `lean` fixed to the version of the `lean-toolchain` file, and
+run
+
``` sh
lake build
```
@@ -26,9 +28,12 @@ This builds the executable in `.lake/build/bin/pantograph-repl`.
## Executable Usage
``` sh
-pantograph MODULES|LEAN_OPTIONS
+pantograph-repl MODULES|LEAN_OPTIONS
```
+The `pantograph-repl` executable must be run with a list of modules to import.
+It can also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
+
The REPL loop accepts commands as single-line JSON inputs and outputs either an
`Error:` (indicating malformed command) or a JSON return value indicating the
result of a command execution. The command can be passed in one of two formats
@@ -39,8 +44,6 @@ command { ... }
The list of available commands can be found in `Pantograph/Protocol.lean` and below. An
empty command aborts the REPL.
-The `pantograph` executable must be run with a list of modules to import. It can
-also accept lean options of the form `--key=value` e.g. `--pp.raw=true`.
Example: (~5k symbols)
```
From 9894ad7c7e2a8e7fde305e1a542f708fd1481c5e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 26 Nov 2024 12:16:14 -0800
Subject: [PATCH 329/465] refactor: InfoTree functions
---
Pantograph/Frontend.lean | 2 +-
Pantograph/Frontend/Elab.lean | 82 ++-----------------------------
Pantograph/Frontend/InfoTree.lean | 81 ++++++++++++++++++++++++++++++
3 files changed, 85 insertions(+), 80 deletions(-)
create mode 100644 Pantograph/Frontend/InfoTree.lean
diff --git a/Pantograph/Frontend.lean b/Pantograph/Frontend.lean
index fd91823..9a41567 100644
--- a/Pantograph/Frontend.lean
+++ b/Pantograph/Frontend.lean
@@ -1,4 +1,4 @@
-/- Adapted from lean-training-data by semorrison -/
import Pantograph.Frontend.Basic
import Pantograph.Frontend.Elab
+import Pantograph.Frontend.InfoTree
import Pantograph.Frontend.MetaTranslate
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index ceecfae..b3173a7 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -7,77 +7,10 @@ import Pantograph.Frontend.Basic
import Pantograph.Frontend.MetaTranslate
import Pantograph.Goal
import Pantograph.Protocol
+import Pantograph.Frontend.InfoTree
open Lean
-namespace Lean.Elab.Info
-/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
-protected def stx? : Info → Option Syntax
- | .ofTacticInfo info => info.stx
- | .ofTermInfo info => info.stx
- | .ofCommandInfo info => info.stx
- | .ofMacroExpansionInfo info => info.stx
- | .ofOptionInfo info => info.stx
- | .ofFieldInfo info => info.stx
- | .ofCompletionInfo info => info.stx
- | .ofUserWidgetInfo info => info.stx
- | .ofCustomInfo info => info.stx
- | .ofFVarAliasInfo _ => none
- | .ofFieldRedeclInfo info => info.stx
- | .ofOmissionInfo info => info.stx
-/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
-protected def isOriginal (i : Info) : Bool :=
- match i.stx? with
- | none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
- | some stx => match stx.getHeadInfo with
- | .original .. => true
- | _ => false
-end Lean.Elab.Info
-
-namespace Lean.Elab.TacticInfo
-
-/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
-def name? (t : TacticInfo) : Option Name :=
- match t.stx with
- | Syntax.node _ n _ => some n
- | _ => none
-/-- Decide whether a tactic is "substantive",
-or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
-def isSubstantive (t : TacticInfo) : Bool :=
- match t.name? with
- | none => false
- | some `null => false
- | some ``cdot => false
- | some ``cdotTk => false
- | some ``Lean.Parser.Term.byTactic => false
- | some ``Lean.Parser.Tactic.tacticSeq => false
- | some ``Lean.Parser.Tactic.tacticSeq1Indented => false
- | some ``Lean.Parser.Tactic.«tactic_<;>_» => false
- | some ``Lean.Parser.Tactic.paren => false
- | _ => true
-
-end Lean.Elab.TacticInfo
-
-namespace Lean.Elab.InfoTree
-
-/--
-Keep `.node` nodes and `.hole` nodes satisfying predicates.
-
-Returns a `List InfoTree`, although in most situations this will be a singleton.
--/
-partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
- InfoTree → List InfoTree
- | .context ctx tree => tree.filter p m |>.map (.context ctx)
- | .node info children =>
- if p info then
- [.node info (children.toList.map (filter p m)).join.toPArray']
- else
- (children.toList.map (filter p m)).join
- | .hole mvar => if m mvar then [.hole mvar] else []
-
-end Lean.Elab.InfoTree
-
-
namespace Pantograph.Frontend
-- Info tree filtering functions
@@ -131,19 +64,10 @@ protected def usedConstants (t: TacticInvocation) : NameSet :=
end TacticInvocation
-/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
-partial def findAllInfo (t : Elab.InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
- List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
- match t with
- | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
- | .node i children =>
- (if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
- | _ => []
-
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/
private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
- let infos := findAllInfo t none fun i => match i with
+ let infos := t.findAllInfo none fun i => match i with
| .ofTacticInfo _ => true
| _ => false
infos.filterMap fun p => match p with
@@ -178,7 +102,7 @@ structure InfoWithContext where
context?: Option Elab.ContextInfo := .none
private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
- let infos := findAllInfo t none fun i => match i with
+ let infos := t.findAllInfo none fun i => match i with
| .ofTermInfo { expectedType?, expr, stx, .. } =>
expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
| .ofTacticInfo { stx, goalsBefore, .. } =>
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
new file mode 100644
index 0000000..4e60710
--- /dev/null
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -0,0 +1,81 @@
+/- Adapted from lean-training-data by semorrison -/
+import Lean.Elab.InfoTree
+import Lean.Parser.Term
+
+open Lean
+
+namespace Lean.Elab.Info
+/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
+protected def stx? : Info → Option Syntax
+ | .ofTacticInfo info => info.stx
+ | .ofTermInfo info => info.stx
+ | .ofCommandInfo info => info.stx
+ | .ofMacroExpansionInfo info => info.stx
+ | .ofOptionInfo info => info.stx
+ | .ofFieldInfo info => info.stx
+ | .ofCompletionInfo info => info.stx
+ | .ofUserWidgetInfo info => info.stx
+ | .ofCustomInfo info => info.stx
+ | .ofFVarAliasInfo _ => none
+ | .ofFieldRedeclInfo info => info.stx
+ | .ofOmissionInfo info => info.stx
+/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
+protected def isOriginal (i : Info) : Bool :=
+ match i.stx? with
+ | none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
+ | some stx => match stx.getHeadInfo with
+ | .original .. => true
+ | _ => false
+end Lean.Elab.Info
+
+namespace Lean.Elab.TacticInfo
+
+/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
+def name? (t : TacticInfo) : Option Name :=
+ match t.stx with
+ | Syntax.node _ n _ => some n
+ | _ => none
+/-- Decide whether a tactic is "substantive",
+or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
+def isSubstantive (t : TacticInfo) : Bool :=
+ match t.name? with
+ | none => false
+ | some `null => false
+ | some ``cdot => false
+ | some ``cdotTk => false
+ | some ``Lean.Parser.Term.byTactic => false
+ | some ``Lean.Parser.Tactic.tacticSeq => false
+ | some ``Lean.Parser.Tactic.tacticSeq1Indented => false
+ | some ``Lean.Parser.Tactic.«tactic_<;>_» => false
+ | some ``Lean.Parser.Tactic.paren => false
+ | _ => true
+
+end Lean.Elab.TacticInfo
+
+namespace Lean.Elab.InfoTree
+
+/--
+Keep `.node` nodes and `.hole` nodes satisfying predicates.
+
+Returns a `List InfoTree`, although in most situations this will be a singleton.
+-/
+partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
+ InfoTree → List InfoTree
+ | .context ctx tree => tree.filter p m |>.map (.context ctx)
+ | .node info children =>
+ if p info then
+ [.node info (children.toList.map (filter p m)).join.toPArray']
+ else
+ (children.toList.map (filter p m)).join
+ | .hole mvar => if m mvar then [.hole mvar] else []
+
+/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
+partial def findAllInfo (t : InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
+ List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+ match t with
+ | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
+ | .node i children =>
+ (if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
+ | _ => []
+
+end Lean.Elab.InfoTree
From a8e7a1a726c7fe5595c92e5c5b8ff4228628ab65 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 26 Nov 2024 12:34:52 -0800
Subject: [PATCH 330/465] feat: Erase macro scopes in sexp
---
Pantograph/Delate.lean | 6 +++---
Test/Delate.lean | 2 +-
Test/Library.lean | 2 +-
Test/Proofs.lean | 6 +++---
4 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index be17729..141abd9 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -346,20 +346,20 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
let args := " ".intercalate args
pure s!"({fn'} {args})"
| .lam binderName binderType body binderInfo => do
- let binderName' := ofName binderName
+ let binderName' := binderName.eraseMacroScopes
let binderType' ← self binderType
let body' ← self body
let binderInfo' := binderInfoSexp binderInfo
pure s!"(:lambda {binderName'} {binderType'} {body'}{binderInfo'})"
| .forallE binderName binderType body binderInfo => do
- let binderName' := ofName binderName
+ let binderName' := binderName.eraseMacroScopes
let binderType' ← self binderType
let body' ← self body
let binderInfo' := binderInfoSexp binderInfo
pure s!"(:forall {binderName'} {binderType'} {body'}{binderInfo'})"
| .letE name type value body _ => do
-- Dependent boolean flag diacarded
- let name' := serializeName name
+ let name' := name.eraseMacroScopes
let type' ← self type
let value' ← self value
let body' ← self body
diff --git a/Test/Delate.lean b/Test/Delate.lean
index 227ab24..d918dc8 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -32,7 +32,7 @@ def test_expr_to_binder (env: Environment): IO LSpec.TestSeq := do
def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × String) := [
-- This one contains unhygienic variable names which must be suppressed
- ("Nat.add", "(:forall _ (:c Nat) (:forall _ (:c Nat) (:c Nat)))"),
+ ("Nat.add", "(:forall a (:c Nat) (:forall a (:c Nat) (:c Nat)))"),
-- These ones are normal and easy
("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
diff --git a/Test/Library.lean b/Test/Library.lean
index d995374..df1ba4d 100644
--- a/Test/Library.lean
+++ b/Test/Library.lean
@@ -24,7 +24,7 @@ def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
},
expr := {
pp? := "⟨∀ (x : Prop), x → x, fun x h => h⟩",
- sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall _ 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
+ sexp? := "((:c PSigma.mk) (:sort 0) (:lambda p (:sort 0) 0) (:forall x (:sort 0) (:forall a 0 1)) (:lambda x (:sort 0) (:lambda h 0 0)))",
}
}))
return tests
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8e3e2a2..02c1bf6 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -282,9 +282,9 @@ def test_or_comm: TestM Unit := do
serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
- let motive := s!"(:lambda t._@._hyg.26 {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
- let caseL := s!"(:lambda h._@._hyg.27 (:fv {fvP}) (:lambda h._@._hyg.28 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
- let caseR := s!"(:lambda h._@._hyg.29 (:fv {fvQ}) (:lambda h._@._hyg.30 ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
+ let motive := s!"(:lambda t {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
+ let caseL := s!"(:lambda h (:fv {fvP}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inl) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseL}) (:fv {fvP}) (:fv {fvQ}) 1)))"
+ let caseR := s!"(:lambda h (:fv {fvQ}) (:lambda h ((:c Eq) {orPQ} (:fv {fvH}) ((:c Or.inr) (:fv {fvP}) (:fv {fvQ}) 0)) (:subst (:mv {caseR}) (:fv {fvP}) (:fv {fvQ}) 1)))"
let conduit := s!"((:c Eq.refl) {orPQ} (:fv {fvH}))"
addTest $ LSpec.test "(2 parent)" (state2parent ==
s!"((:c Or.casesOn) (:fv {fvP}) (:fv {fvQ}) {motive} (:fv {fvH}) {caseL} {caseR} {conduit})")
From 44aef76a10a9638caecef46326130ffd7c9fad29 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 26 Nov 2024 12:57:19 -0800
Subject: [PATCH 331/465] refactor: Remove sanitization for mvarId/fvarId
---
Pantograph/Delate.lean | 15 +++++++--------
1 file changed, 7 insertions(+), 8 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 141abd9..4b3bd51 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -327,11 +327,11 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
-- Lean these are handled using a `#` prefix.
pure s!"{deBruijnIndex}"
| .fvar fvarId =>
- let name := ofName fvarId.name
+ let name := fvarId.name
pure s!"(:fv {name})"
| .mvar mvarId => do
let pref := if ← mvarId.isDelayedAssigned then "mvd" else "mv"
- let name := ofName mvarId.name
+ let name := mvarId.name
pure s!"(:{pref} {name})"
| .sort level =>
let level := serializeSortLevel level sanitize
@@ -387,7 +387,6 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
| .implicit => " :implicit"
| .strictImplicit => " :strictImplicit"
| .instImplicit => " :instImplicit"
- ofName (name: Name) := serializeName name sanitize
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with
@@ -420,13 +419,13 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
match localDecl with
| .cdecl _ fvarId userName _ _ _ =>
return {
- name := ofName fvarId.name,
+ name := fvarId.name.toString,
userName:= ofName userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName
}
| .ldecl _ fvarId userName _ _ _ _ => do
return {
- name := ofName fvarId.name,
+ name := fvarId.name.toString,
userName := toString userName.simpMacroScopes,
isInaccessible := userName.isInaccessibleUserName
}
@@ -436,7 +435,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
let userName := userName.simpMacroScopes
let type ← instantiate type
return {
- name := ofName fvarId.name,
+ name := fvarId.name.toString,
userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
@@ -450,7 +449,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
else
pure $ .none
return {
- name := ofName fvarId.name,
+ name := fvarId.name.toString,
userName:= ofName userName,
isInaccessible := userName.isInaccessibleUserName
type? := .some (← serializeExpression options type)
@@ -469,7 +468,7 @@ def serializeGoal (options: @&Protocol.Options) (goal: MVarId) (mvarDecl: Metava
| false => ppVar localDecl
return var::acc
return {
- name := ofName goal.name,
+ name := goal.name.toString,
userName? := if mvarDecl.userName == .anonymous then .none else .some (ofName mvarDecl.userName),
isConversion := isLHSGoal? mvarDecl.type |>.isSome,
target := (← serializeExpression options (← instantiate mvarDecl.type)),
From 7c9b092200ffc3365060cf7e0d6d0db1c809aeb4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 30 Nov 2024 23:21:16 -0800
Subject: [PATCH 332/465] test: Dual monad testing stub
---
Test/Common.lean | 2 ++
Test/Main.lean | 4 +++-
Test/Serial.lean | 56 ++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 61 insertions(+), 1 deletion(-)
create mode 100644 Test/Serial.lean
diff --git a/Test/Common.lean b/Test/Common.lean
index 3998293..ce21ce8 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -130,6 +130,8 @@ def addTest [Monad m] (test: LSpec.TestSeq): TestT m Unit := do
def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done
+def runTestWithResult { α } [Monad m] (t: TestT m α): m (α × LSpec.TestSeq) :=
+ t.run LSpec.TestSeq.done
def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
IO LSpec.TestSeq :=
diff --git a/Test/Main.lean b/Test/Main.lean
index 25bb0d9..6bf410e 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -1,11 +1,12 @@
import LSpec
+import Test.Delate
import Test.Environment
import Test.Frontend
import Test.Integration
import Test.Library
import Test.Metavar
import Test.Proofs
-import Test.Delate
+import Test.Serial
import Test.Tactic
-- Test running infrastructure
@@ -51,6 +52,7 @@ def main (args: List String) := do
("Metavar", Metavar.suite env_default),
("Proofs", Proofs.suite env_default),
("Delate", Delate.suite env_default),
+ ("Serial", Serial.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
diff --git a/Test/Serial.lean b/Test/Serial.lean
new file mode 100644
index 0000000..4cca464
--- /dev/null
+++ b/Test/Serial.lean
@@ -0,0 +1,56 @@
+import LSpec
+import Test.Common
+import Lean
+import Pantograph.Library
+
+open Lean
+
+namespace Pantograph.Test.Serial
+
+structure MultiState where
+ coreContext : Core.Context
+ coreStates : Array Core.State
+
+abbrev TestM := StateRefT MultiState $ TestT $ EIO LSpec.TestSeq
+
+def runCoreM { α } (id : Nat) (testCoreM: TestT CoreM α) : TestM α := do
+ let multiState ← get
+ let state ← match multiState.coreStates[id]? with
+ | .some state => pure state
+ | .none =>
+ let test := LSpec.test "Invalid index" (id < multiState.coreStates.size)
+ throw test
+ let coreM := runTestWithResult testCoreM
+ match ← (coreM.run' multiState.coreContext state).toBaseIO with
+ | .error _ => do
+ let test := LSpec.test "Exception" false
+ throw test
+ | .ok (a, tests) => do
+ set $ (← getThe LSpec.TestSeq) ++ tests
+ return a
+
+def simple : TestM Unit := do
+ return
+
+structure Test where
+ name : String
+ nInstances : Nat
+ routine: TestM Unit
+
+protected def Test.run (test: Test) (env: Lean.Environment) : IO LSpec.TestSeq := do
+ -- Create the state
+ let state : MultiState := {
+ coreContext := ← createCoreContext #[],
+ coreStates := Array.range test.nInstances |>.map λ _ => { env },
+ }
+ match ← (runTest $ test.routine.run' state).toBaseIO with
+ | .ok e => return e
+ | .error e => return e
+
+def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
+ let tests: List Test := [
+ { name := "simple", nInstances := 2, routine := simple }
+ ]
+ tests.map (fun test => (test.name, test.run env))
+
+end Pantograph.Test.Serial
From 0f946880ae87a5b746b188dcc946ee8c2cbefa8b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 4 Dec 2024 10:44:33 -0800
Subject: [PATCH 333/465] test: Environment pickling
---
Pantograph/Serial.lean | 4 +--
Repl.lean | 4 +--
Test/Common.lean | 9 +++++-
Test/Serial.lean | 73 ++++++++++++++++++++++++++++++------------
4 files changed, 64 insertions(+), 26 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index 2f04bdb..e60fc54 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -55,7 +55,7 @@ and when unpickling, we build a fresh `Environment` from the imports,
and then add the new constants.
-/
@[export pantograph_env_pickle_m]
-def env_pickle (env : Environment) (path : System.FilePath) : IO Unit :=
+def environmentPickle (env : Environment) (path : System.FilePath) : IO Unit :=
Pantograph.pickle path (env.header.imports, env.constants.map₂)
/--
@@ -65,7 +65,7 @@ We construct a fresh `Environment` with the relevant imports,
and then replace the new constants.
-/
@[export pantograph_env_unpickle_m]
-def env_unpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
+def environmentUnpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path
let env ← importModules imports {} 0
return (← env.replay (Std.HashMap.ofList map₂.toList), region)
diff --git a/Repl.lean b/Repl.lean
index e162f05..f0572a1 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -90,10 +90,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
Environment.addDecl args
env_save (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
let env ← Lean.MonadEnv.getEnv
- env_pickle env args.path
+ environmentPickle env args.path
return .ok {}
env_load (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
- let (env, _) ← env_unpickle args.path
+ let (env, _) ← environmentUnpickle args.path
Lean.setEnv env
return .ok {}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
diff --git a/Test/Common.lean b/Test/Common.lean
index ce21ce8..0a0b44c 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -125,9 +125,16 @@ def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
abbrev TestT := StateT LSpec.TestSeq
-def addTest [Monad m] (test: LSpec.TestSeq): TestT m Unit := do
+def addTest [Monad m] (test: LSpec.TestSeq) : TestT m Unit := do
set $ (← get) ++ test
+def checkEq [Monad m] [DecidableEq α] (desc : String) (lhs rhs : α) : TestT m Unit := do
+ addTest $ LSpec.check desc (lhs == rhs)
+def checkTrue [Monad m] (desc : String) (flag : Bool) : TestT m Unit := do
+ addTest $ LSpec.check desc flag
+def fail [Monad m] (desc : String) : TestT m Unit := do
+ addTest $ LSpec.check desc false
+
def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done
def runTestWithResult { α } [Monad m] (t: TestT m α): m (α × LSpec.TestSeq) :=
diff --git a/Test/Serial.lean b/Test/Serial.lean
index 4cca464..d1ce661 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -7,30 +7,60 @@ open Lean
namespace Pantograph.Test.Serial
+def tempPath : IO System.FilePath := do
+ Prod.snd <$> IO.FS.createTempFile
+
structure MultiState where
coreContext : Core.Context
- coreStates : Array Core.State
+ env: Environment
-abbrev TestM := StateRefT MultiState $ TestT $ EIO LSpec.TestSeq
+abbrev TestM := TestT $ StateRefT MultiState $ IO
-def runCoreM { α } (id : Nat) (testCoreM: TestT CoreM α) : TestM α := do
- let multiState ← get
- let state ← match multiState.coreStates[id]? with
- | .some state => pure state
- | .none =>
- let test := LSpec.test "Invalid index" (id < multiState.coreStates.size)
- throw test
+instance : MonadEnv TestM where
+ getEnv := return (← getThe MultiState).env
+ modifyEnv f := do modifyThe MultiState fun s => { s with env := f s.env }
+
+def runCoreM { α } (state : Core.State) (testCoreM : TestT CoreM α) : TestM (α × Core.State) := do
+ let multiState ← getThe MultiState
let coreM := runTestWithResult testCoreM
- match ← (coreM.run' multiState.coreContext state).toBaseIO with
- | .error _ => do
- let test := LSpec.test "Exception" false
- throw test
- | .ok (a, tests) => do
+ match ← (coreM.run multiState.coreContext state).toBaseIO with
+ | .error e => do
+ throw $ .userError $ ← e.toMessageData.toString
+ | .ok ((a, tests), state') => do
set $ (← getThe LSpec.TestSeq) ++ tests
- return a
+ return (a, state')
-def simple : TestM Unit := do
- return
+def test_environment_pickling : TestM Unit := do
+ let stateSrc: Core.State := { env := ← getEnv }
+ let stateDst: Core.State := { env := ← getEnv }
+
+ let name := `mystery
+ let envPicklePath ← tempPath
+ let ((), _) ← runCoreM stateSrc do
+ let type: Expr := .forallE `p (.sort 0) (.forallE `h (.bvar 0) (.bvar 1) .default) .default
+ let value: Expr := .lam `p (.sort 0) (.lam `h (.bvar 0) (.bvar 0) .default) .default
+ let c := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
+ (name := name)
+ (levelParams := [])
+ (type := type)
+ (value := value)
+ (hints := Lean.mkReducibilityHintsRegularEx 1)
+ (safety := Lean.DefinitionSafety.safe)
+ (all := [])
+ let env' ← match (← getEnv).addDecl (← getOptions) c with
+ | .error e => do
+ let error ← (e.toMessageData (← getOptions)).toString
+ throwError error
+ | .ok env' => pure env'
+ environmentPickle env' envPicklePath
+
+ let _ ← runCoreM stateDst do
+ let (env', _) ← environmentUnpickle envPicklePath
+ checkTrue s!"Has symbol {name}" (env'.find? name).isSome
+ let anotherName := `mystery2
+ checkTrue s!"Doesn't have symbol {anotherName}" (env'.find? anotherName).isNone
+
+ IO.FS.removeFile envPicklePath
structure Test where
name : String
@@ -41,15 +71,16 @@ protected def Test.run (test: Test) (env: Lean.Environment) : IO LSpec.TestSeq :
-- Create the state
let state : MultiState := {
coreContext := ← createCoreContext #[],
- coreStates := Array.range test.nInstances |>.map λ _ => { env },
+ env,
}
- match ← (runTest $ test.routine.run' state).toBaseIO with
+ match ← ((runTest $ test.routine).run' state).toBaseIO with
| .ok e => return e
- | .error e => return e
+ | .error e =>
+ return LSpec.check "Emitted exception" (e.toString == "")
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests: List Test := [
- { name := "simple", nInstances := 2, routine := simple }
+ { name := "environment_pickling", nInstances := 2, routine := test_environment_pickling },
]
tests.map (fun test => (test.name, test.run env))
From 105fb7af4bed8da4969ef1265106c239861dece9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 14:23:55 -0800
Subject: [PATCH 334/465] feat: Goal state pickling
---
Pantograph/Serial.lean | 89 ++++++++++++++++++++++++++++++++++++++++++
Test/Serial.lean | 36 +++++++++++++----
2 files changed, 118 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index e60fc54..bd01169 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -2,6 +2,7 @@ import Lean.Environment
import Lean.Replay
import Init.System.IOError
import Std.Data.HashMap
+import Pantograph.Goal
/-!
Input/Output functions
@@ -70,4 +71,92 @@ def environmentUnpickle (path : System.FilePath) : IO (Environment × CompactedR
let env ← importModules imports {} 0
return (← env.replay (Std.HashMap.ofList map₂.toList), region)
+
+open Lean.Core in
+structure CompactCoreState where
+ -- env : Environment
+ nextMacroScope : MacroScope := firstFrontendMacroScope + 1
+ ngen : NameGenerator := {}
+ -- traceState : TraceState := {}
+ -- cache : Cache := {}
+ -- messages : MessageLog := {}
+ -- infoState : Elab.InfoState := {}
+
+@[export pantograph_goal_state_pickle_m]
+def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :=
+ let {
+ savedState := {
+ term := {
+ meta := {
+ core,
+ meta,
+ }
+ «elab»,
+ },
+ tactic
+ }
+ root,
+ parentMVar?,
+ convMVar?,
+ calcPrevRhs?,
+ } := goalState
+ --let env := core.env
+ Pantograph.pickle path (
+ ({ core with } : CompactCoreState),
+ meta,
+ «elab»,
+ tactic,
+
+ root,
+ parentMVar?,
+ convMVar?,
+ calcPrevRhs?,
+ )
+
+@[export pantograph_goal_state_unpickle_m]
+def goalStateUnpickle (path : System.FilePath) (env : Environment)
+ : IO (GoalState × CompactedRegion) := unsafe do
+ let ((
+ compactCore,
+ meta,
+ «elab»,
+ tactic,
+
+ root,
+ parentMVar?,
+ convMVar?,
+ calcPrevRhs?,
+ ), region) ← Pantograph.unpickle (
+ CompactCoreState ×
+ Meta.State ×
+ Elab.Term.State ×
+ Elab.Tactic.State ×
+
+ MVarId ×
+ Option MVarId ×
+ Option (MVarId × MVarId × List MVarId) ×
+ Option (MVarId × Expr)
+ ) path
+ let goalState := {
+ savedState := {
+ term := {
+ meta := {
+ core := {
+ compactCore with
+ passedHeartbeats := 0,
+ env,
+ },
+ meta,
+ },
+ «elab»,
+ },
+ tactic,
+ },
+ root,
+ parentMVar?,
+ convMVar?,
+ calcPrevRhs?,
+ }
+ return (goalState, region)
+
end Pantograph
diff --git a/Test/Serial.lean b/Test/Serial.lean
index d1ce661..fcdc155 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -31,12 +31,12 @@ def runCoreM { α } (state : Core.State) (testCoreM : TestT CoreM α) : TestM (
return (a, state')
def test_environment_pickling : TestM Unit := do
- let stateSrc: Core.State := { env := ← getEnv }
- let stateDst: Core.State := { env := ← getEnv }
+ let coreSrc : Core.State := { env := ← getEnv }
+ let coreDst : Core.State := { env := ← getEnv }
let name := `mystery
let envPicklePath ← tempPath
- let ((), _) ← runCoreM stateSrc do
+ let ((), _) ← runCoreM coreSrc do
let type: Expr := .forallE `p (.sort 0) (.forallE `h (.bvar 0) (.bvar 1) .default) .default
let value: Expr := .lam `p (.sort 0) (.lam `h (.bvar 0) (.bvar 0) .default) .default
let c := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
@@ -54,7 +54,7 @@ def test_environment_pickling : TestM Unit := do
| .ok env' => pure env'
environmentPickle env' envPicklePath
- let _ ← runCoreM stateDst do
+ let _ ← runCoreM coreDst do
let (env', _) ← environmentUnpickle envPicklePath
checkTrue s!"Has symbol {name}" (env'.find? name).isSome
let anotherName := `mystery2
@@ -62,9 +62,30 @@ def test_environment_pickling : TestM Unit := do
IO.FS.removeFile envPicklePath
+def test_goal_state_pickling_simple : TestM Unit := do
+ let coreSrc : Core.State := { env := ← getEnv }
+ let coreDst : Core.State := { env := ← getEnv }
+ let statePath ← tempPath
+
+ let type: Expr := .forallE `p (.sort 0) (.forallE `h (.bvar 0) (.bvar 1) .default) .default
+ let stateGenerate : MetaM GoalState := runTermElabMInMeta do
+ GoalState.create type
+
+ let ((), _) ← runCoreM coreSrc do
+ let state ← stateGenerate.run'
+ goalStatePickle state statePath
+
+ let ((), _) ← runCoreM coreDst do
+ let (goalState, _) ← goalStateUnpickle statePath (← getEnv)
+ let metaM : MetaM (List Expr) := do
+ goalState.goals.mapM λ goal => goalState.withContext goal goal.getType
+ let types ← metaM.run'
+ checkTrue "Goals" $ types[0]!.equal type
+
+ IO.FS.removeFile statePath
+
structure Test where
name : String
- nInstances : Nat
routine: TestM Unit
protected def Test.run (test: Test) (env: Lean.Environment) : IO LSpec.TestSeq := do
@@ -76,11 +97,12 @@ protected def Test.run (test: Test) (env: Lean.Environment) : IO LSpec.TestSeq :
match ← ((runTest $ test.routine).run' state).toBaseIO with
| .ok e => return e
| .error e =>
- return LSpec.check "Emitted exception" (e.toString == "")
+ return LSpec.check s!"Emitted exception: {e.toString}" (e.toString == "")
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests: List Test := [
- { name := "environment_pickling", nInstances := 2, routine := test_environment_pickling },
+ { name := "environment_pickling", routine := test_environment_pickling, },
+ { name := "goal_state_pickling_simple", routine := test_goal_state_pickling_simple, },
]
tests.map (fun test => (test.name, test.run env))
From c54ce93ef5eb745a3db7668886f35ed034f42afb Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 14:31:43 -0800
Subject: [PATCH 335/465] feat: Goal State IO in REPL
---
Pantograph/Protocol.lean | 13 +++++++++++++
Repl.lean | 36 +++++++++++++++++++++++-------------
2 files changed, 36 insertions(+), 13 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index fcd5ebe..0cb6cac 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -289,6 +289,19 @@ structure GoalDiag where
instantiate: Bool := true
printSexp: Bool := false
+structure GoalSave where
+ id: Nat
+ path: System.FilePath
+ deriving Lean.FromJson
+structure GoalSaveResult where
+ deriving Lean.ToJson
+structure GoalLoad where
+ path: System.FilePath
+ deriving Lean.FromJson
+structure GoalLoadResult where
+ id: Nat
+ deriving Lean.ToJson
+
/-- Executes the Lean compiler on a single file -/
structure FrontendProcess where
diff --git a/Repl.lean b/Repl.lean
index f0572a1..3f8a3c6 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -15,6 +15,16 @@ structure State where
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
+def newGoalState (goalState: GoalState) : MainM Nat := do
+ let state ← get
+ let stateId := state.nextId
+ set { state with
+ goalStates := state.goalStates.insert stateId goalState,
+ nextId := state.nextId + 1
+ }
+ return stateId
+
+
-- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
-- certain monadic features in `MainM`
abbrev CR α := Except Protocol.InteractionError α
@@ -50,6 +60,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "goal.continue" => run goal_continue
| "goal.delete" => run goal_delete
| "goal.print" => run goal_print
+ | "goal.save" => run goal_save
+ | "goal.load" => run goal_load
| "frontend.process" => run frontend_process
| cmd =>
let error: Protocol.InteractionError :=
@@ -62,14 +74,6 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
errorCommand := errorI "command"
errorIndex := errorI "index"
errorIO := errorI "io"
- newGoalState (goalState: GoalState) : MainM Nat := do
- let state ← get
- let stateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert stateId goalState,
- nextId := state.nextId + 1
- }
- return stateId
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -203,11 +207,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
match nextState? with
| .error error => return .error <| errorI "structure" error
| .ok nextGoalState =>
- let nextStateId := state.nextId
- set { state with
- goalStates := state.goalStates.insert nextStateId nextGoalState,
- nextId := state.nextId + 1
- }
+ let nextStateId ← newGoalState nextGoalState
let goals ← goalSerialize nextGoalState (options := state.options)
return .ok {
nextStateId,
@@ -224,6 +224,16 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return .error $ errorIndex s!"Invalid state index {args.stateId}"
let result ← runMetaInMainM <| goalPrint goalState state.options
return .ok result
+ goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
+ let state ← get
+ let .some goalState := state.goalStates[args.id]? |
+ return .error $ errorIndex s!"Invalid state index {args.id}"
+ goalStatePickle goalState args.path
+ return .ok {}
+ goal_load (args: Protocol.GoalLoad): MainM (CR Protocol.GoalLoadResult) := do
+ let (goalState, _) ← goalStateUnpickle args.path (← Lean.MonadEnv.getEnv)
+ let id ← newGoalState goalState
+ return .ok { id }
frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
let options := (← get).options
try
From 3da85b7f04fda00d98222f4f988d05461cd03dc1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 16:00:46 -0800
Subject: [PATCH 336/465] doc: Documentation for save/load
---
README.md | 57 +-----------------------------------------------
doc/repl.md | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 64 insertions(+), 56 deletions(-)
create mode 100644 doc/repl.md
diff --git a/README.md b/README.md
index 04213ae..5fec564 100644
--- a/README.md
+++ b/README.md
@@ -64,62 +64,7 @@ stat
```
where the application of `assumption` should lead to a failure.
-### Commands
-
-See `Pantograph/Protocol.lean` for a description of the parameters and return values in JSON.
-* `reset`: Delete all cached expressions and proof trees
-* `stat`: Display resource usage
-* `expr.echo {"expr": <expr>, "type": <optional expected type>, ["levels": [<levels>]]}`: Determine the
- type of an expression and format it.
-* `env.catalog`: Display a list of all safe Lean symbols in the current environment
-* `env.inspect {"name": <name>, "value": <bool>}`: 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
- have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
-
- One particular option for interest for machine learning researchers is the
- automatic mode (flag: `"automaticMode"`). By default it is turned on, with
- all goals automatically resuming. This makes Pantograph act like a gym,
- with no resumption necessary to manage your goals.
-* `options.print`: Display the current set of options
-* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
- Start a new proof from a given expression or symbol
-* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
- given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
- - `{ "tactic": <tactic> }`: Execute an ordinary tactic
- - `{ "expr": <expr> }`: Assign the given proof term to the current goal
- - `{ "have": <expr>, "binderName": <name> }`: Execute `have` and creates a branch goal
- - `{ "calc": <expr> }`: Execute one step of a `calc` tactic. Each step must
- be of the form `lhs op rhs`. An `lhs` of `_` indicates that it should be set
- to the previous `rhs`.
- - `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
- exit, the goal id is ignored.
-* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`:
- Execute continuation/resumption
- - `{ "branch": <id> }`: Continue on branch state. The current state must have no goals.
- - `{ "goals": <names> }`: Resume the given goals
-* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
-* `goal.print {"stateId": <id>}"`: Print a goal state
-* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
- <bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
- either the tactic invocations (`"invocations": true`) or the sorrys into goal
- states (`"sorrys": true`)
-
-### Errors
-
-When an error pertaining to the execution of a command happens, the returning JSON structure is
-
-``` json
-{ "error": "type", "desc": "description" }
-```
-Common error forms:
-* `command`: Indicates malformed command structure which results from either
- invalid command or a malformed JSON structure that cannot be fed to an
- individual command.
-* `index`: Indicates an invariant maintained by the output of one command and
- input of another is broken. For example, attempting to query a symbol not
- existing in the library or indexing into a non-existent proof state.
+For a list of commands, see [REPL Documentation](doc/repl.md).
### Project Environment
diff --git a/doc/repl.md b/doc/repl.md
new file mode 100644
index 0000000..a31db4f
--- /dev/null
+++ b/doc/repl.md
@@ -0,0 +1,63 @@
+# REPL
+
+## Commands
+
+See `Pantograph/Protocol.lean` for a description of the parameters and return values in JSON.
+* `reset`: Delete all cached expressions and proof trees
+* `stat`: Display resource usage
+* `expr.echo {"expr": <expr>, "type": <optional expected type>, ["levels": [<levels>]]}`: Determine the
+ type of an expression and format it.
+* `env.catalog`: Display a list of all safe Lean symbols in the current environment
+* `env.inspect {"name": <name>, "value": <bool>}`: 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.
+* `env.save { path }`, `env.load { path }`: Save/Load the current environment
+ to/from a file
+* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
+ have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
+
+ One particular option for interest for machine learning researchers is the
+ automatic mode (flag: `"automaticMode"`). By default it is turned on, with
+ all goals automatically resuming. This makes Pantograph act like a gym,
+ with no resumption necessary to manage your goals.
+* `options.print`: Display the current set of options
+* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
+ Start a new proof from a given expression or symbol
+* `goal.tactic {"stateId": <id>, "goalId": <id>, ...}`: Execute a tactic string on a
+ given goal. The tactic is supplied as additional key-value pairs in one of the following formats:
+ - `{ "tactic": <tactic> }`: Execute an ordinary tactic
+ - `{ "expr": <expr> }`: Assign the given proof term to the current goal
+ - `{ "have": <expr>, "binderName": <name> }`: Execute `have` and creates a branch goal
+ - `{ "calc": <expr> }`: Execute one step of a `calc` tactic. Each step must
+ be of the form `lhs op rhs`. An `lhs` of `_` indicates that it should be set
+ to the previous `rhs`.
+ - `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
+ exit, the goal id is ignored.
+* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`:
+ Execute continuation/resumption
+ - `{ "branch": <id> }`: Continue on branch state. The current state must have no goals.
+ - `{ "goals": <names> }`: Resume the given goals
+* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
+* `goal.print {"stateId": <id>}"`: Print a goal state
+* `goal.save`{ id, path }, `env.load { path }`: Save/Load a goal state to/from a
+ file. The environment is not carried with the state. The user is responsible
+ to ensure the sender/receiver instances share the same environment.
+* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
+ <bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
+ either the tactic invocations (`"invocations": true`) or the sorrys into goal
+ states (`"sorrys": true`)
+
+## Errors
+
+When an error pertaining to the execution of a command happens, the returning JSON structure is
+
+``` json
+{ "error": "type", "desc": "description" }
+```
+Common error forms:
+* `command`: Indicates malformed command structure which results from either
+ invalid command or a malformed JSON structure that cannot be fed to an
+ individual command.
+* `index`: Indicates an invariant maintained by the output of one command and
+ input of another is broken. For example, attempting to query a symbol not
+ existing in the library or indexing into a non-existent proof state.
From bfdc7dd39ee008506dafb010725fc192ccbe5287 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 16:02:00 -0800
Subject: [PATCH 337/465] doc: Fix code environment
---
doc/repl.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/doc/repl.md b/doc/repl.md
index a31db4f..978bad2 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -39,7 +39,7 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
- `{ "goals": <names> }`: Resume the given goals
* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state
-* `goal.save`{ id, path }, `env.load { path }`: Save/Load a goal state to/from a
+* `goal.save{ id, path }`, `goal.load { path }`: Save/Load a goal state to/from a
file. The environment is not carried with the state. The user is responsible
to ensure the sender/receiver instances share the same environment.
* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
From d00e3769430c1fe5df0c2528768738617a29efd2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 17:18:35 -0800
Subject: [PATCH 338/465] doc: Remove outdated documentation
---
.gitignore | 6 ++----
README.md | 2 +-
2 files changed, 3 insertions(+), 5 deletions(-)
diff --git a/.gitignore b/.gitignore
index 21bcd46..53ec3bb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,4 @@
.*
!.gitignore
-
-*.olean
-/build
-/lake-packages
+*.[io]lean
+/result
diff --git a/README.md b/README.md
index 5fec564..47456ea 100644
--- a/README.md
+++ b/README.md
@@ -75,7 +75,7 @@ the environment might be setup like this:
``` sh
LIB="../lib"
-LIB_MATHLIB="$LIB/mathlib4/lake-packages"
+LIB_MATHLIB="$LIB/mathlib4/.lake"
export LEAN_PATH="$LIB/mathlib4/build/lib:$LIB_MATHLIB/aesop/build/lib:$LIB_MATHLIB/Qq/build/lib:$LIB_MATHLIB/std/build/lib"
LEAN_PATH=$LEAN_PATH build/bin/pantograph $@
From 95408d1d523aa679b544568112da8535506d14e2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 17:21:06 -0800
Subject: [PATCH 339/465] doc: Unify types
---
doc/repl.md | 13 +++++++------
1 file changed, 7 insertions(+), 6 deletions(-)
diff --git a/doc/repl.md b/doc/repl.md
index 978bad2..464c7cc 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -11,8 +11,8 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
* `env.inspect {"name": <name>, "value": <bool>}`: 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.
-* `env.save { path }`, `env.load { path }`: Save/Load the current environment
- to/from a file
+* `env.save { "path": <fileName> }`, `env.load { "path": <fileName> }`: Save/Load the
+ current environment to/from a file
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
@@ -39,10 +39,11 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
- `{ "goals": <names> }`: Resume the given goals
* `goal.remove {"stateIds": [<id>]}"`: Drop the goal states specified in the list
* `goal.print {"stateId": <id>}"`: Print a goal state
-* `goal.save{ id, path }`, `goal.load { path }`: Save/Load a goal state to/from a
- file. The environment is not carried with the state. The user is responsible
- to ensure the sender/receiver instances share the same environment.
-* `frontend.process { ["fileName": <fileName>",] ["file": <str>], invocations:
+* `goal.save { "id": <id>, "path": <fileName> }`, `goal.load { "path": <fileName> }`:
+ Save/Load a goal state to/from a file. The environment is not carried with the
+ state. The user is responsible to ensure the sender/receiver instances share
+ the same environment.
+* `frontend.process { ["fileName": <fileName>,] ["file": <str>], invocations:
<bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
either the tactic invocations (`"invocations": true`) or the sorrys into goal
states (`"sorrys": true`)
From 13dd11e9955dc12bf40208b22898c2942c844cce Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 18:55:30 -0800
Subject: [PATCH 340/465] chore: Update Lean to v4.14
---
Pantograph/Frontend/Basic.lean | 2 +-
Pantograph/Frontend/Elab.lean | 15 ++++++++-------
Test/Integration.lean | 2 +-
Test/Proofs.lean | 24 ++++++++++++------------
Test/Tactic/MotivatedApply.lean | 6 +++---
lean-toolchain | 2 +-
6 files changed, 26 insertions(+), 25 deletions(-)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 1074a94..51f3433 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -60,7 +60,7 @@ def processOneCommand: FrontendM (CompilationStep × Bool) := do
let s := (← get).commandState
let before := s.env
let done ← Elab.Frontend.processCommand
- let stx := (← get).commands.back
+ let stx := (← get).commands.back!
let src := (← read).inputCtx.input.toSubstring.extract (← get).cmdPos (← get).parserState.pos
let s' := (← get).commandState
let after := s'.env
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index ceecfae..57179c4 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -70,9 +70,9 @@ partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
| .context ctx tree => tree.filter p m |>.map (.context ctx)
| .node info children =>
if p info then
- [.node info (children.toList.map (filter p m)).join.toPArray']
+ [.node info (children.toList.map (filter p m)).flatten.toPArray']
else
- (children.toList.map (filter p m)).join
+ (children.toList.map (filter p m)).flatten
| .hole mvar => if m mvar then [.hole mvar] else []
end Lean.Elab.InfoTree
@@ -137,7 +137,8 @@ partial def findAllInfo (t : Elab.InfoTree) (context?: Option Elab.ContextInfo)
match t with
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
| .node i children =>
- (if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
+ (if pred i then [(i, context?, children)] else []) ++
+ children.toList.flatMap (fun t => findAllInfo t context? pred)
| _ => []
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
@@ -155,10 +156,10 @@ def collectTactics (t : Elab.InfoTree) : List TacticInvocation :=
@[export pantograph_frontend_collect_tactics_from_compilation_step_m]
def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protocol.InvokedTactic) := do
- let tacticInfoTrees := step.trees.bind λ tree => tree.filter λ
+ let tacticInfoTrees := step.trees.flatMap λ tree => tree.filter λ
| info@(.ofTacticInfo _) => info.isOriginal
| _ => false
- let tactics := tacticInfoTrees.bind collectTactics
+ let tactics := tacticInfoTrees.flatMap collectTactics
tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
@@ -191,7 +192,7 @@ private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
def collectSorrys (step: CompilationStep) : List InfoWithContext :=
- step.trees.bind collectSorrysInTree
+ step.trees.flatMap collectSorrysInTree
@@ -211,7 +212,7 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
| .ofTacticInfo tacticInfo => do
MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
| _ => panic! "Invalid info"
- let goals := List.join (← goalsM.run {} |>.run' {})
+ let goals := List.flatten (← goalsM.run {} |>.run' {})
let root := match goals with
| [] => panic! "No MVars generated"
| [g] => g
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9fb86b7..60f011f 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -73,7 +73,7 @@ def test_tactic : Test :=
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.print" [("stateId", .num 1)]
- ({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
+ ({ parent? := .some { pp? := .some "fun x => ?m.11" }, }: Protocol.GoalPrintResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
]
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 02c1bf6..dfe3722 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -564,10 +564,10 @@ def test_nat_zero_add: TestM Unit := do
return ()
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal "_uniq.68" [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
+ buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal "_uniq.72" [("n", "Nat")] "Nat",
+ buildNamedGoal "_uniq.73" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal "_uniq.74" [("n", "Nat")] "?motive ?m.72 = (n + 0 = n)" (.some "conduit")
])
let tactic := "exact n"
@@ -650,13 +650,13 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let major := "_uniq.68"
+ let major := "_uniq.72"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.67" [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat → Prop" (.some "motive"),
buildNamedGoal major [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.69" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.70" [("n", "Nat")] "?motive ?m.68 = (n + 0 = n)" (.some "conduit")
+ buildNamedGoal "_uniq.73" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal "_uniq.74" [("n", "Nat")] "?motive ?m.72 = (n + 0 = n)" (.some "conduit")
])
let tactic := "intro x"
@@ -673,7 +673,7 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let (eqL, eqR, eqT) := ("_uniq.88", "_uniq.89", "_uniq.87")
+ let (eqL, eqR, eqT) := ("_uniq.92", "_uniq.93", "_uniq.91")
addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with
@@ -684,16 +684,16 @@ def test_nat_zero_add_alt: TestM Unit := do
let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
- let fvN := "_uniq.63"
+ let fvN := "_uniq.67"
let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
let substOf (mv: String) := s!"(:subst (:mv {mv}) (:fv {fvN}) (:mv {major}))"
addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
#[
{
- name := "_uniq.70",
+ name := "_uniq.74",
userName? := .some "conduit",
target := {
- pp? := .some "(?m.92 ?m.68 = ?m.94 ?m.68) = (n + 0 = n)",
+ pp? := .some "(?m.96 ?m.72 = ?m.98 ?m.72) = (n + 0 = n)",
sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
},
vars := #[{
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 4fb05e3..8c8fdad 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -40,7 +40,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.67 = (n + 0 = n)",
+ "?motive ?m.71 = (n + 0 = n)",
])
addTest test
@@ -83,7 +83,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
- let majorId := 67
+ let majorId := 71
addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Nat → Prop",
@@ -100,7 +100,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
addTest $ ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.138 ?m.{majorId}) = (n + 0 = n)")
+ return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.146 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
diff --git a/lean-toolchain b/lean-toolchain
index 8998520..1e70935 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.12.0
+leanprover/lean4:v4.14.0
From fb3d36584fe7f5155669ab3227fc5213b8f3c3e6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 18:59:14 -0800
Subject: [PATCH 341/465] chore: Add formatter, update lean4-nix
---
flake.lock | 7 ++-
flake.nix | 157 ++++++++++++++++++++++++++++-------------------------
2 files changed, 87 insertions(+), 77 deletions(-)
diff --git a/flake.lock b/flake.lock
index f40dde9..9f54bbe 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,15 +42,16 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1731711316,
- "narHash": "sha256-s5u+A2/Ea9gPveB5wwVM5dWW0NST6kamDsTeovGuLEs=",
+ "lastModified": 1733351931,
+ "narHash": "sha256-ngMjY/ci6490G2gofaS9CODtpnmFoYzfaI13U14TkFM=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "136fc6057c48de970579e960b62421e9c295b67d",
+ "rev": "157c85903f668fadeb79f330961b7bbe5ee596de",
"type": "github"
},
"original": {
"owner": "lenianiva",
+ "ref": "157c85903f668fadeb79f330961b7bbe5ee596de",
"repo": "lean4-nix",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 91901d8..d8ce698 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-24.05";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean4-nix.url = "github:lenianiva/lean4-nix";
+ lean4-nix.url = "github:lenianiva/lean4-nix?ref=157c85903f668fadeb79f330961b7bbe5ee596de";
lspec = {
url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
flake = false;
@@ -18,80 +18,89 @@
lean4-nix,
lspec,
...
- } : flake-parts.lib.mkFlake { inherit inputs; } {
- flake = {
- };
- systems = [
- "x86_64-linux"
- "x86_64-darwin"
- ];
- perSystem = { system, pkgs, ... }: let
- pkgs = import nixpkgs {
- inherit system;
- overlays = [ (lean4-nix.readToolchainFile ./lean-toolchain) ];
+ }:
+ flake-parts.lib.mkFlake {inherit inputs;} {
+ flake = {
};
- lspecLib = pkgs.lean.buildLeanPackage {
- name = "LSpec";
- roots = [ "Main" "LSpec" ];
- src = "${lspec}";
- };
- project = pkgs.lean.buildLeanPackage {
- name = "Pantograph";
- roots = [ "Pantograph" ];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "/Test/" path) &&
- !(pkgs.lib.hasSuffix ".md" path) &&
- !(pkgs.lib.hasSuffix "Repl.lean" path);
- });
- };
- repl = pkgs.lean.buildLeanPackage {
- name = "Repl";
- roots = [ "Main" "Repl" ];
- deps = [ project ];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "/Test/" path) &&
- !(pkgs.lib.hasSuffix ".md" path);
- });
- };
- test = pkgs.lean.buildLeanPackage {
- name = "Test";
- # NOTE: The src directory must be ./. since that is where the import
- # root begins (e.g. `import Test.Environment` and not `import
- # Environment`) and thats where `lakefile.lean` resides.
- roots = [ "Test.Main" ];
- deps = [ lspecLib repl ];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "Pantograph" path);
- });
- };
- in rec {
- packages = {
- inherit (pkgs.lean) lean lean-all;
- inherit (project) sharedLib iTree;
- inherit (repl) executable;
- default = repl.executable;
- };
- legacyPackages = {
- inherit project;
- leanPkgs = pkgs.lean;
- };
- checks = {
- test = pkgs.runCommand "test" {
- buildInputs = [ test.executable pkgs.lean.lean-all ];
- } ''
- #export LEAN_SRC_PATH="${./.}"
- ${test.executable}/bin/test > $out
- '';
- };
- devShells.default = pkgs.mkShell {
- buildInputs = [ pkgs.lean.lean-all pkgs.lean.lean ];
+ systems = [
+ "aarch64-linux"
+ "aarch64-darwin"
+ "x86_64-linux"
+ "x86_64-darwin"
+ ];
+ perSystem = {
+ system,
+ pkgs,
+ ...
+ }: let
+ pkgs = import nixpkgs {
+ inherit system;
+ overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)];
+ };
+ lspecLib = pkgs.lean.buildLeanPackage {
+ name = "LSpec";
+ roots = ["Main" "LSpec"];
+ src = "${lspec}";
+ };
+ project = pkgs.lean.buildLeanPackage {
+ name = "Pantograph";
+ roots = ["Pantograph"];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "/Test/" path)
+ && !(pkgs.lib.hasSuffix ".md" path)
+ && !(pkgs.lib.hasSuffix "Repl.lean" path);
+ });
+ };
+ repl = pkgs.lean.buildLeanPackage {
+ name = "Repl";
+ roots = ["Main" "Repl"];
+ deps = [project];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "/Test/" path)
+ && !(pkgs.lib.hasSuffix ".md" path);
+ });
+ };
+ test = pkgs.lean.buildLeanPackage {
+ name = "Test";
+ # NOTE: The src directory must be ./. since that is where the import
+ # root begins (e.g. `import Test.Environment` and not `import
+ # Environment`) and thats where `lakefile.lean` resides.
+ roots = ["Test.Main"];
+ deps = [lspecLib repl];
+ src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
+ src = ./.;
+ filter = path: type:
+ !(pkgs.lib.hasInfix "Pantograph" path);
+ });
+ };
+ in rec {
+ packages = {
+ inherit (pkgs.lean) lean lean-all;
+ inherit (project) sharedLib iTree;
+ inherit (repl) executable;
+ default = repl.executable;
+ };
+ formatter = pkgs.alejandra;
+ legacyPackages = {
+ inherit project;
+ leanPkgs = pkgs.lean;
+ };
+ checks = {
+ test =
+ pkgs.runCommand "test" {
+ buildInputs = [test.executable pkgs.lean.lean-all];
+ } ''
+ #export LEAN_SRC_PATH="${./.}"
+ ${test.executable}/bin/test > $out
+ '';
+ };
+ devShells.default = pkgs.mkShell {
+ buildInputs = [pkgs.lean.lean-all pkgs.lean.lean];
+ };
};
};
- };
}
From 2e2658bde79aa02c6593371e098a924488ba98bf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 21:35:37 -0800
Subject: [PATCH 342/465] test: Add test case for composite tactic
---
Test/Proofs.lean | 25 +++++++++++++++++++++----
1 file changed, 21 insertions(+), 4 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 02c1bf6..8db8f19 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -14,10 +14,7 @@ inductive Start where
| copy (name: String) -- Start from some name in the environment
| expr (expr: String) -- Start from some expression
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
-
-def addTest (test: LSpec.TestSeq): TestM Unit := do
- set $ (← get) ++ test
+abbrev TestM := TestT $ ReaderT Protocol.Options $ Elab.TermElabM
def startProof (start: Start): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
@@ -704,6 +701,25 @@ def test_nat_zero_add_alt: TestM Unit := do
}
])
+def test_composite_tactic_failure: TestM Unit := do
+ let state? ← startProof (.expr "∀ (p : Prop), ∃ (x : Nat), p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let tactic := "intro p"
+ let state1 ← match ← state0.tacticOn 0 tactic with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ let tactic := "exact ⟨0, by simp⟩"
+ let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
+ checkEq tactic messages #["placeholder"]
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("identity", test_identity),
@@ -716,6 +732,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("calc", test_calc),
("Nat.zero_add", test_nat_zero_add),
("Nat.zero_add alt", test_nat_zero_add_alt),
+ ("composite tactic failure", test_composite_tactic_failure),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 7aafd6956fe71770a356f3d852edc4e91cd5696a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 22:07:21 -0800
Subject: [PATCH 343/465] fix: Capture composite tactic failure
---
Pantograph/Goal.lean | 5 +++++
Test/Common.lean | 22 ++++++++++++++--------
Test/Proofs.lean | 4 ++--
3 files changed, 21 insertions(+), 10 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 79e3004..be745f4 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -73,6 +73,8 @@ protected def GoalState.metaContextOfGoal (state: GoalState) (mvarId: MVarId): O
return { lctx := mvarDecl.lctx, localInstances := mvarDecl.localInstances }
protected def GoalState.metaState (state: GoalState): Meta.State :=
state.savedState.term.meta.meta
+protected def GoalState.coreState (state: GoalState): Core.SavedState :=
+ state.savedState.term.meta.core
protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
@@ -207,6 +209,9 @@ protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: E
Elab.TermElabM TacticResult := do
try
let nextState ← state.step goal tacticM
+ let newMessages ← (← getThe Core.State).messages.toList.drop (state.coreState.messages.toList.length) |>.mapM λ m => m.toString
+ if ¬ newMessages.isEmpty then
+ return .failure newMessages.toArray
return .success nextState
catch exception =>
return .failure #[← exception.toMessageData.toString]
diff --git a/Test/Common.lean b/Test/Common.lean
index 0a0b44c..212e164 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -123,23 +123,29 @@ def mvarUserNameAndType (mvarId: MVarId): MetaM (Name × String) := do
-- Monadic testing
-abbrev TestT := StateT LSpec.TestSeq
+abbrev TestT := StateRefT' IO.RealWorld LSpec.TestSeq
-def addTest [Monad m] (test: LSpec.TestSeq) : TestT m Unit := do
+section Monadic
+
+variable [Monad m] [MonadLiftT (ST IO.RealWorld) m]
+
+def addTest (test: LSpec.TestSeq) : TestT m Unit := do
set $ (← get) ++ test
-def checkEq [Monad m] [DecidableEq α] (desc : String) (lhs rhs : α) : TestT m Unit := do
- addTest $ LSpec.check desc (lhs == rhs)
-def checkTrue [Monad m] (desc : String) (flag : Bool) : TestT m Unit := do
+def checkEq [DecidableEq α] [Repr α] (desc : String) (lhs rhs : α) : TestT m Unit := do
+ addTest $ LSpec.check desc (lhs = rhs)
+def checkTrue (desc : String) (flag : Bool) : TestT m Unit := do
addTest $ LSpec.check desc flag
-def fail [Monad m] (desc : String) : TestT m Unit := do
+def fail (desc : String) : TestT m Unit := do
addTest $ LSpec.check desc false
-def runTest [Monad m] (t: TestT m Unit): m LSpec.TestSeq :=
+def runTest (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done
-def runTestWithResult { α } [Monad m] (t: TestT m α): m (α × LSpec.TestSeq) :=
+def runTestWithResult { α } (t: TestT m α): m (α × LSpec.TestSeq) :=
t.run LSpec.TestSeq.done
+end Monadic
+
def runTestTermElabM (env: Environment) (t: TestT Elab.TermElabM Unit):
IO LSpec.TestSeq :=
runTermElabMSeq env $ runTest t
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 8db8f19..65f099f 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -702,7 +702,7 @@ def test_nat_zero_add_alt: TestM Unit := do
])
def test_composite_tactic_failure: TestM Unit := do
- let state? ← startProof (.expr "∀ (p : Prop), ∃ (x : Nat), p")
+ let state? ← startProof (.expr "∀ (p : Nat → Prop), ∃ (x : Nat), p (0 + x + 0)")
let state0 ← match state? with
| .some state => pure state
| .none => do
@@ -718,7 +718,7 @@ def test_composite_tactic_failure: TestM Unit := do
let tactic := "exact ⟨0, by simp⟩"
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
- checkEq tactic messages #["placeholder"]
+ checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From a62ac51c37ad5dde6c3e850aaaf1e9b9265ec652 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 22:11:37 -0800
Subject: [PATCH 344/465] chore: Remove all redundant filenames
---
Pantograph/Goal.lean | 10 ++++------
Test/Common.lean | 6 +++---
Test/Tactic/MotivatedApply.lean | 6 +++---
Test/Tactic/NoConfuse.lean | 6 +++---
Test/Tactic/Prograde.lean | 2 +-
5 files changed, 14 insertions(+), 16 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index be745f4..8d29aa8 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -10,8 +10,6 @@ import Lean
namespace Pantograph
open Lean
-def filename: String := "<pantograph>"
-
/--
Represents an interconnected set of metavariables, or a state in proof search
-/
@@ -224,7 +222,7 @@ protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: Str
(env := ← MonadEnv.getEnv)
(catName := if state.isConv then `conv else `tactic)
(input := tactic)
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok stx => pure $ stx
| .error error => return .parseError error
state.tryTacticM goal $ Elab.Tactic.evalTactic tactic
@@ -236,7 +234,7 @@ protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: Strin
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := expr)
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalAssign expr
@@ -250,7 +248,7 @@ protected def GoalState.tryLet (state: GoalState) (goal: MVarId) (binderName: St
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := type)
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal $ Tactic.evalLet binderName.toName type
@@ -337,7 +335,7 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
(env := state.env)
(catName := `term)
(input := pred)
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => return .parseError error
goal.checkNotAssigned `GoalState.tryCalc
diff --git a/Test/Common.lean b/Test/Common.lean
index 212e164..53adaa0 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -95,19 +95,19 @@ def runTermElabMSeq (env: Environment) (termElabM: Elab.TermElabM LSpec.TestSeq)
def exprToStr (e: Expr): Lean.MetaM String := toString <$> Meta.ppExpr e
-def strToTermSyntax [Monad m] [MonadEnv m] (s: String): m Syntax := do
+def strToTermSyntax (s: String): CoreM Syntax := do
let .ok stx := Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
- (fileName := filename) | panic! s!"Failed to parse {s}"
+ (fileName := ← getFileName) | panic! s!"Failed to parse {s}"
return stx
def parseSentence (s: String): Elab.TermElabM Expr := do
let stx ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := s)
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
Elab.Term.elabTerm (stx := stx) .none
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 4fb05e3..61d7d6c 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -28,7 +28,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@Nat.brecOn")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
@@ -52,7 +52,7 @@ def test_list_brec_on : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@List.brecOn")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
@@ -74,7 +74,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "@Nat.brecOn")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
let expr ← parseSentence expr
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
index ac277e2..93f0606 100644
--- a/Test/Tactic/NoConfuse.lean
+++ b/Test/Tactic/NoConfuse.lean
@@ -15,7 +15,7 @@ def test_nat : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
@@ -32,7 +32,7 @@ def test_nat_fail : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
@@ -52,7 +52,7 @@ def test_list : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "h")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index 132718a..b3347cb 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -15,7 +15,7 @@ def test_define : TestT Elab.TermElabM Unit := do
(env := ← MonadEnv.getEnv)
(catName := `term)
(input := "Or.inl h")
- (fileName := filename) with
+ (fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
-- Apply the tactic
From 34a4bf5b7321f413e12c1c1cd814d0b0e1a52e29 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 22:12:04 -0800
Subject: [PATCH 345/465] feat: Export GoalState.tryTactic
---
Pantograph/Goal.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 8d29aa8..ac09109 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -215,6 +215,7 @@ protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: E
return .failure #[← exception.toMessageData.toString]
/-- Execute a string tactic on given state. Restores TermElabM -/
+@[export pantograph_goal_state_try_tactic_m]
protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: String):
Elab.TermElabM TacticResult := do
state.restoreElabM
From 0415baaaff3a55475cd532749c1fe9724a16fb43 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 5 Dec 2024 22:16:20 -0800
Subject: [PATCH 346/465] chore: Cleanup old `TestM`
---
Test/Metavar.lean | 7 +------
1 file changed, 1 insertion(+), 6 deletions(-)
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 506e963..c6fc4f0 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -8,10 +8,7 @@ namespace Pantograph.Test.Metavar
open Pantograph
open Lean
-abbrev TestM := StateRefT LSpec.TestSeq (ReaderT Protocol.Options Elab.TermElabM)
-
-def addTest (test: LSpec.TestSeq): TestM Unit := do
- set $ (← get) ++ test
+abbrev TestM := TestT $ ReaderT Protocol.Options Elab.TermElabM
-- Tests that all delay assigned mvars are instantiated
def test_instantiate_mvar: TestM Unit := do
@@ -32,8 +29,6 @@ def test_instantiate_mvar: TestM Unit := do
"((:c LE.le) (:c Nat) (:c instLENat) ((:c OfNat.ofNat) (:mv _uniq.2) (:lit 2) (:mv _uniq.3)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))")
return ()
-
-
def startProof (expr: String): TestM (Option GoalState) := do
let env ← Lean.MonadEnv.getEnv
let syn? := parseTerm env expr
From 929311a0429c2fafb5533c8f44e326c6d66b4d9c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 6 Dec 2024 00:08:20 -0800
Subject: [PATCH 347/465] fix: Only signal failure when there is error
---
Pantograph/Goal.lean | 13 ++++++++++---
1 file changed, 10 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index ac09109..e190d5d 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -202,12 +202,19 @@ inductive TacticResult where
-- The given action cannot be executed in the state
| invalidAction (message: String)
-/-- Executes a `TacticM` monads on this `GoalState`, collecting the errors as necessary -/
+/-- Executes a `TacticM` monad on this `GoalState`, collecting the errors as necessary -/
protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit):
Elab.TermElabM TacticResult := do
try
let nextState ← state.step goal tacticM
- let newMessages ← (← getThe Core.State).messages.toList.drop (state.coreState.messages.toList.length) |>.mapM λ m => m.toString
+
+ -- Check if error messages have been generated in the core.
+ let newMessages ← (← Core.getMessageLog).toList.drop state.coreState.messages.toList.length
+ |>.filterMapM λ m => do
+ if m.severity == .error then
+ return .some $ ← m.toString
+ else
+ return .none
if ¬ newMessages.isEmpty then
return .failure newMessages.toArray
return .success nextState
@@ -357,7 +364,7 @@ protected def GoalState.tryCalc (state: GoalState) (goal: MVarId) (pred: String)
throwErrorAt pred "invalid 'calc' step, relation expected{indentExpr step}"
if let some prevRhs := calcPrevRhs? then
unless ← Meta.isDefEqGuarded lhs prevRhs do
- throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}" -- "
+ throwErrorAt pred "invalid 'calc' step, left-hand-side is{indentD m!"{lhs} : {← Meta.inferType lhs}"}\nprevious right-hand-side is{indentD m!"{prevRhs} : {← Meta.inferType prevRhs}"}"
-- Creates a mvar to represent the proof that the calc tactic solves the
-- current branch
From 9ede3cf7175db43e1e660f64e58eaac4251eed8b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Dec 2024 15:38:03 -0800
Subject: [PATCH 348/465] feat: InfoTree printing
---
Pantograph/Frontend/InfoTree.lean | 73 ++++++++++++++++++++++++-------
1 file changed, 58 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index 4e60710..aa99db2 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -1,12 +1,19 @@
-/- Adapted from lean-training-data by semorrison -/
+/- Adapted from lean-training-data -/
import Lean.Elab.InfoTree
import Lean.Parser.Term
+import Lean.PrettyPrinter
open Lean
-namespace Lean.Elab.Info
+namespace Lean.Elab
+
+private def elaboratorToString : Name → String
+ | .anonymous => ""
+ | n => s!"[{n}]"
+private def indent (s : String) : String := "\n".intercalate $ s.splitOn "\n" |>.map ("\t" ++ .)
+
/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
-protected def stx? : Info → Option Syntax
+protected def Info.stx? : Info → Option Syntax
| .ofTacticInfo info => info.stx
| .ofTermInfo info => info.stx
| .ofCommandInfo info => info.stx
@@ -20,24 +27,35 @@ protected def stx? : Info → Option Syntax
| .ofFieldRedeclInfo info => info.stx
| .ofOmissionInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
-protected def isOriginal (i : Info) : Bool :=
+protected def Info.isOriginal (i : Info) : Bool :=
match i.stx? with
| none => true -- Somewhat unclear what to do with `FVarAliasInfo`, so be conservative.
| some stx => match stx.getHeadInfo with
| .original .. => true
| _ => false
-end Lean.Elab.Info
-namespace Lean.Elab.TacticInfo
+def ContextInfo.ppExpr (ctx : ContextInfo) (lctx : LocalContext) (e : Expr) : IO Format :=
+ ctx.runMetaM lctx (do Meta.ppExpr (← instantiateMVars e))
+
+def CommandInfo.toString (info : CommandInfo) (ctx : ContextInfo) : IO String := do
+ let stx := (← ctx.ppSyntax {} info.stx).pretty
+ return s!"{stx}\n{elaboratorToString info.elaborator}"
+
+def TermInfo.toString (info : TermInfo) (ctx : ContextInfo) : IO String := do
+ let stx := (← ctx.ppSyntax info.lctx info.stx).pretty
+ let expectedType ← info.expectedType?.mapM fun ty => do
+ pure s!": {(← ctx.ppExpr info.lctx ty).pretty}"
+ let expr := (← ctx.ppExpr info.lctx info.expr).pretty
+ return s!"{stx}\n{elaboratorToString info.elaborator}{expr}{expectedType}"
/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
-def name? (t : TacticInfo) : Option Name :=
+def TacticInfo.name? (t : TacticInfo) : Option Name :=
match t.stx with
| Syntax.node _ n _ => some n
| _ => none
/-- Decide whether a tactic is "substantive",
or is merely a tactic combinator (e.g. `by`, `;`, multiline tactics, parenthesized tactics). -/
-def isSubstantive (t : TacticInfo) : Bool :=
+def TacticInfo.isSubstantive (t : TacticInfo) : Bool :=
match t.name? with
| none => false
| some `null => false
@@ -49,17 +67,22 @@ def isSubstantive (t : TacticInfo) : Bool :=
| some ``Lean.Parser.Tactic.«tactic_<;>_» => false
| some ``Lean.Parser.Tactic.paren => false
| _ => true
-
-end Lean.Elab.TacticInfo
-
-namespace Lean.Elab.InfoTree
+def TacticInfo.pp (info : TacticInfo) (ctx : ContextInfo) : IO Format :=
+ ctx.runMetaM {} try
+ Lean.PrettyPrinter.ppTactic ⟨info.stx⟩
+ catch _ =>
+ pure "<failed to pretty print>"
+def TacticInfo.toString (i : TacticInfo) (ctx : ContextInfo) : IO String := do
+ let name := i.name?
+ let stx := Format.pretty (← i.pp ctx)
+ return s!"{stx}\n{name} {stx}"
/--
Keep `.node` nodes and `.hole` nodes satisfying predicates.
Returns a `List InfoTree`, although in most situations this will be a singleton.
-/
-partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
+partial def InfoTree.filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
InfoTree → List InfoTree
| .context ctx tree => tree.filter p m |>.map (.context ctx)
| .node info children =>
@@ -70,7 +93,7 @@ partial def filter (p : Info → Bool) (m : MVarId → Bool := fun _ => false) :
| .hole mvar => if m mvar then [.hole mvar] else []
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
-partial def findAllInfo (t : InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
+partial def InfoTree.findAllInfo (t : InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
@@ -78,4 +101,24 @@ partial def findAllInfo (t : InfoTree) (context?: Option Elab.ContextInfo) (pred
(if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
| _ => []
-end Lean.Elab.InfoTree
+@[export pantograph_infotree_to_string_m]
+partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo) : IO String := do
+ match t with
+ | .context ctx t => t.toString (ctx.mergeIntoOuter? ctx?)
+ | .node info children =>
+ if let some ctx := ctx? then
+ let node : Option String ← match info with
+ | .ofTermInfo info => some <$> (do pure <| s!"[term] {(← info.toString ctx)}")
+ | .ofCommandInfo info => some <$> (do pure <| s!"[command] {(← info.toString ctx)}")
+ | .ofTacticInfo info => some <$> (do pure <| s!"[tactic] {(← info.toString ctx)}")
+ | _ => pure none
+ let children := "\n".intercalate (← children.toList.mapM λ t' => do pure $ indent $ ← t'.toString ctx)
+ return s!"{node}\n{children}"
+ else throw <| IO.userError "No `ContextInfo` available."
+ | .hole mvarId =>
+ if let some ctx := ctx? then
+ let payload := (← ctx.runMetaM {} (do Meta.ppGoal mvarId)).pretty
+ return s!"[hole] {payload}"
+ else throw <| IO.userError "No `ContextInfo` available."
+
+end Lean.Elab
From b950dc9b1a278aabfb7fb2a19be60d7b1e636494 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Dec 2024 22:51:55 -0800
Subject: [PATCH 349/465] fix: Verbose printing of infotree
---
Pantograph/Frontend/InfoTree.lean | 32 +++++++++++++++++++------------
1 file changed, 20 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index aa99db2..3b57a54 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -9,7 +9,7 @@ namespace Lean.Elab
private def elaboratorToString : Name → String
| .anonymous => ""
- | n => s!"[{n}]"
+ | n => s!"⟨{n}⟩ "
private def indent (s : String) : String := "\n".intercalate $ s.splitOn "\n" |>.map ("\t" ++ .)
/-- The `Syntax` for a `Lean.Elab.Info`, if there is one. -/
@@ -39,14 +39,14 @@ def ContextInfo.ppExpr (ctx : ContextInfo) (lctx : LocalContext) (e : Expr) : IO
def CommandInfo.toString (info : CommandInfo) (ctx : ContextInfo) : IO String := do
let stx := (← ctx.ppSyntax {} info.stx).pretty
- return s!"{stx}\n{elaboratorToString info.elaborator}"
+ return s!"{elaboratorToString info.elaborator}\n{stx}"
def TermInfo.toString (info : TermInfo) (ctx : ContextInfo) : IO String := do
let stx := (← ctx.ppSyntax info.lctx info.stx).pretty
- let expectedType ← info.expectedType?.mapM fun ty => do
- pure s!": {(← ctx.ppExpr info.lctx ty).pretty}"
+ let expectedType := (← info.expectedType?.mapM fun ty => do
+ pure s!": {(← ctx.ppExpr info.lctx ty).pretty}").getD ""
let expr := (← ctx.ppExpr info.lctx info.expr).pretty
- return s!"{stx}\n{elaboratorToString info.elaborator}{expr}{expectedType}"
+ return s!"{elaboratorToString info.elaborator}{expr}{expectedType}\n{stx}"
/-- Find the name for the outermost `Syntax` in this `TacticInfo`. -/
def TacticInfo.name? (t : TacticInfo) : Option Name :=
@@ -75,7 +75,7 @@ def TacticInfo.pp (info : TacticInfo) (ctx : ContextInfo) : IO Format :=
def TacticInfo.toString (i : TacticInfo) (ctx : ContextInfo) : IO String := do
let name := i.name?
let stx := Format.pretty (← i.pp ctx)
- return s!"{stx}\n{name} {stx}"
+ return s!"{name}\n{stx}"
/--
Keep `.node` nodes and `.hole` nodes satisfying predicates.
@@ -102,16 +102,24 @@ partial def InfoTree.findAllInfo (t : InfoTree) (context?: Option Elab.ContextIn
| _ => []
@[export pantograph_infotree_to_string_m]
-partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo) : IO String := do
+partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo := .none) : IO String := do
match t with
| .context ctx t => t.toString (ctx.mergeIntoOuter? ctx?)
| .node info children =>
if let some ctx := ctx? then
- let node : Option String ← match info with
- | .ofTermInfo info => some <$> (do pure <| s!"[term] {(← info.toString ctx)}")
- | .ofCommandInfo info => some <$> (do pure <| s!"[command] {(← info.toString ctx)}")
- | .ofTacticInfo info => some <$> (do pure <| s!"[tactic] {(← info.toString ctx)}")
- | _ => pure none
+ let node : String ← match info with
+ | .ofTermInfo info => pure s!"[term] {(← info.toString ctx)}"
+ | .ofCommandInfo info => pure s!"[command] {(← info.toString ctx)}"
+ | .ofTacticInfo info => pure s!"[tactic] {(← info.toString ctx)}"
+ | .ofMacroExpansionInfo _ => pure "[macro_exp]"
+ | .ofOptionInfo _ => pure "[option]"
+ | .ofFieldInfo _ => pure "[field]"
+ | .ofCompletionInfo _ => pure "[completion]"
+ | .ofUserWidgetInfo _ => pure "[user_widget]"
+ | .ofCustomInfo _ => pure "[custom]"
+ | .ofFVarAliasInfo _ => pure "[fvar]"
+ | .ofFieldRedeclInfo _ => pure "[field_redecl]"
+ | .ofOmissionInfo _ => pure "[omission]"
let children := "\n".intercalate (← children.toList.mapM λ t' => do pure $ indent $ ← t'.toString ctx)
return s!"{node}\n{children}"
else throw <| IO.userError "No `ContextInfo` available."
From ea813e5bc5d0116d09d9e8f43c3213fa33b2ae4d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 8 Dec 2024 23:21:36 -0800
Subject: [PATCH 350/465] feat: Monadic info collection
---
Pantograph/Frontend/Elab.lean | 26 ++++++++++++++++----------
Pantograph/Frontend/InfoTree.lean | 29 +++++++++++++++++++++++++----
Repl.lean | 4 ++--
Test/Frontend.lean | 12 +++++++++++-
4 files changed, 54 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index b3173a7..6bc67f3 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -67,7 +67,7 @@ end TacticInvocation
/-- Return all `TacticInfo` nodes in an `InfoTree` corresponding to tactics,
each equipped with its relevant `ContextInfo`, and any children info trees. -/
private def collectTacticNodes (t : Elab.InfoTree) : List TacticInvocation :=
- let infos := t.findAllInfo none fun i => match i with
+ let infos := t.findAllInfo none false fun i => match i with
| .ofTacticInfo _ => true
| _ => false
infos.filterMap fun p => match p with
@@ -101,21 +101,27 @@ structure InfoWithContext where
info: Elab.Info
context?: Option Elab.ContextInfo := .none
-private def collectSorrysInTree (t : Elab.InfoTree) : List InfoWithContext :=
- let infos := t.findAllInfo none fun i => match i with
- | .ofTermInfo { expectedType?, expr, stx, .. } =>
- expr.isSorry ∧ expectedType?.isSome ∧ stx.isOfKind `Lean.Parser.Term.sorry
+private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext) := do
+ let infos ← t.findAllInfoM none true fun i ctx? => match i with
+ | .ofTermInfo { expectedType?, expr, stx, lctx, .. } => do
+ let .some expectedType := expectedType? | return false
+ let .some ctx := ctx? | return false
+ if expr.isSorry ∧ stx.isOfKind `Lean.Parser.Term.sorry then
+ return true
+ ctx.runMetaM lctx do
+ let type ← Meta.inferType expr
+ Bool.not <$> Meta.isDefEq type expectedType
| .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic
let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
- isSorry ∧ !goalsBefore.isEmpty
- | _ => false
- infos.map fun (info, context?, _) => { info, context? }
+ return isSorry ∧ !goalsBefore.isEmpty
+ | _ => return false
+ return infos.map fun (info, context?, _) => { info, context? }
-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
-def collectSorrys (step: CompilationStep) : List InfoWithContext :=
- step.trees.bind collectSorrysInTree
+def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do
+ return (← step.trees.mapM collectSorrysInTree).join
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index 3b57a54..c72dbe6 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -93,14 +93,35 @@ partial def InfoTree.filter (p : Info → Bool) (m : MVarId → Bool := fun _ =>
| .hole mvar => if m mvar then [.hole mvar] else []
/-- Analogue of `Lean.Elab.InfoTree.findInfo?`, but that returns a list of all results. -/
-partial def InfoTree.findAllInfo (t : InfoTree) (context?: Option Elab.ContextInfo) (pred : Elab.Info → Bool) :
- List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
+partial def InfoTree.findAllInfo
+ (t : InfoTree)
+ (context?: Option Elab.ContextInfo)
+ (haltOnMatch : Bool := false)
+ (pred : Elab.Info → Bool)
+ : List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree) :=
match t with
- | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) pred
+ | .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children =>
- (if pred i then [(i, context?, children)] else []) ++ children.toList.bind (fun t => findAllInfo t context? pred)
+ let head := if pred i then [(i, context?, children)] else []
+ let tail := if haltOnMatch then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred)
+ head ++ tail
| _ => []
+/-- Monadic analogue of `findAllInfo` -/
+partial def InfoTree.findAllInfoM [Monad m]
+ (t : InfoTree)
+ (context?: Option Elab.ContextInfo)
+ (haltOnMatch : Bool)
+ (pred : Elab.Info → Option Elab.ContextInfo → m Bool)
+ : m (List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree)) := do
+ match t with
+ | .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) haltOnMatch pred
+ | .node i children =>
+ let head := if ← pred i context? then [(i, context?, children)] else []
+ let tail := if haltOnMatch then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred)
+ return head ++ (← tail).join
+ | _ => return []
+
@[export pantograph_infotree_to_string_m]
partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo := .none) : IO String := do
match t with
diff --git a/Repl.lean b/Repl.lean
index 3f8a3c6..f1c8f42 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -257,10 +257,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
pure $ .some invocations
else
pure .none
- let sorrys := if args.sorrys then
+ let sorrys ← if args.sorrys then
Frontend.collectSorrys step
else
- []
+ pure []
let messages ← step.messageStrings
return (step.before, boundary, invocations?, sorrys, messages)
let li ← frontendM.run context |>.run' state
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 015cfa8..a03b283 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -10,7 +10,9 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
- return (step.before, Frontend.collectSorrys step)
+ for tree in step.trees do
+ IO.println s!"{← tree.toString}"
+ return (step.before, ← Frontend.collectSorrys step)
let li ← m.run context |>.run' state
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
if sorrys.isEmpty then
@@ -177,6 +179,13 @@ example (n: Nat) : mystery n + 1 = n + 2 := sorry
}
])
+def test_capture_type_mismatch : TestT MetaM Unit := do
+ let input := "
+def mystery : Nat := true
+ "
+ let goalStates ← (collectSorrysFromSource input).run' {}
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
@@ -185,6 +194,7 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_induction", test_sorry_in_induction),
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
+ ("capture_type_mismatch", test_capture_type_mismatch),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
From 17ab2eafd8868652d83072f074696413825ebab5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 00:03:53 -0800
Subject: [PATCH 351/465] fix: Halt on match guard
---
Pantograph/Frontend/Elab.lean | 2 --
Pantograph/Frontend/InfoTree.lean | 4 ++--
Test/Frontend.lean | 2 --
3 files changed, 2 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 6bc67f3..d5af8b5 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -123,8 +123,6 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do
return (← step.trees.mapM collectSorrysInTree).join
-
-
/--
Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index c72dbe6..50b0965 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -103,7 +103,7 @@ partial def InfoTree.findAllInfo
| .context inner t => findAllInfo t (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children =>
let head := if pred i then [(i, context?, children)] else []
- let tail := if haltOnMatch then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred)
+ let tail := if haltOnMatch ∧ !head.isEmpty then [] else children.toList.bind (fun t => findAllInfo t context? haltOnMatch pred)
head ++ tail
| _ => []
@@ -118,7 +118,7 @@ partial def InfoTree.findAllInfoM [Monad m]
| .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) haltOnMatch pred
| .node i children =>
let head := if ← pred i context? then [(i, context?, children)] else []
- let tail := if haltOnMatch then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred)
+ let tail := if haltOnMatch ∧ !head.isEmpty then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred)
return head ++ (← tail).join
| _ => return []
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index a03b283..3b765fd 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -10,8 +10,6 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
- for tree in step.trees do
- IO.println s!"{← tree.toString}"
return (step.before, ← Frontend.collectSorrys step)
let li ← m.run context |>.run' state
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
From 2d068ecd5072386fd4043931b96e64fd47760aab Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 00:06:20 -0800
Subject: [PATCH 352/465] fix: Use guarded `isDefEq`
---
Pantograph/Frontend/Elab.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index d5af8b5..c4704fc 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -110,7 +110,7 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
return true
ctx.runMetaM lctx do
let type ← Meta.inferType expr
- Bool.not <$> Meta.isDefEq type expectedType
+ Bool.not <$> Meta.isExprDefEqGuarded type expectedType
| .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic
let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
From 7fc2bd0d0fc4901b7423782b6092518ac887e38b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 08:15:01 -0800
Subject: [PATCH 353/465] test: Tactic failure on synthesizing placeholder
---
Test/Proofs.lean | 24 ++++++++++++++++++++++--
1 file changed, 22 insertions(+), 2 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 65f099f..1903306 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -701,7 +701,7 @@ def test_nat_zero_add_alt: TestM Unit := do
}
])
-def test_composite_tactic_failure: TestM Unit := do
+def test_tactic_failure_unresolved_goals : TestM Unit := do
let state? ← startProof (.expr "∀ (p : Nat → Prop), ∃ (x : Nat), p (0 + x + 0)")
let state0 ← match state? with
| .some state => pure state
@@ -720,6 +720,25 @@ def test_composite_tactic_failure: TestM Unit := do
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
+def test_tactic_failure_synthesize_placeholder : TestM Unit := do
+ let state? ← startProof (.expr "∀ (p q r : Prop) (h : p → q), q ∧ r")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let tactic := "intro p q r h"
+ let state1 ← match ← state0.tacticOn 0 tactic with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ let tactic := "simpa [h] using And.imp_left h _"
+ let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
+ checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("identity", test_identity),
@@ -732,7 +751,8 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("calc", test_calc),
("Nat.zero_add", test_nat_zero_add),
("Nat.zero_add alt", test_nat_zero_add_alt),
- ("composite tactic failure", test_composite_tactic_failure),
+ ("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
+ ("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 47d26badc82e606972a1b8a5285b78197411e067 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 17:30:33 -0800
Subject: [PATCH 354/465] feat: Capture mvar errors
---
Pantograph/Goal.lean | 6 +++++-
Test/Proofs.lean | 4 +++-
2 files changed, 8 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index e190d5d..4bb1afd 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -208,8 +208,12 @@ protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: E
try
let nextState ← state.step goal tacticM
+ Elab.Term.synthesizeSyntheticMVarsNoPostponing
+ let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar goal)
+ let _ ← Elab.Term.logUnassignedUsingErrorInfos descendants
+
-- Check if error messages have been generated in the core.
- let newMessages ← (← Core.getMessageLog).toList.drop state.coreState.messages.toList.length
+ let newMessages ← (← Core.getMessageLog).toList --.drop state.coreState.messages.toList.length
|>.filterMapM λ m => do
if m.severity == .error then
return .some $ ← m.toString
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index 1903306..b48e3b0 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -720,6 +720,7 @@ def test_tactic_failure_unresolved_goals : TestM Unit := do
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
+
def test_tactic_failure_synthesize_placeholder : TestM Unit := do
let state? ← startProof (.expr "∀ (p q r : Prop) (h : p → q), q ∧ r")
let state0 ← match state? with
@@ -737,7 +738,8 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
let tactic := "simpa [h] using And.imp_left h _"
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
- checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
+ let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
+ checkEq s!"{tactic} fails" messages #[message]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From d040d2006c7332eee67b9a0b3d8558e18469386e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 17:58:08 -0800
Subject: [PATCH 355/465] fix: Do not guard mvar errors in other tactics
---
Pantograph/Goal.lean | 37 +++++++++++++++++++++++++++----------
Test/Proofs.lean | 16 +++++++++++++---
2 files changed, 40 insertions(+), 13 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 4bb1afd..51aed88 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -177,16 +177,37 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarI
--- Tactic execution functions ---
-protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
+private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId) := do
+ let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
+ (← getThe Elab.Term.State).mvarErrorInfos
+ |>.map (·.mvarId)
+ |>.filterM λ mvarId =>
+ return descendants.contains mvarId ∧ !(← mvarId.isAssignedOrDelayedAssigned)
+
+private def mergeMVarLists (li1 li2 : List MVarId) : List MVarId :=
+ let li2' := li2.filter (¬ li1.contains ·)
+ li1 ++ li2'
+
+/--
+Set `guardMVarErrors` to true to capture mvar errors. Lean will not
+automatically collect mvars from text tactics (vide
+`test_tactic_failure_synthesize_placeholder`)
+-/
+protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit) (guardMVarErrors : Bool := false)
: Elab.TermElabM GoalState := do
unless (← getMCtx).decls.contains goal do
throwError s!"Goal is not in context: {goal.name}"
goal.checkNotAssigned `GoalState.step
- let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
+ let (_, { goals }) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState
+
+ let goals ← if guardMVarErrors then
+ pure $ mergeMVarLists goals (← collectAllErroredMVars goal)
+ else
+ pure goals
return {
state with
- savedState := { term := nextElabState, tactic := newGoals },
+ savedState := { term := nextElabState, tactic := { goals }, },
parentMVar? := .some goal,
calcPrevRhs? := .none,
}
@@ -203,14 +224,10 @@ inductive TacticResult where
| invalidAction (message: String)
/-- Executes a `TacticM` monad on this `GoalState`, collecting the errors as necessary -/
-protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit):
+protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit) (guardMVarErrors : Bool := false):
Elab.TermElabM TacticResult := do
try
- let nextState ← state.step goal tacticM
-
- Elab.Term.synthesizeSyntheticMVarsNoPostponing
- let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar goal)
- let _ ← Elab.Term.logUnassignedUsingErrorInfos descendants
+ let nextState ← state.step goal tacticM guardMVarErrors
-- Check if error messages have been generated in the core.
let newMessages ← (← Core.getMessageLog).toList --.drop state.coreState.messages.toList.length
@@ -237,7 +254,7 @@ protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: Str
(fileName := ← getFileName) with
| .ok stx => pure $ stx
| .error error => return .parseError error
- state.tryTacticM goal $ Elab.Tactic.evalTactic tactic
+ state.tryTacticM goal (Elab.Tactic.evalTactic tactic) true
protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String):
Elab.TermElabM TacticResult := do
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index b48e3b0..a6b5487 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -737,9 +737,19 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
return ()
let tactic := "simpa [h] using And.imp_left h _"
- let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
- let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
- checkEq s!"{tactic} fails" messages #[message]
+ let state2 ← match ← state1.tacticOn 0 tactic with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ checkEq tactic ((← state2.serializeGoals).map (·.devolatilize)) #[
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
+ ]
+
+ --let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
+ --let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
+ --checkEq s!"{tactic} fails" messages #[message]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From 5ef2b5c11840890471db123ecce3f26642e38478 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 19:40:00 -0800
Subject: [PATCH 356/465] feat: Collect newly defined constants
---
Pantograph/Frontend/Elab.lean | 15 ++++++++++++++-
Test/Frontend.lean | 27 +++++++++++++++++++++++++++
2 files changed, 41 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index c4704fc..4ace608 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -2,6 +2,7 @@
import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
+import Lean.DeclarationRange
import Pantograph.Frontend.Basic
import Pantograph.Frontend.MetaTranslate
@@ -128,7 +129,7 @@ Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
-/
-@[export pantograph_frontend_sorrys_to_goal_state]
+@[export pantograph_frontend_sorrys_to_goal_state_m]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
assert! !sorrys.isEmpty
let goalsM := sorrys.mapM λ i => do
@@ -147,5 +148,17 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
GoalState.createFromMVars goals root
+@[export pantograph_frontend_collect_new_defined_constants_m]
+def collectNewDefinedConstants (step : CompilationStep) : IO (List Name) := do
+ step.after.constants.map₂.foldlM (λ acc name _ => do
+ if step.before.contains name then
+ return acc
+ let coreM : CoreM Bool := Option.isSome <$> findDeclarationRanges? name
+ let hasRange ← coreM.run' { fileName := step.fileName, fileMap := step.fileMap } { env := step.after } |>.toBaseIO
+ match hasRange with
+ | .ok true => return name :: acc
+ | .ok false => return acc
+ | .error e => throw $ IO.userError (← e.toMessageData.toString)
+ ) []
end Pantograph.Frontend
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 3b765fd..68aaf94 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -184,6 +184,31 @@ def mystery : Nat := true
let goalStates ← (collectSorrysFromSource input).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+def collectNewConstants (source: String) : MetaM (List (List Name)) := do
+ let filename := "<anonymous>"
+ let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
+ let m := Frontend.mapCompilationSteps λ step => do
+ Frontend.collectNewDefinedConstants step
+ m.run context |>.run' state
+
+def test_collect_one_constant : TestT MetaM Unit := do
+ let input := "
+def mystery : Nat := 123
+ "
+ let names ← collectNewConstants input
+ checkEq "constants" names [[`mystery]]
+def test_collect_one_theorem : TestT MetaM Unit := do
+ let input := "
+theorem mystery [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get i) < sizeOf as := by
+ match as, i with
+ | a::as, ⟨0, _⟩ => simp_arith [get]
+ | a::as, ⟨i+1, h⟩ =>
+ have ih := sizeOf_get as ⟨i, Nat.le_of_succ_le_succ h⟩
+ apply Nat.lt_trans ih
+ simp_arith
+ "
+ let names ← collectNewConstants input
+ checkEq "constants" names [[`mystery]]
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
@@ -193,6 +218,8 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
("capture_type_mismatch", test_capture_type_mismatch),
+ ("collect_one_constant", test_collect_one_constant),
+ ("collect_one_theorem", test_collect_one_theorem),
]
tests.map (fun (name, test) => (name, runMetaMSeq env $ runTest test))
From 0b4ded10493585aeba2e9b345ddc9ed81d4a02ad Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 20:15:53 -0800
Subject: [PATCH 357/465] fix: Collect sorrys and type mismatches
---
Pantograph/Frontend/Elab.lean | 21 +++++++++++++--------
Pantograph/Frontend/InfoTree.lean | 12 ++++++------
Test/Frontend.lean | 11 ++++++++++-
3 files changed, 29 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 4ace608..2eff084 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -103,20 +103,25 @@ structure InfoWithContext where
context?: Option Elab.ContextInfo := .none
private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext) := do
- let infos ← t.findAllInfoM none true fun i ctx? => match i with
+ let infos ← t.findAllInfoM none fun i ctx? => match i with
| .ofTermInfo { expectedType?, expr, stx, lctx, .. } => do
- let .some expectedType := expectedType? | return false
- let .some ctx := ctx? | return false
+ let .some expectedType := expectedType? | return (false, true)
+ let .some ctx := ctx? | return (false, true)
if expr.isSorry ∧ stx.isOfKind `Lean.Parser.Term.sorry then
- return true
- ctx.runMetaM lctx do
+ return (true, false)
+ let typeMatch ← ctx.runMetaM lctx do
let type ← Meta.inferType expr
- Bool.not <$> Meta.isExprDefEqGuarded type expectedType
+ Meta.isExprDefEqGuarded type expectedType
+ return match typeMatch, expr.hasSorry with
+ | false, true => (true, false) -- Types mismatch but has sorry -> collect, halt
+ | false, false => (true, false) -- Types mistmatch but no sorry -> collect, halt
+ | true, true => (false, true) -- Types match but has sorry -> continue
+ | true, false => (false, false) -- Types match but no sorries -> halt
| .ofTacticInfo { stx, goalsBefore, .. } =>
-- The `sorry` term is distinct from the `sorry` tactic
let isSorry := stx.isOfKind `Lean.Parser.Tactic.tacticSorry
- return isSorry ∧ !goalsBefore.isEmpty
- | _ => return false
+ return (isSorry ∧ !goalsBefore.isEmpty, ¬ isSorry)
+ | _ => return (false, true)
return infos.map fun (info, context?, _) => { info, context? }
-- NOTE: Plural deliberately not spelled "sorries"
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index 50b0965..cfef621 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -107,18 +107,18 @@ partial def InfoTree.findAllInfo
head ++ tail
| _ => []
-/-- Monadic analogue of `findAllInfo` -/
+/-- Monadic analogue of `findAllInfo`, but predicate controls whether to recurse. -/
partial def InfoTree.findAllInfoM [Monad m]
(t : InfoTree)
(context?: Option Elab.ContextInfo)
- (haltOnMatch : Bool)
- (pred : Elab.Info → Option Elab.ContextInfo → m Bool)
+ (pred : Elab.Info → Option Elab.ContextInfo → m (Bool × Bool))
: m (List (Elab.Info × Option Elab.ContextInfo × PersistentArray Elab.InfoTree)) := do
match t with
- | .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) haltOnMatch pred
+ | .context inner t => t.findAllInfoM (inner.mergeIntoOuter? context?) pred
| .node i children =>
- let head := if ← pred i context? then [(i, context?, children)] else []
- let tail := if haltOnMatch ∧ !head.isEmpty then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? haltOnMatch pred)
+ let (flagCollect, flagRecurse) ← pred i context?
+ let head := if flagCollect then [(i, context?, children)] else []
+ let tail := if ¬ flagRecurse then pure [] else children.toList.mapM (fun t => t.findAllInfoM context? pred)
return head ++ (← tail).join
| _ => return []
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 68aaf94..2259029 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -179,10 +179,19 @@ example (n: Nat) : mystery n + 1 = n + 2 := sorry
def test_capture_type_mismatch : TestT MetaM Unit := do
let input := "
-def mystery : Nat := true
+def mystery (k: Nat) : Nat := true
"
let goalStates ← (collectSorrysFromSource input).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ checkEq "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize)) #[
+ {
+ target := { pp? := "Nat" },
+ vars := #[{
+ userName := "k",
+ type? := .some { pp? := "Nat" },
+ }],
+ }
+ ]
def collectNewConstants (source: String) : MetaM (List (List Name)) := do
let filename := "<anonymous>"
From e9cbc6eab37a81e527b8d9b220a47ec1cf8debee Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 20:17:55 -0800
Subject: [PATCH 358/465] chore: Update version
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 2decbc1..81dceee 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.19"
+def version := "0.2.22"
end Pantograph
From dd00d803d1fe500f46710bb32bfcc9eeeb2d8062 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 20:38:27 -0800
Subject: [PATCH 359/465] feat: Collect sorry/elab failure boundaries
---
Pantograph/Frontend/Basic.lean | 7 +++++++
Pantograph/Frontend/Elab.lean | 19 ++++++++++++++-----
Pantograph/Protocol.lean | 2 ++
Repl.lean | 13 +++++++------
Test/Frontend.lean | 4 ++--
5 files changed, 32 insertions(+), 13 deletions(-)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 1074a94..87decd4 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -30,6 +30,13 @@ end Lean.PersistentArray
namespace Pantograph.Frontend
+@[export pantograph_frontend_stx_byte_range]
+def stxByteRange (stx : Syntax) : String.Pos × String.Pos :=
+ let pos := stx.getPos?.getD 0
+ let endPos := stx.getTailPos?.getD 0
+ (pos, endPos)
+
+
abbrev FrontendM := Elab.Frontend.FrontendM
structure CompilationStep where
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 2eff084..a33fbef 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -129,28 +129,37 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do
return (← step.trees.mapM collectSorrysInTree).join
+structure AnnotatedGoalState where
+ state : GoalState
+ srcBoundaries : List (String.Pos × String.Pos)
+
/--
Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
-/
@[export pantograph_frontend_sorrys_to_goal_state_m]
-def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM GoalState := do
+def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM AnnotatedGoalState := do
assert! !sorrys.isEmpty
let goalsM := sorrys.mapM λ i => do
match i.info with
| .ofTermInfo termInfo => do
let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
- return [mvarId]
+ return [(mvarId, stxByteRange termInfo.stx)]
| .ofTacticInfo tacticInfo => do
- MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
+ let mvarIds ← MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
+ let range := stxByteRange tacticInfo.stx
+ return mvarIds.map (·, range)
| _ => panic! "Invalid info"
- let goals := List.join (← goalsM.run {} |>.run' {})
+ let annotatedGoals := List.join (← goalsM.run {} |>.run' {})
+ let goals := annotatedGoals.map Prod.fst
+ let srcBoundaries := annotatedGoals.map Prod.snd
let root := match goals with
| [] => panic! "No MVars generated"
| [g] => g
| _ => { name := .anonymous }
- GoalState.createFromMVars goals root
+ let state ← GoalState.createFromMVars goals root
+ return { state, srcBoundaries }
@[export pantograph_frontend_collect_new_defined_constants_m]
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 0cb6cac..5cb24e8 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -329,6 +329,8 @@ structure CompilationUnit where
invocations?: Option (List InvokedTactic) := .none
goalStateId?: Option Nat := .none
goals: Array Goal := #[]
+ -- Code segments which generated the goals
+ goalSrcBoundaries: Array (Nat × Nat) := #[]
messages: Array String := #[]
deriving Lean.ToJson
structure FrontendProcessResult where
diff --git a/Repl.lean b/Repl.lean
index f1c8f42..201a841 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -265,18 +265,19 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return (step.before, boundary, invocations?, sorrys, messages)
let li ← frontendM.run context |>.run' state
let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages) => Lean.withEnv env do
- let (goalStateId?, goals) ← if sorrys.isEmpty then do
- pure (.none, #[])
+ let (goalStateId?, goals, goalSrcBoundaries) ← if sorrys.isEmpty then do
+ pure (.none, #[], #[])
else do
- let goalState ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
- let stateId ← newGoalState goalState
- let goals ← goalSerialize goalState options
- pure (.some stateId, goals)
+ let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
+ let stateId ← newGoalState state
+ let goals ← goalSerialize state options
+ pure (.some stateId, goals, srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx)))
return {
boundary,
invocations?,
goalStateId?,
goals,
+ goalSrcBoundaries,
messages,
}
return .ok { units }
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 2259029..a3b73ae 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -15,8 +15,8 @@ def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
if sorrys.isEmpty then
return .none
- let goalState ← Frontend.sorrysToGoalState sorrys
- return .some goalState
+ let { state, .. } ← Frontend.sorrysToGoalState sorrys
+ return .some state
return goalStates
def test_multiple_sorrys_in_proof : TestT MetaM Unit := do
From 9a69c48cb23f313e5986e87a8867eaf3d9b6528e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 20:42:05 -0800
Subject: [PATCH 360/465] fix: Integration test failure
---
Test/Integration.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9fb86b7..171bc91 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -222,6 +222,7 @@ def test_frontend_process_sorry : Test :=
boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
goalStateId? := .some 0,
goals := #[goal1],
+ goalSrcBoundaries := #[(57, 62)],
messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
}],
}: Protocol.FrontendProcessResult),
From eb0374dfb3cd73df86bfcfe5a0ed1f5d03d37cce Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 20:57:25 -0800
Subject: [PATCH 361/465] feat: Collect new constants in repl
---
Pantograph/Protocol.lean | 3 +++
Repl.lean | 13 +++++++++++--
Test/Integration.lean | 2 ++
3 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 5cb24e8..d80c761 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -312,6 +312,8 @@ structure FrontendProcess where
invocations: Bool := false
-- If set to true, collect `sorry`s
sorrys: Bool := false
+ -- If set to true, extract new constants
+ newConstants: Bool := false
deriving Lean.FromJson
structure InvokedTactic where
goalBefore: String
@@ -332,6 +334,7 @@ structure CompilationUnit where
-- Code segments which generated the goals
goalSrcBoundaries: Array (Nat × Nat) := #[]
messages: Array String := #[]
+ newConstants: Option (Array String) := .none
deriving Lean.ToJson
structure FrontendProcessResult where
units: List CompilationUnit
diff --git a/Repl.lean b/Repl.lean
index 201a841..710b132 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -262,9 +262,17 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
else
pure []
let messages ← step.messageStrings
- return (step.before, boundary, invocations?, sorrys, messages)
+ let newConstants ← if args.newConstants then
+ Frontend.collectNewDefinedConstants step
+ else
+ pure []
+ return (step.before, boundary, invocations?, sorrys, messages, newConstants)
let li ← frontendM.run context |>.run' state
- let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages) => Lean.withEnv env do
+ let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages, newConstants) => Lean.withEnv env do
+ let newConstants := if args.newConstants then
+ .some $ newConstants.toArray.map λ name => name.toString
+ else
+ .none
let (goalStateId?, goals, goalSrcBoundaries) ← if sorrys.isEmpty then do
pure (.none, #[], #[])
else do
@@ -279,6 +287,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goals,
goalSrcBoundaries,
messages,
+ newConstants,
}
return .ok { units }
catch e =>
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 171bc91..8d53168 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -174,6 +174,7 @@ def test_frontend_process : Test :=
("file", .str file),
("invocations", .bool true),
("sorrys", .bool false),
+ ("newConstants", .bool false),
]
({
units := [{
@@ -214,6 +215,7 @@ def test_frontend_process_sorry : Test :=
("file", .str file),
("invocations", .bool false),
("sorrys", .bool true),
+ ("newConstants", .bool false),
]
({
units := [{
From 1527743900b2af65514be9cf6a3d9f18b818874a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 21:00:33 -0800
Subject: [PATCH 362/465] refactor: Optionalize CompilationUnit
---
Pantograph/Protocol.lean | 10 ++++++----
Repl.lean | 17 +++++++++--------
Test/Integration.lean | 4 ++--
3 files changed, 17 insertions(+), 14 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index d80c761..f232d9e 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -327,14 +327,16 @@ structure InvokedTactic where
structure CompilationUnit where
-- String boundaries of compilation units
boundary: (Nat × Nat)
+ messages: Array String := #[]
-- Tactic invocations
invocations?: Option (List InvokedTactic) := .none
goalStateId?: Option Nat := .none
- goals: Array Goal := #[]
+ goals?: Option (Array Goal) := .none
-- Code segments which generated the goals
- goalSrcBoundaries: Array (Nat × Nat) := #[]
- messages: Array String := #[]
- newConstants: Option (Array String) := .none
+ goalSrcBoundaries?: Option (Array (Nat × Nat)) := .none
+
+ -- New constants defined in compilation unit
+ newConstants?: Option (Array String) := .none
deriving Lean.ToJson
structure FrontendProcessResult where
units: List CompilationUnit
diff --git a/Repl.lean b/Repl.lean
index 710b132..283bcf3 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -269,25 +269,26 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
return (step.before, boundary, invocations?, sorrys, messages, newConstants)
let li ← frontendM.run context |>.run' state
let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages, newConstants) => Lean.withEnv env do
- let newConstants := if args.newConstants then
+ let newConstants? := if args.newConstants then
.some $ newConstants.toArray.map λ name => name.toString
else
.none
- let (goalStateId?, goals, goalSrcBoundaries) ← if sorrys.isEmpty then do
- pure (.none, #[], #[])
+ let (goalStateId?, goals?, goalSrcBoundaries?) ← if sorrys.isEmpty then do
+ pure (.none, .none, .none)
else do
let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
let stateId ← newGoalState state
let goals ← goalSerialize state options
- pure (.some stateId, goals, srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx)))
+ let srcBoundaries := srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx))
+ pure (.some stateId, .some goals, .some srcBoundaries)
return {
boundary,
+ messages,
invocations?,
goalStateId?,
- goals,
- goalSrcBoundaries,
- messages,
- newConstants,
+ goals?,
+ goalSrcBoundaries?,
+ newConstants?,
}
return .ok { units }
catch e =>
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 8d53168..3e9bed2 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -223,8 +223,8 @@ def test_frontend_process_sorry : Test :=
}, {
boundary := (solved.utf8ByteSize, solved.utf8ByteSize + withSorry.utf8ByteSize),
goalStateId? := .some 0,
- goals := #[goal1],
- goalSrcBoundaries := #[(57, 62)],
+ goals? := .some #[goal1],
+ goalSrcBoundaries? := .some #[(57, 62)],
messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
}],
}: Protocol.FrontendProcessResult),
From 37a5884be40790a946e0b8e26879ed3bbf509077 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 9 Dec 2024 21:39:33 -0800
Subject: [PATCH 363/465] fix: Use `ppSyntax` instead of `ppTactic`
---
Pantograph/Frontend/Elab.lean | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index a33fbef..d9480f0 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -87,9 +87,11 @@ def collectTacticsFromCompilationStep (step : CompilationStep) : IO (List Protoc
tactics.mapM λ invocation => do
let goalBefore := (Format.joinSep (← invocation.goalState) "\n").pretty
let goalAfter := (Format.joinSep (← invocation.goalStateAfter) "\n").pretty
- let tactic ← invocation.ctx.runMetaM {} do
- let t ← PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
- return t.pretty
+ let tactic ← invocation.ctx.runMetaM {} <| Meta.withMCtx invocation.info.mctxBefore do
+ return (← invocation.ctx.ppSyntax {} invocation.info.stx).pretty
+ -- FIXME: Why does this not work? There are problems with `term.pseudo.antiquot`
+ --PrettyPrinter.ppTactic ⟨invocation.info.stx⟩
+ --return t.pretty
let usedConstants := invocation.usedConstants.toArray.map λ n => n.toString
return {
goalBefore,
From 681c3fb78d2055e4d8dbe1fcd2ef5c66d28b6469 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 12:21:56 -0800
Subject: [PATCH 364/465] fix: Disallow indeterminant type `sorry`
---
Pantograph/Frontend/Elab.lean | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index d9480f0..3da5fca 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -1,4 +1,3 @@
-/- Adapted from https://github.com/semorrison/lean-training-data -/
import Lean.Elab.Import
import Lean.Elab.Command
import Lean.Elab.InfoTree
@@ -16,6 +15,7 @@ namespace Pantograph.Frontend
-- Info tree filtering functions
+/- Adapted from lean-training-data -/
structure TacticInvocation where
info : Elab.TacticInfo
ctx : Elab.ContextInfo
@@ -107,10 +107,12 @@ structure InfoWithContext where
private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext) := do
let infos ← t.findAllInfoM none fun i ctx? => match i with
| .ofTermInfo { expectedType?, expr, stx, lctx, .. } => do
- let .some expectedType := expectedType? | return (false, true)
let .some ctx := ctx? | return (false, true)
if expr.isSorry ∧ stx.isOfKind `Lean.Parser.Term.sorry then
+ if expectedType?.isNone then
+ throw $ .userError "Sorry of indeterminant type is not allowed"
return (true, false)
+ let .some expectedType := expectedType? | return (false, true)
let typeMatch ← ctx.runMetaM lctx do
let type ← Meta.inferType expr
Meta.isExprDefEqGuarded type expectedType
From 0725d865de5dbe0195c6cafa8e81b42f9e967fc5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 12:40:00 -0800
Subject: [PATCH 365/465] feat: Print value of arbitrary mvar in goal state
---
Pantograph/Library.lean | 16 +++++++++++-----
Pantograph/Protocol.lean | 4 ++++
Repl.lean | 3 ++-
3 files changed, 17 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 20c7c9b..ee17fa5 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -138,16 +138,22 @@ def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array
runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m]
-def goalPrint (state: GoalState) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
+def goalPrint (state: GoalState) (extraMVars : Array String) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
runMetaM do
state.restoreMetaM
return {
- root? := ← state.rootExpr?.mapM (λ expr =>
+ root? := ← state.rootExpr?.mapM λ expr =>
state.withRootContext do
- serializeExpression options (← instantiateAll expr)),
- parent? := ← state.parentExpr?.mapM (λ expr =>
+ serializeExpression options (← instantiateAll expr),
+ parent? := ← state.parentExpr?.mapM λ expr =>
state.withParentContext do
- serializeExpression options (← instantiateAll expr)),
+ serializeExpression options (← instantiateAll expr),
+ extraMVars := ← extraMVars.mapM λ mvarId => do
+ let mvarId: MVarId := { name := mvarId.toName }
+ let .some _ ← mvarId.findDecl? | return {}
+ state.withContext mvarId do
+ let .some expr ← getExprMVarAssignment? mvarId | return {}
+ serializeExpression options (← instantiateAll expr),
}
@[export pantograph_goal_tactic_m]
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 0cb6cac..9b00dfe 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -271,12 +271,16 @@ structure GoalDeleteResult where
structure GoalPrint where
stateId: Nat
+ -- Print values of extra mvars
+ extraMVars?: Option (Array String) := .none
deriving Lean.FromJson
structure GoalPrintResult where
-- The root expression
root?: Option Expression := .none
-- The filling expression of the parent goal
parent?: Option Expression
+
+ extraMVars: Array Expression := #[]
deriving Lean.ToJson
-- Diagnostic Options, not available in REPL
diff --git a/Repl.lean b/Repl.lean
index 3f8a3c6..0dd92d2 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -222,7 +222,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
- let result ← runMetaInMainM <| goalPrint goalState state.options
+ let extraMVars := args.extraMVars?.getD #[]
+ let result ← runMetaInMainM <| goalPrint goalState extraMVars state.options
return .ok result
goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
let state ← get
From 95503c45e4ac6217889cd21d63672d58768835f1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 21:45:57 -0800
Subject: [PATCH 366/465] doc: frontend.process newConstants
---
doc/repl.md | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/doc/repl.md b/doc/repl.md
index 464c7cc..d332986 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -44,9 +44,11 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
state. The user is responsible to ensure the sender/receiver instances share
the same environment.
* `frontend.process { ["fileName": <fileName>,] ["file": <str>], invocations:
- <bool>, sorrys: <bool> }`: Executes the Lean frontend on a file, collecting
- either the tactic invocations (`"invocations": true`) or the sorrys into goal
- states (`"sorrys": true`)
+ <bool>, sorrys: <bool>, newConstants: <bool> }`: Executes the Lean frontend on
+ a file, collecting the tactic invocations (`"invocations": true`), the
+ sorrys and type errors into goal states (`"sorrys": true`), and new constants
+ (`"newConstants": true`). In the case of `sorrys`, this command additionally
+ outputs the position of each captured `sorry`.
## Errors
From 1d10cd2b205f8baf172384733793cd2a55a1f5d8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 23:16:33 -0800
Subject: [PATCH 367/465] fix: Collect errored mvars by iterating errorInfo
---
Pantograph/Goal.lean | 21 +++++++++++++++++----
1 file changed, 17 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 51aed88..f2eb25a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -177,12 +177,25 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarI
--- Tactic execution functions ---
+-- Mimics `Elab.Term.logUnassignedUsingErrorInfos`
private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId) := do
let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
- (← getThe Elab.Term.State).mvarErrorInfos
- |>.map (·.mvarId)
- |>.filterM λ mvarId =>
- return descendants.contains mvarId ∧ !(← mvarId.isAssignedOrDelayedAssigned)
+ let mut alreadyVisited : MVarIdSet := {}
+ let mut result : MVarIdSet := {}
+ for mvarErrorInfo in (← get).mvarErrorInfos do
+ let mvarId := mvarErrorInfo.mvarId
+ unless alreadyVisited.contains mvarId do
+ alreadyVisited := alreadyVisited.insert mvarId
+ /- The metavariable `mvarErrorInfo.mvarId` may have been assigned or
+ delayed assigned to another metavariable that is unassigned. -/
+ let mvarDeps ← Meta.getMVars (mkMVar mvarId)
+ if mvarDeps.any descendants.contains then do
+ result := result.insert mvarId
+ return result.toList
+ --(← getThe Elab.Term.State).mvarErrorInfos
+ -- |>.map (·.mvarId)
+ -- |>.filterM λ mvarId =>
+ -- return descendants.contains mvarId ∧ !(← mvarId.isAssignedOrDelayedAssigned)
private def mergeMVarLists (li1 li2 : List MVarId) : List MVarId :=
let li2' := li2.filter (¬ li1.contains ·)
From 755ba13c1b8f92d91dea492d4b8106a90f68e295 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 23:48:46 -0800
Subject: [PATCH 368/465] fix: Set `synthesizeSyntheticMVarsNoPostponing`
---
Pantograph/Goal.lean | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index f2eb25a..3a6e97a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -179,6 +179,10 @@ protected def GoalState.getMVarEAssignment (goalState: GoalState) (mvarId: MVarI
-- Mimics `Elab.Term.logUnassignedUsingErrorInfos`
private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId) := do
+ -- These descendants serve as "seed" mvars. If a MVarError's mvar is related
+ -- to one of these seed mvars, it means an error has occurred when a tactic
+ -- was executing on `src`. `evalTactic`, will not capture these mvars, so we
+ -- need to manually find them and save them into the goal list.
let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
let mut alreadyVisited : MVarIdSet := {}
let mut result : MVarIdSet := {}
@@ -213,6 +217,7 @@ protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Ta
goal.checkNotAssigned `GoalState.step
let (_, { goals }) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState
+ Elab.Term.synthesizeSyntheticMVarsNoPostponing
let goals ← if guardMVarErrors then
pure $ mergeMVarLists goals (← collectAllErroredMVars goal)
From e0e5c9ec681d0423a12a0c0278fef38cd8c5af80 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 10 Dec 2024 23:51:47 -0800
Subject: [PATCH 369/465] chore: Code cleanup
---
Pantograph/Goal.lean | 7 +------
1 file changed, 1 insertion(+), 6 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 3a6e97a..7a09435 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -186,8 +186,7 @@ private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId)
let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
let mut alreadyVisited : MVarIdSet := {}
let mut result : MVarIdSet := {}
- for mvarErrorInfo in (← get).mvarErrorInfos do
- let mvarId := mvarErrorInfo.mvarId
+ for { mvarId, .. } in (← get).mvarErrorInfos do
unless alreadyVisited.contains mvarId do
alreadyVisited := alreadyVisited.insert mvarId
/- The metavariable `mvarErrorInfo.mvarId` may have been assigned or
@@ -196,10 +195,6 @@ private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId)
if mvarDeps.any descendants.contains then do
result := result.insert mvarId
return result.toList
- --(← getThe Elab.Term.State).mvarErrorInfos
- -- |>.map (·.mvarId)
- -- |>.filterM λ mvarId =>
- -- return descendants.contains mvarId ∧ !(← mvarId.isAssignedOrDelayedAssigned)
private def mergeMVarLists (li1 li2 : List MVarId) : List MVarId :=
let li2' := li2.filter (¬ li1.contains ·)
From cb87fcd9dd89fdeaaaad49f0dd0111b4e7416c49 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 00:16:52 -0800
Subject: [PATCH 370/465] fix: Insert `mvarDeps`
---
Pantograph/Goal.lean | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 7a09435..52562e7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -184,6 +184,7 @@ private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId)
-- was executing on `src`. `evalTactic`, will not capture these mvars, so we
-- need to manually find them and save them into the goal list.
let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
+ --let _ ← Elab.Term.logUnassignedUsingErrorInfos descendants
let mut alreadyVisited : MVarIdSet := {}
let mut result : MVarIdSet := {}
for { mvarId, .. } in (← get).mvarErrorInfos do
@@ -191,9 +192,9 @@ private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId)
alreadyVisited := alreadyVisited.insert mvarId
/- The metavariable `mvarErrorInfo.mvarId` may have been assigned or
delayed assigned to another metavariable that is unassigned. -/
- let mvarDeps ← Meta.getMVars (mkMVar mvarId)
+ let mvarDeps ← Meta.getMVars (.mvar mvarId)
if mvarDeps.any descendants.contains then do
- result := result.insert mvarId
+ result := mvarDeps.foldl (·.insert ·) result
return result.toList
private def mergeMVarLists (li1 li2 : List MVarId) : List MVarId :=
From 58956d33fe25069c708213ccb625ac88c8f04a47 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 00:21:26 -0800
Subject: [PATCH 371/465] doc: Update behaviour rationale
---
doc/rationale.md | 16 ++++++++++++++++
1 file changed, 16 insertions(+)
diff --git a/doc/rationale.md b/doc/rationale.md
index 87c1606..4209474 100644
--- a/doc/rationale.md
+++ b/doc/rationale.md
@@ -24,6 +24,22 @@ The name Pantograph is a pun. It means two things
a locomotive. In comparison the (relatively) simple Pantograph software powers
theorem proving projects.
+## Caveats
+
+Pantograph does not exactly mimic Lean LSP's behaviour. That would not grant the
+flexibility it offers. To support tree search means Pantograph has to act
+differently from Lean in some times, but never at the sacrifice of soundness.
+
+- When Lean LSP says "don't know how to synthesize placeholder", this indicates
+ the human operator needs to manually move the cursor to the placeholder and
+ type in the correct expression. This error therefore should not halt the proof
+ process, and the placeholder should be turned into a goal.
+- When Lean LSP says "unresolved goals", that means a proof cannot finish where
+ it is supposed to finish at the end of a `by` block. Pantograph will raise the
+ error in this case, since it indicates the termination of a proof search branch.
+- `pick_goal` or `swap` will not work since they run contrary to tree search
+ paradigms.
+
## References
* [Pantograph Paper](https://arxiv.org/abs/2410.16429)
From aa122b2bb904e6cd757c1b5e0b75113510c1efaa Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 00:24:56 -0800
Subject: [PATCH 372/465] doc: Update rationale link
---
README.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/README.md b/README.md
index e070fff..02de68c 100644
--- a/README.md
+++ b/README.md
@@ -7,7 +7,7 @@ A Machine-to-Machine interaction system for Lean 4.
Pantograph provides interfaces to execute proofs, construct expressions, and
examine the symbol list of a Lean project for machine learning.
-See [documentations](doc/) for design rationale and references.
+See [documentations](doc/rationale.md) for design rationale and references.
## Installation
From c96df2ed1cd834f3a04374f60c852ed8a2253e8f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 00:29:29 -0800
Subject: [PATCH 373/465] chore: Add `aarch64` build targets to flake
---
flake.nix | 2 ++
1 file changed, 2 insertions(+)
diff --git a/flake.nix b/flake.nix
index 91901d8..f49a331 100644
--- a/flake.nix
+++ b/flake.nix
@@ -22,6 +22,8 @@
flake = {
};
systems = [
+ "aarch64-linux"
+ "aarch64-darwin"
"x86_64-linux"
"x86_64-darwin"
];
From f2f71a60281f66d78687128b8fb879e0f7a11fe0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 09:01:57 -0800
Subject: [PATCH 374/465] fix: Reset core message log
---
Pantograph/Goal.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 52562e7..b140ee7 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -250,6 +250,7 @@ protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: E
return .some $ ← m.toString
else
return .none
+ Core.resetMessageLog
if ¬ newMessages.isEmpty then
return .failure newMessages.toArray
return .success nextState
From ab77418e242d81e502f4ae7a88ab7decf8d6b1a6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 09:05:47 -0800
Subject: [PATCH 375/465] fix: Drop previous message lists
---
Pantograph/Goal.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index b140ee7..6ff14d2 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -244,7 +244,7 @@ protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: E
let nextState ← state.step goal tacticM guardMVarErrors
-- Check if error messages have been generated in the core.
- let newMessages ← (← Core.getMessageLog).toList --.drop state.coreState.messages.toList.length
+ let newMessages ← (← Core.getMessageLog).toList.drop state.coreState.messages.toList.length
|>.filterMapM λ m => do
if m.severity == .error then
return .some $ ← m.toString
From 396a787771909d722e531acf2c11ffec2dd11900 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 09:06:42 -0800
Subject: [PATCH 376/465] feat: Reset message log in MainM
---
Repl.lean | 1 +
1 file changed, 1 insertion(+)
diff --git a/Repl.lean b/Repl.lean
index 283bcf3..2060061 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -79,6 +79,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty }
+ Lean.Core.resetMessageLog
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
From f111da7de79ab8006a0bcda8a916c5785cabc8e8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 15:09:14 -0800
Subject: [PATCH 377/465] doc: Add limitations
---
doc/rationale.md | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
diff --git a/doc/rationale.md b/doc/rationale.md
index 4209474..d73bb22 100644
--- a/doc/rationale.md
+++ b/doc/rationale.md
@@ -24,7 +24,7 @@ The name Pantograph is a pun. It means two things
a locomotive. In comparison the (relatively) simple Pantograph software powers
theorem proving projects.
-## Caveats
+## Caveats and Limitations
Pantograph does not exactly mimic Lean LSP's behaviour. That would not grant the
flexibility it offers. To support tree search means Pantograph has to act
@@ -38,7 +38,20 @@ differently from Lean in some times, but never at the sacrifice of soundness.
it is supposed to finish at the end of a `by` block. Pantograph will raise the
error in this case, since it indicates the termination of a proof search branch.
- `pick_goal` or `swap` will not work since they run contrary to tree search
- paradigms.
+ paradigms. However, if there are tactics which perform non-trivial operations
+ to multiple goals at the same time, this constrain could potentially be
+ relaxed at a cost of great bookkeeping overhead to the user.
+
+Pantograph cannot perform things that are inherently constrained by Lean. These
+include:
+
+- If a tactic loses track of metavariables, it will not be caught until the end
+ of the proof search. This is a bug in the tactic itself.
+- Timeouts for executing tactics is not available. Maybe this will change in the
+ future.
+- Interceptions of parsing errors generally cannot be turned into goals (e.g.
+ `def mystery : Nat := :=`) due to Lean's parsing system.
+
## References
From bb445f4d737b3355edbe42a27be9ec782c5e3b9b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 16:38:59 -0800
Subject: [PATCH 378/465] chore: Update version
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 81dceee..9d044d4 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.22"
+def version := "0.2.23"
end Pantograph
From 2f732a7f2094b0226990d4c89cd9586b51fc6f0b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 11 Dec 2024 16:49:52 -0800
Subject: [PATCH 379/465] feat: Print goals in `goal.print`
---
Pantograph/Library.lean | 47 +++++++++++++++++++++++++---------------
Pantograph/Protocol.lean | 13 ++++++++---
Repl.lean | 9 ++++++--
Test/Integration.lean | 2 +-
4 files changed, 48 insertions(+), 23 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index ee17fa5..bb094b6 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -138,23 +138,36 @@ def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array
runMetaM <| state.serializeGoals (parent := .none) options
@[export pantograph_goal_print_m]
-def goalPrint (state: GoalState) (extraMVars : Array String) (options: @&Protocol.Options): CoreM Protocol.GoalPrintResult :=
- runMetaM do
- state.restoreMetaM
- return {
- root? := ← state.rootExpr?.mapM λ expr =>
- state.withRootContext do
- serializeExpression options (← instantiateAll expr),
- parent? := ← state.parentExpr?.mapM λ expr =>
- state.withParentContext do
- serializeExpression options (← instantiateAll expr),
- extraMVars := ← extraMVars.mapM λ mvarId => do
- let mvarId: MVarId := { name := mvarId.toName }
- let .some _ ← mvarId.findDecl? | return {}
- state.withContext mvarId do
- let .some expr ← getExprMVarAssignment? mvarId | return {}
- serializeExpression options (← instantiateAll expr),
- }
+def goalPrint (state: GoalState) (rootExpr: Bool) (parentExpr: Bool) (goals: Bool) (extraMVars : Array String) (options: @&Protocol.Options)
+ : CoreM Protocol.GoalPrintResult := runMetaM do
+ state.restoreMetaM
+
+ let root? ← if rootExpr then
+ state.rootExpr?.mapM λ expr => state.withRootContext do
+ serializeExpression options (← instantiateAll expr)
+ else
+ pure .none
+ let parent? ← if parentExpr then
+ state.parentExpr?.mapM λ expr => state.withParentContext do
+ serializeExpression options (← instantiateAll expr)
+ else
+ pure .none
+ let goals ← if goals then
+ goalSerialize state options
+ else
+ pure #[]
+ let extraMVars ← extraMVars.mapM λ mvarId => do
+ let mvarId: MVarId := { name := mvarId.toName }
+ let .some _ ← mvarId.findDecl? | return {}
+ state.withContext mvarId do
+ let .some expr ← getExprMVarAssignment? mvarId | return {}
+ serializeExpression options (← instantiateAll expr)
+ return {
+ root?,
+ parent?,
+ goals,
+ extraMVars,
+ }
@[export pantograph_goal_tactic_m]
def goalTactic (state: GoalState) (goal: MVarId) (tactic: String): CoreM TacticResult :=
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 88100a1..90ac149 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -271,15 +271,22 @@ structure GoalDeleteResult where
structure GoalPrint where
stateId: Nat
- -- Print values of extra mvars
+
+ -- Print root?
+ rootExpr?: Option Bool := .some False
+ -- Print the parent expr?
+ parentExpr?: Option Bool := .some False
+ -- Print goals?
+ goals?: Option Bool := .some False
+ -- Print values of extra mvars?
extraMVars?: Option (Array String) := .none
deriving Lean.FromJson
structure GoalPrintResult where
-- The root expression
root?: Option Expression := .none
-- The filling expression of the parent goal
- parent?: Option Expression
-
+ parent?: Option Expression := .none
+ goals: Array Goal := #[]
extraMVars: Array Expression := #[]
deriving Lean.ToJson
diff --git a/Repl.lean b/Repl.lean
index e42558d..eb02f59 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -223,8 +223,13 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
- let extraMVars := args.extraMVars?.getD #[]
- let result ← runMetaInMainM <| goalPrint goalState extraMVars state.options
+ let result ← runMetaInMainM <| goalPrint
+ goalState
+ (rootExpr := args.rootExpr?.getD False)
+ (parentExpr := args.parentExpr?.getD False)
+ (goals := args.goals?.getD False)
+ (extraMVars := args.extraMVars?.getD #[])
+ (options := state.options)
return .ok result
goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
let state ← get
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 3e9bed2..77968f0 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -72,7 +72,7 @@ def test_tactic : Test :=
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
- step "goal.print" [("stateId", .num 1)]
+ step "goal.print" [("stateId", .num 1), ("parentExpr", .bool true), ("rootExpr", .bool true)]
({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
From c0090dec975cd30303060f172ec1da28782e53ad Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 15 Dec 2024 12:40:47 -0800
Subject: [PATCH 380/465] fix: Quote string literal in sexp
---
Pantograph/Delate.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 4b3bd51..582b783 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -369,7 +369,7 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
-- is wrapped in a :lit sexp.
let v' := match v with
| .natVal val => toString val
- | .strVal val => s!"\"{val}\""
+ | .strVal val => IR.EmitC.quoteString val
pure s!"(:lit {v'})"
| .mdata _ inner =>
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
From 7a3b89cc0edcb223ddaf23ff2f35c3fa14dfb3bd Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 15 Dec 2024 12:48:49 -0800
Subject: [PATCH 381/465] feat: Simplify sexp binder
---
Pantograph/Delate.lean | 6 +++---
Test/Delate.lean | 8 ++++----
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 582b783..c68d7cd 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -384,9 +384,9 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
-- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String
| .default => ""
- | .implicit => " :implicit"
- | .strictImplicit => " :strictImplicit"
- | .instImplicit => " :instImplicit"
+ | .implicit => " :i"
+ | .strictImplicit => " :si"
+ | .instImplicit => " :ii"
def serializeExpression (options: @&Protocol.Options) (e: Expr): MetaM Protocol.Expression := do
let pp?: Option String ← match options.printExprPretty with
diff --git a/Test/Delate.lean b/Test/Delate.lean
index d918dc8..013be73 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -35,7 +35,7 @@ def test_sexp_of_symbol (env: Environment): IO LSpec.TestSeq := do
("Nat.add", "(:forall a (:c Nat) (:forall a (:c Nat) (:c Nat)))"),
-- These ones are normal and easy
("Nat.add_one", "(:forall n (:c Nat) ((:c Eq) (:c Nat) ((:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat)) 0 ((:c OfNat.ofNat) (:c Nat) (:lit 1) ((:c instOfNatNat) (:lit 1)))) ((:c Nat.succ) 0)))"),
- ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :implicit) :implicit)"),
+ ("Nat.le_of_succ_le", "(:forall n (:c Nat) (:forall m (:c Nat) (:forall h ((:c LE.le) (:c Nat) (:c instLENat) ((:c Nat.succ) 1) 0) ((:c LE.le) (:c Nat) (:c instLENat) 2 1)) :i) :i)"),
-- Handling of higher order types
("Or", "(:forall a (:sort 0) (:forall b (:sort 0) (:sort 0)))"),
("List", "(:forall α (:sort (+ u 1)) (:sort (+ u 1)))")
@@ -50,8 +50,8 @@ def test_sexp_of_elab (env: Environment): IO LSpec.TestSeq := do
let entries: List (String × (List Name) × String) := [
("λ x: Nat × Bool => x.1", [], "(:lambda x ((:c Prod) (:c Nat) (:c Bool)) ((:c Prod.fst) (:c Nat) (:c Bool) 0))"),
("λ x: Array Nat => x.data", [], "(:lambda x ((:c Array) (:c Nat)) ((:c Array.data) (:c Nat) 0))"),
- ("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :implicit)"),
- ("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :implicit)"),
+ ("λ {α: Sort (u + 1)} => List α", [`u], "(:lambda α (:sort (+ u 1)) ((:c List) 0) :i)"),
+ ("λ {α} => List α", [], "(:lambda α (:sort (+ (:mv _uniq.4) 1)) ((:c List) 0) :i)"),
("(2: Nat) <= (5: Nat)", [], "((:c LE.le) (:mv _uniq.18) (:mv _uniq.19) ((:c OfNat.ofNat) (:mv _uniq.4) (:lit 2) (:mv _uniq.5)) ((:c OfNat.ofNat) (:mv _uniq.14) (:lit 5) (:mv _uniq.15)))"),
]
entries.foldlM (λ suites (source, levels, target) =>
@@ -77,7 +77,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
.default)
.implicit)
.implicit,
- "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :implicit) :implicit)"
+ "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :i) :i)"
),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
From 53bad1c4c995ee44f145439add930177ac49f16f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 15 Dec 2024 12:52:08 -0800
Subject: [PATCH 382/465] refactor: Remove obsolete sanitize option
---
Pantograph/Delate.lean | 20 ++++++++++----------
Test/Proofs.lean | 8 ++++----
2 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index c68d7cd..38d8bda 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -264,25 +264,24 @@ def serializeName (name: Name) (sanitize: Bool := true): String :=
if n.contains Lean.idBeginEscape then s!"{quote}{n}{quote}" else n
/-- serialize a sort level. Expression is optimized to be compact e.g. `(+ u 2)` -/
-partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
+partial def serializeSortLevel (level: Level) : String :=
let k := level.getOffset
let u := level.getLevelOffset
let u_str := match u with
| .zero => "0"
| .succ _ => panic! "getLevelOffset should not return .succ"
| .max v w =>
- let v := serializeSortLevel v sanitize
- let w := serializeSortLevel w sanitize
+ let v := serializeSortLevel v
+ let w := serializeSortLevel w
s!"(:max {v} {w})"
| .imax v w =>
- let v := serializeSortLevel v sanitize
- let w := serializeSortLevel w sanitize
+ let v := serializeSortLevel v
+ let w := serializeSortLevel w
s!"(:imax {v} {w})"
| .param name =>
- let name := serializeName name sanitize
s!"{name}"
| .mvar id =>
- let name := serializeName id.name sanitize
+ let name := id.name
s!"(:mv {name})"
match k, u with
| 0, _ => u_str
@@ -295,7 +294,7 @@ partial def serializeSortLevel (level: Level) (sanitize: Bool): String :=
A `_` symbol in the AST indicates automatic deductions not present in the original expression.
-/
-partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM String := do
+partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
self expr
where
delayedMVarToSexp (e: Expr): MetaM (Option String) := do
@@ -334,9 +333,10 @@ partial def serializeExpressionSexp (expr: Expr) (sanitize: Bool := true): MetaM
let name := mvarId.name
pure s!"(:{pref} {name})"
| .sort level =>
- let level := serializeSortLevel level sanitize
+ let level := serializeSortLevel level
pure s!"(:sort {level})"
| .const declName _ =>
+ let declName := serializeName declName (sanitize := false)
-- The universe level of the const expression is elided since it should be
-- inferrable from surrounding expression
pure s!"(:c {declName})"
@@ -532,7 +532,7 @@ protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState :
then instantiateAll decl.type
else pure $ decl.type
let type_sexp ← if options.printSexp then
- let sexp ← serializeExpressionSexp type (sanitize := false)
+ let sexp ← serializeExpressionSexp type
pure <| " " ++ sexp
else
pure ""
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a6b5487..104a849 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -97,7 +97,7 @@ def test_identity: TestM Unit := do
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.name) =
#[inner])
let state1parent ← state1.withParentContext do
- serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
+ serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda h 0 (:subst (:mv {inner}) 1 0)))")
-- Individual test cases
@@ -259,7 +259,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(1 root)" state1.rootExpr?.isNone
let state1parent ← state1.withParentContext do
- serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!) (sanitize := false)
+ serializeExpressionSexp (← instantiateAll state1.parentExpr?.get!)
addTest $ LSpec.test "(1 parent)" (state1parent == s!"(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda h ((:c Or) 1 0) (:subst (:mv {state1g0}) 2 1 0))))")
let tactic := "cases h"
let state2 ← match ← state1.tacticOn (goalId := 0) (tactic := tactic) with
@@ -276,7 +276,7 @@ def test_or_comm: TestM Unit := do
addTest $ LSpec.check "(2 root)" state2.rootExpr?.isNone
let state2parent ← state2.withParentContext do
- serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!) (sanitize := false)
+ serializeExpressionSexp (← instantiateAll state2.parentExpr?.get!)
let orPQ := s!"((:c Or) (:fv {fvP}) (:fv {fvQ}))"
let orQP := s!"((:c Or) (:fv {fvQ}) (:fv {fvP}))"
let motive := s!"(:lambda t {orPQ} (:forall h ((:c Eq) ((:c Or) (:fv {fvP}) (:fv {fvQ})) (:fv {fvH}) 0) {orQP}))"
@@ -292,7 +292,7 @@ def test_or_comm: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
let state3_1parent ← state3_1.withParentContext do
- serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!) (sanitize := false)
+ serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!)
addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
From b42d917aa70fa82ebf07d4480ecd14441e07eb23 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 17 Dec 2024 08:18:27 +0900
Subject: [PATCH 383/465] fix: Unnecessary instantiation call
---
Pantograph/Goal.lean | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 6ff14d2..f573332 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -183,7 +183,8 @@ private def collectAllErroredMVars (src : MVarId) : Elab.TermElabM (List MVarId)
-- to one of these seed mvars, it means an error has occurred when a tactic
-- was executing on `src`. `evalTactic`, will not capture these mvars, so we
-- need to manually find them and save them into the goal list.
- let descendants ← Meta.getMVars $ ← instantiateMVars (.mvar src)
+
+ let descendants ← Meta.getMVars (.mvar src)
--let _ ← Elab.Term.logUnassignedUsingErrorInfos descendants
let mut alreadyVisited : MVarIdSet := {}
let mut result : MVarIdSet := {}
From 48b924fae26f0354625d65eb047c57d034945aa1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 20 Dec 2024 19:10:38 +0900
Subject: [PATCH 384/465] fix(frontend): Incorrect capture of binder term
---
Pantograph/Frontend/Elab.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 3da5fca..a07efb0 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -106,7 +106,7 @@ structure InfoWithContext where
private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext) := do
let infos ← t.findAllInfoM none fun i ctx? => match i with
- | .ofTermInfo { expectedType?, expr, stx, lctx, .. } => do
+ | .ofTermInfo { expectedType?, expr, stx, lctx, isBinder := false, .. } => do
let .some ctx := ctx? | return (false, true)
if expr.isSorry ∧ stx.isOfKind `Lean.Parser.Term.sorry then
if expectedType?.isNone then
From 5a05e9e8d4d3226e49747e1fa4a4b820ecd46dac Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 22 Dec 2024 08:47:38 +0900
Subject: [PATCH 385/465] test: Add binder capturing test
---
Test/Frontend.lean | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index a3b73ae..2c5809f 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -193,6 +193,15 @@ def mystery (k: Nat) : Nat := true
}
]
+def test_capture_type_mismatch_in_binder : TestT MetaM Unit := do
+ let input := "
+example (p: Prop) (h: (∀ (x: Prop), Nat) → p): p := h (λ (y: Nat) => 5)
+ "
+ let goalStates ← (collectSorrysFromSource input).run' {}
+ let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
+ checkEq "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize)) #[
+ ]
+
def collectNewConstants (source: String) : MetaM (List (List Name)) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
@@ -227,6 +236,7 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
("capture_type_mismatch", test_capture_type_mismatch),
+ ("capture_type_mismatch_in_binder", test_capture_type_mismatch_in_binder),
("collect_one_constant", test_collect_one_constant),
("collect_one_theorem", test_collect_one_theorem),
]
From 524314721b3213c380d54d461786abbddedf6c55 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Jan 2025 19:40:03 +0900
Subject: [PATCH 386/465] feat: Gate type error collection behind flag
---
Pantograph/Frontend/Elab.lean | 13 ++++++++++---
Pantograph/Protocol.lean | 8 +++++---
Repl.lean | 2 +-
Test/Frontend.lean | 15 +++++++++------
Test/Integration.lean | 10 ++++++----
5 files changed, 31 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index a07efb0..b5a7274 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -104,7 +104,11 @@ structure InfoWithContext where
info: Elab.Info
context?: Option Elab.ContextInfo := .none
-private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext) := do
+structure GoalCollectionOptions where
+ collectTypeErrors : Bool := false
+
+private def collectSorrysInTree (t : Elab.InfoTree) (options : GoalCollectionOptions := {})
+ : IO (List InfoWithContext) := do
let infos ← t.findAllInfoM none fun i ctx? => match i with
| .ofTermInfo { expectedType?, expr, stx, lctx, isBinder := false, .. } => do
let .some ctx := ctx? | return (false, true)
@@ -112,6 +116,8 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
if expectedType?.isNone then
throw $ .userError "Sorry of indeterminant type is not allowed"
return (true, false)
+ unless options.collectTypeErrors do
+ return (false, true)
let .some expectedType := expectedType? | return (false, true)
let typeMatch ← ctx.runMetaM lctx do
let type ← Meta.inferType expr
@@ -130,8 +136,9 @@ private def collectSorrysInTree (t : Elab.InfoTree) : IO (List InfoWithContext)
-- NOTE: Plural deliberately not spelled "sorries"
@[export pantograph_frontend_collect_sorrys_m]
-def collectSorrys (step: CompilationStep) : IO (List InfoWithContext) := do
- return (← step.trees.mapM collectSorrysInTree).join
+def collectSorrys (step: CompilationStep) (options : GoalCollectionOptions := {})
+ : IO (List InfoWithContext) := do
+ return (← step.trees.mapM $ λ tree => collectSorrysInTree tree options).join
structure AnnotatedGoalState where
state : GoalState
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 90ac149..47ed879 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -319,11 +319,13 @@ structure FrontendProcess where
-- One of these two must be supplied: Either supply the file name or the content.
fileName?: Option String := .none
file?: Option String := .none
- -- If set to true, collect tactic invocations
+ -- collect tactic invocations
invocations: Bool := false
- -- If set to true, collect `sorry`s
+ -- collect `sorry`s
sorrys: Bool := false
- -- If set to true, extract new constants
+ -- collect type errors
+ typeErrorsAsGoals: Bool := false
+ -- list new constants from each compilation step
newConstants: Bool := false
deriving Lean.FromJson
structure InvokedTactic where
diff --git a/Repl.lean b/Repl.lean
index eb02f59..1fd8266 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -265,7 +265,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
else
pure .none
let sorrys ← if args.sorrys then
- Frontend.collectSorrys step
+ Frontend.collectSorrys step (options := { collectTypeErrors := args.typeErrorsAsGoals })
else
pure []
let messages ← step.messageStrings
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 2c5809f..571aa9f 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -6,11 +6,12 @@ import Test.Common
open Lean Pantograph
namespace Pantograph.Test.Frontend
-def collectSorrysFromSource (source: String) : MetaM (List GoalState) := do
+def collectSorrysFromSource (source: String) (options : Frontend.GoalCollectionOptions := {})
+ : MetaM (List GoalState) := do
let filename := "<anonymous>"
let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
let m := Frontend.mapCompilationSteps λ step => do
- return (step.before, ← Frontend.collectSorrys step)
+ return (step.before, ← Frontend.collectSorrys step options)
let li ← m.run context |>.run' state
let goalStates ← li.filterMapM λ (env, sorrys) => withEnv env do
if sorrys.isEmpty then
@@ -181,9 +182,10 @@ def test_capture_type_mismatch : TestT MetaM Unit := do
let input := "
def mystery (k: Nat) : Nat := true
"
- let goalStates ← (collectSorrysFromSource input).run' {}
+ let options := { collectTypeErrors := true }
+ let goalStates ← (collectSorrysFromSource input options).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
- checkEq "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize)) #[
+ checkEq "goals" ((← goalState.serializeGoals).map (·.devolatilize)) #[
{
target := { pp? := "Nat" },
vars := #[{
@@ -197,7 +199,8 @@ def test_capture_type_mismatch_in_binder : TestT MetaM Unit := do
let input := "
example (p: Prop) (h: (∀ (x: Prop), Nat) → p): p := h (λ (y: Nat) => 5)
"
- let goalStates ← (collectSorrysFromSource input).run' {}
+ let options := { collectTypeErrors := true }
+ let goalStates ← (collectSorrysFromSource input options).run' {}
let [goalState] := goalStates | panic! s!"Incorrect number of states: {goalStates.length}"
checkEq "goals" ((← goalState.serializeGoals (options := {})).map (·.devolatilize)) #[
]
@@ -236,7 +239,7 @@ def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
("sorry_in_coupled", test_sorry_in_coupled),
("environment_capture", test_environment_capture),
("capture_type_mismatch", test_capture_type_mismatch),
- ("capture_type_mismatch_in_binder", test_capture_type_mismatch_in_binder),
+ --("capture_type_mismatch_in_binder", test_capture_type_mismatch_in_binder),
("collect_one_constant", test_collect_one_constant),
("collect_one_theorem", test_collect_one_theorem),
]
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 77968f0..1a2e97c 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -171,10 +171,11 @@ def test_frontend_process : Test :=
let goal1 := "p q : Prop\nh : p\n⊢ p ∨ q"
step "frontend.process"
[
- ("file", .str file),
- ("invocations", .bool true),
- ("sorrys", .bool false),
- ("newConstants", .bool false),
+ ("file", .str file),
+ ("invocations", .bool true),
+ ("sorrys", .bool false),
+ ("typeErrorsAsGoals", .bool false),
+ ("newConstants", .bool false),
]
({
units := [{
@@ -215,6 +216,7 @@ def test_frontend_process_sorry : Test :=
("file", .str file),
("invocations", .bool false),
("sorrys", .bool true),
+ ("typeErrorsAsGoals", .bool false),
("newConstants", .bool false),
]
({
From 6302b747b86fbfa9e9802c50535b102178cb49ec Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Jan 2025 17:51:32 -0800
Subject: [PATCH 387/465] feat: Improve error message clarity
---
Pantograph/Goal.lean | 31 ++++++++++++++++++++-----------
Test/Proofs.lean | 27 +++++++++++++++------------
2 files changed, 35 insertions(+), 23 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 6ff14d2..3dff60a 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -237,25 +237,34 @@ inductive TacticResult where
-- The given action cannot be executed in the state
| invalidAction (message: String)
+private def dumpMessageLog (prevMessageLength : Nat) : CoreM (Array String) := do
+ let newMessages ← (← Core.getMessageLog).toList.drop prevMessageLength
+ |>.filterMapM λ m => do
+ if m.severity == .error then
+ return .some $ ← m.toString
+ else
+ return .none
+ Core.resetMessageLog
+ return newMessages.toArray
+
/-- Executes a `TacticM` monad on this `GoalState`, collecting the errors as necessary -/
-protected def GoalState.tryTacticM (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit) (guardMVarErrors : Bool := false):
- Elab.TermElabM TacticResult := do
+protected def GoalState.tryTacticM
+ (state: GoalState) (goal: MVarId) (tacticM: Elab.Tactic.TacticM Unit)
+ (guardMVarErrors : Bool := false)
+ : Elab.TermElabM TacticResult := do
+ let prevMessageLength := state.coreState.messages.toList.length
try
let nextState ← state.step goal tacticM guardMVarErrors
-- Check if error messages have been generated in the core.
- let newMessages ← (← Core.getMessageLog).toList.drop state.coreState.messages.toList.length
- |>.filterMapM λ m => do
- if m.severity == .error then
- return .some $ ← m.toString
- else
- return .none
- Core.resetMessageLog
+ let newMessages ← dumpMessageLog prevMessageLength
if ¬ newMessages.isEmpty then
- return .failure newMessages.toArray
+ return .failure newMessages
return .success nextState
catch exception =>
- return .failure #[← exception.toMessageData.toString]
+ match exception with
+ | .internal _ => return .failure $ ← dumpMessageLog prevMessageLength
+ | _ => return .failure #[← exception.toMessageData.toString]
/-- Execute a string tactic on given state. Restores TermElabM -/
@[export pantograph_goal_state_try_tactic_m]
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a4a916b..a179b74 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -720,7 +720,6 @@ def test_tactic_failure_unresolved_goals : TestM Unit := do
let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
checkEq s!"{tactic} fails" messages #[s!"{← getFileName}:0:12: error: unsolved goals\np : Nat → Prop\n⊢ p 0\n"]
-
def test_tactic_failure_synthesize_placeholder : TestM Unit := do
let state? ← startProof (.expr "∀ (p q r : Prop) (h : p → q), q ∧ r")
let state0 ← match state? with
@@ -736,20 +735,24 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
+ let iex : InternalExceptionId := { idx := 4 }
+ IO.println s!"{← iex.getName}"
let tactic := "simpa [h] using And.imp_left h _"
- let state2 ← match ← state1.tacticOn 0 tactic with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
+ --let state2 ← match ← state1.tacticOn 0 tactic with
+ -- | .success state => pure state
+ -- | other => do
+ -- addTest $ assertUnreachable $ other.toString
+ -- return ()
- checkEq tactic ((← state2.serializeGoals).map (·.devolatilize)) #[
- buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
- ]
+ -- Volatile behaviour. This easily changes across Lean versions
- --let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
- --let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
- --checkEq s!"{tactic} fails" messages #[message]
+ --checkEq tactic ((← state2.serializeGoals).map (·.devolatilize)) #[
+ -- buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
+ --]
+
+ let .failure messages ← state1.tacticOn 0 tactic | addTest $ assertUnreachable s!"{tactic} should fail"
+ let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
+ checkEq s!"{tactic} fails" messages #[message]
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
From f89196036246590131ce66019a9aad664db9b508 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 7 Jan 2025 17:52:28 -0800
Subject: [PATCH 388/465] fix: Volatile test
---
Test/Integration.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 77968f0..098b7fc 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -73,7 +73,7 @@ def test_tactic : Test :=
step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.print" [("stateId", .num 1), ("parentExpr", .bool true), ("rootExpr", .bool true)]
- ({ parent? := .some { pp? := .some "fun x => ?m.12 x" }, }: Protocol.GoalPrintResult),
+ ({ parent? := .some { pp? := .some "fun x => ?m.11" }, }: Protocol.GoalPrintResult),
step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
]
From 5ce6123de74af4823026771ce62cadd075a32771 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 Jan 2025 19:56:14 -0800
Subject: [PATCH 389/465] feat: Draft tactic
---
Pantograph/Tactic/Assign.lean | 30 ++++++++++++++++++++++++++++++
1 file changed, 30 insertions(+)
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index 8a5b998..1607e83 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -27,5 +27,35 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
goal.assign expr
Elab.Tactic.replaceMainGoal nextGoals
+def sorryToHole (src : Expr) : StateRefT (List MVarId) MetaM Expr := do
+ Meta.transform src λ
+ | .app (.app (.const ``sorryAx ..) type) .. => do
+ let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
+ modify (mvar.mvarId! :: .)
+ pure $ .done mvar
+ | _ => pure .continue
+
+-- Given a complete (no holes) expression, extract the sorry's from it and convert them into goals.
+def draft (goal : MVarId) (expr : Expr) : MetaM (List MVarId) := do
+ goal.checkNotAssigned `Pantograph.Tactic.draft
+ let exprType ← Meta.inferType expr
+ let goalType ← goal.getType
+ unless ← Meta.isDefEq goalType exprType do
+ throwError s!"{← Meta.ppExpr expr} : {← Meta.ppExpr exprType} ≠ {← Meta.ppExpr goalType}"
+
+ let (expr', holes) ← sorryToHole expr |>.run []
+ goal.assign expr'
+ return holes.reverse
+
+def evalDraft : Elab.Tactic.Tactic := fun stx ↦ Elab.Tactic.withMainContext do
+ let target ← Elab.Tactic.getMainTarget
+ let goal ← Elab.Tactic.getMainGoal
+ let (expr, holeGoals) ← Elab.Tactic.elabTermWithHoles stx
+ (expectedType? := .some target)
+ (tagSuffix := .anonymous )
+ (allowNaturalHoles := true)
+ let draftGoals ← draft goal expr
+ Elab.Tactic.replaceMainGoal $ holeGoals ++ draftGoals
+
end Pantograph.Tactic
From cb46b47a60cbe06a3b26efd261f9a07a6fe76326 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 Jan 2025 22:23:30 -0800
Subject: [PATCH 390/465] test: Draft tactic test
---
Pantograph/Tactic/Assign.lean | 3 ++-
Test/Main.lean | 1 +
Test/Proofs.lean | 28 ++++++++++++++++++++++++++++
Test/Tactic.lean | 1 +
4 files changed, 32 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index 1607e83..d1dbf0c 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -30,6 +30,7 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
def sorryToHole (src : Expr) : StateRefT (List MVarId) MetaM Expr := do
Meta.transform src λ
| .app (.app (.const ``sorryAx ..) type) .. => do
+ -- FIXME: Handle cases of coupled goals
let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
modify (mvar.mvarId! :: .)
pure $ .done mvar
@@ -52,7 +53,7 @@ def evalDraft : Elab.Tactic.Tactic := fun stx ↦ Elab.Tactic.withMainContext do
let goal ← Elab.Tactic.getMainGoal
let (expr, holeGoals) ← Elab.Tactic.elabTermWithHoles stx
(expectedType? := .some target)
- (tagSuffix := .anonymous )
+ (tagSuffix := .anonymous)
(allowNaturalHoles := true)
let draftGoals ← draft goal expr
Elab.Tactic.replaceMainGoal $ holeGoals ++ draftGoals
diff --git a/Test/Main.lean b/Test/Main.lean
index 6bf410e..18dc9e3 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -53,6 +53,7 @@ def main (args: List String) := do
("Proofs", Proofs.suite env_default),
("Delate", Delate.suite env_default),
("Serial", Serial.suite env_default),
+ ("Tactic/Assign", Tactic.Assign.suite env_default),
("Tactic/Congruence", Tactic.Congruence.suite env_default),
("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a6b5487..b1b770b 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -751,6 +751,33 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
--let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
--checkEq s!"{tactic} fails" messages #[message]
+
+def test_draft_tactic : TestM Unit := do
+ let state? ← startProof (.expr "∀ (p : Prop), p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let tactic := "intro p"
+ let state1 ← match ← state0.tacticOn 0 tactic with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ let payload := "by\nhave q : Or p p := sorry\nsorry"
+ let state2 ← match ← state1.tryAssign (state1.goals.get! 0) payload with
+ | .success state => pure state
+ | other => do
+ addTest $ assertUnreachable $ other.toString
+ return ()
+
+ checkEq payload ((← state2.serializeGoals).map (·.devolatilize)) #[
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
+ ]
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("identity", test_identity),
@@ -765,6 +792,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Nat.zero_add alt", test_nat_zero_add_alt),
("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
+ ("draft", test_draft_tactic),
]
tests.map (fun (name, test) => (name, proofRunner env test))
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
index 3cb0e40..6b3e8fd 100644
--- a/Test/Tactic.lean
+++ b/Test/Tactic.lean
@@ -1,3 +1,4 @@
+import Test.Tactic.Assign
import Test.Tactic.Congruence
import Test.Tactic.MotivatedApply
import Test.Tactic.NoConfuse
From 072d351f0406616592f0ef727a8120164b926ffc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 Jan 2025 22:47:08 -0800
Subject: [PATCH 391/465] fix: Delete extraneous test
---
Test/Proofs.lean | 27 ---------------------------
1 file changed, 27 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index b1b770b..a26ec50 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -752,32 +752,6 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
--checkEq s!"{tactic} fails" messages #[message]
-def test_draft_tactic : TestM Unit := do
- let state? ← startProof (.expr "∀ (p : Prop), p")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
-
- let tactic := "intro p"
- let state1 ← match ← state0.tacticOn 0 tactic with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
-
- let payload := "by\nhave q : Or p p := sorry\nsorry"
- let state2 ← match ← state1.tryAssign (state1.goals.get! 0) payload with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
-
- checkEq payload ((← state2.serializeGoals).map (·.devolatilize)) #[
- buildGoal [("p", "Prop"), ("q", "Prop"), ("r", "Prop"), ("h", "p → q")] "p ∧ r"
- ]
-
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
("identity", test_identity),
@@ -792,7 +766,6 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Nat.zero_add alt", test_nat_zero_add_alt),
("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
- ("draft", test_draft_tactic),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From aa066b8634a65a3036745c331022c576722acbab Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 8 Jan 2025 22:53:10 -0800
Subject: [PATCH 392/465] fix: Add test
---
Test/Tactic/Assign.lean | 33 +++++++++++++++++++++++++++++++++
1 file changed, 33 insertions(+)
create mode 100644 Test/Tactic/Assign.lean
diff --git a/Test/Tactic/Assign.lean b/Test/Tactic/Assign.lean
new file mode 100644
index 0000000..e527bbb
--- /dev/null
+++ b/Test/Tactic/Assign.lean
@@ -0,0 +1,33 @@
+import Lean.Meta
+import Lean.Elab
+import LSpec
+import Test.Common
+
+open Lean
+
+namespace Pantograph.Test.Tactic.Assign
+
+def test_draft : TestT Elab.TermElabM Unit := do
+ let expr := "forall (p : Prop), (p ∨ p) ∨ p"
+ let skeleton := "by\nhave a : p ∨ p := sorry\nsorry"
+ let expr ← parseSentence expr
+ Meta.forallTelescope expr $ λ _ body => do
+ let skeleton' ← match Parser.runParserCategory
+ (env := ← MonadEnv.getEnv)
+ (catName := `term)
+ (input := skeleton)
+ (fileName := ← getFileName) with
+ | .ok syn => pure syn
+ | .error error => throwError "Failed to parse: {error}"
+ -- Apply the tactic
+ let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
+ let tactic := Tactic.evalDraft skeleton'
+ let newGoals ← runTacticOnMVar tactic target.mvarId!
+ addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = ["p ∨ p", "(p ∨ p) ∨ p"])
+
+def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
+ [
+ ("draft", test_draft),
+ ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
+
+end Pantograph.Test.Tactic.Assign
From 97eaadc93ce912875f841113d7f773d27bdc8089 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 10 Jan 2025 12:16:23 -0800
Subject: [PATCH 393/465] feat: Add source location extraction
---
Pantograph/Environment.lean | 18 ++++++++++++++++--
Pantograph/Protocol.lean | 13 ++++++++++---
2 files changed, 26 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index ad21284..c9f9fec 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -58,7 +58,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
| none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}"
| some info => pure info
let module? := env.getModuleIdxFor? name >>=
- (λ idx => env.allImportedModuleNames.get? idx.toNat) |>.map toString
+ (λ idx => env.allImportedModuleNames.get? idx.toNat)
let value? := match args.value?, info with
| .some true, _ => info.value?
| .some false, _ => .none
@@ -80,7 +80,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
then value?.map (λ e =>
e.getUsedConstants.filter (!isNameInternal ·) |>.map (λ n => serializeName n) )
else .none,
- module? := module?
+ module? := module?.map (·.toString)
}
let result ← match info with
| .inductInfo induct => pure { core with inductInfo? := .some {
@@ -113,6 +113,20 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
k := r.k,
} }
| _ => pure core
+ let result ← if args.source?.getD false then
+ let searchPath ← searchPathRef.get
+ let sourceUri? ← module?.bindM (Server.documentUriFromModule searchPath ·)
+ let declRange? ← findDeclarationRanges? name
+ let sourceStart? := declRange?.map (·.range.pos)
+ let sourceEnd? := declRange?.map (·.range.endPos)
+ .pure {
+ result with
+ sourceUri?,
+ sourceStart?,
+ sourceEnd?,
+ }
+ else
+ .pure result
return .ok result
def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do
let env ← Lean.MonadEnv.getEnv
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 90ac149..67a37df 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -5,6 +5,7 @@ Note that no command other than `InteractionError` may have `error` as one of
its field names to avoid confusion with error messages generated by the REPL.
-/
import Lean.Data.Json
+import Lean.Data.Position
namespace Pantograph.Protocol
@@ -121,11 +122,13 @@ structure EnvCatalogResult where
-- Print the type of a symbol
structure EnvInspect where
name: String
- -- If true/false, show/hide the value expressions; By default definitions
- -- values are shown and theorem values are hidden.
+ -- Show the value expressions; By default definitions values are shown and
+ -- theorem values are hidden.
value?: Option Bool := .some false
- -- If true, show the type and value dependencies
+ -- Show the type and value dependencies
dependency?: Option Bool := .some false
+ -- Show source location
+ source?: Option Bool := .some false
deriving Lean.FromJson
-- See `InductiveVal`
structure InductInfo where
@@ -172,6 +175,10 @@ structure EnvInspectResult where
inductInfo?: Option InductInfo := .none
constructorInfo?: Option ConstructorInfo := .none
recursorInfo?: Option RecursorInfo := .none
+
+ sourceUri?: Option String := .none
+ sourceStart?: Option Lean.Position := .none
+ sourceEnd?: Option Lean.Position := .none
deriving Lean.ToJson
structure EnvAdd where
From 4a4b02d7b05ff0a669ce59cc91f2b842d0ef361d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 10 Jan 2025 12:47:13 -0800
Subject: [PATCH 394/465] test: Source location extraction
---
Pantograph/Environment.lean | 4 ++--
Pantograph/Protocol.lean | 1 +
Test/Common.lean | 2 ++
Test/Environment.lean | 15 +++++++++++++++
4 files changed, 20 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index c9f9fec..c48414a 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -114,8 +114,8 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
} }
| _ => pure core
let result ← if args.source?.getD false then
- let searchPath ← searchPathRef.get
- let sourceUri? ← module?.bindM (Server.documentUriFromModule searchPath ·)
+ let srcSearchPath ← initSrcSearchPath
+ let sourceUri? ← module?.bindM (Server.documentUriFromModule srcSearchPath ·)
let declRange? ← findDeclarationRanges? name
let sourceStart? := declRange?.map (·.range.pos)
let sourceEnd? := declRange?.map (·.range.endPos)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 67a37df..a8abb3d 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -176,6 +176,7 @@ structure EnvInspectResult where
constructorInfo?: Option ConstructorInfo := .none
recursorInfo?: Option RecursorInfo := .none
+ -- Location in source
sourceUri?: Option String := .none
sourceStart?: Option Lean.Position := .none
sourceEnd?: Option Lean.Position := .none
diff --git a/Test/Common.lean b/Test/Common.lean
index 53adaa0..3cad256 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -143,6 +143,8 @@ def runTest (t: TestT m Unit): m LSpec.TestSeq :=
Prod.snd <$> t.run LSpec.TestSeq.done
def runTestWithResult { α } (t: TestT m α): m (α × LSpec.TestSeq) :=
t.run LSpec.TestSeq.done
+def runTestCoreM (env: Environment) (coreM: TestT CoreM Unit) (options: Array String := #[]): IO LSpec.TestSeq := do
+ runCoreMSeq env (runTest coreM) options
end Monadic
diff --git a/Test/Environment.lean b/Test/Environment.lean
index 79d04ed..a9f6cdc 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -97,11 +97,26 @@ def test_inspect: IO LSpec.TestSeq := do
) LSpec.TestSeq.done
runCoreMSeq env inner
+def test_symbol_location : TestT IO Unit := do
+ let env: Environment ← importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
+ addTest $ ← runTestCoreM env do
+ let .ok result ← Environment.inspect { name := "Nat.le_of_succ_le", source? := .some true } (options := {}) | fail "Inspect failed"
+ checkEq "module" result.module? <| .some "Init.Data.Nat.Basic"
+
+ -- Doesn't work for symbols in `Init` for some reason
+ --checkEq "file" result.sourceUri? <| .some "??"
+ checkEq "pos" result.sourceStart? <| .some { line := 344, column := 0 }
+ checkEq "pos" result.sourceEnd? <| .some { line := 344, column := 88 }
+
def suite: List (String × IO LSpec.TestSeq) :=
[
("Catalog", test_catalog),
("Symbol Visibility", test_symbol_visibility),
("Inspect", test_inspect),
+ ("Symbol Location", runTest test_symbol_location),
]
end Pantograph.Test.Environment
From ef4e5ecbf8057c6baf542391d4c40ec068810aa4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 10 Jan 2025 12:55:26 -0800
Subject: [PATCH 395/465] chore: Update version
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index 9d044d4..d20dec5 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.23"
+def version := "0.2.24"
end Pantograph
From ebde7c9eed50d4cc29b235150cf5e4841f6dbc85 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 10:20:36 -0800
Subject: [PATCH 396/465] feat: Prohibit coupling in drafting
---
Pantograph/Frontend/Elab.lean | 5 +++++
Pantograph/Tactic/Assign.lean | 4 +++-
2 files changed, 8 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 3da5fca..4ccb609 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -149,9 +149,14 @@ def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM AnnotatedGoalState
match i.info with
| .ofTermInfo termInfo => do
let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
+ if (← mvarId.getType).hasSorry then
+ throwError s!"Coupling is not allowed in drafting"
return [(mvarId, stxByteRange termInfo.stx)]
| .ofTacticInfo tacticInfo => do
let mvarIds ← MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
+ for mvarId in mvarIds do
+ if (← mvarId.getType).hasSorry then
+ throwError s!"Coupling is not allowed in drafting"
let range := stxByteRange tacticInfo.stx
return mvarIds.map (·, range)
| _ => panic! "Invalid info"
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index d1dbf0c..c87dd46 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -30,7 +30,9 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
def sorryToHole (src : Expr) : StateRefT (List MVarId) MetaM Expr := do
Meta.transform src λ
| .app (.app (.const ``sorryAx ..) type) .. => do
- -- FIXME: Handle cases of coupled goals
+ let type ← instantiateMVars type
+ if type.hasSorry then
+ throwError s!"Coupling is not allowed in draft tactic: {← Meta.ppExpr type}"
let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
modify (mvar.mvarId! :: .)
pure $ .done mvar
From 5e61282660c72397d478b66eddee60add989679f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 10:30:26 -0800
Subject: [PATCH 397/465] test: Source location extraction
---
Test/Environment.lean | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/Test/Environment.lean b/Test/Environment.lean
index af98c10..b646279 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -106,8 +106,8 @@ def test_symbol_location : TestT IO Unit := do
let .ok result ← Environment.inspect { name := "Nat.le_of_succ_le", source? := .some true } (options := {}) | fail "Inspect failed"
checkEq "module" result.module? <| .some "Init.Data.Nat.Basic"
- -- Doesn't work for symbols in `Init` for some reason
- --checkEq "file" result.sourceUri? <| .some "??"
+ -- Extraction of source doesn't work for symbols in `Init` for some reason
+ checkTrue "file" result.sourceUri?.isNone
checkEq "pos" (result.sourceStart?.map (·.column)) <| .some 0
checkEq "pos" (result.sourceEnd?.map (·.column)) <| .some 88
From 06fdf7e678c1ce2e7a2bb5fe26962c6d89715e22 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 11:09:55 -0800
Subject: [PATCH 398/465] chore: Update Lean to v4.15.0
---
Pantograph/Frontend/InfoTree.lean | 4 ++++
Pantograph/Tactic/Prograde.lean | 2 +-
flake.lock | 7 +++----
flake.nix | 20 +++++---------------
lean-toolchain | 2 +-
5 files changed, 14 insertions(+), 21 deletions(-)
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index b170ee6..a38775c 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -26,6 +26,8 @@ protected def Info.stx? : Info → Option Syntax
| .ofFVarAliasInfo _ => none
| .ofFieldRedeclInfo info => info.stx
| .ofOmissionInfo info => info.stx
+ | .ofChoiceInfo info => info.stx
+ | .ofPartialTermInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
protected def Info.isOriginal (i : Info) : Bool :=
match i.stx? with
@@ -141,6 +143,8 @@ partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo := .
| .ofFVarAliasInfo _ => pure "[fvar]"
| .ofFieldRedeclInfo _ => pure "[field_redecl]"
| .ofOmissionInfo _ => pure "[omission]"
+ | .ofChoiceInfo _ => pure "[choice]"
+ | .ofPartialTermInfo _ => pure "[partial_term]"
let children := "\n".intercalate (← children.toList.mapM λ t' => do pure $ indent $ ← t'.toString ctx)
return s!"{node}\n{children}"
else throw <| IO.userError "No `ContextInfo` available."
diff --git a/Pantograph/Tactic/Prograde.lean b/Pantograph/Tactic/Prograde.lean
index 0b4719f..c0cdcc1 100644
--- a/Pantograph/Tactic/Prograde.lean
+++ b/Pantograph/Tactic/Prograde.lean
@@ -40,7 +40,7 @@ def «have» (mvarId: MVarId) (binderName: Name) (type: Expr): MetaM BranchResul
let fvarId ← mkFreshFVarId
let lctxUpstream := lctx.mkLocalDecl fvarId binderName type
let mvarUpstream ←
- withTheReader Meta.Context (fun ctx => { ctx with lctx := lctxUpstream }) do
+ Meta.withLCtx lctxUpstream #[] do
Meta.withNewLocalInstances #[.fvar fvarId] 0 do
let mvarUpstream ← mkUpstreamMVar mvarId
--let expr: Expr := .app (.lam binderName type mvarBranch .default) mvarUpstream
diff --git a/flake.lock b/flake.lock
index 9f54bbe..4a17f3d 100644
--- a/flake.lock
+++ b/flake.lock
@@ -42,16 +42,15 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1733351931,
- "narHash": "sha256-ngMjY/ci6490G2gofaS9CODtpnmFoYzfaI13U14TkFM=",
+ "lastModified": 1736388194,
+ "narHash": "sha256-ymSrd/A8Pw+9FzbxUbR7CkFHLJK1b4SnFFWg/1e0JeE=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "157c85903f668fadeb79f330961b7bbe5ee596de",
+ "rev": "90f496bc0694fb97bdfa6adedfc2dc2c841a4cf2",
"type": "github"
},
"original": {
"owner": "lenianiva",
- "ref": "157c85903f668fadeb79f330961b7bbe5ee596de",
"repo": "lean4-nix",
"type": "github"
}
diff --git a/flake.nix b/flake.nix
index 1dfc515..af6e4fb 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,7 +4,7 @@
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-24.05";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean4-nix.url = "github:lenianiva/lean4-nix?ref=157c85903f668fadeb79f330961b7bbe5ee596de";
+ lean4-nix.url = "github:lenianiva/lean4-nix";
lspec = {
url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
flake = false;
@@ -18,19 +18,9 @@
lean4-nix,
lspec,
...
- } : flake-parts.lib.mkFlake { inherit inputs; } {
- flake = {
- };
- systems = [
- "aarch64-linux"
- "aarch64-darwin"
- "x86_64-linux"
- "x86_64-darwin"
- ];
- perSystem = { system, pkgs, ... }: let
- pkgs = import nixpkgs {
- inherit system;
- overlays = [ (lean4-nix.readToolchainFile ./lean-toolchain) ];
+ }:
+ flake-parts.lib.mkFlake {inherit inputs;} {
+ flake = {
};
systems = [
"aarch64-linux"
@@ -94,7 +84,6 @@
inherit (repl) executable;
default = repl.executable;
};
- formatter = pkgs.alejandra;
legacyPackages = {
inherit project;
leanPkgs = pkgs.lean;
@@ -108,6 +97,7 @@
${test.executable}/bin/test > $out
'';
};
+ formatter = pkgs.alejandra;
devShells.default = pkgs.mkShell {
buildInputs = [pkgs.lean.lean-all pkgs.lean.lean];
};
diff --git a/lean-toolchain b/lean-toolchain
index 1e70935..d0eb99f 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.14.0
+leanprover/lean4:v4.15.0
From 60e78b322eacb6a3bfefff1a527ede2e9cc1ed1c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 12:28:16 -0800
Subject: [PATCH 399/465] fix: Test failures
---
Test/Common.lean | 6 ++++
Test/Integration.lean | 12 +++----
Test/Metavar.lean | 4 +--
Test/Proofs.lean | 61 ++++++++++++++++++++-------------
Test/Tactic/Congruence.lean | 6 ++--
Test/Tactic/MotivatedApply.lean | 6 ++--
6 files changed, 58 insertions(+), 37 deletions(-)
diff --git a/Test/Common.lean b/Test/Common.lean
index 3cad256..5274bad 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -48,6 +48,12 @@ namespace Condensed
deriving instance BEq, Repr for LocalDecl
deriving instance BEq, Repr for Goal
+-- Enable string interpolation
+instance : ToString FVarId where
+ toString id := id.name.toString
+instance : ToString MVarId where
+ toString id := id.name.toString
+
protected def LocalDecl.devolatilize (decl: LocalDecl): LocalDecl :=
{
decl with fvarId := { name := .anonymous }
diff --git a/Test/Integration.lean b/Test/Integration.lean
index dce7e65..7864515 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -90,27 +90,27 @@ def test_automatic_mode (automatic: Bool): Test :=
],
}
let goal2l: Protocol.Goal := {
- name := "_uniq.59",
+ name := "_uniq.61",
userName? := .some "inl",
target := { pp? := .some "q ∨ p" },
vars := varsPQ ++ #[
- { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
+ { name := "_uniq.49", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
],
}
let goal2r: Protocol.Goal := {
- name := "_uniq.72",
+ name := "_uniq.74",
userName? := .some "inr",
target := { pp? := .some "q ∨ p" },
vars := varsPQ ++ #[
- { name := "_uniq.60", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true}
+ { name := "_uniq.62", userName := "h✝", type? := .some { pp? := .some "q" }, isInaccessible := true}
],
}
let goal3l: Protocol.Goal := {
- name := "_uniq.78",
+ name := "_uniq.80",
userName? := .some "inl.h",
target := { pp? := .some "p" },
vars := varsPQ ++ #[
- { name := "_uniq.47", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
+ { name := "_uniq.49", userName := "h✝", type? := .some { pp? := .some "p" }, isInaccessible := true}
],
}
[
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index c6fc4f0..276004b 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -239,7 +239,7 @@ def test_partial_continuation: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
+ #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Roundtrip
@@ -253,7 +253,7 @@ def test_partial_continuation: TestM Unit := do
return ()
| .ok state => pure state
addTest $ LSpec.check "(continue)" ((← state1b.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "2 ≤ ?m.succ", .some "?m.succ ≤ 5", .some "Nat"])
+ #[.some "2 ≤ Nat.succ ?m", .some "Nat.succ ?m ≤ 5", .some "Nat"])
addTest $ LSpec.test "(2 root)" state1b.rootExpr?.isNone
-- Continuation should fail if the state does not exist:
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index d7722e2..e13e528 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -241,13 +241,15 @@ def test_or_comm: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let fvP := "_uniq.10"
- let fvQ := "_uniq.13"
- let fvH := "_uniq.16"
- let state1g0 := "_uniq.17"
+ let [state1g0] := state1.goals | fail "Should have 1 goal"
+ let (fvP, fvQ, fvH) ← state1.withContext state1g0 do
+ let lctx ← getLCtx
+ let #[fvP, fvQ, fvH] := lctx.getFVarIds.map (toString ·.name) |
+ panic! "Incorrect number of decls"
+ pure (fvP, fvQ, fvH)
addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)) =
#[{
- name := state1g0,
+ name := state1g0.name.toString,
target := { pp? := .some "q ∨ p" },
vars := #[
{ name := fvP, userName := "p", type? := .some { pp? := .some "Prop" } },
@@ -269,7 +271,9 @@ def test_or_comm: TestM Unit := do
return ()
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.devolatilize) =
#[branchGoal "inl" "p", branchGoal "inr" "q"])
- let (caseL, caseR) := ("_uniq.64", "_uniq.77")
+ let [state2g0, state2g1] := state2.goals |
+ fail s!"Should have 2 goals, but it has {state2.goals.length}"
+ let (caseL, caseR) := (state2g0.name.toString, state2g1.name.toString)
addTest $ LSpec.check tactic ((← state2.serializeGoals (options := ← read)).map (·.name) =
#[caseL, caseR])
addTest $ LSpec.check "(2 parent exists)" state2.parentExpr?.isSome
@@ -293,7 +297,8 @@ def test_or_comm: TestM Unit := do
return ()
let state3_1parent ← state3_1.withParentContext do
serializeExpressionSexp (← instantiateAll state3_1.parentExpr?.get!)
- addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv _uniq.91))")
+ let [state3_1goal0] := state3_1.goals | fail "Should have 1 goal"
+ addTest $ LSpec.test "(3_1 parent)" (state3_1parent == s!"((:c Or.inr) (:fv {fvQ}) (:fv {fvP}) (:mv {state3_1goal0}))")
addTest $ LSpec.check "· apply Or.inr" (state3_1.goals.length = 1)
let state4_1 ← match ← state3_1.tacticOn (goalId := 0) (tactic := "assumption") with
| .success state => pure state
@@ -559,12 +564,15 @@ def test_nat_zero_add: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
+ let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals |
+ fail "Incorrect number of goals"
+ let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal "_uniq.72" [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.73" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.74" [("n", "Nat")] "?motive ?m.72 = (n + 0 = n)" (.some "conduit")
+ buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat",
+ buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit")
])
let tactic := "exact n"
@@ -647,13 +655,15 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let major := "_uniq.72"
+ let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals |
+ fail "Incorrect number of goals"
+ let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
#[
- buildNamedGoal "_uniq.71" [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal major [("n", "Nat")] "Nat",
- buildNamedGoal "_uniq.73" [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal "_uniq.74" [("n", "Nat")] "?motive ?m.72 = (n + 0 = n)" (.some "conduit")
+ buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"),
+ buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat",
+ buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
+ buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit")
])
let tactic := "intro x"
@@ -670,8 +680,7 @@ def test_nat_zero_add_alt: TestM Unit := do
| other => do
addTest $ assertUnreachable $ other.toString
return ()
- let (eqL, eqR, eqT) := ("_uniq.92", "_uniq.93", "_uniq.91")
- addTest $ LSpec.check tactic $ state3m2.goals.map (·.name.toString) = [eqL, eqR, eqT]
+ let [eqL, eqR, eqT] := state3m2.goals | fail "Incorrect number of goals"
let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
let state2b ← match state3m2.resume [conduit] with
| .ok state => pure state
@@ -681,20 +690,26 @@ def test_nat_zero_add_alt: TestM Unit := do
let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
- let fvN := "_uniq.67"
+ let fvN ← state2b.withContext conduit do
+ let lctx ← getLCtx
+ pure $ lctx.getFVarIds.get! 0 |>.name
let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
- let substOf (mv: String) := s!"(:subst (:mv {mv}) (:fv {fvN}) (:mv {major}))"
+ let substOf (mvarId: MVarId) := s!"(:subst (:mv {mvarId.name}) (:fv {fvN}) (:mv {mvarMajor}))"
+ let .num _ nL := eqL.name | fail "Incorrect form of mvar id"
+ let .num _ nR := eqR.name | fail "Incorrect form of mvar id"
+ let nL' := nL + 4
+ let nR' := nR + 5
addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
#[
{
- name := "_uniq.74",
+ name := mvarConduit.name.toString,
userName? := .some "conduit",
target := {
- pp? := .some "(?m.96 ?m.72 = ?m.98 ?m.72) = (n + 0 = n)",
+ pp? := .some s!"(?m.{nL'} ?m.{major} = ?m.{nR'} ?m.{major}) = (n + 0 = n)",
sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
},
vars := #[{
- name := fvN,
+ name := fvN.toString,
userName := "n",
type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
}],
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
index 180c2f4..e861b2f 100644
--- a/Test/Tactic/Congruence.lean
+++ b/Test/Tactic/Congruence.lean
@@ -28,7 +28,7 @@ def test_congr_arg_list : TestT Elab.TermElabM Unit := do
let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse")
addTest $ LSpec.check "apply" (results.length = 0)
addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
- addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(?a₁.reverse = ?a₂.reverse) = (l1.reverse = l2.reverse)")
+ addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(List.reverse ?a₁ = List.reverse ?a₂) = (l1.reverse = l2.reverse)")
def test_congr_arg : TestT Elab.TermElabM Unit := do
let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
let expr ← parseSentence expr
@@ -37,7 +37,7 @@ def test_congr_arg : TestT Elab.TermElabM Unit := do
let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
- (`α, "Sort ?u.70"),
+ (`α, "Sort ?u.73"),
(`a₁, "?α"),
(`a₂, "?α"),
(`f, "?α → Nat"),
@@ -52,7 +52,7 @@ def test_congr_fun : TestT Elab.TermElabM Unit := do
let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId!
addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
[
- (`α, "Sort ?u.159"),
+ (`α, "Sort ?u.165"),
(`f₁, "?α → Nat"),
(`f₂, "?α → Nat"),
(`h, "?f₁ = ?f₂"),
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 66bb336..2da643e 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -40,7 +40,7 @@ def test_nat_brec_on : TestT Elab.TermElabM Unit := do
"Nat → Prop",
"Nat",
"∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.71 = (n + 0 = n)",
+ "?motive ?m.74 = (n + 0 = n)",
])
addTest test
@@ -83,7 +83,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
let tactic := Tactic.evalMotivatedApply recursor
let newGoals ← runTacticOnMVar tactic target.mvarId!
- let majorId := 71
+ let majorId := 74
addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
[
"Nat → Prop",
@@ -100,7 +100,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
addTest $ ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = s!"(?m.{majorId}.add + 0 = ?m.146 ?m.{majorId}) = (n + 0 = n)")
+ return LSpec.check "conduit" (t = s!"(Nat.add ?m.{majorId} + 0 = ?m.149 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
From c1f63af01920e5038298795e969c574994411329 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 10:22:53 -0800
Subject: [PATCH 400/465] chore: Update version to 0.2.25
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index d20dec5..a4b056c 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.24"
+def version := "0.2.25"
end Pantograph
From fef7f1e2f3b4f816d3d61794a2dfba8f1ab333b2 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 12:43:19 -0800
Subject: [PATCH 401/465] feat: Pickle constants in goal state
---
Pantograph/Serial.lean | 23 ++++++++++++++++++-----
1 file changed, 18 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Serial.lean b/Pantograph/Serial.lean
index bd01169..c242713 100644
--- a/Pantograph/Serial.lean
+++ b/Pantograph/Serial.lean
@@ -59,6 +59,12 @@ and then add the new constants.
def environmentPickle (env : Environment) (path : System.FilePath) : IO Unit :=
Pantograph.pickle path (env.header.imports, env.constants.map₂)
+def resurrectEnvironment
+ (imports : Array Import)
+ (map₂ : PHashMap Name ConstantInfo)
+ : IO Environment := do
+ let env ← importModules imports {} 0
+ env.replay (Std.HashMap.ofList map₂.toList)
/--
Unpickle an `Environment` from disk.
@@ -68,8 +74,7 @@ and then replace the new constants.
@[export pantograph_env_unpickle_m]
def environmentUnpickle (path : System.FilePath) : IO (Environment × CompactedRegion) := unsafe do
let ((imports, map₂), region) ← Pantograph.unpickle (Array Import × PHashMap Name ConstantInfo) path
- let env ← importModules imports {} 0
- return (← env.replay (Std.HashMap.ofList map₂.toList), region)
+ return (← resurrectEnvironment imports map₂, region)
open Lean.Core in
@@ -88,7 +93,9 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
savedState := {
term := {
meta := {
- core,
+ core := {
+ env, nextMacroScope, ngen, ..
+ },
meta,
}
«elab»,
@@ -100,9 +107,10 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
convMVar?,
calcPrevRhs?,
} := goalState
- --let env := core.env
Pantograph.pickle path (
- ({ core with } : CompactCoreState),
+ env.constants.map₂,
+
+ ({ nextMacroScope, ngen } : CompactCoreState),
meta,
«elab»,
tactic,
@@ -117,6 +125,8 @@ def goalStatePickle (goalState : GoalState) (path : System.FilePath) : IO Unit :
def goalStateUnpickle (path : System.FilePath) (env : Environment)
: IO (GoalState × CompactedRegion) := unsafe do
let ((
+ map₂,
+
compactCore,
meta,
«elab»,
@@ -127,6 +137,8 @@ def goalStateUnpickle (path : System.FilePath) (env : Environment)
convMVar?,
calcPrevRhs?,
), region) ← Pantograph.unpickle (
+ PHashMap Name ConstantInfo ×
+
CompactCoreState ×
Meta.State ×
Elab.Term.State ×
@@ -137,6 +149,7 @@ def goalStateUnpickle (path : System.FilePath) (env : Environment)
Option (MVarId × MVarId × List MVarId) ×
Option (MVarId × Expr)
) path
+ let env ← env.replay (Std.HashMap.ofList map₂.toList)
let goalState := {
savedState := {
term := {
From 9d445783c29a2f6b567ffb46bdca0c724c62587f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 13 Jan 2025 12:50:25 -0800
Subject: [PATCH 402/465] feat: Draft tactic REPL interface
---
Pantograph/Library.lean | 8 ++++++++
Pantograph/Protocol.lean | 1 +
Repl.lean | 21 ++++++++++++---------
doc/repl.md | 12 +++++++-----
4 files changed, 28 insertions(+), 14 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index bb094b6..b5c3655 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -207,6 +207,14 @@ protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: Stri
| .ok syn => pure syn
| .error error => return .parseError error
state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
+@[export pantograph_goal_try_draft_m]
+protected def GoalState.tryDraft (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult := do
+ let expr ← match (← parseTermM expr) with
+ | .ok syn => pure syn
+ | .error error => return .parseError error
+ runTermElabM do
+ state.restoreElabM
+ state.tryTacticM goal (Tactic.evalDraft expr)
@[export pantograph_goal_let_m]
def goalLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult :=
runTermElabM <| state.tryLet goal binderName type
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 62f3f69..7faef01 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -237,6 +237,7 @@ structure GoalTactic where
calc?: Option String := .none
-- true to enter `conv`, `false` to exit. In case of exit the `goalId` is ignored.
conv?: Option Bool := .none
+ draft?: Option String := .none
-- In case of the `have` tactic, the new free variable name is provided here
binderName?: Option String := .none
diff --git a/Repl.lean b/Repl.lean
index 1fd8266..3fb43be 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -145,24 +145,27 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let .some goal := goalState.goals.get? args.goalId |
return .error $ errorIndex s!"Invalid goal index {args.goalId}"
let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
- match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv? with
- | .some tactic, .none, .none, .none, .none, .none => do
+ -- NOTE: Should probably use a macro to handle this...
+ match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv?, args.draft? with
+ | .some tactic, .none, .none, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryTactic goal tactic
- | .none, .some expr, .none, .none, .none, .none => do
+ | .none, .some expr, .none, .none, .none, .none, .none => do
pure <| Except.ok <| ← goalState.tryAssign goal expr
- | .none, .none, .some type, .none, .none, .none => do
+ | .none, .none, .some type, .none, .none, .none, .none => do
let binderName := args.binderName?.getD ""
pure <| Except.ok <| ← goalState.tryHave goal binderName type
- | .none, .none, .none, .some type, .none, .none => do
+ | .none, .none, .none, .some type, .none, .none, .none => do
let binderName := args.binderName?.getD ""
pure <| Except.ok <| ← goalState.tryLet goal binderName type
- | .none, .none, .none, .none, .some pred, .none => do
+ | .none, .none, .none, .none, .some pred, .none, .none => do
pure <| Except.ok <| ← goalState.tryCalc goal pred
- | .none, .none, .none, .none, .none, .some true => do
+ | .none, .none, .none, .none, .none, .some true, .none => do
pure <| Except.ok <| ← goalState.conv goal
- | .none, .none, .none, .none, .none, .some false => do
+ | .none, .none, .none, .none, .none, .some false, .none => do
pure <| Except.ok <| ← goalState.convExit
- | _, _, _, _, _, _ =>
+ | .none, .none, .none, .none, .none, .none, .some draft => do
+ pure <| Except.ok <| ← goalState.tryDraft goal draft
+ | _, _, _, _, _, _, _ =>
let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
pure $ Except.error $ error
match nextGoalState? with
diff --git a/doc/repl.md b/doc/repl.md
index d332986..c7c6f3f 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -33,6 +33,7 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
to the previous `rhs`.
- `{ "conv": <bool> }`: Enter or exit conversion tactic mode. In the case of
exit, the goal id is ignored.
+ - `{ "draft": <expr> }`: Draft an expression with `sorry`s, turning them into goals. Coupling is not allowed.
* `goal.continue {"stateId": <id>, ["branch": <id>], ["goals": <names>]}`:
Execute continuation/resumption
- `{ "branch": <id> }`: Continue on branch state. The current state must have no goals.
@@ -44,11 +45,12 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
state. The user is responsible to ensure the sender/receiver instances share
the same environment.
* `frontend.process { ["fileName": <fileName>,] ["file": <str>], invocations:
- <bool>, sorrys: <bool>, newConstants: <bool> }`: Executes the Lean frontend on
- a file, collecting the tactic invocations (`"invocations": true`), the
- sorrys and type errors into goal states (`"sorrys": true`), and new constants
- (`"newConstants": true`). In the case of `sorrys`, this command additionally
- outputs the position of each captured `sorry`.
+ <bool>, sorrys: <bool>, typeErrorsAsGoals: <bool>, newConstants: <bool> }`:
+ Executes the Lean frontend on a file, collecting the tactic invocations
+ (`"invocations": true`), the sorrys and type errors into goal states
+ (`"sorrys": true`), and new constants (`"newConstants": true`). In the case of
+ `sorrys`, this command additionally outputs the position of each captured
+ `sorry`.
## Errors
From 62363cb9438d8f7875227a180bbf618865675141 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 14 Jan 2025 13:21:38 -0800
Subject: [PATCH 403/465] fix: Over-eager assertion of fvarId validity
---
Pantograph/Frontend/MetaTranslate.lean | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index bd3568d..c6592d2 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -68,7 +68,8 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
match e with
| .fvar fvarId =>
let .some fvarId' := state.fvarMap[fvarId]? | panic! s!"FVar id not registered: {fvarId.name}"
- assert! (← getLCtx).contains fvarId'
+ -- Delegating this to `Meta.check` later
+ --assert! (← getLCtx).contains fvarId'
return .done $ .fvar fvarId'
| .mvar mvarId => do
-- Must not be assigned
From 4f5ffc1ffbc00a0b21fe0f12514a75fc925701b3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 15 Jan 2025 21:02:04 -0800
Subject: [PATCH 404/465] feat: Protocol for module access
---
Pantograph/Protocol.lean | 18 ++++++++++++++++++
1 file changed, 18 insertions(+)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 62f3f69..c73e791 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -112,6 +112,24 @@ structure ExprEchoResult where
type: Expression
deriving Lean.ToJson
+-- Describe the current state of the environment
+structure EnvDescribe where
+ deriving Lean.FromJson
+structure EnvDescribeResult where
+ imports : Array String
+ modules : Array String
+ deriving Lean.ToJson
+
+-- Describe a module
+structure EnvModule where
+ module : String
+ deriving Lean.FromJson
+structure EnvModuleResult where
+ imports: Array String
+ constNames: Array String
+ extraConstNames: Array String
+ deriving Lean.ToJson
+
-- Print all symbols in environment
structure EnvCatalog where
deriving Lean.FromJson
From c9f524b9aea1c475dc3085bd109fbd7ea9f4187a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 15 Jan 2025 21:20:05 -0800
Subject: [PATCH 405/465] feat: Implement `env.describe` and `env.module_read`
---
Pantograph/Environment.lean | 16 ++++++++++++++++
Pantograph/Protocol.lean | 4 ++--
2 files changed, 18 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index c48414a..6bd3f76 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -43,6 +43,22 @@ def toFilteredSymbol (n: Lean.Name) (info: Lean.ConstantInfo): Option String :=
if isNameInternal n || info.isUnsafe
then Option.none
else Option.some <| toCompactSymbolName n info
+def describe (_: Protocol.EnvDescribe): CoreM Protocol.EnvDescribeResult := do
+ let env ← Lean.MonadEnv.getEnv
+ return {
+ imports := env.header.imports.map toString,
+ modules := env.header.moduleNames.map (·.toString),
+ }
+def moduleRead (args: Protocol.EnvModuleRead): CoreM (Protocol.CR Protocol.EnvModuleReadResult) := do
+ let env ← Lean.MonadEnv.getEnv
+ let .some i := env.header.moduleNames.findIdx? (· == args.module.toName) |
+ return .error $ Protocol.errorIndex s!"Module not found {args.module}"
+ let data := env.header.moduleData[i]!
+ return .ok {
+ imports := data.imports.map toString,
+ constNames := data.constNames.map (·.toString),
+ extraConstNames := data.extraConstNames.map (·.toString),
+ }
def catalog (_: Protocol.EnvCatalog): CoreM Protocol.EnvCatalogResult := do
let env ← Lean.MonadEnv.getEnv
let names := env.constants.fold (init := #[]) (λ acc name info =>
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index c73e791..cab288c 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -121,10 +121,10 @@ structure EnvDescribeResult where
deriving Lean.ToJson
-- Describe a module
-structure EnvModule where
+structure EnvModuleRead where
module : String
deriving Lean.FromJson
-structure EnvModuleResult where
+structure EnvModuleReadResult where
imports: Array String
constNames: Array String
extraConstNames: Array String
From bc4bf47c8b8c5e9c8d39ef7675fca7c7b942e152 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 15 Jan 2025 21:23:37 -0800
Subject: [PATCH 406/465] feat: Implement repl interfaces
---
Repl.lean | 7 +++++++
1 file changed, 7 insertions(+)
diff --git a/Repl.lean b/Repl.lean
index 1fd8266..aebb738 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -48,6 +48,8 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| "reset" => run reset
| "stat" => run stat
| "expr.echo" => run expr_echo
+ | "env.describe" => run env_describe
+ | "env.module_read" => run env_module_read
| "env.catalog" => run env_catalog
| "env.inspect" => run env_inspect
| "env.add" => run env_add
@@ -85,6 +87,11 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let nGoals := state.goalStates.size
return .ok { nGoals }
+ env_describe (args: Protocol.EnvDescribe): MainM (CR Protocol.EnvDescribeResult) := do
+ let result ← Environment.describe args
+ return .ok result
+ env_module_read (args: Protocol.EnvModuleRead): MainM (CR Protocol.EnvModuleReadResult) := do
+ Environment.moduleRead args
env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
let result ← Environment.catalog args
return .ok result
From 5994f0ddf03b71b9b1c6fbb80a7a8e153a24e17d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 17 Jan 2025 23:10:03 -0800
Subject: [PATCH 407/465] fix: Conditional handling of `.proj`
---
Pantograph/Delate.lean | 17 +++++++++--------
Test/Delate.lean | 15 ++++++++++++++-
2 files changed, 23 insertions(+), 9 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 38d8bda..a404fba 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -17,15 +17,18 @@ structure ProjectionApplication where
numParams: Nat
inner: Expr
+/-- Converts a `.proj` expression to a function application if possible. Not all
+such expressions are convertible. -/
@[export pantograph_expr_proj_to_app]
-def exprProjToApp (env: Environment) (e: Expr): ProjectionApplication :=
+def exprProjToApp (env: Environment) (e: Expr): Option ProjectionApplication := do
let (typeName, idx, inner) := match e with
| .proj typeName idx inner => (typeName, idx, inner)
| _ => panic! "Argument must be proj"
+ let _ ← getStructureInfo? env typeName
let ctor := getStructureCtor env typeName
let fieldName := getStructureFields env typeName |>.get! idx
let projector := getProjFnForField? env typeName fieldName |>.get!
- {
+ return {
projector,
numParams := ctor.numParams,
inner,
@@ -375,12 +378,10 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
self inner
- | .proj _ _ _ => do
- let env ← getEnv
- let projApp := exprProjToApp env e
- let autos := String.intercalate " " (List.replicate projApp.numParams "_")
- let inner ← self projApp.inner
- pure s!"((:c {projApp.projector}) {autos} {inner})"
+ | .proj typeName idx e => do
+ let typeName' := serializeName typeName (sanitize := false)
+ let e' ← self e
+ pure s!"(:proj {typeName'} {idx} {e'})"
-- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String
| .default => ""
diff --git a/Test/Delate.lean b/Test/Delate.lean
index 013be73..7b449bf 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -77,7 +77,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
.default)
.implicit)
.implicit,
- "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :i) :i)"
+ "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) (:proj And 1 0)) :i) :i)"
),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
@@ -96,6 +96,18 @@ def test_instance (env: Environment): IO LSpec.TestSeq :=
let _expr := (← runTermElabMInMeta <| elabTerm s) |>.toOption |>.get!
return LSpec.TestSeq.done
+def test_projection (env: Environment) : IO LSpec.TestSeq:= runTest do
+ let prod := .app (.bvar 1) (.bvar 0)
+ let expr := .proj `Prod 1 prod
+ let .some { projector, numParams, inner }:= exprProjToApp env expr |
+ fail "`Prod should have projection function"
+ checkEq "projector" projector `Prod.snd
+ checkEq "numParams" numParams 2
+ checkTrue "inner" $ inner.equal prod
+
+ let expr := .proj `Exists 1 prod
+ checkTrue "Exists" (exprProjToApp env expr).isNone
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("serializeName", do pure test_serializeName),
@@ -104,6 +116,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Sexp from elaborated expr", test_sexp_of_elab env),
("Sexp from expr", test_sexp_of_expr env),
("Instance", test_instance env),
+ ("Projection", test_projection env),
]
end Pantograph.Test.Delate
From 3a26bb19249c89d16dd0b105c147c120c795200a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 22 Jan 2025 12:49:33 -0800
Subject: [PATCH 408/465] fix: Analyze projection application
---
Pantograph/Delate.lean | 38 +++++++++++++++++++-------------------
Test/Delate.lean | 25 ++++++++++++++++---------
2 files changed, 35 insertions(+), 28 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index a404fba..18eaaf1 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -12,27 +12,27 @@ open Lean
namespace Pantograph
-structure ProjectionApplication where
- projector: Name
- numParams: Nat
- inner: Expr
+inductive Projection where
+ -- Normal field case
+ | field (projector : Name) (numParams : Nat) (struct : Expr)
+ -- Singular inductive case
+ | singular (recursor : Name) (numParams : Nat) (struct : Expr)
-/-- Converts a `.proj` expression to a function application if possible. Not all
-such expressions are convertible. -/
-@[export pantograph_expr_proj_to_app]
-def exprProjToApp (env: Environment) (e: Expr): Option ProjectionApplication := do
- let (typeName, idx, inner) := match e with
- | .proj typeName idx inner => (typeName, idx, inner)
+/-- Converts a `.proj` expression to a form suitable for exporting/transpilation -/
+@[export pantograph_analyze_projection]
+def analyzeProjection (env: Environment) (e: Expr): Projection :=
+ let (typeName, idx, struct) := match e with
+ | .proj typeName idx struct => (typeName, idx, struct)
| _ => panic! "Argument must be proj"
- let _ ← getStructureInfo? env typeName
- let ctor := getStructureCtor env typeName
- let fieldName := getStructureFields env typeName |>.get! idx
- let projector := getProjFnForField? env typeName fieldName |>.get!
- return {
- projector,
- numParams := ctor.numParams,
- inner,
- }
+ if (getStructureInfo? env typeName).isSome then
+ let ctor := getStructureCtor env typeName
+ let fieldName := getStructureFields env typeName |>.get! idx
+ let projector := getProjFnForField? env typeName fieldName |>.get!
+ .field projector ctor.numParams struct
+ else
+ let recursor := mkRecOnName typeName
+ let ctor := getStructureCtor env typeName
+ .singular recursor ctor.numParams struct
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
diff --git a/Test/Delate.lean b/Test/Delate.lean
index 7b449bf..aa5ea7c 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -96,17 +96,23 @@ def test_instance (env: Environment): IO LSpec.TestSeq :=
let _expr := (← runTermElabMInMeta <| elabTerm s) |>.toOption |>.get!
return LSpec.TestSeq.done
-def test_projection (env: Environment) : IO LSpec.TestSeq:= runTest do
- let prod := .app (.bvar 1) (.bvar 0)
- let expr := .proj `Prod 1 prod
- let .some { projector, numParams, inner }:= exprProjToApp env expr |
- fail "`Prod should have projection function"
+def test_projection_prod (env: Environment) : IO LSpec.TestSeq:= runTest do
+ let struct := .app (.bvar 1) (.bvar 0)
+ let expr := .proj `Prod 1 struct
+ let .field projector numParams struct' := analyzeProjection env expr |
+ fail "`Prod has fields"
checkEq "projector" projector `Prod.snd
checkEq "numParams" numParams 2
- checkTrue "inner" $ inner.equal prod
+ checkTrue "struct" $ struct.equal struct'
- let expr := .proj `Exists 1 prod
- checkTrue "Exists" (exprProjToApp env expr).isNone
+def test_projection_exists (env: Environment) : IO LSpec.TestSeq:= runTest do
+ let struct := .app (.bvar 1) (.bvar 0)
+ let expr := .proj `Exists 1 struct
+ let .singular recursor numParams struct' := analyzeProjection env expr |
+ fail "`Exists has no projectors"
+ checkEq "recursor" recursor `Exists.recOn
+ checkEq "numParams" numParams 2
+ checkTrue "struct" $ struct.equal struct'
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
@@ -116,7 +122,8 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Sexp from elaborated expr", test_sexp_of_elab env),
("Sexp from expr", test_sexp_of_expr env),
("Instance", test_instance env),
- ("Projection", test_projection env),
+ ("Projection Prod", test_projection_prod env),
+ ("Projection Exists", test_projection_exists env),
]
end Pantograph.Test.Delate
From 8ce4cbdcf55e73589f3eca3052fadfa1843589d0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Wed, 22 Jan 2025 13:01:47 -0800
Subject: [PATCH 409/465] feat: Printing field projection in sexp
---
Pantograph/Delate.lean | 27 +++++++++++++++++----------
Test/Delate.lean | 8 +++-----
2 files changed, 20 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 18eaaf1..28f4851 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -14,25 +14,25 @@ namespace Pantograph
inductive Projection where
-- Normal field case
- | field (projector : Name) (numParams : Nat) (struct : Expr)
+ | field (projector : Name) (numParams : Nat)
-- Singular inductive case
- | singular (recursor : Name) (numParams : Nat) (struct : Expr)
+ | singular (recursor : Name) (numParams : Nat)
/-- Converts a `.proj` expression to a form suitable for exporting/transpilation -/
@[export pantograph_analyze_projection]
def analyzeProjection (env: Environment) (e: Expr): Projection :=
- let (typeName, idx, struct) := match e with
+ let (typeName, idx, _) := match e with
| .proj typeName idx struct => (typeName, idx, struct)
| _ => panic! "Argument must be proj"
if (getStructureInfo? env typeName).isSome then
let ctor := getStructureCtor env typeName
let fieldName := getStructureFields env typeName |>.get! idx
let projector := getProjFnForField? env typeName fieldName |>.get!
- .field projector ctor.numParams struct
+ .field projector ctor.numParams
else
let recursor := mkRecOnName typeName
let ctor := getStructureCtor env typeName
- .singular recursor ctor.numParams struct
+ .singular recursor ctor.numParams
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
@@ -291,7 +291,7 @@ partial def serializeSortLevel (level: Level) : String :=
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
-
+#check Exists.recOn
/--
Completely serializes an expression tree. Json not used due to compactness
@@ -378,10 +378,17 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
-- NOTE: Equivalent to expr itself, but mdata influences the prettyprinter
-- It may become necessary to incorporate the metadata.
self inner
- | .proj typeName idx e => do
- let typeName' := serializeName typeName (sanitize := false)
- let e' ← self e
- pure s!"(:proj {typeName'} {idx} {e'})"
+ | .proj typeName idx inner => do
+ let env ← getEnv
+ match analyzeProjection env e with
+ | .field projector numParams =>
+ let autos := String.intercalate " " (List.replicate numParams "_")
+ let inner' ← self inner
+ pure s!"((:c {projector}) {autos} {inner'})"
+ | .singular _ _ =>
+ let typeName' := serializeName typeName (sanitize := false)
+ let e' ← self e
+ pure s!"(:proj {typeName'} {idx} {e'})"
-- Elides all unhygenic names
binderInfoSexp : Lean.BinderInfo → String
| .default => ""
diff --git a/Test/Delate.lean b/Test/Delate.lean
index aa5ea7c..befc60b 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -77,7 +77,7 @@ def test_sexp_of_expr (env: Environment): IO LSpec.TestSeq := do
.default)
.implicit)
.implicit,
- "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) (:proj And 1 0)) :i) :i)"
+ "(:lambda p (:sort 0) (:lambda q (:sort 0) (:lambda k ((:c And) 1 0) ((:c And.right) _ _ 0)) :i) :i)"
),
]
let termElabM: Elab.TermElabM LSpec.TestSeq := entries.foldlM (λ suites (expr, target) => do
@@ -99,20 +99,18 @@ def test_instance (env: Environment): IO LSpec.TestSeq :=
def test_projection_prod (env: Environment) : IO LSpec.TestSeq:= runTest do
let struct := .app (.bvar 1) (.bvar 0)
let expr := .proj `Prod 1 struct
- let .field projector numParams struct' := analyzeProjection env expr |
+ let .field projector numParams := analyzeProjection env expr |
fail "`Prod has fields"
checkEq "projector" projector `Prod.snd
checkEq "numParams" numParams 2
- checkTrue "struct" $ struct.equal struct'
def test_projection_exists (env: Environment) : IO LSpec.TestSeq:= runTest do
let struct := .app (.bvar 1) (.bvar 0)
let expr := .proj `Exists 1 struct
- let .singular recursor numParams struct' := analyzeProjection env expr |
+ let .singular recursor numParams := analyzeProjection env expr |
fail "`Exists has no projectors"
checkEq "recursor" recursor `Exists.recOn
checkEq "numParams" numParams 2
- checkTrue "struct" $ struct.equal struct'
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
From 5c1e7599c0ea85301d859f94052d1b9f4251119d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 14:44:09 -0800
Subject: [PATCH 410/465] feat: Projection export function
---
Pantograph/Delate.lean | 36 ++++++++++++++++++++++++++++++++----
Test/Delate.lean | 3 ++-
2 files changed, 34 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 28f4851..ad923aa 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -16,7 +16,7 @@ inductive Projection where
-- Normal field case
| field (projector : Name) (numParams : Nat)
-- Singular inductive case
- | singular (recursor : Name) (numParams : Nat)
+ | singular (recursor : Name) (numParams : Nat) (numFields : Nat)
/-- Converts a `.proj` expression to a form suitable for exporting/transpilation -/
@[export pantograph_analyze_projection]
@@ -32,7 +32,36 @@ def analyzeProjection (env: Environment) (e: Expr): Projection :=
else
let recursor := mkRecOnName typeName
let ctor := getStructureCtor env typeName
- .singular recursor ctor.numParams
+ .singular recursor ctor.numParams ctor.numFields
+
+def anonymousLevel : Level := .mvar ⟨.anonymous⟩
+
+@[export pantograph_expr_proj_to_app]
+def exprProjToApp (env: Environment) (e: Expr): Expr :=
+ let anon : Expr := .mvar ⟨.anonymous⟩
+ match analyzeProjection env e with
+ | .field projector numParams =>
+ let info := match env.find? projector with
+ | .some info => info
+ | _ => panic! "Illegal projector"
+ let callee := .const projector $ List.replicate info.numLevelParams anonymousLevel
+ let args := (List.replicate numParams anon) ++ [e.projExpr!]
+ mkAppN callee args.toArray
+ | .singular recursor numParams numFields =>
+ let info := match env.find? recursor with
+ | .some info => info
+ | _ => panic! "Illegal recursor"
+ let callee := .const recursor $ List.replicate info.numLevelParams anonymousLevel
+ let typeArgs := List.replicate numParams anon
+ -- Motive type can be inferred directly
+ let motive := .lam .anonymous anon anon .default
+ let major := e.projExpr!
+ -- Generate a lambda of `numFields` parameters, and returns the `e.projIdx!` one.
+ let induct := List.foldl
+ (λ acc _ => .lam .anonymous anon acc .default)
+ (.bvar $ (numFields - e.projIdx! - 1))
+ (List.range numFields)
+ mkAppN callee (typeArgs ++ [motive, major, induct]).toArray
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
@@ -291,7 +320,6 @@ partial def serializeSortLevel (level: Level) : String :=
| _, .zero => s!"{k}"
| _, _ => s!"(+ {u_str} {k})"
-#check Exists.recOn
/--
Completely serializes an expression tree. Json not used due to compactness
@@ -385,7 +413,7 @@ partial def serializeExpressionSexp (expr: Expr) : MetaM String := do
let autos := String.intercalate " " (List.replicate numParams "_")
let inner' ← self inner
pure s!"((:c {projector}) {autos} {inner'})"
- | .singular _ _ =>
+ | .singular _ _ _ =>
let typeName' := serializeName typeName (sanitize := false)
let e' ← self e
pure s!"(:proj {typeName'} {idx} {e'})"
diff --git a/Test/Delate.lean b/Test/Delate.lean
index befc60b..517a394 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -107,10 +107,11 @@ def test_projection_prod (env: Environment) : IO LSpec.TestSeq:= runTest do
def test_projection_exists (env: Environment) : IO LSpec.TestSeq:= runTest do
let struct := .app (.bvar 1) (.bvar 0)
let expr := .proj `Exists 1 struct
- let .singular recursor numParams := analyzeProjection env expr |
+ let .singular recursor numParams numFields := analyzeProjection env expr |
fail "`Exists has no projectors"
checkEq "recursor" recursor `Exists.recOn
checkEq "numParams" numParams 2
+ checkEq "numFields" numFields 2
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
From be8dee6731f23462895484a91c815edcb70c116e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 15:00:35 -0800
Subject: [PATCH 411/465] test: Add test for module read
---
Test/Environment.lean | 3 +++
1 file changed, 3 insertions(+)
diff --git a/Test/Environment.lean b/Test/Environment.lean
index b646279..c49cbae 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -110,6 +110,9 @@ def test_symbol_location : TestT IO Unit := do
checkTrue "file" result.sourceUri?.isNone
checkEq "pos" (result.sourceStart?.map (·.column)) <| .some 0
checkEq "pos" (result.sourceEnd?.map (·.column)) <| .some 88
+ let .ok { imports, constNames, extraConstNames } ← Environment.moduleRead ⟨"Init.Data.Nat.Basic"⟩ | fail "Module read failed"
+ checkEq "imports" imports #["Init.SimpLemmas", "Init.Data.NeZero"]
+ checkTrue "constNames" $ constNames.contains "Nat.succ_add"
def suite: List (String × IO LSpec.TestSeq) :=
[
From 418d630255b2f78b0fcdf5257c244279d478f809 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 19:06:07 -0800
Subject: [PATCH 412/465] fix: Remove unused variable
---
Test/Environment.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Test/Environment.lean b/Test/Environment.lean
index c49cbae..e954bc3 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -110,7 +110,7 @@ def test_symbol_location : TestT IO Unit := do
checkTrue "file" result.sourceUri?.isNone
checkEq "pos" (result.sourceStart?.map (·.column)) <| .some 0
checkEq "pos" (result.sourceEnd?.map (·.column)) <| .some 88
- let .ok { imports, constNames, extraConstNames } ← Environment.moduleRead ⟨"Init.Data.Nat.Basic"⟩ | fail "Module read failed"
+ let .ok { imports, constNames, .. } ← Environment.moduleRead ⟨"Init.Data.Nat.Basic"⟩ | fail "Module read failed"
checkEq "imports" imports #["Init.SimpLemmas", "Init.Data.NeZero"]
checkTrue "constNames" $ constNames.contains "Nat.succ_add"
From 976646fb67f3c86365b06ac1e5332047444ea3aa Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 19:11:05 -0800
Subject: [PATCH 413/465] chore: Use repeat-break structure
---
Main.lean | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/Main.lean b/Main.lean
index be01ff6..b20724d 100644
--- a/Main.lean
+++ b/Main.lean
@@ -23,10 +23,10 @@ def parseCommand (s: String): Except String Command := do
return { cmd := s.take offset, payload := payload }
| .none => throw "Command is empty"
-partial def loop : MainM Unit := do
+partial def loop : MainM Unit := do repeat do
let state ← get
let command ← (← IO.getStdin).getLine
- if command.trim.length = 0 then return ()
+ if command.trim.length = 0 then break
match parseCommand command with
| .error error =>
let error := Lean.toJson ({ error := "command", desc := error }: InteractionError)
@@ -43,7 +43,6 @@ partial def loop : MainM Unit := do
let message ← e.toMessageData.toString
let error := Lean.toJson ({ error := "main", desc := message }: InteractionError)
IO.println error.compress
- loop
unsafe def main (args: List String): IO Unit := do
From 787c9e606d30ef78ee2b0786db3d87e8576df242 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 19:22:58 -0800
Subject: [PATCH 414/465] chore: Cleanup REPL loop
---
Main.lean | 24 ++++++++++++------------
Repl.lean | 1 -
Test/Integration.lean | 4 +---
3 files changed, 13 insertions(+), 16 deletions(-)
diff --git a/Main.lean b/Main.lean
index b20724d..c4d30c6 100644
--- a/Main.lean
+++ b/Main.lean
@@ -10,22 +10,25 @@ open Pantograph.Protocol
/-- Parse a command either in `{ "cmd": ..., "payload": ... }` form or `cmd { ... }` form. -/
def parseCommand (s: String): Except String Command := do
- let s := s.trim
- match s.get? 0 with
- | .some '{' => -- Parse in Json mode
+ match s.trim.get? 0 with
+ | .some '{' =>
+ -- Parse in Json mode
Lean.fromJson? (← Lean.Json.parse s)
- | .some _ => -- Parse in line mode
+ | .some _ =>
+ -- Parse in line mode
let offset := s.posOf ' ' |> s.offsetOfPos
if offset = s.length then
return { cmd := s.take offset, payload := Lean.Json.null }
else
let payload ← s.drop offset |> Lean.Json.parse
return { cmd := s.take offset, payload := payload }
- | .none => throw "Command is empty"
+ | .none =>
+ throw "Command is empty"
partial def loop : MainM Unit := do repeat do
let state ← get
let command ← (← IO.getStdin).getLine
+ -- Halt the program if empty line is given
if command.trim.length = 0 then break
match parseCommand command with
| .error error =>
@@ -47,20 +50,17 @@ partial def loop : MainM Unit := do repeat do
unsafe def main (args: List String): IO Unit := do
-- NOTE: A more sophisticated scheme of command line argument handling is needed.
- -- Separate imports and options
if args == ["--version"] then do
IO.println s!"{Pantograph.version}"
return
Pantograph.initSearch ""
- let coreContext ← args.filterMap (λ s => if s.startsWith "--" then .some <| s.drop 2 else .none)
- |>.toArray |> Pantograph.createCoreContext
- let imports:= args.filter (λ s => ¬ (s.startsWith "--"))
+ -- Separate imports and options
+ let (options, imports) := args.partition (·.startsWith "--")
+ let coreContext ← options.map (·.drop 2) |>.toArray |> Pantograph.createCoreContext
let coreState ← Pantograph.createCoreState imports.toArray
- let context: Context := {
- imports
- }
+ let context: Context := {}
try
let coreM := loop.run context |>.run' {}
IO.println "ready."
diff --git a/Repl.lean b/Repl.lean
index 083edd1..ddf3201 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -4,7 +4,6 @@ import Pantograph
namespace Pantograph.Repl
structure Context where
- imports: List String
/-- Stores state of the REPL -/
structure State where
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 7864515..9815954 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -235,9 +235,7 @@ def test_frontend_process_sorry : Test :=
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
-- Setup the environment for execution
- let context: Context := {
- imports := ["Init"]
- }
+ let context: Context := {}
let commands: MainM LSpec.TestSeq :=
steps.foldlM (λ suite step => do
let result ← step
From 6a7830cb717a23c7a5ea5d43a59dbb2886b35991 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 19:24:54 -0800
Subject: [PATCH 415/465] fix: Remove spurious print
---
Test/Proofs.lean | 2 --
1 file changed, 2 deletions(-)
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index e13e528..bf43bf6 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -750,8 +750,6 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
- let iex : InternalExceptionId := { idx := 4 }
- IO.println s!"{← iex.getName}"
let tactic := "simpa [h] using And.imp_left h _"
--let state2 ← match ← state1.tacticOn 0 tactic with
-- | .success state => pure state
From 970c16a0a4d808c4be86cc313ff1f4acb3ff0aca Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 20:19:07 -0800
Subject: [PATCH 416/465] chore: Use `StateRefT` in `Repl.lean`
---
Repl.lean | 8 +++-----
1 file changed, 3 insertions(+), 5 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index ddf3201..4c7adc3 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -12,7 +12,9 @@ structure State where
goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context (StateT State Lean.CoreM)
+abbrev MainM := ReaderT Context $ StateRefT State Lean.CoreM
+/-- Fallible subroutine return type -/
+abbrev CR α := Except Protocol.InteractionError α
def newGoalState (goalState: GoalState) : MainM Nat := do
let state ← get
@@ -24,10 +26,6 @@ def newGoalState (goalState: GoalState) : MainM Nat := do
return stateId
--- HACK: For some reason writing `CommandM α := MainM (Except ... α)` disables
--- certain monadic features in `MainM`
-abbrev CR α := Except Protocol.InteractionError α
-
def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
metaM.run'
def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
From 003a63bd13662b750277da75ebd880c97afa23a8 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 24 Jan 2025 20:21:31 -0800
Subject: [PATCH 417/465] doc: Manual about `env.{describe,module_read}`
---
doc/repl.md | 2 ++
1 file changed, 2 insertions(+)
diff --git a/doc/repl.md b/doc/repl.md
index c7c6f3f..82074e5 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -13,6 +13,8 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
only the values of definitions are printed.
* `env.save { "path": <fileName> }`, `env.load { "path": <fileName> }`: Save/Load the
current environment to/from a file
+* `env.module_read { "module": <name }`: Reads a list of symbols from a module
+* `env.describe {}`: Describes the imports and modules in the current environment
* `options.set { key: value, ... }`: Set one or more options (not Lean options; those
have to be set via command line arguments.), for options, see `Pantograph/Protocol.lean`
From 274e29199d4332ec4a4d9fcc0791cfce4bda755b Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 27 Jan 2025 19:57:02 -0800
Subject: [PATCH 418/465] fix: Use post-step environment in sorry collection
---
Repl.lean | 170 +++++++++++++++++++++++++++++++-----------------------
1 file changed, 99 insertions(+), 71 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index 4c7adc3..0e745a4 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -3,6 +3,8 @@ import Pantograph
namespace Pantograph.Repl
+open Lean
+
structure Context where
/-- Stores state of the REPL -/
@@ -12,7 +14,7 @@ structure State where
goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context $ StateRefT State Lean.CoreM
+abbrev MainM := ReaderT Context $ StateRefT State CoreM
/-- Fallible subroutine return type -/
abbrev CR α := Except Protocol.InteractionError α
@@ -26,20 +28,100 @@ def newGoalState (goalState: GoalState) : MainM Nat := do
return stateId
-def runMetaInMainM { α } (metaM: Lean.MetaM α): MainM α :=
+def runMetaInMainM { α } (metaM: MetaM α): MainM α :=
metaM.run'
-def runTermElabInMainM { α } (termElabM: Lean.Elab.TermElabM α) : MainM α :=
+def runTermElabInMainM { α } (termElabM: Elab.TermElabM α) : MainM α :=
termElabM.run' (ctx := defaultElabContext) |>.run'
+section Frontend
+
+structure CompilationUnit where
+ -- Should be the penultimate environment, but this is ok
+ env : Environment
+ boundary : Nat × Nat
+ invocations : List Protocol.InvokedTactic
+ sorrys : List Frontend.InfoWithContext
+ messages : Array String
+ newConstants : List Name
+
+
+
+def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
+ let options := (← get).options
+ let (fileName, file) ← match args.fileName?, args.file? with
+ | .some fileName, .none => do
+ let file ← IO.FS.readFile fileName
+ pure (fileName, file)
+ | .none, .some file =>
+ pure ("<anonymous>", file)
+ | _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
+ let env?: Option Environment ← if args.fileName?.isSome then
+ pure .none
+ else do
+ let env ← getEnv
+ pure <| .some env
+ let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
+ let frontendM: Elab.Frontend.FrontendM (List CompilationUnit) :=
+ Frontend.mapCompilationSteps λ step => do
+ let boundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
+ let invocations: Option (List Protocol.InvokedTactic) ← if args.invocations then
+ Frontend.collectTacticsFromCompilationStep step
+ else
+ pure []
+ let sorrys ← if args.sorrys then
+ Frontend.collectSorrys step (options := { collectTypeErrors := args.typeErrorsAsGoals })
+ else
+ pure []
+ let messages ← step.messageStrings
+ let newConstants ← if args.newConstants then
+ Frontend.collectNewDefinedConstants step
+ else
+ pure []
+ return {
+ env := step.after,
+ boundary,
+ invocations,
+ sorrys,
+ messages,
+ newConstants
+ }
+ let li ← frontendM.run context |>.run' state
+ let units ← li.mapM λ step => withEnv step.env do
+ let newConstants? := if args.newConstants then
+ .some $ step.newConstants.toArray.map λ name => name.toString
+ else
+ .none
+ let (goalStateId?, goals?, goalSrcBoundaries?) ← if step.sorrys.isEmpty then do
+ pure (.none, .none, .none)
+ else do
+ let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState step.sorrys
+ let stateId ← newGoalState state
+ let goals ← goalSerialize state options
+ let srcBoundaries := srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx))
+ pure (.some stateId, .some goals, .some srcBoundaries)
+ let invocations? := if args.invocations then .some step.invocations else .none
+ return {
+ boundary := step.boundary,
+ messages := step.messages,
+ invocations?,
+ goalStateId?,
+ goals?,
+ goalSrcBoundaries?,
+ newConstants?,
+ }
+ return .ok { units }
+
+end Frontend
+
/-- Main loop command of the REPL -/
-def execute (command: Protocol.Command): MainM Lean.Json := do
- let run { α β: Type } [Lean.FromJson α] [Lean.ToJson β] (comm: α → MainM (CR β)): MainM Lean.Json :=
- match Lean.fromJson? command.payload with
+def execute (command: Protocol.Command): MainM Json := do
+ let run { α β: Type } [FromJson α] [ToJson β] (comm: α → MainM (CR β)): MainM Json :=
+ match fromJson? command.payload with
| .ok args => do
match (← comm args) with
- | .ok result => return Lean.toJson result
- | .error ierror => return Lean.toJson ierror
- | .error error => return Lean.toJson $ errorCommand s!"Unable to parse json: {error}"
+ | .ok result => return toJson result
+ | .error ierror => return toJson ierror
+ | .error error => return toJson $ errorCommand s!"Unable to parse json: {error}"
try
match command.cmd with
| "reset" => run reset
@@ -65,10 +147,10 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
- return Lean.toJson error
+ return toJson error
catch ex => do
let error ← ex.toMessageData.toString
- return Lean.toJson $ errorIO error
+ return toJson $ errorIO error
where
errorCommand := errorI "command"
errorIndex := errorI "index"
@@ -78,7 +160,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
let state ← get
let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty }
- Lean.Core.resetMessageLog
+ Core.resetMessageLog
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
let state ← get
@@ -98,12 +180,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
Environment.addDecl args
env_save (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
- let env ← Lean.MonadEnv.getEnv
+ let env ← MonadEnv.getEnv
environmentPickle env args.path
return .ok {}
env_load (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
let (env, _) ← environmentUnpickle args.path
- Lean.setEnv env
+ setEnv env
return .ok {}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
let state ← get
@@ -128,7 +210,7 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
return .ok (← get).options
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
- let env ← Lean.MonadEnv.getEnv
+ let env ← MonadEnv.getEnv
let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
| .some expr, .none => goalStartExpr expr (args.levels.getD #[])
| .none, .some copyFrom =>
@@ -245,66 +327,12 @@ def execute (command: Protocol.Command): MainM Lean.Json := do
goalStatePickle goalState args.path
return .ok {}
goal_load (args: Protocol.GoalLoad): MainM (CR Protocol.GoalLoadResult) := do
- let (goalState, _) ← goalStateUnpickle args.path (← Lean.MonadEnv.getEnv)
+ let (goalState, _) ← goalStateUnpickle args.path (← MonadEnv.getEnv)
let id ← newGoalState goalState
return .ok { id }
frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
- let options := (← get).options
try
- let (fileName, file) ← match args.fileName?, args.file? with
- | .some fileName, .none => do
- let file ← IO.FS.readFile fileName
- pure (fileName, file)
- | .none, .some file =>
- pure ("<anonymous>", file)
- | _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
- let env?: Option Lean.Environment ← if args.fileName?.isSome then
- pure .none
- else do
- let env ← Lean.MonadEnv.getEnv
- pure <| .some env
- let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
- let frontendM := Frontend.mapCompilationSteps λ step => do
- let boundary := (step.src.startPos.byteIdx, step.src.stopPos.byteIdx)
- let invocations?: Option (List Protocol.InvokedTactic) ← if args.invocations then
- let invocations ← Frontend.collectTacticsFromCompilationStep step
- pure $ .some invocations
- else
- pure .none
- let sorrys ← if args.sorrys then
- Frontend.collectSorrys step (options := { collectTypeErrors := args.typeErrorsAsGoals })
- else
- pure []
- let messages ← step.messageStrings
- let newConstants ← if args.newConstants then
- Frontend.collectNewDefinedConstants step
- else
- pure []
- return (step.before, boundary, invocations?, sorrys, messages, newConstants)
- let li ← frontendM.run context |>.run' state
- let units ← li.mapM λ (env, boundary, invocations?, sorrys, messages, newConstants) => Lean.withEnv env do
- let newConstants? := if args.newConstants then
- .some $ newConstants.toArray.map λ name => name.toString
- else
- .none
- let (goalStateId?, goals?, goalSrcBoundaries?) ← if sorrys.isEmpty then do
- pure (.none, .none, .none)
- else do
- let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState sorrys
- let stateId ← newGoalState state
- let goals ← goalSerialize state options
- let srcBoundaries := srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx))
- pure (.some stateId, .some goals, .some srcBoundaries)
- return {
- boundary,
- messages,
- invocations?,
- goalStateId?,
- goals?,
- goalSrcBoundaries?,
- newConstants?,
- }
- return .ok { units }
+ frontend_process_inner args
catch e =>
return .error $ errorI "frontend" (← e.toMessageData.toString)
From c77f14d383a3d46b1f749a3c55204f35aee0f084 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 28 Jan 2025 17:40:49 -0800
Subject: [PATCH 419/465] fix: Use context environment in sorry capture
---
Pantograph/Frontend/Elab.lean | 49 +++++++++++++++++++----------------
Repl.lean | 4 +--
2 files changed, 28 insertions(+), 25 deletions(-)
diff --git a/Pantograph/Frontend/Elab.lean b/Pantograph/Frontend/Elab.lean
index 1e16a82..6dc6a28 100644
--- a/Pantograph/Frontend/Elab.lean
+++ b/Pantograph/Frontend/Elab.lean
@@ -148,34 +148,39 @@ structure AnnotatedGoalState where
Since we cannot directly merge `MetavarContext`s, we have to get creative. This
function duplicates frozen mvars in term and tactic info nodes, and add them to
the current `MetavarContext`.
+
+WARNING: Behaviour is unstable when there are multiple `sorry`s. Consider using
+the draft tactic instead.
-/
@[export pantograph_frontend_sorrys_to_goal_state_m]
def sorrysToGoalState (sorrys : List InfoWithContext) : MetaM AnnotatedGoalState := do
+ let env := sorrys.head? >>= (·.context?) |>.map (·.env) |>.getD (← getEnv)
assert! !sorrys.isEmpty
- let goalsM := sorrys.mapM λ i => do
- match i.info with
- | .ofTermInfo termInfo => do
- let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
- if (← mvarId.getType).hasSorry then
- throwError s!"Coupling is not allowed in drafting"
- return [(mvarId, stxByteRange termInfo.stx)]
- | .ofTacticInfo tacticInfo => do
- let mvarIds ← MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
- for mvarId in mvarIds do
+ withEnv env do
+ let goalsM := sorrys.mapM λ i => do
+ match i.info with
+ | .ofTermInfo termInfo => do
+ let mvarId ← MetaTranslate.translateMVarFromTermInfo termInfo i.context?
if (← mvarId.getType).hasSorry then
throwError s!"Coupling is not allowed in drafting"
- let range := stxByteRange tacticInfo.stx
- return mvarIds.map (·, range)
- | _ => panic! "Invalid info"
- let annotatedGoals := List.flatten (← goalsM.run {} |>.run' {})
- let goals := annotatedGoals.map Prod.fst
- let srcBoundaries := annotatedGoals.map Prod.snd
- let root := match goals with
- | [] => panic! "No MVars generated"
- | [g] => g
- | _ => { name := .anonymous }
- let state ← GoalState.createFromMVars goals root
- return { state, srcBoundaries }
+ return [(mvarId, stxByteRange termInfo.stx)]
+ | .ofTacticInfo tacticInfo => do
+ let mvarIds ← MetaTranslate.translateMVarFromTacticInfoBefore tacticInfo i.context?
+ for mvarId in mvarIds do
+ if (← mvarId.getType).hasSorry then
+ throwError s!"Coupling is not allowed in drafting"
+ let range := stxByteRange tacticInfo.stx
+ return mvarIds.map (·, range)
+ | _ => panic! "Invalid info"
+ let annotatedGoals := List.flatten (← goalsM.run {} |>.run' {})
+ let goals := annotatedGoals.map Prod.fst
+ let srcBoundaries := annotatedGoals.map Prod.snd
+ let root := match goals with
+ | [] => panic! "No MVars generated"
+ | [g] => g
+ | _ => { name := .anonymous }
+ let state ← GoalState.createFromMVars goals root
+ return { state, srcBoundaries }
@[export pantograph_frontend_collect_new_defined_constants_m]
diff --git a/Repl.lean b/Repl.lean
index 0e745a4..c8f4028 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -44,8 +44,6 @@ structure CompilationUnit where
messages : Array String
newConstants : List Name
-
-
def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
let options := (← get).options
let (fileName, file) ← match args.fileName?, args.file? with
@@ -78,7 +76,7 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
else
pure []
return {
- env := step.after,
+ env := step.before,
boundary,
invocations,
sorrys,
From 05f69970623d6000a4867a91f4056124203ef08d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 28 Jan 2025 17:41:41 -0800
Subject: [PATCH 420/465] doc: Update repl documentation
---
doc/repl.md | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/doc/repl.md b/doc/repl.md
index 82074e5..a86c01b 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -52,7 +52,8 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
(`"invocations": true`), the sorrys and type errors into goal states
(`"sorrys": true`), and new constants (`"newConstants": true`). In the case of
`sorrys`, this command additionally outputs the position of each captured
- `sorry`.
+ `sorry`. Warning: Behaviour is unstable in case of multiple `sorry`s. Use the
+ draft tactic if possible.
## Errors
From 31c76e0d007b2232114d801443039c6e83977192 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 23 Feb 2025 14:10:24 -0800
Subject: [PATCH 421/465] chore: Version bump
---
Pantograph/Frontend/InfoTree.lean | 4 ++--
Pantograph/Version.lean | 2 +-
flake.lock | 26 +++++++++++++-------------
lean-toolchain | 2 +-
4 files changed, 17 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Frontend/InfoTree.lean b/Pantograph/Frontend/InfoTree.lean
index a38775c..6fe9370 100644
--- a/Pantograph/Frontend/InfoTree.lean
+++ b/Pantograph/Frontend/InfoTree.lean
@@ -25,9 +25,9 @@ protected def Info.stx? : Info → Option Syntax
| .ofCustomInfo info => info.stx
| .ofFVarAliasInfo _ => none
| .ofFieldRedeclInfo info => info.stx
- | .ofOmissionInfo info => info.stx
| .ofChoiceInfo info => info.stx
| .ofPartialTermInfo info => info.stx
+ | .ofDelabTermInfo info => info.stx
/-- Is the `Syntax` for this `Lean.Elab.Info` original, or synthetic? -/
protected def Info.isOriginal (i : Info) : Bool :=
match i.stx? with
@@ -142,9 +142,9 @@ partial def InfoTree.toString (t : InfoTree) (ctx?: Option Elab.ContextInfo := .
| .ofCustomInfo _ => pure "[custom]"
| .ofFVarAliasInfo _ => pure "[fvar]"
| .ofFieldRedeclInfo _ => pure "[field_redecl]"
- | .ofOmissionInfo _ => pure "[omission]"
| .ofChoiceInfo _ => pure "[choice]"
| .ofPartialTermInfo _ => pure "[partial_term]"
+ | .ofDelabTermInfo _ => pure "[delab_term]"
let children := "\n".intercalate (← children.toList.mapM λ t' => do pure $ indent $ ← t'.toString ctx)
return s!"{node}\n{children}"
else throw <| IO.userError "No `ContextInfo` available."
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index a4b056c..fc3ca88 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.25"
+def version := "0.2.26"
end Pantograph
diff --git a/flake.lock b/flake.lock
index 4a17f3d..f164bbd 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1730504689,
- "narHash": "sha256-hgmguH29K2fvs9szpq2r3pz2/8cJd2LPS+b4tfNFCwE=",
+ "lastModified": 1738453229,
+ "narHash": "sha256-7H9XgNiGLKN1G1CgRh0vUL4AheZSYzPm+zmZ7vxbJdo=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "506278e768c2a08bec68eb62932193e341f55c90",
+ "rev": "32ea77a06711b758da0ad9bd6a844c5740a87abd",
"type": "github"
},
"original": {
@@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs"
},
"locked": {
- "lastModified": 1736388194,
- "narHash": "sha256-ymSrd/A8Pw+9FzbxUbR7CkFHLJK1b4SnFFWg/1e0JeE=",
+ "lastModified": 1739073990,
+ "narHash": "sha256-VmLkZf4+1HWrIDB/JUlPOAmOlutR6XTFRhDzDYJcYZM=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "90f496bc0694fb97bdfa6adedfc2dc2c841a4cf2",
+ "rev": "7a6faedc6c3ab35c42add15c354bf69542b9a6e6",
"type": "github"
},
"original": {
@@ -90,14 +90,14 @@
},
"nixpkgs-lib": {
"locked": {
- "lastModified": 1730504152,
- "narHash": "sha256-lXvH/vOfb4aGYyvFmZK/HlsNsr/0CVWlwYvo2rxJk3s=",
+ "lastModified": 1738452942,
+ "narHash": "sha256-vJzFZGaCpnmo7I6i416HaBLpC+hvcURh/BQwROcGIp8=",
"type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
+ "url": "https://github.com/NixOS/nixpkgs/archive/072a6db25e947df2f31aab9eccd0ab75d5b2da11.tar.gz"
},
"original": {
"type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
+ "url": "https://github.com/NixOS/nixpkgs/archive/072a6db25e947df2f31aab9eccd0ab75d5b2da11.tar.gz"
}
},
"nixpkgs-lib_2": {
@@ -114,11 +114,11 @@
},
"nixpkgs_2": {
"locked": {
- "lastModified": 1731386116,
- "narHash": "sha256-lKA770aUmjPHdTaJWnP3yQ9OI1TigenUqVC3wweqZuI=",
+ "lastModified": 1735563628,
+ "narHash": "sha256-OnSAY7XDSx7CtDoqNh8jwVwh4xNL/2HaJxGjryLWzX8=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "689fed12a013f56d4c4d3f612489634267d86529",
+ "rev": "b134951a4c9f3c995fd7be05f3243f8ecd65d798",
"type": "github"
},
"original": {
diff --git a/lean-toolchain b/lean-toolchain
index d0eb99f..2586f88 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.15.0
+leanprover/lean4:v4.16.0
From aac39ca60c8da8fc2d807f94b0c177eb1e051ad9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 23 Feb 2025 14:13:44 -0800
Subject: [PATCH 422/465] fix: Some test errors
---
Test/Metavar.lean | 2 +-
Test/Tactic/MotivatedApply.lean | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/Test/Metavar.lean b/Test/Metavar.lean
index 276004b..421ea01 100644
--- a/Test/Metavar.lean
+++ b/Test/Metavar.lean
@@ -192,7 +192,7 @@ def test_proposition_generation: TestM Unit := do
addTest $ assertUnreachable $ other.toString
return ()
addTest $ LSpec.check ":= λ (x: Nat), _" ((← state2.serializeGoals (options := ← read)).map (·.target.pp?) =
- #[.some "?m.29 x"])
+ #[.some "?m.30 x"])
addTest $ LSpec.test "(2 root)" state2.rootExpr?.isNone
let assign := "Eq.refl x"
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
index 2da643e..fbb1d7c 100644
--- a/Test/Tactic/MotivatedApply.lean
+++ b/Test/Tactic/MotivatedApply.lean
@@ -100,7 +100,7 @@ def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
addTest $ ← conduit.withContext do
let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = s!"(Nat.add ?m.{majorId} + 0 = ?m.149 ?m.{majorId}) = (n + 0 = n)")
+ return LSpec.check "conduit" (t = s!"(Nat.add ?m.{majorId} + 0 = ?m.150 ?m.{majorId}) = (n + 0 = n)")
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
From 267290c8f71a83309ef217c53b8c44de293692ea Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 23 Feb 2025 14:14:59 -0800
Subject: [PATCH 423/465] fix: Draft tactic failure by new `sorry` semantics
---
Pantograph/Tactic/Assign.lean | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Tactic/Assign.lean b/Pantograph/Tactic/Assign.lean
index c87dd46..af9d15f 100644
--- a/Pantograph/Tactic/Assign.lean
+++ b/Pantograph/Tactic/Assign.lean
@@ -28,15 +28,16 @@ def evalAssign : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
Elab.Tactic.replaceMainGoal nextGoals
def sorryToHole (src : Expr) : StateRefT (List MVarId) MetaM Expr := do
- Meta.transform src λ
- | .app (.app (.const ``sorryAx ..) type) .. => do
- let type ← instantiateMVars type
+ Meta.transform src λ expr =>
+ if expr.isSorry then do
+ let type ← instantiateMVars (expr.getArg! 0 |>.bindingBody!)
if type.hasSorry then
throwError s!"Coupling is not allowed in draft tactic: {← Meta.ppExpr type}"
let mvar ← Meta.mkFreshExprSyntheticOpaqueMVar type
modify (mvar.mvarId! :: .)
pure $ .done mvar
- | _ => pure .continue
+ else
+ pure .continue
-- Given a complete (no holes) expression, extract the sorry's from it and convert them into goals.
def draft (goal : MVarId) (expr : Expr) : MetaM (List MVarId) := do
From 76639d026665ca99edf78502837074652caf19b0 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 24 Feb 2025 15:45:31 -0800
Subject: [PATCH 424/465] fix: Panic edge case for module name
---
Pantograph/Environment.lean | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 6bd3f76..aa4dd03 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -24,8 +24,11 @@ def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[
@[export pantograph_environment_module_of_name]
def module_of_name (env: Environment) (name: Name): Option Name := do
- let moduleId ← env.getModuleIdxFor? name
- return env.allImportedModuleNames.get! moduleId.toNat
+ let moduleId ← env.getModuleIdxFor? name
+ if h : moduleId.toNat < env.allImportedModuleNames.size then
+ return env.allImportedModuleNames.get moduleId.toNat h
+ else
+ .none
def toCompactSymbolName (n: Name) (info: ConstantInfo): String :=
let pref := match info with
From ec3e1ff2c0beb453d1be19eba168e3cc0dc88dc4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 25 Feb 2025 15:16:10 -0800
Subject: [PATCH 425/465] chore: Bump version to 0.3.0-rc.1
---
Pantograph/Version.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index fc3ca88..a65274d 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.2.26"
+def version := "0.3.0-rc.1"
end Pantograph
From 999bb146fab96d2f026fc92e54857d529aef3f29 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 1 Mar 2025 20:12:30 -0800
Subject: [PATCH 426/465] chore: Remove all unused auxiliary tactics
---
Pantograph/Library.lean | 16 ---
Pantograph/Tactic.lean | 3 -
Pantograph/Tactic/Congruence.lean | 98 ---------------
Pantograph/Tactic/MotivatedApply.lean | 106 ----------------
Pantograph/Tactic/NoConfuse.lean | 22 ----
Test/Main.lean | 3 -
Test/Proofs.lean | 175 --------------------------
Test/Tactic.lean | 3 -
Test/Tactic/Congruence.lean | 88 -------------
Test/Tactic/MotivatedApply.lean | 113 -----------------
Test/Tactic/NoConfuse.lean | 72 -----------
11 files changed, 699 deletions(-)
delete mode 100644 Pantograph/Tactic/Congruence.lean
delete mode 100644 Pantograph/Tactic/MotivatedApply.lean
delete mode 100644 Pantograph/Tactic/NoConfuse.lean
delete mode 100644 Test/Tactic/Congruence.lean
delete mode 100644 Test/Tactic/MotivatedApply.lean
delete mode 100644 Test/Tactic/NoConfuse.lean
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index b5c3655..b060275 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -191,22 +191,6 @@ protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName:
runTermElabM do
state.restoreElabM
state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
-@[export pantograph_goal_try_motivated_apply_m]
-protected def GoalState.tryMotivatedApply (state: GoalState) (goal: MVarId) (recursor: String):
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let recursor ← match (← parseTermM recursor) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- state.tryTacticM goal (tacticM := Tactic.evalMotivatedApply recursor)
-@[export pantograph_goal_try_no_confuse_m]
-protected def GoalState.tryNoConfuse (state: GoalState) (goal: MVarId) (eq: String):
- Elab.TermElabM TacticResult := do
- state.restoreElabM
- let eq ← match (← parseTermM eq) with
- | .ok syn => pure syn
- | .error error => return .parseError error
- state.tryTacticM goal (tacticM := Tactic.evalNoConfuse eq)
@[export pantograph_goal_try_draft_m]
protected def GoalState.tryDraft (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult := do
let expr ← match (← parseTermM expr) with
diff --git a/Pantograph/Tactic.lean b/Pantograph/Tactic.lean
index 72902f4..442e7ea 100644
--- a/Pantograph/Tactic.lean
+++ b/Pantograph/Tactic.lean
@@ -1,5 +1,2 @@
import Pantograph.Tactic.Assign
-import Pantograph.Tactic.Congruence
-import Pantograph.Tactic.MotivatedApply
-import Pantograph.Tactic.NoConfuse
import Pantograph.Tactic.Prograde
diff --git a/Pantograph/Tactic/Congruence.lean b/Pantograph/Tactic/Congruence.lean
deleted file mode 100644
index 0f6d80d..0000000
--- a/Pantograph/Tactic/Congruence.lean
+++ /dev/null
@@ -1,98 +0,0 @@
-import Lean
-
-open Lean
-
-namespace Pantograph.Tactic
-
-def congruenceArg (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
- mvarId.checkNotAssigned `Pantograph.Tactic.congruenceArg
- let target ← mvarId.getType
- let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
- let userName := (← mvarId.getDecl).userName
-
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
- (tag := userName ++ `α)
- let f ← Meta.mkFreshExprSyntheticOpaqueMVar (.forallE .anonymous α β .default)
- (tag := userName ++ `f)
- let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
- (tag := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
- (tag := userName ++ `a₂)
- let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
- (tag := userName ++ `h)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) target
- let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
- (tag := userName ++ `conduit)
- mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
- let result := [α, a₁, a₂, f, h, conduit]
- return result.map (·.mvarId!)
-
-def evalCongruenceArg: Elab.Tactic.TacticM Unit := do
- let goal ← Elab.Tactic.getMainGoal
- let nextGoals ← congruenceArg goal
- Elab.Tactic.replaceMainGoal nextGoals
-
-def congruenceFun (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
- mvarId.checkNotAssigned `Pantograph.Tactic.congruenceFun
- let target ← mvarId.getType
- let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
- let userName := (← mvarId.getDecl).userName
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
- (tag := userName ++ `α)
- let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
- (tag := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
- (tag := userName ++ `f₂)
- let a ← Meta.mkFreshExprSyntheticOpaqueMVar α
- (tag := userName ++ `a)
- let h ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
- (tag := userName ++ `h)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) target
- let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
- (tag := userName ++ `conduit)
- mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
- let result := [α, f₁, f₂, h, a, conduit]
- return result.map (·.mvarId!)
-
-def evalCongruenceFun: Elab.Tactic.TacticM Unit := do
- let goal ← Elab.Tactic.getMainGoal
- let nextGoals ← congruenceFun goal
- Elab.Tactic.replaceMainGoal nextGoals
-
-def congruence (mvarId: MVarId): MetaM (List MVarId) := mvarId.withContext do
- mvarId.checkNotAssigned `Pantograph.Tactic.congruence
- let target ← mvarId.getType
- let .some (β, _, _) := (← instantiateMVars target).eq? | throwError "Goal is not an Eq"
- let userName := (← mvarId.getDecl).userName
- let u ← Meta.mkFreshLevelMVar
- let α ← Meta.mkFreshExprSyntheticOpaqueMVar (mkSort u)
- (tag := userName ++ `α)
- let fType := .forallE .anonymous α β .default
- let f₁ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
- (tag := userName ++ `f₁)
- let f₂ ← Meta.mkFreshExprSyntheticOpaqueMVar fType
- (tag := userName ++ `f₂)
- let a₁ ← Meta.mkFreshExprSyntheticOpaqueMVar α
- (tag := userName ++ `a₁)
- let a₂ ← Meta.mkFreshExprSyntheticOpaqueMVar α
- (tag := userName ++ `a₂)
- let h₁ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq f₁ f₂)
- (tag := userName ++ `h₁)
- let h₂ ← Meta.mkFreshExprSyntheticOpaqueMVar (← Meta.mkEq a₁ a₂)
- (tag := userName ++ `h₂)
- let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) target
- let conduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType
- (tag := userName ++ `conduit)
- mvarId.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
- let result := [α, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
- return result.map (·.mvarId!)
-
-def evalCongruence: Elab.Tactic.TacticM Unit := do
- let goal ← Elab.Tactic.getMainGoal
- let nextGoals ← congruence goal
- Elab.Tactic.replaceMainGoal nextGoals
-
-end Pantograph.Tactic
diff --git a/Pantograph/Tactic/MotivatedApply.lean b/Pantograph/Tactic/MotivatedApply.lean
deleted file mode 100644
index 993d287..0000000
--- a/Pantograph/Tactic/MotivatedApply.lean
+++ /dev/null
@@ -1,106 +0,0 @@
-import Lean
-
-open Lean
-
-namespace Pantograph.Tactic
-
-def getForallArgsBody: Expr → List Expr × Expr
- | .forallE _ d b _ =>
- let (innerArgs, innerBody) := getForallArgsBody b
- (d :: innerArgs, innerBody)
- | e => ([], e)
-
-def replaceForallBody: Expr → Expr → Expr
- | .forallE param domain body binderInfo, target =>
- let body := replaceForallBody body target
- .forallE param domain body binderInfo
- | _, target => target
-
-structure RecursorWithMotive where
- args: List Expr
- body: Expr
-
- -- .bvar index for the motive and major from the body
- iMotive: Nat
-
-namespace RecursorWithMotive
-
-protected def nArgs (info: RecursorWithMotive): Nat := info.args.length
-
-protected def getMotiveType (info: RecursorWithMotive): Expr :=
- let level := info.nArgs - info.iMotive - 1
- let a := info.args.get! level
- a
-
-protected def surrogateMotiveType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
- let motiveType := Expr.instantiateRev info.getMotiveType mvars
- let resultantType ← Meta.inferType resultant
- return replaceForallBody motiveType resultantType
-
-protected def conduitType (info: RecursorWithMotive) (mvars: Array Expr) (resultant: Expr): MetaM Expr := do
- let motiveCall := Expr.instantiateRev info.body mvars
- Meta.mkEq motiveCall resultant
-
-end RecursorWithMotive
-
-def getRecursorInformation (recursorType: Expr): Option RecursorWithMotive := do
- let (args, body) := getForallArgsBody recursorType
- if ¬ body.isApp then
- .none
- let iMotive ← match body.getAppFn with
- | .bvar iMotive => pure iMotive
- | _ => .none
- return {
- args,
- body,
- iMotive,
- }
-
-def collectMotiveArguments (forallBody: Expr): SSet Nat :=
- match forallBody with
- | .app (.bvar i) _ => SSet.empty.insert i
- | _ => SSet.empty
-
-/-- Applies a symbol of the type `∀ (motive: α → Sort u) (a: α)..., (motive α)` -/
-def motivatedApply (mvarId: MVarId) (recursor: Expr) : MetaM (Array Meta.InductionSubgoal) := mvarId.withContext do
- mvarId.checkNotAssigned `Pantograph.Tactic.motivatedApply
- let recursorType ← Meta.inferType recursor
- let resultant ← mvarId.getType
- let tag ← mvarId.getTag
-
- let info ← match getRecursorInformation recursorType with
- | .some info => pure info
- | .none => throwError "Recursor return type does not correspond with the invocation of a motive: {← Meta.ppExpr recursorType}"
-
- let rec go (i: Nat) (prev: Array Expr): MetaM (Array Expr) := do
- if i ≥ info.nArgs then
- return prev
- else
- let argType := info.args.get! i
- -- If `argType` has motive references, its goal needs to be placed in it
- let argType := argType.instantiateRev prev
- let bvarIndex := info.nArgs - i - 1
- let argGoal ← if bvarIndex = info.iMotive then
- let surrogateMotiveType ← info.surrogateMotiveType prev resultant
- Meta.mkFreshExprSyntheticOpaqueMVar surrogateMotiveType (tag := tag ++ `motive)
- else
- Meta.mkFreshExprSyntheticOpaqueMVar argType (tag := .anonymous)
- let prev := prev ++ [argGoal]
- go (i + 1) prev
- termination_by info.nArgs - i
- let mut newMVars ← go 0 #[]
-
- -- Create the conduit type which proves the result of the motive is equal to the goal
- let conduitType ← info.conduitType newMVars resultant
- let goalConduit ← Meta.mkFreshExprSyntheticOpaqueMVar conduitType (tag := `conduit)
- mvarId.assign $ ← Meta.mkEqMP goalConduit (mkAppN recursor newMVars)
- newMVars := newMVars ++ [goalConduit]
-
- return newMVars.map (λ mvar => { mvarId := mvar.mvarId!})
-
-def evalMotivatedApply : Elab.Tactic.Tactic := fun stx => Elab.Tactic.withMainContext do
- let recursor ← Elab.Term.elabTerm (stx := stx) .none
- let nextGoals ← motivatedApply (← Elab.Tactic.getMainGoal) recursor
- Elab.Tactic.replaceMainGoal $ nextGoals.toList.map (·.mvarId)
-
-end Pantograph.Tactic
diff --git a/Pantograph/Tactic/NoConfuse.lean b/Pantograph/Tactic/NoConfuse.lean
deleted file mode 100644
index e9ff459..0000000
--- a/Pantograph/Tactic/NoConfuse.lean
+++ /dev/null
@@ -1,22 +0,0 @@
-import Lean
-
-open Lean
-
-namespace Pantograph.Tactic
-
-def noConfuse (mvarId: MVarId) (h: Expr): MetaM Unit := mvarId.withContext do
- mvarId.checkNotAssigned `Pantograph.Tactic.noConfuse
- let target ← mvarId.getType
- let noConfusion ← Meta.mkNoConfusion (target := target) (h := h)
-
- unless ← Meta.isDefEq (← Meta.inferType noConfusion) target do
- throwError "invalid noConfuse call: The resultant type {← Meta.ppExpr $ ← Meta.inferType noConfusion} cannot be unified with {← Meta.ppExpr target}"
- mvarId.assign noConfusion
-
-def evalNoConfuse: Elab.Tactic.Tactic := λ stx => do
- let goal ← Elab.Tactic.getMainGoal
- let h ← goal.withContext $ Elab.Term.elabTerm (stx := stx) .none
- noConfuse goal h
- Elab.Tactic.replaceMainGoal []
-
-end Pantograph.Tactic
diff --git a/Test/Main.lean b/Test/Main.lean
index 18dc9e3..e5cf285 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -54,9 +54,6 @@ def main (args: List String) := do
("Delate", Delate.suite env_default),
("Serial", Serial.suite env_default),
("Tactic/Assign", Tactic.Assign.suite env_default),
- ("Tactic/Congruence", Tactic.Congruence.suite env_default),
- ("Tactic/Motivated Apply", Tactic.MotivatedApply.suite env_default),
- ("Tactic/No Confuse", Tactic.NoConfuse.suite env_default),
("Tactic/Prograde", Tactic.Prograde.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index bf43bf6..ef8bc09 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -543,179 +543,6 @@ def test_calc: TestM Unit := do
("h1", "a + b = b + c"), ("h2", "b + c = c + d")] ++ free
buildGoal free target userName?
-def test_nat_zero_add: TestM Unit := do
- let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
- let tactic := "intro n"
- let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("n", "Nat")] "n + 0 = n"])
- let recursor := "@Nat.brecOn"
- let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals |
- fail "Incorrect number of goals"
- let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
- addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
- #[
- buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat",
- buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit")
- ])
-
- let tactic := "exact n"
- let state3b ← match ← state2.tacticOn (goalId := 1) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state3b.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
- let state2b ← match state3b.continue state2 with
- | .ok state => pure state
- | .error e => do
- addTest $ assertUnreachable e
- return ()
- let tactic := "exact (λ x => x + 0 = x)"
- let state3c ← match ← state2b.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state3c.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[])
- let state2c ← match state3c.continue state2b with
- | .ok state => pure state
- | .error e => do
- addTest $ assertUnreachable e
- return ()
- let tactic := "intro t h"
- let state3 ← match ← state2c.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state3.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("n", "Nat"), ("t", "Nat"), ("h", "Nat.below t")] "t + 0 = t"])
-
- let tactic := "simp"
- let state3d ← match ← state3.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let state2d ← match state3d.continue state2c with
- | .ok state => pure state
- | .error e => do
- addTest $ assertUnreachable e
- return ()
- let tactic := "rfl"
- let stateF ← match ← state2d.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← stateF.serializeGoals (options := ← read)) =
- #[])
-
- let expr := stateF.mctx.eAssignment.find! stateF.root
- let (expr, _) := instantiateMVarsCore (mctx := stateF.mctx) (e := expr)
- addTest $ LSpec.check "(F root)" stateF.rootExpr?.isSome
-
-def test_nat_zero_add_alt: TestM Unit := do
- let state? ← startProof (.expr "∀ (n: Nat), n + 0 = n")
- let state0 ← match state? with
- | .some state => pure state
- | .none => do
- addTest $ assertUnreachable "Goal could not parse"
- return ()
- let tactic := "intro n"
- let state1 ← match ← state0.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("n", "Nat")] "n + 0 = n"])
- let recursor := "@Nat.brecOn"
- let state2 ← match ← state1.tryMotivatedApply (state1.get! 0) (recursor := recursor) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let [mvarMotive, mvarMajor, mvarInduct, mvarConduit] := state2.goals |
- fail "Incorrect number of goals"
- let .num _ major := mvarMajor.name | fail "Incorrect form of mvar id"
- addTest $ LSpec.check s!"mapply {recursor}" ((← state2.serializeGoals (options := ← read)).map (·.devolatilizeVars) =
- #[
- buildNamedGoal mvarMotive.name.toString [("n", "Nat")] "Nat → Prop" (.some "motive"),
- buildNamedGoal mvarMajor.name.toString [("n", "Nat")] "Nat",
- buildNamedGoal mvarInduct.name.toString [("n", "Nat")] "∀ (t : Nat), Nat.below t → ?motive t",
- buildNamedGoal mvarConduit.name.toString [("n", "Nat")] s!"?motive ?m.{major} = (n + 0 = n)" (.some "conduit")
- ])
-
- let tactic := "intro x"
- let state3m ← match ← state2.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- addTest $ LSpec.check tactic ((← state3m.serializeGoals (options := ← read)).map (·.devolatilize) =
- #[buildGoal [("n", "Nat"), ("x", "Nat")] "Prop" (.some "motive")])
- let tactic := "apply Eq"
- let state3m2 ← match ← state3m.tacticOn (goalId := 0) (tactic := tactic) with
- | .success state => pure state
- | other => do
- addTest $ assertUnreachable $ other.toString
- return ()
- let [eqL, eqR, eqT] := state3m2.goals | fail "Incorrect number of goals"
- let [_motive, _major, _step, conduit] := state2.goals | panic! "Goals conflict"
- let state2b ← match state3m2.resume [conduit] with
- | .ok state => pure state
- | .error e => do
- addTest $ assertUnreachable e
- return ()
-
- let cNatAdd := "(:c HAdd.hAdd) (:c Nat) (:c Nat) (:c Nat) ((:c instHAdd) (:c Nat) (:c instAddNat))"
- let cNat0 := "((:c OfNat.ofNat) (:c Nat) (:lit 0) ((:c instOfNatNat) (:lit 0)))"
- let fvN ← state2b.withContext conduit do
- let lctx ← getLCtx
- pure $ lctx.getFVarIds.get! 0 |>.name
- let conduitRight := s!"((:c Eq) (:c Nat) ({cNatAdd} (:fv {fvN}) {cNat0}) (:fv {fvN}))"
- let substOf (mvarId: MVarId) := s!"(:subst (:mv {mvarId.name}) (:fv {fvN}) (:mv {mvarMajor}))"
- let .num _ nL := eqL.name | fail "Incorrect form of mvar id"
- let .num _ nR := eqR.name | fail "Incorrect form of mvar id"
- let nL' := nL + 4
- let nR' := nR + 5
- addTest $ LSpec.check "resume" ((← state2b.serializeGoals (options := { ← read with printExprAST := true })) =
- #[
- {
- name := mvarConduit.name.toString,
- userName? := .some "conduit",
- target := {
- pp? := .some s!"(?m.{nL'} ?m.{major} = ?m.{nR'} ?m.{major}) = (n + 0 = n)",
- sexp? := .some s!"((:c Eq) (:sort 0) ((:c Eq) {substOf eqT} {substOf eqL} {substOf eqR}) {conduitRight})",
- },
- vars := #[{
- name := fvN.toString,
- userName := "n",
- type? := .some { pp? := .some "Nat", sexp? := .some "(:c Nat)" },
- }],
- }
- ])
-
def test_tactic_failure_unresolved_goals : TestM Unit := do
let state? ← startProof (.expr "∀ (p : Nat → Prop), ∃ (x : Nat), p (0 + x + 0)")
let state0 ← match state? with
@@ -778,8 +605,6 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Or.comm", test_or_comm),
("conv", test_conv),
("calc", test_calc),
- ("Nat.zero_add", test_nat_zero_add),
- ("Nat.zero_add alt", test_nat_zero_add_alt),
("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
]
diff --git a/Test/Tactic.lean b/Test/Tactic.lean
index 6b3e8fd..217edb6 100644
--- a/Test/Tactic.lean
+++ b/Test/Tactic.lean
@@ -1,5 +1,2 @@
import Test.Tactic.Assign
-import Test.Tactic.Congruence
-import Test.Tactic.MotivatedApply
-import Test.Tactic.NoConfuse
import Test.Tactic.Prograde
diff --git a/Test/Tactic/Congruence.lean b/Test/Tactic/Congruence.lean
deleted file mode 100644
index e861b2f..0000000
--- a/Test/Tactic/Congruence.lean
+++ /dev/null
@@ -1,88 +0,0 @@
-import LSpec
-import Lean
-import Test.Common
-
-open Lean
-open Pantograph
-
-namespace Pantograph.Test.Tactic.Congruence
-
-def test_congr_arg_list : TestT Elab.TermElabM Unit := do
- let expr := "λ {α} (l1 l2 : List α) (h: l1 = l2) => l1.reverse = l2.reverse"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.30"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`f, "?α → List α"),
- (`h, "?a₁ = ?a₂"),
- (`conduit, "(?f ?a₁ = ?f ?a₂) = (l1.reverse = l2.reverse)"),
- ])
- let f := newGoals.get! 3
- let h := newGoals.get! 4
- let c := newGoals.get! 5
- let results ← Meta.withAssignableSyntheticOpaque do f.apply (← parseSentence "List.reverse")
- addTest $ LSpec.check "apply" (results.length = 0)
- addTest $ LSpec.check "h" ((← exprToStr $ ← h.getType) = "?a₁ = ?a₂")
- addTest $ LSpec.check "conduit" ((← exprToStr $ ← c.getType) = "(List.reverse ?a₁ = List.reverse ?a₂) = (l1.reverse = l2.reverse)")
-def test_congr_arg : TestT Elab.TermElabM Unit := do
- let expr := "λ (n m: Nat) (h: n = m) => n * n = m * m"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.evalCongruenceArg target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.73"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`f, "?α → Nat"),
- (`h, "?a₁ = ?a₂"),
- (`conduit, "(?f ?a₁ = ?f ?a₂) = (n * n = m * m)"),
- ])
-def test_congr_fun : TestT Elab.TermElabM Unit := do
- let expr := "λ (n m: Nat) => (n + m) + (n + m) = (n + m) * 2"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.evalCongruenceFun target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.165"),
- (`f₁, "?α → Nat"),
- (`f₂, "?α → Nat"),
- (`h, "?f₁ = ?f₂"),
- (`a, "?α"),
- (`conduit, "(?f₁ ?a = ?f₂ ?a) = (n + m + (n + m) = (n + m) * 2)"),
- ])
-def test_congr : TestT Elab.TermElabM Unit := do
- let expr := "λ (a b: Nat) => a = b"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let newGoals ← runTacticOnMVar Tactic.evalCongruence target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ x => mvarUserNameAndType x)) =
- [
- (`α, "Sort ?u.10"),
- (`f₁, "?α → Nat"),
- (`f₂, "?α → Nat"),
- (`a₁, "?α"),
- (`a₂, "?α"),
- (`h₁, "?f₁ = ?f₂"),
- (`h₂, "?a₁ = ?a₂"),
- (`conduit, "(?f₁ ?a₁ = ?f₂ ?a₂) = (a = b)"),
- ])
-
-def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
- [
- ("congrArg List.reverse", test_congr_arg_list),
- ("congrArg", test_congr_arg),
- ("congrFun", test_congr_fun),
- ("congr", test_congr),
- ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
-
-end Pantograph.Test.Tactic.Congruence
diff --git a/Test/Tactic/MotivatedApply.lean b/Test/Tactic/MotivatedApply.lean
deleted file mode 100644
index 2da643e..0000000
--- a/Test/Tactic/MotivatedApply.lean
+++ /dev/null
@@ -1,113 +0,0 @@
-import LSpec
-import Lean
-import Test.Common
-
-open Lean
-open Pantograph
-
-namespace Pantograph.Test.Tactic.MotivatedApply
-
-def test_type_extract : TestT Elab.TermElabM Unit := do
- let recursor ← parseSentence "@Nat.brecOn"
- let recursorType ← Meta.inferType recursor
- addTest $ LSpec.check "recursorType" ("{motive : Nat → Sort ?u.1} → (t : Nat) → ((t : Nat) → Nat.below t → motive t) → motive t" =
- (← exprToStr recursorType))
- let info ← match Tactic.getRecursorInformation recursorType with
- | .some info => pure info
- | .none => throwError "Failed to extract recursor info"
- addTest $ LSpec.check "iMotive" (info.iMotive = 2)
- let motiveType := info.getMotiveType
- addTest $ LSpec.check "motiveType" ("Nat → Sort ?u.1" =
- (← exprToStr motiveType))
-
-def test_nat_brec_on : TestT Elab.TermElabM Unit := do
- let expr := "λ (n t: Nat) => n + 0 = n"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "@Nat.brecOn")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.evalMotivatedApply recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- let test := LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Nat → Prop",
- "Nat",
- "∀ (t : Nat), Nat.below t → ?motive t",
- "?motive ?m.74 = (n + 0 = n)",
- ])
- addTest test
-
-def test_list_brec_on : TestT Elab.TermElabM Unit := do
- let expr := "λ {α : Type} (l: List α) => l ++ [] = [] ++ l"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "@List.brecOn")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.evalMotivatedApply recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Type ?u.90",
- "List ?m.92 → Prop",
- "List ?m.92",
- "∀ (t : List ?m.92), List.below t → ?motive t",
- "?motive ?m.94 = (l ++ [] = [] ++ l)",
- ])
-
-def test_partial_motive_instantiation : TestT Elab.TermElabM Unit := do
- let expr := "λ (n t: Nat) => n + 0 = n"
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "@Nat.brecOn")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.evalMotivatedApply recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- let majorId := 74
- addTest $ (LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) =
- [
- "Nat → Prop",
- "Nat",
- "∀ (t : Nat), Nat.below t → ?motive t",
- s!"?motive ?m.{majorId} = (n + 0 = n)",
- ]))
- let [motive, major, step, conduit] := newGoals | panic! "Incorrect goal number"
- addTest $ (LSpec.check "goal name" (major.name.toString = s!"_uniq.{majorId}"))
-
- -- Assign motive to `λ x => x + _`
- let motive_assign ← parseSentence "λ (x: Nat) => @Nat.add x + 0 = _"
- motive.assign motive_assign
-
- addTest $ ← conduit.withContext do
- let t := toString (← Meta.ppExpr $ ← conduit.getType)
- return LSpec.check "conduit" (t = s!"(Nat.add ?m.{majorId} + 0 = ?m.149 ?m.{majorId}) = (n + 0 = n)")
-
-def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
- [
- ("type_extract", test_type_extract),
- ("Nat.brecOn", test_nat_brec_on),
- ("List.brecOn", test_list_brec_on),
- ("Nat.brecOn partial motive instantiation", test_partial_motive_instantiation),
- ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
-
-end Pantograph.Test.Tactic.MotivatedApply
diff --git a/Test/Tactic/NoConfuse.lean b/Test/Tactic/NoConfuse.lean
deleted file mode 100644
index 93f0606..0000000
--- a/Test/Tactic/NoConfuse.lean
+++ /dev/null
@@ -1,72 +0,0 @@
-import LSpec
-import Lean
-import Test.Common
-
-open Lean
-open Pantograph
-
-namespace Pantograph.Test.Tactic.NoConfuse
-
-def test_nat : TestT Elab.TermElabM Unit := do
- let expr := "λ (n: Nat) (h: 0 = n + 1) => False"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.evalNoConfuse recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- addTest $ LSpec.check "goals" ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
-
-def test_nat_fail : TestT Elab.TermElabM Unit := do
- let expr := "λ (n: Nat) (h: n = n) => False"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- try
- let tactic := Tactic.evalNoConfuse recursor
- let _ ← runTacticOnMVar tactic target.mvarId!
- addTest $ assertUnreachable "Tactic should fail"
- catch _ =>
- addTest $ LSpec.check "Tactic should fail" true
-
-def test_list : TestT Elab.TermElabM Unit := do
- let expr := "λ (l: List Nat) (h: [] = 1 :: l) => False"
- let expr ← parseSentence expr
- Meta.lambdaTelescope expr $ λ _ body => do
- let recursor ← match Parser.runParserCategory
- (env := ← MonadEnv.getEnv)
- (catName := `term)
- (input := "h")
- (fileName := ← getFileName) with
- | .ok syn => pure syn
- | .error error => throwError "Failed to parse: {error}"
- -- Apply the tactic
- let target ← Meta.mkFreshExprSyntheticOpaqueMVar body
- let tactic := Tactic.evalNoConfuse recursor
- let newGoals ← runTacticOnMVar tactic target.mvarId!
- addTest $ LSpec.check "goals"
- ((← newGoals.mapM (λ g => do exprToStr (← g.getType))) = [])
-
-def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
- [
- ("Nat", test_nat),
- ("Nat fail", test_nat_fail),
- ("List", test_list),
- ] |>.map (λ (name, t) => (name, runTestTermElabM env t))
-
-end Pantograph.Test.Tactic.NoConfuse
From 39ec79e6bb11a49d6f0137385e6a70969d3c55c5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 21:07:15 -0800
Subject: [PATCH 427/465] feat: Monad lifting in `GoalState.withContext`
---
Pantograph/Goal.lean | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index aaff02d..43f3e85 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -74,13 +74,14 @@ protected def GoalState.metaState (state: GoalState): Meta.State :=
protected def GoalState.coreState (state: GoalState): Core.SavedState :=
state.savedState.term.meta.core
-protected def GoalState.withContext (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
+protected def GoalState.withContext' (state: GoalState) (mvarId: MVarId) (m: MetaM α): MetaM α := do
mvarId.withContext m |>.run' (← read) state.metaState
-
+protected def GoalState.withContext { m } [MonadControlT MetaM m] [Monad m] (state: GoalState) (mvarId: MVarId) : m α → m α :=
+ Meta.mapMetaM <| state.withContext' mvarId
protected def GoalState.withParentContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
- Meta.mapMetaM <| state.withContext state.parentMVar?.get!
+ Meta.mapMetaM <| state.withContext' state.parentMVar?.get!
protected def GoalState.withRootContext { n } [MonadControlT MetaM n] [Monad n] (state: GoalState): n α → n α :=
- Meta.mapMetaM <| state.withContext state.root
+ Meta.mapMetaM <| state.withContext' state.root
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
From 5a690c4421f650d1a6fb85f8bc9c28efc7579cb1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 21:11:34 -0800
Subject: [PATCH 428/465] chore: Use `fetchGit` for `LSpec` input
---
flake.nix | 17 +++++++++--------
1 file changed, 9 insertions(+), 8 deletions(-)
diff --git a/flake.nix b/flake.nix
index af6e4fb..54552c5 100644
--- a/flake.nix
+++ b/flake.nix
@@ -2,12 +2,11 @@
description = "Pantograph";
inputs = {
- nixpkgs.url = "github:nixos/nixpkgs/nixos-24.05";
+ nixpkgs.url = "github:nixos/nixpkgs/nixos-24.11";
flake-parts.url = "github:hercules-ci/flake-parts";
- lean4-nix.url = "github:lenianiva/lean4-nix";
- lspec = {
- url = "github:argumentcomputer/LSpec?ref=504a8cecf8da601b9466ac727aebb6b511aae4ab";
- flake = false;
+ lean4-nix = {
+ url = "github:lenianiva/lean4-nix";
+ inputs.nixpkgs.follows = "nixpkgs";
};
};
@@ -16,7 +15,6 @@
nixpkgs,
flake-parts,
lean4-nix,
- lspec,
...
}:
flake-parts.lib.mkFlake {inherit inputs;} {
@@ -39,8 +37,11 @@
};
lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
- roots = ["Main" "LSpec"];
- src = "${lspec}";
+ roots = ["LSpec"];
+ src = builtins.fetchGit {
+ url = "https://github.com/argumentcomputer/LSpec.git";
+ rev = "ca8e2803f89f0c12bf9743ae7abbfb2ea6b0eeec";
+ };
};
project = pkgs.lean.buildLeanPackage {
name = "Pantograph";
From 92515ea0f2ba2f38f13779545c646445af0803a6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 21:11:59 -0800
Subject: [PATCH 429/465] fix: Update flake lock
---
flake.lock | 75 +++++++++++++++++-------------------------------------
1 file changed, 23 insertions(+), 52 deletions(-)
diff --git a/flake.lock b/flake.lock
index 4a17f3d..dedddc8 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1730504689,
- "narHash": "sha256-hgmguH29K2fvs9szpq2r3pz2/8cJd2LPS+b4tfNFCwE=",
+ "lastModified": 1741352980,
+ "narHash": "sha256-+u2UunDA4Cl5Fci3m7S643HzKmIDAe+fiXrLqYsR2fs=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "506278e768c2a08bec68eb62932193e341f55c90",
+ "rev": "f4330d22f1c5d2ba72d3d22df5597d123fdb60a9",
"type": "github"
},
"original": {
@@ -39,14 +39,16 @@
"lean4-nix": {
"inputs": {
"flake-parts": "flake-parts_2",
- "nixpkgs": "nixpkgs"
+ "nixpkgs": [
+ "nixpkgs"
+ ]
},
"locked": {
- "lastModified": 1736388194,
- "narHash": "sha256-ymSrd/A8Pw+9FzbxUbR7CkFHLJK1b4SnFFWg/1e0JeE=",
+ "lastModified": 1741472588,
+ "narHash": "sha256-XnMeMZKuspEphP+fEq4soc3PY7Nz+gsMPjlsXbobyrA=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "90f496bc0694fb97bdfa6adedfc2dc2c841a4cf2",
+ "rev": "cffeb67d58e02b50ccb9acd51b0212dc653ed6ce",
"type": "github"
},
"original": {
@@ -55,49 +57,35 @@
"type": "github"
}
},
- "lspec": {
- "flake": false,
- "locked": {
- "lastModified": 1728279187,
- "narHash": "sha256-ZMqbvCqR/gHXRuIkuo7b0Yp9N1vOQR7xnrcy/SeIBoQ=",
- "owner": "argumentcomputer",
- "repo": "LSpec",
- "rev": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
- "type": "github"
- },
- "original": {
- "owner": "argumentcomputer",
- "ref": "504a8cecf8da601b9466ac727aebb6b511aae4ab",
- "repo": "LSpec",
- "type": "github"
- }
- },
"nixpkgs": {
"locked": {
- "lastModified": 1728500571,
- "narHash": "sha256-dOymOQ3AfNI4Z337yEwHGohrVQb4yPODCW9MDUyAc4w=",
+ "lastModified": 1741332913,
+ "narHash": "sha256-ri1e8ZliWS3Jnp9yqpKApHaOo7KBN33W8ECAKA4teAQ=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "d51c28603def282a24fa034bcb007e2bcb5b5dd0",
+ "rev": "20755fa05115c84be00b04690630cb38f0a203ad",
"type": "github"
},
"original": {
"owner": "nixos",
- "ref": "nixos-24.05",
+ "ref": "nixos-24.11",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-lib": {
"locked": {
- "lastModified": 1730504152,
- "narHash": "sha256-lXvH/vOfb4aGYyvFmZK/HlsNsr/0CVWlwYvo2rxJk3s=",
- "type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
+ "lastModified": 1740877520,
+ "narHash": "sha256-oiwv/ZK/2FhGxrCkQkB83i7GnWXPPLzoqFHpDD3uYpk=",
+ "owner": "nix-community",
+ "repo": "nixpkgs.lib",
+ "rev": "147dee35aab2193b174e4c0868bd80ead5ce755c",
+ "type": "github"
},
"original": {
- "type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/cc2f28000298e1269cea6612cd06ec9979dd5d7f.tar.gz"
+ "owner": "nix-community",
+ "repo": "nixpkgs.lib",
+ "type": "github"
}
},
"nixpkgs-lib_2": {
@@ -112,28 +100,11 @@
"url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
}
},
- "nixpkgs_2": {
- "locked": {
- "lastModified": 1731386116,
- "narHash": "sha256-lKA770aUmjPHdTaJWnP3yQ9OI1TigenUqVC3wweqZuI=",
- "owner": "nixos",
- "repo": "nixpkgs",
- "rev": "689fed12a013f56d4c4d3f612489634267d86529",
- "type": "github"
- },
- "original": {
- "owner": "nixos",
- "ref": "nixos-24.05",
- "repo": "nixpkgs",
- "type": "github"
- }
- },
"root": {
"inputs": {
"flake-parts": "flake-parts",
"lean4-nix": "lean4-nix",
- "lspec": "lspec",
- "nixpkgs": "nixpkgs_2"
+ "nixpkgs": "nixpkgs"
}
}
},
From 9cf071eefe73c15418523575c028c7b4c0a8e2bf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 21:16:47 -0800
Subject: [PATCH 430/465] chore: Read manifest for LSpec version
---
flake.nix | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/flake.nix b/flake.nix
index 54552c5..424f863 100644
--- a/flake.nix
+++ b/flake.nix
@@ -35,13 +35,12 @@
inherit system;
overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)];
};
+ manifest = pkgs.lib.importJSON ./lake-manifest.json;
+ manifest-lspec = builtins.head manifest;
lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
roots = ["LSpec"];
- src = builtins.fetchGit {
- url = "https://github.com/argumentcomputer/LSpec.git";
- rev = "ca8e2803f89f0c12bf9743ae7abbfb2ea6b0eeec";
- };
+ src = builtins.fetchGit { inherit (manifest-lspec) url rev; };
};
project = pkgs.lean.buildLeanPackage {
name = "Pantograph";
From 5d0a7e84432aef08919767328afcc45c930232a1 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 22:50:04 -0800
Subject: [PATCH 431/465] fix: Manifest key error
---
flake.nix | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flake.nix b/flake.nix
index 424f863..71d957f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -36,7 +36,7 @@
overlays = [(lean4-nix.readToolchainFile ./lean-toolchain)];
};
manifest = pkgs.lib.importJSON ./lake-manifest.json;
- manifest-lspec = builtins.head manifest;
+ manifest-lspec = builtins.head manifest.packages;
lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
roots = ["LSpec"];
From 9e1ea54cbe0ad5d8527134d98033c123831d8148 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 8 Mar 2025 22:52:36 -0800
Subject: [PATCH 432/465] chore: Cleanup file filtering system
---
flake.nix | 57 ++++++++++++++++++++++++++++++++++++-------------------
1 file changed, 38 insertions(+), 19 deletions(-)
diff --git a/flake.nix b/flake.nix
index 71d957f..839ff9c 100644
--- a/flake.nix
+++ b/flake.nix
@@ -40,29 +40,52 @@
lspecLib = pkgs.lean.buildLeanPackage {
name = "LSpec";
roots = ["LSpec"];
- src = builtins.fetchGit { inherit (manifest-lspec) url rev; };
+ src = builtins.fetchGit {inherit (manifest-lspec) url rev;};
+ };
+ inherit (pkgs.lib.fileset) unions toSource fileFilter;
+ src = ./.;
+ set-project = unions [
+ ./Pantograph.lean
+ (fileFilter (file: file.hasExt "lean") ./Pantograph)
+ ];
+ set-repl = unions [
+ ./Main.lean
+ ./Repl.lean
+ ];
+ set-test = unions [
+ (fileFilter (file: file.hasExt "lean") ./Test)
+ ];
+ src-project = toSource {
+ root = src;
+ fileset = unions [
+ set-project
+ ];
+ };
+ src-repl = toSource {
+ root = src;
+ fileset = unions [
+ set-project
+ set-repl
+ ];
+ };
+ src-test = toSource {
+ root = src;
+ fileset = unions [
+ set-project
+ set-repl
+ set-test
+ ];
};
project = pkgs.lean.buildLeanPackage {
name = "Pantograph";
roots = ["Pantograph"];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "/Test/" path)
- && !(pkgs.lib.hasSuffix ".md" path)
- && !(pkgs.lib.hasSuffix "Repl.lean" path);
- });
+ src = src-project;
};
repl = pkgs.lean.buildLeanPackage {
name = "Repl";
roots = ["Main" "Repl"];
deps = [project];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "/Test/" path)
- && !(pkgs.lib.hasSuffix ".md" path);
- });
+ src = src-repl;
};
test = pkgs.lean.buildLeanPackage {
name = "Test";
@@ -71,11 +94,7 @@
# Environment`) and thats where `lakefile.lean` resides.
roots = ["Test.Main"];
deps = [lspecLib repl];
- src = pkgs.lib.cleanSource (pkgs.lib.cleanSourceWith {
- src = ./.;
- filter = path: type:
- !(pkgs.lib.hasInfix "Pantograph" path);
- });
+ src = src-test;
};
in rec {
packages = {
From 0cfd73e44e57556068b5962e3ec59d847058594e Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sun, 9 Mar 2025 23:29:33 -0700
Subject: [PATCH 433/465] test(frontend): Add scope `open` test
---
Pantograph/Frontend/Basic.lean | 3 ++-
Test/Frontend.lean | 19 ++++++++++++++++++-
2 files changed, 20 insertions(+), 2 deletions(-)
diff --git a/Pantograph/Frontend/Basic.lean b/Pantograph/Frontend/Basic.lean
index 4e15ad8..035c34b 100644
--- a/Pantograph/Frontend/Basic.lean
+++ b/Pantograph/Frontend/Basic.lean
@@ -40,6 +40,7 @@ def stxByteRange (stx : Syntax) : String.Pos × String.Pos :=
abbrev FrontendM := Elab.Frontend.FrontendM
structure CompilationStep where
+ scope : Elab.Command.Scope
fileName : String
fileMap : FileMap
src : Substring
@@ -74,7 +75,7 @@ def processOneCommand: FrontendM (CompilationStep × Bool) := do
let msgs := s'.messages.toList.drop s.messages.toList.length
let trees := s'.infoState.trees.drop s.infoState.trees.size
let ⟨_, fileName, fileMap⟩ := (← read).inputCtx
- return ({ fileName, fileMap, src, stx, before, after, msgs, trees }, done)
+ return ({ scope := s.scopes.head!, fileName, fileMap, src, stx, before, after, msgs, trees }, done)
partial def mapCompilationSteps { α } (f: CompilationStep → IO α) : FrontendM (List α) := do
let (cmd, done) ← processOneCommand
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index 571aa9f..bb160b0 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -1,11 +1,27 @@
-import LSpec
import Pantograph
import Repl
import Test.Common
+import LSpec
+
open Lean Pantograph
namespace Pantograph.Test.Frontend
+def runFrontend { α } (source: String) (f : Frontend.CompilationStep → IO α) : MetaM (List α) := do
+ let filename := "<anonymous>"
+ let (context, state) ← do Frontend.createContextStateFromFile source filename (← getEnv) {}
+ let m := Frontend.mapCompilationSteps f
+ m.run context |>.run' state
+
+def test_open : TestT MetaM Unit := do
+ let sketch := "
+open Nat
+example : ∀ (n m: Nat), n + m = m + n := by
+ apply add_comm
+ "
+ let errors ← runFrontend sketch λ step => step.msgs.mapM (·.toString)
+ checkEq "errors" errors [[]]
+
def collectSorrysFromSource (source: String) (options : Frontend.GoalCollectionOptions := {})
: MetaM (List GoalState) := do
let filename := "<anonymous>"
@@ -233,6 +249,7 @@ theorem mystery [SizeOf α] (as : List α) (i : Fin as.length) : sizeOf (as.get
def suite (env : Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
+ ("open", test_open),
("multiple_sorrys_in_proof", test_multiple_sorrys_in_proof),
("sorry_in_middle", test_sorry_in_middle),
("sorry_in_induction", test_sorry_in_induction),
From 896475848b55c98d205134eb965adf611ce1187a Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 10 Mar 2025 19:03:14 -0700
Subject: [PATCH 434/465] fix: Name generation not available due to context
---
Pantograph/Elab.lean | 3 ++-
Test/Proofs.lean | 20 ++++++++++++++++++++
2 files changed, 22 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Elab.lean b/Pantograph/Elab.lean
index 3c3b3cd..50cb7ef 100644
--- a/Pantograph/Elab.lean
+++ b/Pantograph/Elab.lean
@@ -6,7 +6,8 @@ namespace Pantograph
-- Functions for creating contexts and states
@[export pantograph_default_elab_context]
def defaultElabContext: Elab.Term.Context := {
- errToSorry := false
+ declName? := .some `mystery,
+ errToSorry := false,
}
/-- Read syntax object from string -/
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index ef8bc09..a760eb4 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -594,6 +594,25 @@ def test_tactic_failure_synthesize_placeholder : TestM Unit := do
let message := s!"<Pantograph>:0:31: error: don't know how to synthesize placeholder\ncontext:\np q r : Prop\nh : p → q\n⊢ p ∧ r\n"
checkEq s!"{tactic} fails" messages #[message]
+def test_deconstruct : TestM Unit := do
+ let state? ← startProof (.expr "∀ (p q : Prop) (h : And p q), And q p")
+ let state0 ← match state? with
+ | .some state => pure state
+ | .none => do
+ addTest $ assertUnreachable "Goal could not parse"
+ return ()
+
+ let tactic := "intro p q ⟨hp, hq⟩"
+ let state1 ← match ← state0.tacticOn 0 tactic with
+ | .success state => pure state
+ | other => do
+ fail other.toString
+ return ()
+ checkEq tactic ((← state1.serializeGoals (options := ← read)).map (·.devolatilize))
+ #[
+ buildGoal [("p", "Prop"), ("q", "Prop"), ("hp", "p"), ("hq", "q")] "q ∧ p"
+ ]
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
@@ -607,6 +626,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("calc", test_calc),
("tactic failure with unresolved goals", test_tactic_failure_unresolved_goals),
("tactic failure with synthesize placeholder", test_tactic_failure_synthesize_placeholder),
+ ("deconstruct", test_deconstruct),
]
tests.map (fun (name, test) => (name, proofRunner env test))
From 8797bbe245a9bb7ef7f90b41fb46d80c3ded5488 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Mar 2025 16:35:12 -0700
Subject: [PATCH 435/465] test(frontend): Fix the open test
---
Test/Frontend.lean | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/Test/Frontend.lean b/Test/Frontend.lean
index bb160b0..4062fb7 100644
--- a/Test/Frontend.lean
+++ b/Test/Frontend.lean
@@ -16,11 +16,12 @@ def runFrontend { α } (source: String) (f : Frontend.CompilationStep → IO α)
def test_open : TestT MetaM Unit := do
let sketch := "
open Nat
-example : ∀ (n m: Nat), n + m = m + n := by
- apply add_comm
+example : ∀ (n : Nat), n + 1 = Nat.succ n := by
+ intro
+ apply add_one
"
let errors ← runFrontend sketch λ step => step.msgs.mapM (·.toString)
- checkEq "errors" errors [[]]
+ checkEq "errors" errors [[], []]
def collectSorrysFromSource (source: String) (options : Frontend.GoalCollectionOptions := {})
: MetaM (List GoalState) := do
From 79e4dc697e49dcf19a96c4e9e4f6320e24eaf48c Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Mar 2025 16:46:28 -0700
Subject: [PATCH 436/465] feat(frontend): Add option to inherit environment
---
Pantograph/Protocol.lean | 5 +++++
Repl.lean | 11 ++++++-----
2 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 6d2c66b..164b72a 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -346,6 +346,11 @@ structure FrontendProcess where
-- One of these two must be supplied: Either supply the file name or the content.
fileName?: Option String := .none
file?: Option String := .none
+ -- If set to true, read the header (otherwise discards the header)
+ readHeader : Bool := false
+ -- If set to true, Pantograph's environment will be altered to whatever is
+ -- after the compilation units.
+ inheritEnv : Bool := false
-- collect tactic invocations
invocations: Bool := false
-- collect `sorry`s
diff --git a/Repl.lean b/Repl.lean
index c8f4028..e571397 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -53,11 +53,10 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
| .none, .some file =>
pure ("<anonymous>", file)
| _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
- let env?: Option Environment ← if args.fileName?.isSome then
+ let env?: Option Environment ← if args.readHeader then
pure .none
else do
- let env ← getEnv
- pure <| .some env
+ .some <$> getEnv
let (context, state) ← do Frontend.createContextStateFromFile file fileName env? {}
let frontendM: Elab.Frontend.FrontendM (List CompilationUnit) :=
Frontend.mapCompilationSteps λ step => do
@@ -83,7 +82,9 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
messages,
newConstants
}
- let li ← frontendM.run context |>.run' state
+ let (li, state') ← frontendM.run context |>.run state
+ if args.inheritEnv then
+ setEnv state'.commandState.env
let units ← li.mapM λ step => withEnv step.env do
let newConstants? := if args.newConstants then
.some $ step.newConstants.toArray.map λ name => name.toString
@@ -141,7 +142,7 @@ def execute (command: Protocol.Command): MainM Json := do
| "goal.print" => run goal_print
| "goal.save" => run goal_save
| "goal.load" => run goal_load
- | "frontend.process" => run frontend_process
+ | "frontend.process" => run frontend_process
| cmd =>
let error: Protocol.InteractionError :=
errorCommand s!"Unknown command {cmd}"
From ef165b70457080faa92b9668d1c0abc955e42e1f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Mar 2025 16:47:46 -0700
Subject: [PATCH 437/465] fix(frontend): Test update
---
Test/Integration.lean | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9815954..fc2f80b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -173,6 +173,8 @@ def test_frontend_process : Test :=
[
("file", .str file),
("invocations", .bool true),
+ ("readHeader", .bool false),
+ ("inheritEnv", .bool false),
("sorrys", .bool false),
("typeErrorsAsGoals", .bool false),
("newConstants", .bool false),
@@ -214,6 +216,8 @@ def test_frontend_process_sorry : Test :=
step "frontend.process"
[
("file", .str file),
+ ("readHeader", .bool false),
+ ("inheritEnv", .bool false),
("invocations", .bool false),
("sorrys", .bool true),
("typeErrorsAsGoals", .bool false),
From 98ad1ae2831c3136d7ff3c56869272323625a111 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Mar 2025 16:54:34 -0700
Subject: [PATCH 438/465] feat(delate): Tracing tags
---
Pantograph/Delate.lean | 26 +++++++++++++++-----------
1 file changed, 15 insertions(+), 11 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index ad923aa..44c09a9 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -85,13 +85,13 @@ This function ensures any metavariable in the result is either
1. Delayed assigned with its pending mvar not assigned in any form
2. Not assigned (delay or not)
-/
-partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
+partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
--let padding := String.join $ List.replicate level "│ "
- --IO.println s!"{padding}Starting {toString eOrig}"
+ withTraceNode `Pantograph.Delate (λ _ex => return m!":= {← Meta.ppExpr eOrig}") do
let mut result ← Meta.transform (← instantiateMVars eOrig)
(pre := fun e => e.withApp fun f args => do
let .mvar mvarId := f | return .continue
- --IO.println s!"{padding}├V {e}"
+ trace[Pantograph.Delate] "V {e}"
let mvarDecl ← mvarId.getDecl
-- This is critical to maintaining the interdependency of metavariables.
@@ -109,12 +109,13 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
if let .some assign ← getExprMVarAssignment? mvarId then
- --IO.println s!"{padding}├A ?{mvarId.name}"
+ trace[Pantograph.Delate] "A ?{mvarId.name}"
assert! !(← mvarId.isDelayedAssigned)
return .visit (mkAppN assign args)
else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
- --let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
- --IO.println s!"{padding}├MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
+ if ← isTracingEnabledFor `Pantograph.Delate then
+ let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ trace[Pantograph.Delate]"MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
if args.size < fvars.size then
throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
@@ -124,18 +125,18 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
--if !args.isEmpty then
--IO.println s!"{padding}├── Arguments End"
if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
- --IO.println s!"{padding}├T1"
+ trace[Pantograph.Delate] "T1"
let result := mkAppN f args
return .done result
let pending ← mvarIdPending.withContext do
let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
- --IO.println s!"{padding}├Pre: {inner}"
+ trace[Pantograph.Delate] "Pre: {inner}"
pure <| (← inner.abstractM fvars).instantiateRev args
-- Tail arguments
let result := mkAppRange pending fvars.size args.size args
- --IO.println s!"{padding}├MD {result}"
+ trace[Pantograph.Delate] "MD {result}"
return .done result
else
assert! !(← mvarId.isAssigned)
@@ -146,9 +147,9 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr := do
--if !args.isEmpty then
-- IO.println s!"{padding}├── Arguments End"
- --IO.println s!"{padding}├M ?{mvarId.name}"
+ trace[Pantograph.Delate] "M ?{mvarId.name}"
return .done (mkAppN f args))
- --IO.println s!"{padding}└Result {result}"
+ trace[Pantoraph.Delate] "Result {result}"
return result
where
self e := instantiateDelayedMVars e --(level := level + 1)
@@ -594,4 +595,7 @@ protected def GoalState.diag (goalState: GoalState) (parent?: Option GoalState :
| other => s!"[{other}]"
parentHasMVar (mvarId: MVarId): Bool := parent?.map (λ state => state.mctx.decls.contains mvarId) |>.getD true
+initialize
+ registerTraceClass `Pantograph.Delate
+
end Pantograph
From 78485ae6e23ee1d5a4e2bb15c610b5543c2535d3 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 14 Mar 2025 20:07:31 -0700
Subject: [PATCH 439/465] doc(frontend): Update documentation for
`frontend.process`
---
Pantograph/Protocol.lean | 5 ++---
doc/repl.md | 7 ++++---
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 164b72a..7924db7 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -346,10 +346,9 @@ structure FrontendProcess where
-- One of these two must be supplied: Either supply the file name or the content.
fileName?: Option String := .none
file?: Option String := .none
- -- If set to true, read the header (otherwise discards the header)
+ -- Whether to read the header
readHeader : Bool := false
- -- If set to true, Pantograph's environment will be altered to whatever is
- -- after the compilation units.
+ -- Alter the REPL environment after the compilation units.
inheritEnv : Bool := false
-- collect tactic invocations
invocations: Bool := false
diff --git a/doc/repl.md b/doc/repl.md
index a86c01b..93eb6ab 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -46,14 +46,15 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
Save/Load a goal state to/from a file. The environment is not carried with the
state. The user is responsible to ensure the sender/receiver instances share
the same environment.
-* `frontend.process { ["fileName": <fileName>,] ["file": <str>], invocations:
+* `frontend.process { ["fileName": <fileName>,] ["file": <str>], readHeader: <bool>, inheritEnv: <bool>, invocations:
<bool>, sorrys: <bool>, typeErrorsAsGoals: <bool>, newConstants: <bool> }`:
Executes the Lean frontend on a file, collecting the tactic invocations
(`"invocations": true`), the sorrys and type errors into goal states
(`"sorrys": true`), and new constants (`"newConstants": true`). In the case of
`sorrys`, this command additionally outputs the position of each captured
- `sorry`. Warning: Behaviour is unstable in case of multiple `sorry`s. Use the
- draft tactic if possible.
+ `sorry`. Conditionally inherit the environment from executing the file.
+ Warning: Behaviour is unstable in case of multiple `sorry`s. Use the draft
+ tactic if possible.
## Errors
From dc29d48b774cc32c3f67219746a6b4539348c700 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 09:31:39 -0700
Subject: [PATCH 440/465] chore: Remove IO.println for trace
---
Pantograph/Delate.lean | 18 +++++++++---------
Pantograph/Frontend/MetaTranslate.lean | 9 ++++++---
2 files changed, 15 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 44c09a9..2fff009 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -119,11 +119,11 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
if args.size < fvars.size then
throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments Begin"
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments Begin"
let args ← args.mapM self
- --if !args.isEmpty then
- --IO.println s!"{padding}├── Arguments End"
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments End"
if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
trace[Pantograph.Delate] "T1"
let result := mkAppN f args
@@ -141,18 +141,18 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
else
assert! !(← mvarId.isAssigned)
assert! !(← mvarId.isDelayedAssigned)
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments Begin"
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments Begin"
let args ← args.mapM self
- --if !args.isEmpty then
- -- IO.println s!"{padding}├── Arguments End"
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments End"
trace[Pantograph.Delate] "M ?{mvarId.name}"
return .done (mkAppN f args))
trace[Pantoraph.Delate] "Result {result}"
return result
where
- self e := instantiateDelayedMVars e --(level := level + 1)
+ self e := instantiateDelayedMVars e
/--
Convert an expression to an equiavlent form with
diff --git a/Pantograph/Frontend/MetaTranslate.lean b/Pantograph/Frontend/MetaTranslate.lean
index c6592d2..8067d17 100644
--- a/Pantograph/Frontend/MetaTranslate.lean
+++ b/Pantograph/Frontend/MetaTranslate.lean
@@ -62,7 +62,7 @@ private partial def translateExpr (srcExpr: Expr) : MetaTranslateM Expr := do
let sourceMCtx ← getSourceMCtx
-- We want to create as few mvars as possible
let (srcExpr, _) := instantiateMVarsCore (mctx := sourceMCtx) srcExpr
- --IO.println s!"Transform src: {srcExpr}"
+ trace[Pantograph.Frontend.MetaTranslate] "Transform src: {srcExpr}"
let result ← Core.transform srcExpr λ e => do
let state ← get
match e with
@@ -100,10 +100,10 @@ partial def translateLocalDecl (srcLocalDecl: LocalDecl) : MetaTranslateM LocalD
addTranslatedFVar srcLocalDecl.fvarId fvarId
match srcLocalDecl with
| .cdecl index _ userName type bi kind => do
- --IO.println s!"[CD] {userName} {toString type}"
+ trace[Pantograph.Frontend.MetaTranslate] "[CD] {userName} {toString type}"
return .cdecl index fvarId userName (← translateExpr type) bi kind
| .ldecl index _ userName type value nonDep kind => do
- --IO.println s!"[LD] {toString type} := {toString value}"
+ trace[Pantograph.Frontend.MetaTranslate] "[LD] {toString type} := {toString value}"
return .ldecl index fvarId userName (← translateExpr type) (← translateExpr value) nonDep kind
partial def translateLCtx : MetaTranslateM LocalContext := do
@@ -162,4 +162,7 @@ end MetaTranslate
export MetaTranslate (MetaTranslateM)
+initialize
+ registerTraceClass `Pantograph.Frontend.MetaTranslate
+
end Pantograph.Frontend
From a28ad9b239553ed9cd9d776daf14ef8e10f5954d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 10:47:11 -0700
Subject: [PATCH 441/465] feat(delate): Expand matcher applications
---
Pantograph/Delate.lean | 9 ++++++++-
Test/Common.lean | 4 ++--
Test/Delate.lean | 13 ++++++++++---
3 files changed, 20 insertions(+), 6 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 2fff009..1a4af5d 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -66,7 +66,7 @@ def exprProjToApp (env: Environment) (e: Expr): Expr :=
def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _ "_auxLemma") _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
-@[export pantograph_unfold_aux_lemmas]
+@[export pantograph_unfold_aux_lemmas_m]
def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
@@ -164,6 +164,13 @@ Convert an expression to an equiavlent form with
def instantiateAll (e: Expr): MetaM Expr := do
let e ← instantiateDelayedMVars e
let e ← unfoldAuxLemmas e
+ let e ← Core.transform e λ e' => do
+ match ← Meta.matchMatcherApp? e' with
+ | .none => return .continue e'
+ | .some mapp =>
+ let .some matcherInfo := (← getEnv).find? mapp.matcherName | panic! "Matcher must exist"
+ let f ← Meta.instantiateValueLevelParams matcherInfo mapp.matcherLevels.toList
+ return .visit (f.betaRev e'.getAppRevArgs (useZeta := true))
return e
structure DelayedMVarInvocation where
diff --git a/Test/Common.lean b/Test/Common.lean
index 5274bad..c32d62d 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -108,7 +108,7 @@ def strToTermSyntax (s: String): CoreM Syntax := do
(input := s)
(fileName := ← getFileName) | panic! s!"Failed to parse {s}"
return stx
-def parseSentence (s: String): Elab.TermElabM Expr := do
+def parseSentence (s : String) (expectedType? : Option Expr := .none) : Elab.TermElabM Expr := do
let stx ← match Parser.runParserCategory
(env := ← MonadEnv.getEnv)
(catName := `term)
@@ -116,7 +116,7 @@ def parseSentence (s: String): Elab.TermElabM Expr := do
(fileName := ← getFileName) with
| .ok syn => pure syn
| .error error => throwError "Failed to parse: {error}"
- Elab.Term.elabTerm (stx := stx) .none
+ Elab.Term.elabTerm (stx := stx) expectedType?
def runTacticOnMVar (tacticM: Elab.Tactic.TacticM Unit) (goal: MVarId): Elab.TermElabM (List MVarId) := do
let (_, newGoals) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
diff --git a/Test/Delate.lean b/Test/Delate.lean
index 517a394..7c5eec3 100644
--- a/Test/Delate.lean
+++ b/Test/Delate.lean
@@ -3,10 +3,9 @@ import Pantograph.Delate
import Test.Common
import Lean
-open Lean
-namespace Pantograph.Test.Delate
+open Lean Pantograph
-open Pantograph
+namespace Pantograph.Test.Delate
deriving instance Repr, DecidableEq for Protocol.BoundExpression
@@ -113,6 +112,13 @@ def test_projection_exists (env: Environment) : IO LSpec.TestSeq:= runTest do
checkEq "numParams" numParams 2
checkEq "numFields" numFields 2
+def test_matcher : TestT Elab.TermElabM Unit := do
+ let t ← parseSentence "Nat → Nat"
+ let e ← parseSentence "fun (n : Nat) => match n with | 0 => 0 | k => k" (.some t)
+ let .some _ ← Meta.matchMatcherApp? e.bindingBody! | fail "Must be a matcher app"
+ let e' ← instantiateAll e
+ checkTrue "ok" <| ← Meta.isTypeCorrect e'
+
def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
[
("serializeName", do pure test_serializeName),
@@ -123,6 +129,7 @@ def suite (env: Environment): List (String × IO LSpec.TestSeq) :=
("Instance", test_instance env),
("Projection Prod", test_projection_prod env),
("Projection Exists", test_projection_exists env),
+ ("Matcher", runTestTermElabM env test_matcher),
]
end Pantograph.Test.Delate
From 3b4b196a302c3c74c0ebabea0435fa8e1e602950 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 11:20:38 -0700
Subject: [PATCH 442/465] feat(delate): Add mdata annotation for matcher
---
Pantograph/Delate.lean | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 1a4af5d..5060d25 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -170,7 +170,8 @@ def instantiateAll (e: Expr): MetaM Expr := do
| .some mapp =>
let .some matcherInfo := (← getEnv).find? mapp.matcherName | panic! "Matcher must exist"
let f ← Meta.instantiateValueLevelParams matcherInfo mapp.matcherLevels.toList
- return .visit (f.betaRev e'.getAppRevArgs (useZeta := true))
+ let mdata := KVMap.empty.insert `matcher (DataValue.ofName mapp.matcherName)
+ return .visit $ .mdata mdata (f.betaRev e'.getAppRevArgs (useZeta := true))
return e
structure DelayedMVarInvocation where
From 4643992c3bb18b4a96b1cf755b709123b6137f63 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 11:26:13 -0700
Subject: [PATCH 443/465] refactor(delate): Unfold matchers into function
---
Pantograph/Delate.lean | 32 +++++++++++++++++---------------
1 file changed, 17 insertions(+), 15 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 5060d25..3ef2c35 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -67,8 +67,17 @@ def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
@[export pantograph_unfold_aux_lemmas_m]
-def unfoldAuxLemmas (e : Expr) : CoreM Expr := do
- Lean.Meta.deltaExpand e Lean.Name.isAuxLemma
+def unfoldAuxLemmas : Expr → CoreM Expr :=
+ (Lean.Meta.deltaExpand · Lean.Name.isAuxLemma)
+/-- Unfold all matcher applications -/
+@[export pantograph_unfold_matchers_m]
+def unfoldMatchers (expr : Expr) : CoreM Expr :=
+ Core.transform expr λ e' => do
+ let .some mapp ← Meta.matchMatcherApp? e' | return .continue e'
+ let .some matcherInfo := (← getEnv).find? mapp.matcherName | panic! "Matcher must exist"
+ let f ← Meta.instantiateValueLevelParams matcherInfo mapp.matcherLevels.toList
+ let mdata := KVMap.empty.insert `matcher (DataValue.ofName mapp.matcherName)
+ return .visit $ .mdata mdata (f.betaRev e'.getAppRevArgs (useZeta := true))
/--
Force the instantiation of delayed metavariables even if they cannot be fully
@@ -157,28 +166,21 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
/--
Convert an expression to an equiavlent form with
1. No nested delayed assigned mvars
-2. No aux lemmas
+2. No aux lemmas or matchers
3. No assigned mvars
-/
@[export pantograph_instantiate_all_m]
-def instantiateAll (e: Expr): MetaM Expr := do
+def instantiateAll (e : Expr) : MetaM Expr := do
let e ← instantiateDelayedMVars e
let e ← unfoldAuxLemmas e
- let e ← Core.transform e λ e' => do
- match ← Meta.matchMatcherApp? e' with
- | .none => return .continue e'
- | .some mapp =>
- let .some matcherInfo := (← getEnv).find? mapp.matcherName | panic! "Matcher must exist"
- let f ← Meta.instantiateValueLevelParams matcherInfo mapp.matcherLevels.toList
- let mdata := KVMap.empty.insert `matcher (DataValue.ofName mapp.matcherName)
- return .visit $ .mdata mdata (f.betaRev e'.getAppRevArgs (useZeta := true))
+ let e ← unfoldMatchers e
return e
structure DelayedMVarInvocation where
- mvarIdPending: MVarId
- args: Array (FVarId × (Option Expr))
+ mvarIdPending : MVarId
+ args : Array (FVarId × (Option Expr))
-- Extra arguments applied to the result of this substitution
- tail: Array Expr
+ tail : Array Expr
-- The pending mvar of any delayed assigned mvar must not be assigned in any way.
@[export pantograph_to_delayed_mvar_invocation_m]
From 678cc9b3c0d7dc759791b6934a4d8c0df859aa26 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 11:30:24 -0700
Subject: [PATCH 444/465] chore: Code cleanup
---
Pantograph/Delate.lean | 19 +++++++++----------
1 file changed, 9 insertions(+), 10 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 3ef2c35..6e47799 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -37,7 +37,7 @@ def analyzeProjection (env: Environment) (e: Expr): Projection :=
def anonymousLevel : Level := .mvar ⟨.anonymous⟩
@[export pantograph_expr_proj_to_app]
-def exprProjToApp (env: Environment) (e: Expr): Expr :=
+def exprProjToApp (env : Environment) (e : Expr) : Expr :=
let anon : Expr := .mvar ⟨.anonymous⟩
match analyzeProjection env e with
| .field projector numParams =>
@@ -72,12 +72,12 @@ def unfoldAuxLemmas : Expr → CoreM Expr :=
/-- Unfold all matcher applications -/
@[export pantograph_unfold_matchers_m]
def unfoldMatchers (expr : Expr) : CoreM Expr :=
- Core.transform expr λ e' => do
- let .some mapp ← Meta.matchMatcherApp? e' | return .continue e'
+ Core.transform expr λ e => do
+ let .some mapp ← Meta.matchMatcherApp? e | return .continue e
let .some matcherInfo := (← getEnv).find? mapp.matcherName | panic! "Matcher must exist"
let f ← Meta.instantiateValueLevelParams matcherInfo mapp.matcherLevels.toList
let mdata := KVMap.empty.insert `matcher (DataValue.ofName mapp.matcherName)
- return .visit $ .mdata mdata (f.betaRev e'.getAppRevArgs (useZeta := true))
+ return .visit $ .mdata mdata (f.betaRev e.getAppRevArgs (useZeta := true))
/--
Force the instantiation of delayed metavariables even if they cannot be fully
@@ -94,10 +94,9 @@ This function ensures any metavariable in the result is either
1. Delayed assigned with its pending mvar not assigned in any form
2. Not assigned (delay or not)
-/
-partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
- --let padding := String.join $ List.replicate level "│ "
- withTraceNode `Pantograph.Delate (λ _ex => return m!":= {← Meta.ppExpr eOrig}") do
- let mut result ← Meta.transform (← instantiateMVars eOrig)
+partial def instantiateDelayedMVars (expr : Expr) : MetaM Expr :=
+ withTraceNode `Pantograph.Delate (λ _ex => return m!":= {← Meta.ppExpr expr}") do
+ let mut result ← Meta.transform (← instantiateMVars expr)
(pre := fun e => e.withApp fun f args => do
let .mvar mvarId := f | return .continue
trace[Pantograph.Delate] "V {e}"
@@ -127,7 +126,7 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
trace[Pantograph.Delate]"MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
if args.size < fvars.size then
- throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString eOrig}"
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString expr}"
if !args.isEmpty then
trace[Pantograph.Delate] "─ Arguments Begin"
let args ← args.mapM self
@@ -139,7 +138,7 @@ partial def instantiateDelayedMVars (eOrig: Expr) : MetaM Expr :=
return .done result
let pending ← mvarIdPending.withContext do
- let inner ← instantiateDelayedMVars (.mvar mvarIdPending) --(level := level + 1)
+ let inner ← instantiateDelayedMVars (.mvar mvarIdPending)
trace[Pantograph.Delate] "Pre: {inner}"
pure <| (← inner.abstractM fvars).instantiateRev args
From cb1082c7c7eea7d117fd17940a4f172278372280 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 17 Mar 2025 12:14:16 -0700
Subject: [PATCH 445/465] chore: More code cleanup
---
Pantograph/Delate.lean | 110 ++++++++++++++++++++---------------------
1 file changed, 55 insertions(+), 55 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index 6e47799..efb1008 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -68,7 +68,7 @@ def _root_.Lean.Name.isAuxLemma (n : Lean.Name) : Bool := n matches .num (.str _
/-- Unfold all lemmas created by `Lean.Meta.mkAuxLemma`. These end in `_auxLemma.nn` where `nn` is a number. -/
@[export pantograph_unfold_aux_lemmas_m]
def unfoldAuxLemmas : Expr → CoreM Expr :=
- (Lean.Meta.deltaExpand · Lean.Name.isAuxLemma)
+ (Meta.deltaExpand · Lean.Name.isAuxLemma)
/-- Unfold all matcher applications -/
@[export pantograph_unfold_matchers_m]
def unfoldMatchers (expr : Expr) : CoreM Expr :=
@@ -97,66 +97,66 @@ This function ensures any metavariable in the result is either
partial def instantiateDelayedMVars (expr : Expr) : MetaM Expr :=
withTraceNode `Pantograph.Delate (λ _ex => return m!":= {← Meta.ppExpr expr}") do
let mut result ← Meta.transform (← instantiateMVars expr)
- (pre := fun e => e.withApp fun f args => do
- let .mvar mvarId := f | return .continue
- trace[Pantograph.Delate] "V {e}"
- let mvarDecl ← mvarId.getDecl
+ λ e => e.withApp fun f args => do
+ let .mvar mvarId := f | return .continue
+ trace[Pantograph.Delate] "V {e}"
+ let mvarDecl ← mvarId.getDecl
- -- This is critical to maintaining the interdependency of metavariables.
- -- Without setting `.syntheticOpaque`, Lean's metavariable elimination
- -- system will not make the necessary delayed assigned mvars in case of
- -- nested mvars.
- mvarId.setKind .syntheticOpaque
+ -- This is critical to maintaining the interdependency of metavariables.
+ -- Without setting `.syntheticOpaque`, Lean's metavariable elimination
+ -- system will not make the necessary delayed assigned mvars in case of
+ -- nested mvars.
+ mvarId.setKind .syntheticOpaque
- mvarId.withContext do
- let lctx ← MonadLCtx.getLCtx
- if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
- let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
- | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
- | .none => acc) []
- panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
+ mvarId.withContext do
+ let lctx ← MonadLCtx.getLCtx
+ if mvarDecl.lctx.any (λ decl => !lctx.contains decl.fvarId) then
+ let violations := mvarDecl.lctx.decls.foldl (λ acc decl? => match decl? with
+ | .some decl => if lctx.contains decl.fvarId then acc else acc ++ [decl.fvarId.name]
+ | .none => acc) []
+ panic! s!"In the context of {mvarId.name}, there are local context variable violations: {violations}"
- if let .some assign ← getExprMVarAssignment? mvarId then
- trace[Pantograph.Delate] "A ?{mvarId.name}"
- assert! !(← mvarId.isDelayedAssigned)
- return .visit (mkAppN assign args)
- else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
- if ← isTracingEnabledFor `Pantograph.Delate then
- let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
- trace[Pantograph.Delate]"MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
+ if let .some assign ← getExprMVarAssignment? mvarId then
+ trace[Pantograph.Delate] "A ?{mvarId.name}"
+ assert! !(← mvarId.isDelayedAssigned)
+ return .visit (mkAppN assign args)
+ else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
+ if ← isTracingEnabledFor `Pantograph.Delate then
+ let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ trace[Pantograph.Delate]"MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
- if args.size < fvars.size then
- throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString expr}"
- if !args.isEmpty then
- trace[Pantograph.Delate] "─ Arguments Begin"
- let args ← args.mapM self
- if !args.isEmpty then
- trace[Pantograph.Delate] "─ Arguments End"
- if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
- trace[Pantograph.Delate] "T1"
- let result := mkAppN f args
- return .done result
-
- let pending ← mvarIdPending.withContext do
- let inner ← instantiateDelayedMVars (.mvar mvarIdPending)
- trace[Pantograph.Delate] "Pre: {inner}"
- pure <| (← inner.abstractM fvars).instantiateRev args
-
- -- Tail arguments
- let result := mkAppRange pending fvars.size args.size args
- trace[Pantograph.Delate] "MD {result}"
+ if args.size < fvars.size then
+ throwError "Not enough arguments to instantiate a delay assigned mvar. This is due to bad implementations of a tactic: {args.size} < {fvars.size}. Expr: {toString e}; Origin: {toString expr}"
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments Begin"
+ let args ← args.mapM self
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments End"
+ if !(← mvarIdPending.isAssignedOrDelayedAssigned) then
+ trace[Pantograph.Delate] "T1"
+ let result := mkAppN f args
return .done result
- else
- assert! !(← mvarId.isAssigned)
- assert! !(← mvarId.isDelayedAssigned)
- if !args.isEmpty then
- trace[Pantograph.Delate] "─ Arguments Begin"
- let args ← args.mapM self
- if !args.isEmpty then
- trace[Pantograph.Delate] "─ Arguments End"
- trace[Pantograph.Delate] "M ?{mvarId.name}"
- return .done (mkAppN f args))
+ let pending ← mvarIdPending.withContext do
+ let inner ← instantiateDelayedMVars (.mvar mvarIdPending)
+ trace[Pantograph.Delate] "Pre: {inner}"
+ pure <| (← inner.abstractM fvars).instantiateRev args
+
+ -- Tail arguments
+ let result := mkAppRange pending fvars.size args.size args
+ trace[Pantograph.Delate] "MD {result}"
+ return .done result
+ else
+ assert! !(← mvarId.isAssigned)
+ assert! !(← mvarId.isDelayedAssigned)
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments Begin"
+ let args ← args.mapM self
+ if !args.isEmpty then
+ trace[Pantograph.Delate] "─ Arguments End"
+
+ trace[Pantograph.Delate] "M ?{mvarId.name}"
+ return .done (mkAppN f args)
trace[Pantoraph.Delate] "Result {result}"
return result
where
From 3e55b4b22fc3e8218d5a33f5de05c18113633e43 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 24 Mar 2025 17:47:56 -0700
Subject: [PATCH 446/465] feat(repl): Record last scope
---
Repl.lean | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/Repl.lean b/Repl.lean
index e571397..a6b8db6 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -13,6 +13,9 @@ structure State where
nextId: Nat := 0
goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
+ -- Parser state
+ scope : Elab.Command.Scope := { header := "" }
+
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context $ StateRefT State CoreM
/-- Fallible subroutine return type -/
@@ -85,6 +88,9 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
let (li, state') ← frontendM.run context |>.run state
if args.inheritEnv then
setEnv state'.commandState.env
+ if let .some scope := state'.commandState.scopes.head? then
+ -- modify the scope
+ set { (← get) with scope }
let units ← li.mapM λ step => withEnv step.env do
let newConstants? := if args.newConstants then
.some $ step.newConstants.toArray.map λ name => name.toString
From d305918bb944fef285864ab8df3d863c13f3d287 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 24 Mar 2025 17:57:34 -0700
Subject: [PATCH 447/465] chore: Update Lean to v4.17.0
---
Pantograph/Delate.lean | 3 ++-
Pantograph/Environment.lean | 11 ++---------
Pantograph/Version.lean | 2 +-
Test/Serial.lean | 8 ++------
lean-toolchain | 2 +-
5 files changed, 8 insertions(+), 18 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index efb1008..b6e016c 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -122,7 +122,8 @@ partial def instantiateDelayedMVars (expr : Expr) : MetaM Expr :=
return .visit (mkAppN assign args)
else if let some { fvars, mvarIdPending } ← getDelayedMVarAssignment? mvarId then
if ← isTracingEnabledFor `Pantograph.Delate then
- let substTableStr := String.intercalate ", " $ Array.zipWith fvars args (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") |>.toList
+ let substTableStr := ",".intercalate $
+ Array.zipWith (λ fvar assign => s!"{fvar.fvarId!.name} := {assign}") fvars args |>.toList
trace[Pantograph.Delate]"MD ?{mvarId.name} := ?{mvarIdPending.name} [{substTableStr}]"
if args.size < fvars.size then
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index aa4dd03..8e552a3 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -91,7 +91,6 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
isUnsafe := info.isUnsafe,
value? := ← value?.mapM (λ v => serializeExpression 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 <| type.getUsedConstants.map (λ n => serializeName n)
else .none,
@@ -169,7 +168,7 @@ def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) :
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
+ let decl := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
(name := args.name.toName)
(levelParams := [])
(type := type)
@@ -177,13 +176,7 @@ def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) :
(hints := Lean.mkReducibilityHintsRegularEx 1)
(safety := Lean.DefinitionSafety.safe)
(all := [])
- let env' ← match env.addDecl (← getOptions) 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')
+ Lean.addDecl decl
return .ok {}
end Pantograph.Environment
diff --git a/Pantograph/Version.lean b/Pantograph/Version.lean
index a65274d..845d83f 100644
--- a/Pantograph/Version.lean
+++ b/Pantograph/Version.lean
@@ -1,6 +1,6 @@
namespace Pantograph
@[export pantograph_version]
-def version := "0.3.0-rc.1"
+def version := "0.3.0"
end Pantograph
diff --git a/Test/Serial.lean b/Test/Serial.lean
index fcdc155..bd22d72 100644
--- a/Test/Serial.lean
+++ b/Test/Serial.lean
@@ -47,12 +47,8 @@ def test_environment_pickling : TestM Unit := do
(hints := Lean.mkReducibilityHintsRegularEx 1)
(safety := Lean.DefinitionSafety.safe)
(all := [])
- let env' ← match (← getEnv).addDecl (← getOptions) c with
- | .error e => do
- let error ← (e.toMessageData (← getOptions)).toString
- throwError error
- | .ok env' => pure env'
- environmentPickle env' envPicklePath
+ addDecl c
+ environmentPickle (← getEnv) envPicklePath
let _ ← runCoreM coreDst do
let (env', _) ← environmentUnpickle envPicklePath
diff --git a/lean-toolchain b/lean-toolchain
index 2586f88..5499a24 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.16.0
+leanprover/lean4:v4.17.0
From ebf514b92b3fbe083d715b6c36c5fe98f8236068 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 24 Mar 2025 18:04:34 -0700
Subject: [PATCH 448/465] chore: Update nix flake
---
flake.lock | 33 ++++++++++++++++++---------------
1 file changed, 18 insertions(+), 15 deletions(-)
diff --git a/flake.lock b/flake.lock
index 2b9a841..11c740e 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1738453229,
- "narHash": "sha256-7H9XgNiGLKN1G1CgRh0vUL4AheZSYzPm+zmZ7vxbJdo=",
+ "lastModified": 1741352980,
+ "narHash": "sha256-+u2UunDA4Cl5Fci3m7S643HzKmIDAe+fiXrLqYsR2fs=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "32ea77a06711b758da0ad9bd6a844c5740a87abd",
+ "rev": "f4330d22f1c5d2ba72d3d22df5597d123fdb60a9",
"type": "github"
},
"original": {
@@ -44,11 +44,11 @@
]
},
"locked": {
- "lastModified": 1739073990,
- "narHash": "sha256-VmLkZf4+1HWrIDB/JUlPOAmOlutR6XTFRhDzDYJcYZM=",
+ "lastModified": 1741472588,
+ "narHash": "sha256-XnMeMZKuspEphP+fEq4soc3PY7Nz+gsMPjlsXbobyrA=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "7a6faedc6c3ab35c42add15c354bf69542b9a6e6",
+ "rev": "cffeb67d58e02b50ccb9acd51b0212dc653ed6ce",
"type": "github"
},
"original": {
@@ -59,11 +59,11 @@
},
"nixpkgs": {
"locked": {
- "lastModified": 1741332913,
- "narHash": "sha256-ri1e8ZliWS3Jnp9yqpKApHaOo7KBN33W8ECAKA4teAQ=",
+ "lastModified": 1742751704,
+ "narHash": "sha256-rBfc+H1dDBUQ2mgVITMGBPI1PGuCznf9rcWX/XIULyE=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "20755fa05115c84be00b04690630cb38f0a203ad",
+ "rev": "f0946fa5f1fb876a9dc2e1850d9d3a4e3f914092",
"type": "github"
},
"original": {
@@ -75,14 +75,17 @@
},
"nixpkgs-lib": {
"locked": {
- "lastModified": 1738452942,
- "narHash": "sha256-vJzFZGaCpnmo7I6i416HaBLpC+hvcURh/BQwROcGIp8=",
- "type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/072a6db25e947df2f31aab9eccd0ab75d5b2da11.tar.gz"
+ "lastModified": 1740877520,
+ "narHash": "sha256-oiwv/ZK/2FhGxrCkQkB83i7GnWXPPLzoqFHpDD3uYpk=",
+ "owner": "nix-community",
+ "repo": "nixpkgs.lib",
+ "rev": "147dee35aab2193b174e4c0868bd80ead5ce755c",
+ "type": "github"
},
"original": {
- "type": "tarball",
- "url": "https://github.com/NixOS/nixpkgs/archive/072a6db25e947df2f31aab9eccd0ab75d5b2da11.tar.gz"
+ "owner": "nix-community",
+ "repo": "nixpkgs.lib",
+ "type": "github"
}
},
"nixpkgs-lib_2": {
From c2b75016492842e23d3e4877ba2e4e4d94b766a9 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 00:50:39 -0700
Subject: [PATCH 449/465] refactor: Remove `CoreM` from `MainM`
---
Pantograph/Goal.lean | 16 +++-
Repl.lean | 163 +++++++++++++++++++++-----------------
Test/Integration.lean | 23 +++---
Test/Tactic/Prograde.lean | 2 +-
4 files changed, 113 insertions(+), 91 deletions(-)
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 43f3e85..9af1740 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -85,12 +85,19 @@ protected def GoalState.withRootContext { n } [MonadControlT MetaM n] [Monad n]
private def GoalState.mvars (state: GoalState): SSet MVarId :=
state.mctx.decls.foldl (init := .empty) fun acc k _ => acc.insert k
-protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit :=
+-- Restore the name generator and macro scopes of the core state
+protected def GoalState.restoreCoreMExtra (state: GoalState): CoreM Unit := do
+ let savedCore := state.coreState
+ modifyGetThe Core.State (fun st => ((),
+ { st with nextMacroScope := savedCore.nextMacroScope, ngen := savedCore.ngen }))
+protected def GoalState.restoreMetaM (state: GoalState): MetaM Unit := do
+ state.restoreCoreMExtra
state.savedState.term.meta.restore
-protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit :=
+protected def GoalState.restoreElabM (state: GoalState): Elab.TermElabM Unit := do
+ state.restoreCoreMExtra
state.savedState.term.restore
private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tactic.TacticM Unit := do
- state.savedState.restore
+ state.restoreElabM
Elab.Tactic.setGoals [goal]
@[export pantograph_goal_state_focus]
@@ -215,7 +222,7 @@ protected def GoalState.step (state: GoalState) (goal: MVarId) (tacticM: Elab.Ta
goal.checkNotAssigned `GoalState.step
let (_, { goals }) ← tacticM { elaborator := .anonymous } |>.run { goals := [goal] }
let nextElabState ← MonadBacktrack.saveState
- Elab.Term.synthesizeSyntheticMVarsNoPostponing
+ --Elab.Term.synthesizeSyntheticMVarsNoPostponing
let goals ← if guardMVarErrors then
pure $ mergeMVarLists goals (← collectAllErroredMVars goal)
@@ -280,6 +287,7 @@ protected def GoalState.tryTactic (state: GoalState) (goal: MVarId) (tactic: Str
(fileName := ← getFileName) with
| .ok stx => pure $ stx
| .error error => return .parseError error
+ assert! ¬ (← goal.isAssigned)
state.tryTacticM goal (Elab.Tactic.evalTactic tactic) true
protected def GoalState.tryAssign (state: GoalState) (goal: MVarId) (expr: String):
diff --git a/Repl.lean b/Repl.lean
index a6b8db6..310b9bf 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -6,21 +6,28 @@ namespace Pantograph.Repl
open Lean
structure Context where
+ coreContext : Core.Context
/-- Stores state of the REPL -/
structure State where
- options: Protocol.Options := {}
- nextId: Nat := 0
- goalStates: Std.HashMap Nat GoalState := Std.HashMap.empty
+ options : Protocol.Options := {}
+ nextId : Nat := 0
+ goalStates : Std.HashMap Nat GoalState := Std.HashMap.empty
+ env : Environment
-- Parser state
scope : Elab.Command.Scope := { header := "" }
/-- Main state monad for executing commands -/
-abbrev MainM := ReaderT Context $ StateRefT State CoreM
+abbrev MainM := ReaderT Context $ StateRefT State IO
+def getMainState : MainM State := get
/-- Fallible subroutine return type -/
abbrev CR α := Except Protocol.InteractionError α
+instance : MonadEnv MainM where
+ getEnv := return (← get).env
+ modifyEnv f := modify fun s => { s with env := f s.env }
+
def newGoalState (goalState: GoalState) : MainM Nat := do
let state ← get
let stateId := state.nextId
@@ -30,11 +37,25 @@ def newGoalState (goalState: GoalState) : MainM Nat := do
}
return stateId
+def runCoreM { α } (coreM : CoreM α) : MainM α := do
+ let scope := (← get).scope
+ let coreCtx : Core.Context := {
+ (← read).coreContext with
+ currNamespace := scope.currNamespace
+ openDecls := scope.openDecls
+ options := scope.opts
+ }
+ let coreState : Core.State := {
+ env := (← get).env
+ }
+ let (result, state') ← coreM.toIO coreCtx coreState
+ modifyEnv λ _ => state'.env
+ return result
-def runMetaInMainM { α } (metaM: MetaM α): MainM α :=
- metaM.run'
-def runTermElabInMainM { α } (termElabM: Elab.TermElabM α) : MainM α :=
- termElabM.run' (ctx := defaultElabContext) |>.run'
+def liftMetaM { α } (metaM : MetaM α): MainM α :=
+ runCoreM metaM.run'
+def liftTermElabM { α } (termElabM: Elab.TermElabM α) : MainM α :=
+ runCoreM $ termElabM.run' (ctx := defaultElabContext) |>.run'
section Frontend
@@ -48,7 +69,7 @@ structure CompilationUnit where
newConstants : List Name
def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
- let options := (← get).options
+ let options := (← getMainState).options
let (fileName, file) ← match args.fileName?, args.file? with
| .some fileName, .none => do
let file ← IO.FS.readFile fileName
@@ -90,7 +111,7 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
setEnv state'.commandState.env
if let .some scope := state'.commandState.scopes.head? then
-- modify the scope
- set { (← get) with scope }
+ set { ← getMainState with scope }
let units ← li.mapM λ step => withEnv step.env do
let newConstants? := if args.newConstants then
.some $ step.newConstants.toArray.map λ name => name.toString
@@ -99,9 +120,11 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
let (goalStateId?, goals?, goalSrcBoundaries?) ← if step.sorrys.isEmpty then do
pure (.none, .none, .none)
else do
- let { state, srcBoundaries } ← runMetaInMainM $ Frontend.sorrysToGoalState step.sorrys
+ let ({ state, srcBoundaries }, goals) ← liftMetaM do
+ let result@{state, .. } ← Frontend.sorrysToGoalState step.sorrys
+ let goals ← goalSerialize state options
+ pure (result, goals)
let stateId ← newGoalState state
- let goals ← goalSerialize state options
let srcBoundaries := srcBoundaries.toArray.map (λ (b, e) => (b.byteIdx, e.byteIdx))
pure (.some stateId, .some goals, .some srcBoundaries)
let invocations? := if args.invocations then .some step.invocations else .none
@@ -127,63 +150,58 @@ def execute (command: Protocol.Command): MainM Json := do
| .ok result => return toJson result
| .error ierror => return toJson ierror
| .error error => return toJson $ errorCommand s!"Unable to parse json: {error}"
- try
- match command.cmd with
- | "reset" => run reset
- | "stat" => run stat
- | "expr.echo" => run expr_echo
- | "env.describe" => run env_describe
- | "env.module_read" => run env_module_read
- | "env.catalog" => run env_catalog
- | "env.inspect" => run env_inspect
- | "env.add" => run env_add
- | "env.save" => run env_save
- | "env.load" => run env_load
- | "options.set" => run options_set
- | "options.print" => run options_print
- | "goal.start" => run goal_start
- | "goal.tactic" => run goal_tactic
- | "goal.continue" => run goal_continue
- | "goal.delete" => run goal_delete
- | "goal.print" => run goal_print
- | "goal.save" => run goal_save
- | "goal.load" => run goal_load
- | "frontend.process" => run frontend_process
- | cmd =>
- let error: Protocol.InteractionError :=
- errorCommand s!"Unknown command {cmd}"
- return toJson error
- catch ex => do
- let error ← ex.toMessageData.toString
- return toJson $ errorIO error
+ match command.cmd with
+ | "reset" => run reset
+ | "stat" => run stat
+ | "expr.echo" => run expr_echo
+ | "env.describe" => run env_describe
+ | "env.module_read" => run env_module_read
+ | "env.catalog" => run env_catalog
+ | "env.inspect" => run env_inspect
+ | "env.add" => run env_add
+ | "env.save" => run env_save
+ | "env.load" => run env_load
+ | "options.set" => run options_set
+ | "options.print" => run options_print
+ | "goal.start" => run goal_start
+ | "goal.tactic" => run goal_tactic
+ | "goal.continue" => run goal_continue
+ | "goal.delete" => run goal_delete
+ | "goal.print" => run goal_print
+ | "goal.save" => run goal_save
+ | "goal.load" => run goal_load
+ | "frontend.process" => run frontend_process
+ | cmd =>
+ let error: Protocol.InteractionError :=
+ errorCommand s!"Unknown command {cmd}"
+ return toJson error
where
errorCommand := errorI "command"
errorIndex := errorI "index"
errorIO := errorI "io"
-- Command Functions
reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
- let state ← get
+ let state ← getMainState
let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty }
- Core.resetMessageLog
return .ok { nGoals }
stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
- let state ← get
+ let state ← getMainState
let nGoals := state.goalStates.size
return .ok { nGoals }
env_describe (args: Protocol.EnvDescribe): MainM (CR Protocol.EnvDescribeResult) := do
- let result ← Environment.describe args
+ let result ← runCoreM $ Environment.describe args
return .ok result
env_module_read (args: Protocol.EnvModuleRead): MainM (CR Protocol.EnvModuleReadResult) := do
- Environment.moduleRead args
+ runCoreM $ Environment.moduleRead args
env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
- let result ← Environment.catalog args
+ let result ← runCoreM $ Environment.catalog args
return .ok result
env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
- let state ← get
- Environment.inspect args state.options
+ let state ← getMainState
+ runCoreM $ Environment.inspect args state.options
env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
- Environment.addDecl args
+ runCoreM $ Environment.addDecl args
env_save (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
let env ← MonadEnv.getEnv
environmentPickle env args.path
@@ -193,10 +211,10 @@ def execute (command: Protocol.Command): MainM Json := do
setEnv env
return .ok {}
expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
- let state ← get
- exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
+ let state ← getMainState
+ runCoreM $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
- let state ← get
+ let state ← getMainState
let options := state.options
set { state with
options := {
@@ -213,13 +231,12 @@ def execute (command: Protocol.Command): MainM Json := do
}
return .ok { }
options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
- return .ok (← get).options
+ return .ok (← getMainState).options
goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
- let env ← MonadEnv.getEnv
- let expr?: Except _ GoalState ← runTermElabInMainM (match args.expr, args.copyFrom with
+ let expr?: Except _ GoalState ← liftTermElabM (match args.expr, args.copyFrom with
| .some expr, .none => goalStartExpr expr (args.levels.getD #[])
- | .none, .some copyFrom =>
- (match env.find? <| copyFrom.toName with
+ | .none, .some copyFrom => do
+ (match (← getEnv).find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok (← GoalState.create cInfo.type))
| _, _ =>
@@ -230,12 +247,12 @@ def execute (command: Protocol.Command): MainM Json := do
let stateId ← newGoalState goalState
return .ok { stateId, root := goalState.root.name.toString }
goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
- let state ← get
+ let state ← getMainState
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
let .some goal := goalState.goals.get? args.goalId |
return .error $ errorIndex s!"Invalid goal index {args.goalId}"
- let nextGoalState?: Except _ TacticResult ← runTermElabInMainM do
+ let nextGoalState?: Except _ TacticResult ← liftTermElabM do
-- NOTE: Should probably use a macro to handle this...
match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv?, args.draft? with
| .some tactic, .none, .none, .none, .none, .none, .none => do
@@ -257,26 +274,26 @@ def execute (command: Protocol.Command): MainM Json := do
| .none, .none, .none, .none, .none, .none, .some draft => do
pure <| Except.ok <| ← goalState.tryDraft goal draft
| _, _, _, _, _, _, _ =>
- let error := errorI "arguments" "Exactly one of {tactic, expr, have, calc, conv} must be supplied"
- pure $ Except.error $ error
+ let error := errorI "arguments" "Exactly one of {tactic, expr, have, let, calc, conv, draft} must be supplied"
+ pure $ .error error
match nextGoalState? with
| .error error => return .error error
| .ok (.success nextGoalState) => do
let nextGoalState ← match state.options.automaticMode, args.conv? with
| true, .none => do
let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) |
- throwError "Resuming known goals"
+ return .error $ errorIO "Resuming known goals"
pure result
| true, .some true => pure nextGoalState
| true, .some false => do
let .some (_, _, dormantGoals) := goalState.convMVar? |
- throwError "If conv exit succeeded this should not fail"
+ return .error $ errorIO "If conv exit succeeded this should not fail"
let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) |
- throwError "Resuming known goals"
+ return .error $ errorIO "Resuming known goals"
pure result
| false, _ => pure nextGoalState
let nextStateId ← newGoalState nextGoalState
- let goals ← nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
+ let goals ← runCoreM $ nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
return .ok {
nextStateId? := .some nextStateId,
goals? := .some goals,
@@ -288,7 +305,7 @@ def execute (command: Protocol.Command): MainM Json := do
| .ok (.failure messages) =>
return .ok { tacticErrors? := .some messages }
goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
- let state ← get
+ let state ← getMainState
let .some target := state.goalStates[args.target]? |
return .error $ errorIndex s!"Invalid state index {args.target}"
let nextState? ← match args.branch?, args.goals? with
@@ -303,21 +320,21 @@ def execute (command: Protocol.Command): MainM Json := do
| .error error => return .error <| errorI "structure" error
| .ok nextGoalState =>
let nextStateId ← newGoalState nextGoalState
- let goals ← goalSerialize nextGoalState (options := state.options)
+ let goals ← liftMetaM $ goalSerialize nextGoalState (options := state.options)
return .ok {
nextStateId,
goals,
}
goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
- let state ← get
+ let state ← getMainState
let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
set { state with goalStates }
return .ok {}
goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
- let state ← get
+ let state ← getMainState
let .some goalState := state.goalStates[args.stateId]? |
return .error $ errorIndex s!"Invalid state index {args.stateId}"
- let result ← runMetaInMainM <| goalPrint
+ let result ← liftMetaM <| goalPrint
goalState
(rootExpr := args.rootExpr?.getD False)
(parentExpr := args.parentExpr?.getD False)
@@ -326,7 +343,7 @@ def execute (command: Protocol.Command): MainM Json := do
(options := state.options)
return .ok result
goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
- let state ← get
+ let state ← getMainState
let .some goalState := state.goalStates[args.id]? |
return .error $ errorIndex s!"Invalid state index {args.id}"
goalStatePickle goalState args.path
@@ -339,6 +356,6 @@ def execute (command: Protocol.Command): MainM Json := do
try
frontend_process_inner args
catch e =>
- return .error $ errorI "frontend" (← e.toMessageData.toString)
+ return .error $ errorI "frontend" e.toString
end Pantograph.Repl
diff --git a/Test/Integration.lean b/Test/Integration.lean
index fc2f80b..c5e6ace 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -13,7 +13,7 @@ def step { α } [Lean.ToJson α] (cmd: String) (payload: List (String × Lean.Js
let payload := Lean.Json.mkObj payload
let name := name?.getD s!"{cmd} {payload.compress}"
let result ← Repl.execute { cmd, payload }
- return LSpec.test name (toString result = toString (Lean.toJson expected))
+ return LSpec.test name (result.pretty = (Lean.toJson expected).pretty)
abbrev Test := List (MainM LSpec.TestSeq)
@@ -54,17 +54,18 @@ def test_malformed_command : Test :=
(name? := .some "JSON Deserialization")
]
def test_tactic : Test :=
+ let varX := { name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }}
let goal1: Protocol.Goal := {
name := "_uniq.11",
target := { pp? := .some "∀ (q : Prop), x ∨ q → q ∨ x" },
- vars := #[{ name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }}],
+ vars := #[varX],
}
let goal2: Protocol.Goal := {
- name := "_uniq.17",
+ name := "_uniq.14",
target := { pp? := .some "x ∨ y → y ∨ x" },
vars := #[
- { name := "_uniq.10", userName := "x", type? := .some { pp? := .some "Prop" }},
- { name := "_uniq.16", userName := "y", type? := .some { pp? := .some "Prop" }}
+ varX,
+ { name := "_uniq.13", userName := "y", type? := .some { pp? := .some "Prop" }}
],
}
[
@@ -236,16 +237,12 @@ def test_frontend_process_sorry : Test :=
}: Protocol.FrontendProcessResult),
]
-
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
-- Setup the environment for execution
- let context: Context := {}
- let commands: MainM LSpec.TestSeq :=
- steps.foldlM (λ suite step => do
- let result ← step
- return suite ++ result) LSpec.TestSeq.done
- runCoreMSeq env <| commands.run context |>.run' {}
-
+ let coreContext ← createCoreContext #[]
+ let mainM : MainM LSpec.TestSeq :=
+ steps.foldlM (λ suite step => do return suite ++ (← step)) LSpec.TestSeq.done
+ mainM.run { coreContext } |>.run' { env }
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
diff --git a/Test/Tactic/Prograde.lean b/Test/Tactic/Prograde.lean
index b3347cb..63bc525 100644
--- a/Test/Tactic/Prograde.lean
+++ b/Test/Tactic/Prograde.lean
@@ -87,7 +87,7 @@ def test_define_proof : TestT Elab.TermElabM Unit := do
{ userName := "q", type? := .some { pp? := .some "Prop" } },
{ userName := "h", type? := .some { pp? := .some "p" } },
{ userName := "y",
- type? := .some { pp? := .some "p ∨ ?m.25" },
+ type? := .some { pp? := .some "p ∨ ?m.19" },
value? := .some { pp? := .some "Or.inl h" },
}
]
From 8adab241577031000d25ee5e77909f5dd707baf5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 00:56:18 -0700
Subject: [PATCH 450/465] fix: Call sites in `Main.lean`
---
Main.lean | 7 +++----
1 file changed, 3 insertions(+), 4 deletions(-)
diff --git a/Main.lean b/Main.lean
index c4d30c6..4e3ae33 100644
--- a/Main.lean
+++ b/Main.lean
@@ -43,7 +43,7 @@ partial def loop : MainM Unit := do repeat do
| false => ret.compress
IO.println str
catch e =>
- let message ← e.toMessageData.toString
+ let message := e.toString
let error := Lean.toJson ({ error := "main", desc := message }: InteractionError)
IO.println error.compress
@@ -60,11 +60,10 @@ unsafe def main (args: List String): IO Unit := do
let (options, imports) := args.partition (·.startsWith "--")
let coreContext ← options.map (·.drop 2) |>.toArray |> Pantograph.createCoreContext
let coreState ← Pantograph.createCoreState imports.toArray
- let context: Context := {}
try
- let coreM := loop.run context |>.run' {}
+ let mainM := loop.run { coreContext } |>.run' { env := coreState.env }
IO.println "ready."
- discard <| coreM.toIO coreContext coreState
+ mainM
catch ex =>
let message := ex.toString
let error := Lean.toJson ({ error := "io", desc := message }: InteractionError)
From 9980fd9c399a7f31abbf9b5ed35059bcc7088256 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 18:45:58 -0700
Subject: [PATCH 451/465] test(repl): Environment loading from header
---
Pantograph/Protocol.lean | 20 +++---
Test/Integration.lean | 147 ++++++++++++++++++++++++---------------
2 files changed, 99 insertions(+), 68 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 7924db7..0742986 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -103,7 +103,7 @@ structure StatResult where
-- Return the type of an expression
structure ExprEcho where
expr: String
- type?: Option String
+ type?: Option String := .none
-- universe levels
levels: Option (Array String) := .none
deriving Lean.FromJson
@@ -217,14 +217,14 @@ structure EnvSaveLoadResult where
/-- Set options; See `Options` struct above for meanings -/
structure OptionsSet where
- printJsonPretty?: Option Bool
- printExprPretty?: Option Bool
- printExprAST?: Option Bool
- printDependentMVars?: Option Bool
- noRepeat?: Option Bool
- printAuxDecls?: Option Bool
- printImplementationDetailHyps?: Option Bool
- automaticMode?: Option Bool
+ printJsonPretty?: Option Bool := .none
+ printExprPretty?: Option Bool := .none
+ printExprAST?: Option Bool := .none
+ printDependentMVars?: Option Bool := .none
+ noRepeat?: Option Bool := .none
+ printAuxDecls?: Option Bool := .none
+ printImplementationDetailHyps?: Option Bool := .none
+ automaticMode?: Option Bool := .none
deriving Lean.FromJson
structure OptionsSetResult where
deriving Lean.ToJson
@@ -236,7 +236,7 @@ structure GoalStart where
expr: Option String -- Directly parse in an expression
-- universe levels
levels: Option (Array String) := .none
- copyFrom: Option String -- Copy the type from a theorem in the environment
+ copyFrom: Option String := .none -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure GoalStartResult where
stateId: Nat := 0
diff --git a/Test/Integration.lean b/Test/Integration.lean
index c5e6ace..9263fbe 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -8,23 +8,33 @@ import Test.Common
namespace Pantograph.Test.Integration
open Pantograph.Repl
-def step { α } [Lean.ToJson α] (cmd: String) (payload: List (String × Lean.Json))
- (expected: α) (name? : Option String := .none): MainM LSpec.TestSeq := do
- let payload := Lean.Json.mkObj payload
+deriving instance Lean.ToJson for Protocol.EnvInspect
+deriving instance Lean.ToJson for Protocol.EnvAdd
+deriving instance Lean.ToJson for Protocol.ExprEcho
+deriving instance Lean.ToJson for Protocol.OptionsSet
+deriving instance Lean.ToJson for Protocol.OptionsPrint
+deriving instance Lean.ToJson for Protocol.GoalStart
+deriving instance Lean.ToJson for Protocol.GoalPrint
+deriving instance Lean.ToJson for Protocol.GoalTactic
+deriving instance Lean.ToJson for Protocol.FrontendProcess
+
+def step { α β } [Lean.ToJson α] [Lean.ToJson β] (cmd: String) (payload: α)
+ (expected: β) (name? : Option String := .none): MainM LSpec.TestSeq := do
+ let payload := Lean.toJson payload
let name := name?.getD s!"{cmd} {payload.compress}"
let result ← Repl.execute { cmd, payload }
return LSpec.test name (result.pretty = (Lean.toJson expected).pretty)
abbrev Test := List (MainM LSpec.TestSeq)
-def test_elab : Test :=
+def test_expr_echo : Test :=
[
step "expr.echo"
- [("expr", .str "λ {α : Sort (u + 1)} => List α"), ("levels", .arr #["u"])]
- (Lean.toJson ({
+ ({ expr := "λ {α : Sort (u + 1)} => List α", levels := .some #["u"]}: Protocol.ExprEcho)
+ ({
type := { pp? := .some "{α : Type u} → Type u" },
expr := { pp? := .some "fun {α} => List α" }
- }: Protocol.ExprEchoResult)),
+ }: Protocol.ExprEchoResult),
]
def test_option_modify : Test :=
@@ -33,22 +43,22 @@ def test_option_modify : Test :=
let module? := Option.some "Init.Data.Nat.Basic"
let options: Protocol.Options := {}
[
- step "env.inspect" [("name", .str "Nat.add_one")]
+ step "env.inspect" ({ name := "Nat.add_one" } : Protocol.EnvInspect)
({ type := { pp? }, module? }: Protocol.EnvInspectResult),
- step "options.set" [("printExprAST", .bool true)]
+ step "options.set" ({ printExprAST? := .some true } : Protocol.OptionsSet)
({ }: Protocol.OptionsSetResult),
- step "env.inspect" [("name", .str "Nat.add_one")]
+ step "env.inspect" ({ name := "Nat.add_one" } : Protocol.EnvInspect)
({ type := { pp?, sexp? }, module? }: Protocol.EnvInspectResult),
- step "options.print" []
+ step "options.print" ({} : Protocol.OptionsPrint)
({ options with printExprAST := true }: Protocol.Options),
]
def test_malformed_command : Test :=
let invalid := "invalid"
[
- step invalid [("name", .str "Nat.add_one")]
+ step invalid ({ name := "Nat.add_one" }: Protocol.EnvInspect)
({ error := "command", desc := s!"Unknown command {invalid}" }: Protocol.InteractionError)
(name? := .some "Invalid Command"),
- step "expr.echo" [(invalid, .str "Random garbage data")]
+ step "expr.echo" (Lean.Json.mkObj [(invalid, .str "Random garbage data")])
({ error := "command", desc := s!"Unable to parse json: Pantograph.Protocol.ExprEcho.expr: String expected" }:
Protocol.InteractionError)
(name? := .some "JSON Deserialization")
@@ -69,14 +79,17 @@ def test_tactic : Test :=
],
}
[
- step "goal.start" [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
+ step "goal.start" ({ expr := "∀ (p q: Prop), p ∨ q → q ∨ p" }: Protocol.GoalStart)
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
- step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro x")]
+ step "goal.tactic" ({ stateId := 0, tactic? := .some "intro x" }: Protocol.GoalTactic)
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
- step "goal.print" [("stateId", .num 1), ("parentExpr", .bool true), ("rootExpr", .bool true)]
+ step "goal.print" ({ stateId := 1, parentExpr? := .some true, rootExpr? := .some true }: Protocol.GoalPrint)
({ parent? := .some { pp? := .some "fun x => ?m.11" }, }: Protocol.GoalPrintResult),
- step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "intro y")]
+ step "goal.tactic" ({ stateId := 1, tactic? := .some "intro y" }: Protocol.GoalTactic)
({ nextStateId? := .some 2, goals? := #[goal2], }: Protocol.GoalTacticResult),
+ step "goal.tactic" ({ stateId := 1, tactic? := .some "apply Nat.le_of_succ_le" }: Protocol.GoalTactic)
+ ({ tacticErrors? := .some #["tactic 'apply' failed, failed to unify\n ∀ {m : Nat}, Nat.succ ?n ≤ m → ?n ≤ m\nwith\n ∀ (q : Prop), x ∨ q → q ∨ x\nx : Prop\n⊢ ∀ (q : Prop), x ∨ q → q ∨ x"] }:
+ Protocol.GoalTacticResult)
]
def test_automatic_mode (automatic: Bool): Test :=
let varsPQ := #[
@@ -115,16 +128,16 @@ def test_automatic_mode (automatic: Bool): Test :=
],
}
[
- step "options.set" [("automaticMode", .bool automatic)]
+ step "options.set" ({automaticMode? := .some automatic}: Protocol.OptionsSet)
({}: Protocol.OptionsSetResult),
- step "goal.start" [("expr", .str "∀ (p q: Prop), p ∨ q → q ∨ p")]
+ step "goal.start" ({ expr := "∀ (p q: Prop), p ∨ q → q ∨ p"} : Protocol.GoalStart)
({ stateId := 0, root := "_uniq.9" }: Protocol.GoalStartResult),
- step "goal.tactic" [("stateId", .num 0), ("goalId", .num 0), ("tactic", .str "intro p q h")]
+ step "goal.tactic" ({ stateId := 0, tactic? := .some "intro p q h" }: Protocol.GoalTactic)
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
- step "goal.tactic" [("stateId", .num 1), ("goalId", .num 0), ("tactic", .str "cases h")]
+ step "goal.tactic" ({ stateId := 1, tactic? := .some "cases h" }: Protocol.GoalTactic)
({ nextStateId? := .some 2, goals? := #[goal2l, goal2r], }: Protocol.GoalTacticResult),
let goals? := if automatic then #[goal3l, goal2r] else #[goal3l]
- step "goal.tactic" [("stateId", .num 2), ("goalId", .num 0), ("tactic", .str "apply Or.inr")]
+ step "goal.tactic" ({ stateId := 2, tactic? := .some "apply Or.inr" }: Protocol.GoalTactic)
({ nextStateId? := .some 3, goals?, }: Protocol.GoalTacticResult),
]
@@ -133,28 +146,28 @@ def test_env_add_inspect : Test :=
let name2 := "Pantograph.mystery2"
[
step "env.add"
- [
- ("name", .str name1),
- ("type", .str "Prop → Prop → Prop"),
- ("value", .str "λ (a b: Prop) => Or a b"),
- ("isTheorem", .bool false)
- ]
+ ({
+ name := name1,
+ type := "Prop → Prop → Prop",
+ value := "λ (a b: Prop) => Or a b",
+ isTheorem := false
+ }: Protocol.EnvAdd)
({}: Protocol.EnvAddResult),
- step "env.inspect" [("name", .str name1)]
+ step "env.inspect" ({name := name1, value? := .some true} : Protocol.EnvInspect)
({
value? := .some { pp? := .some "fun a b => a ∨ b" },
type := { pp? := .some "Prop → Prop → Prop" },
}:
Protocol.EnvInspectResult),
step "env.add"
- [
- ("name", .str name2),
- ("type", .str "Nat → Int"),
- ("value", .str "λ (a: Nat) => a + 1"),
- ("isTheorem", .bool false)
- ]
+ ({
+ name := name2,
+ type := "Nat → Int",
+ value := "λ (a: Nat) => a + 1",
+ isTheorem := false
+ }: Protocol.EnvAdd)
({}: Protocol.EnvAddResult),
- step "env.inspect" [("name", .str name2)]
+ step "env.inspect" ({name := name2, value? := .some true} : Protocol.EnvInspect)
({
value? := .some { pp? := .some "fun a => ↑a + 1" },
type := { pp? := .some "Nat → Int" },
@@ -167,19 +180,14 @@ example : ∀ (p: Prop), p → p := by
exact h
def test_frontend_process : Test :=
+ let file := "example : ∀ (p q: Prop), p → p ∨ q := by\n intro p q h\n exact Or.inl h"
+ let goal1 := "p q : Prop\nh : p\n⊢ p ∨ q"
[
- let file := "example : ∀ (p q: Prop), p → p ∨ q := by\n intro p q h\n exact Or.inl h"
- let goal1 := "p q : Prop\nh : p\n⊢ p ∨ q"
step "frontend.process"
- [
- ("file", .str file),
- ("invocations", .bool true),
- ("readHeader", .bool false),
- ("inheritEnv", .bool false),
- ("sorrys", .bool false),
- ("typeErrorsAsGoals", .bool false),
- ("newConstants", .bool false),
- ]
+ ({
+ file? := .some file,
+ invocations := true,
+ }: Protocol.FrontendProcess)
({
units := [{
boundary := (0, file.utf8ByteSize),
@@ -215,15 +223,10 @@ def test_frontend_process_sorry : Test :=
vars := #[{ name := "_uniq.4", userName := "p", type? := .some { pp? := .some "Prop" }}],
}
step "frontend.process"
- [
- ("file", .str file),
- ("readHeader", .bool false),
- ("inheritEnv", .bool false),
- ("invocations", .bool false),
- ("sorrys", .bool true),
- ("typeErrorsAsGoals", .bool false),
- ("newConstants", .bool false),
- ]
+ ({
+ file? := .some file,
+ sorrys := true,
+ }: Protocol.FrontendProcess)
({
units := [{
boundary := (0, solved.utf8ByteSize),
@@ -234,7 +237,34 @@ def test_frontend_process_sorry : Test :=
goalSrcBoundaries? := .some #[(57, 62)],
messages := #["<anonymous>:2:0: warning: declaration uses 'sorry'\n"],
}],
- }: Protocol.FrontendProcessResult),
+ }: Protocol.FrontendProcessResult),
+ ]
+
+def test_import_open : Test :=
+ let header := "import Init\nopen Nat"
+ let goal1: Protocol.Goal := {
+ name := "_uniq.67",
+ target := { pp? := .some "n + 1 = n.succ" },
+ vars := #[{ name := "_uniq.66", userName := "n", type? := .some { pp? := .some "Nat" }}],
+ }
+ [
+ step "frontend.process"
+ ({
+ file? := .some header,
+ readHeader := true,
+ inheritEnv := true,
+ }: Protocol.FrontendProcess)
+ ({
+ units := [{
+ boundary := (12, header.utf8ByteSize),
+ }],
+ }: Protocol.FrontendProcessResult),
+ step "goal.start" ({ expr := "∀ (n : Nat), n + 1 = Nat.succ n"} : Protocol.GoalStart)
+ ({ stateId := 0, root := "_uniq.65" }: Protocol.GoalStartResult),
+ step "goal.tactic" ({ stateId := 0, tactic? := .some "intro n" }: Protocol.GoalTactic)
+ ({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
+ step "goal.tactic" ({ stateId := 1, tactic? := .some "apply add_one" }: Protocol.GoalTactic)
+ ({ nextStateId? := .some 2, goals? := .some #[], }: Protocol.GoalTacticResult),
]
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
@@ -246,7 +276,7 @@ def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
let tests := [
- ("expr.echo", test_elab),
+ ("expr.echo", test_expr_echo),
("options.set options.print", test_option_modify),
("Malformed command", test_malformed_command),
("Tactic", test_tactic),
@@ -255,6 +285,7 @@ def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
("env.add env.inspect", test_env_add_inspect),
("frontend.process invocation", test_frontend_process),
("frontend.process sorry", test_frontend_process_sorry),
+ ("frontend.process import", test_import_open),
]
tests.map (fun (name, test) => (name, runTest env test))
From be505b80504b34f1298c734a97ecfc3af2d06a68 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 19:06:43 -0700
Subject: [PATCH 452/465] feat: Run cancel token with timeout
---
Pantograph/Library.lean | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index b060275..aa7c42d 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -3,7 +3,10 @@ import Pantograph.Goal
import Pantograph.Protocol
import Pantograph.Delate
import Pantograph.Version
+
import Lean
+import Std.Time
+import Std.Internal.Async
namespace Lean
@@ -212,4 +215,12 @@ def goalConvExit (state: GoalState): CoreM TacticResult :=
def goalCalc (state: GoalState) (goal: MVarId) (pred: String): CoreM TacticResult :=
runTermElabM <| state.tryCalc goal pred
+-- Cancel the token after a timeout.
+@[export pantograph_run_cancel_token_with_timeout_m]
+def runCancelTokenWithTimeout (cancelToken : IO.CancelToken) (timeout : Std.Time.Millisecond.Offset) : IO Unit := do
+ let _ ← EIO.asTask do
+ let () ← (← Std.Internal.IO.Async.sleep timeout).block
+ cancelToken.set
+ return ()
+
end Pantograph
From 4610348fed595b6f4d04a5260c622de45091d647 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 20:42:10 -0700
Subject: [PATCH 453/465] feat: `CoreM` timeout
---
Pantograph/Environment.lean | 51 ++++++-----
Pantograph/Library.lean | 58 +++++-------
Pantograph/Protocol.lean | 11 ++-
Repl.lean | 177 ++++++++++++++++++++----------------
Test/Environment.lean | 4 +-
Test/Integration.lean | 19 ++++
doc/repl.md | 3 +
7 files changed, 186 insertions(+), 137 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 8e552a3..e18da61 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -52,12 +52,12 @@ def describe (_: Protocol.EnvDescribe): CoreM Protocol.EnvDescribeResult := do
imports := env.header.imports.map toString,
modules := env.header.moduleNames.map (·.toString),
}
-def moduleRead (args: Protocol.EnvModuleRead): CoreM (Protocol.CR Protocol.EnvModuleReadResult) := do
+def moduleRead (args: Protocol.EnvModuleRead): CoreM Protocol.EnvModuleReadResult := do
let env ← Lean.MonadEnv.getEnv
let .some i := env.header.moduleNames.findIdx? (· == args.module.toName) |
- return .error $ Protocol.errorIndex s!"Module not found {args.module}"
+ throwError s!"Module not found {args.module}"
let data := env.header.moduleData[i]!
- return .ok {
+ return {
imports := data.imports.map toString,
constNames := data.constNames.map (·.toString),
extraConstNames := data.extraConstNames.map (·.toString),
@@ -69,13 +69,11 @@ def catalog (_: Protocol.EnvCatalog): CoreM Protocol.EnvCatalogResult := do
| .some x => acc.push x
| .none => acc)
return { symbols := names }
-def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Protocol.CR Protocol.EnvInspectResult) := do
+def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): Protocol.FallibleT CoreM Protocol.EnvInspectResult := do
let env ← Lean.MonadEnv.getEnv
let name := args.name.toName
let info? := env.find? name
- let info ← match info? with
- | none => return .error $ Protocol.errorIndex s!"Symbol not found {args.name}"
- | some info => pure info
+ let .some info := info? | Protocol.throw $ Protocol.errorIndex s!"Symbol not found {args.name}"
let module? := env.getModuleIdxFor? name >>=
(λ idx => env.allImportedModuleNames.get? idx.toNat)
let value? := match args.value?, info with
@@ -145,17 +143,19 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): CoreM (Pr
}
else
.pure result
- return .ok result
-def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) := do
+ return result
+@[export pantograph_env_add_m]
+def addDecl (name: String) (levels: Array String := #[]) (type: String) (value: String) (isTheorem: Bool)
+ : Protocol.FallibleT CoreM Protocol.EnvAddResult := do
let env ← Lean.MonadEnv.getEnv
let tvM: Elab.TermElabM (Except String (Expr × Expr)) := do
- let type ← match parseTerm env args.type with
+ let type ← match parseTerm env type with
| .ok syn => do
match ← elabTerm syn with
| .error e => return .error e
| .ok expr => pure expr
| .error e => return .error e
- let value ← match parseTerm env args.value with
+ let value ← match parseTerm env value with
| .ok syn => do
try
let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
@@ -167,16 +167,25 @@ def addDecl (args: Protocol.EnvAdd): CoreM (Protocol.CR Protocol.EnvAddResult) :
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 decl := Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
- (name := args.name.toName)
- (levelParams := [])
- (type := type)
- (value := value)
- (hints := Lean.mkReducibilityHintsRegularEx 1)
- (safety := Lean.DefinitionSafety.safe)
- (all := [])
+ | .error e => Protocol.throw $ Protocol.errorExpr e
+ let levelParams := levels.toList.map (·.toName)
+ let decl := if isTheorem then
+ Lean.Declaration.thmDecl <| Lean.mkTheoremValEx
+ (name := name.toName)
+ (levelParams := levelParams)
+ (type := type )
+ (value := value)
+ (all := [])
+ else
+ Lean.Declaration.defnDecl <| Lean.mkDefinitionValEx
+ (name := name.toName)
+ (levelParams := levelParams)
+ (type := type)
+ (value := value)
+ (hints := Lean.mkReducibilityHintsRegularEx 1)
+ (safety := Lean.DefinitionSafety.safe)
+ (all := [])
Lean.addDecl decl
- return .ok {}
+ return {}
end Pantograph.Environment
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index aa7c42d..3c147b0 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -5,8 +5,6 @@ import Pantograph.Delate
import Pantograph.Version
import Lean
-import Std.Time
-import Std.Internal.Async
namespace Lean
@@ -78,59 +76,53 @@ def createCoreState (imports: Array String): IO Core.State := do
(trustLevel := 1)
return { env := env }
-@[export pantograph_env_add_m]
-def envAdd (name: String) (type: String) (value: String) (isTheorem: Bool):
- CoreM (Protocol.CR Protocol.EnvAddResult) :=
- Environment.addDecl { name, type, value, isTheorem }
-
@[export pantograph_parse_elab_type_m]
-def parseElabType (type: String): Elab.TermElabM (Protocol.CR Expr) := do
+def parseElabType (type: String): Protocol.FallibleT Elab.TermElabM Expr := do
let env ← MonadEnv.getEnv
let syn ← match parseTerm env type with
- | .error str => return .error $ errorI "parsing" str
+ | .error str => Protocol.throw $ errorI "parsing" str
| .ok syn => pure syn
match ← elabType syn with
- | .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok (← instantiateMVars expr)
+ | .error str => Protocol.throw $ errorI "elab" str
+ | .ok expr => return (← instantiateMVars expr)
/-- This must be a TermElabM since the parsed expr contains extra information -/
@[export pantograph_parse_elab_expr_m]
-def parseElabExpr (expr: String) (expectedType?: Option String := .none): Elab.TermElabM (Protocol.CR Expr) := do
+def parseElabExpr (expr: String) (expectedType?: Option String := .none): Protocol.FallibleT Elab.TermElabM Expr := do
let env ← MonadEnv.getEnv
- let expectedType? ← match ← expectedType?.mapM parseElabType with
- | .none => pure $ .none
- | .some (.ok t) => pure $ .some t
- | .some (.error e) => return .error e
+ let expectedType? ← expectedType?.mapM parseElabType
let syn ← match parseTerm env expr with
- | .error str => return .error $ errorI "parsing" str
+ | .error str => Protocol.throw $ errorI "parsing" str
| .ok syn => pure syn
match ← elabTerm syn expectedType? with
- | .error str => return .error $ errorI "elab" str
- | .ok expr => return .ok (← instantiateMVars expr)
+ | .error str => Protocol.throw $ errorI "elab" str
+ | .ok expr => return (← instantiateMVars expr)
@[export pantograph_expr_echo_m]
def exprEcho (expr: String) (expectedType?: Option String := .none) (levels: Array String := #[]) (options: @&Protocol.Options := {}):
- CoreM (Protocol.CR Protocol.ExprEchoResult) :=
- runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
- let expr ← match ← parseElabExpr expr expectedType? with
- | .error e => return .error e
+ Protocol.FallibleT CoreM Protocol.ExprEchoResult := do
+ let e : Except Protocol.InteractionError _ ← runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
+ let expr ← match ← parseElabExpr expr expectedType? |>.run with
+ | .error e => return Except.error e
| .ok expr => pure expr
try
let type ← unfoldAuxLemmas (← Meta.inferType expr)
- return .ok {
+ return .ok $ .ok ({
type := (← serializeExpression options type),
- expr := (← serializeExpression options expr)
- }
+ expr := (← serializeExpression options expr),
+ }: Protocol.ExprEchoResult)
catch exception =>
- return .error $ errorI "typing" (← exception.toMessageData.toString)
+ return Except.error $ errorI "typing" (← exception.toMessageData.toString)
+ liftExcept e
@[export pantograph_goal_start_expr_m]
-def goalStartExpr (expr: String) (levels: Array String): CoreM (Protocol.CR GoalState) :=
- runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
- let expr ← match ← parseElabType expr with
+def goalStartExpr (expr: String) (levels: Array String): Protocol.FallibleT CoreM GoalState := do
+ let e : Except Protocol.InteractionError _ ← runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
+ let expr ← match ← parseElabType expr |>.run with
| .error e => return .error e
| .ok expr => pure $ expr
- return .ok $ ← GoalState.create expr
+ return .ok $ .ok $ ← GoalState.create expr
+ liftExcept e
@[export pantograph_goal_resume]
def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
@@ -217,9 +209,9 @@ def goalCalc (state: GoalState) (goal: MVarId) (pred: String): CoreM TacticResul
-- Cancel the token after a timeout.
@[export pantograph_run_cancel_token_with_timeout_m]
-def runCancelTokenWithTimeout (cancelToken : IO.CancelToken) (timeout : Std.Time.Millisecond.Offset) : IO Unit := do
+def runCancelTokenWithTimeout (cancelToken : IO.CancelToken) (timeout : UInt32) : IO Unit := do
let _ ← EIO.asTask do
- let () ← (← Std.Internal.IO.Async.sleep timeout).block
+ IO.sleep timeout
cancelToken.set
return ()
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 0742986..41a6ccd 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -30,6 +30,8 @@ structure Options where
printImplementationDetailHyps: Bool := false
-- If this is set to `true`, goals will never go dormant, so you don't have to manage resumption
automaticMode: Bool := true
+ -- Timeout for tactics and operations that could potentially execute a tactic
+ timeout: Nat := 0
deriving Lean.ToJson
abbrev OptionsT := ReaderT Options
@@ -202,9 +204,10 @@ structure EnvInspectResult where
structure EnvAdd where
name: String
+ levels: Array String := #[]
type: String
value: String
- isTheorem: Bool
+ isTheorem: Bool := false
deriving Lean.FromJson
structure EnvAddResult where
deriving Lean.ToJson
@@ -225,6 +228,7 @@ structure OptionsSet where
printAuxDecls?: Option Bool := .none
printImplementationDetailHyps?: Option Bool := .none
automaticMode?: Option Bool := .none
+ timeout?: Option Nat := .none
deriving Lean.FromJson
structure OptionsSetResult where
deriving Lean.ToJson
@@ -386,6 +390,9 @@ structure FrontendProcessResult where
units: List CompilationUnit
deriving Lean.ToJson
-abbrev CR α := Except InteractionError α
+abbrev FallibleT := ExceptT InteractionError
+
+abbrev throw {m : Type v → Type w} [MonadExceptOf InteractionError m] {α : Type v} (e : InteractionError) : m α :=
+ throwThe InteractionError e
end Pantograph.Protocol
diff --git a/Repl.lean b/Repl.lean
index 310b9bf..0518296 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -20,9 +20,8 @@ structure State where
/-- Main state monad for executing commands -/
abbrev MainM := ReaderT Context $ StateRefT State IO
+abbrev EMainM := Protocol.FallibleT $ ReaderT Context $ StateRefT State IO
def getMainState : MainM State := get
-/-- Fallible subroutine return type -/
-abbrev CR α := Except Protocol.InteractionError α
instance : MonadEnv MainM where
getEnv := return (← get).env
@@ -37,24 +36,42 @@ def newGoalState (goalState: GoalState) : MainM Nat := do
}
return stateId
-def runCoreM { α } (coreM : CoreM α) : MainM α := do
+def runCoreM { α } (coreM : CoreM α) : EMainM α := do
let scope := (← get).scope
+ let options :=(← get).options
+ let cancelTk? ← match options.timeout with
+ | 0 => pure .none
+ | _ => .some <$> IO.CancelToken.new
let coreCtx : Core.Context := {
(← read).coreContext with
currNamespace := scope.currNamespace
openDecls := scope.openDecls
options := scope.opts
+ cancelTk?,
}
let coreState : Core.State := {
env := (← get).env
}
- let (result, state') ← coreM.toIO coreCtx coreState
- modifyEnv λ _ => state'.env
- return result
+ -- Remap the coreM to capture every exception
+ let coreM' : CoreM _ :=
+ Core.tryCatchRuntimeEx (Except.ok <$> coreM) λ ex => do
+ let desc ← ex.toMessageData.toString
+ return Except.error $ ({ error := "exception", desc } : Protocol.InteractionError)
+ let io := coreM'.toIO coreCtx coreState
+ if let .some token := cancelTk? then
+ runCancelTokenWithTimeout token (timeout := .mk options.timeout)
+ let (result, state') ← io
+ if result matches .ok _ then
+ modifyEnv λ _ => state'.env
+ liftExcept result
-def liftMetaM { α } (metaM : MetaM α): MainM α :=
+def runCoreM' { α } (coreM : Protocol.FallibleT CoreM α) : EMainM α := do
+ liftExcept $ ← runCoreM coreM.run
+
+
+def liftMetaM { α } (metaM : MetaM α): EMainM α :=
runCoreM metaM.run'
-def liftTermElabM { α } (termElabM: Elab.TermElabM α) : MainM α :=
+def liftTermElabM { α } (termElabM: Elab.TermElabM α) : EMainM α :=
runCoreM $ termElabM.run' (ctx := defaultElabContext) |>.run'
section Frontend
@@ -68,7 +85,7 @@ structure CompilationUnit where
messages : Array String
newConstants : List Name
-def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
+def frontend_process_inner (args: Protocol.FrontendProcess): EMainM Protocol.FrontendProcessResult := do
let options := (← getMainState).options
let (fileName, file) ← match args.fileName?, args.file? with
| .some fileName, .none => do
@@ -76,7 +93,7 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
pure (fileName, file)
| .none, .some file =>
pure ("<anonymous>", file)
- | _, _ => return .error <| errorI "arguments" "Exactly one of {fileName, file} must be supplied"
+ | _, _ => Protocol.throw $ errorI "arguments" "Exactly one of {fileName, file} must be supplied"
let env?: Option Environment ← if args.readHeader then
pure .none
else do
@@ -137,19 +154,23 @@ def frontend_process_inner (args: Protocol.FrontendProcess): MainM (CR Protocol.
goalSrcBoundaries?,
newConstants?,
}
- return .ok { units }
+ return { units }
end Frontend
/-- Main loop command of the REPL -/
def execute (command: Protocol.Command): MainM Json := do
- let run { α β: Type } [FromJson α] [ToJson β] (comm: α → MainM (CR β)): MainM Json :=
- match fromJson? command.payload with
- | .ok args => do
- match (← comm args) with
- | .ok result => return toJson result
- | .error ierror => return toJson ierror
- | .error error => return toJson $ errorCommand s!"Unable to parse json: {error}"
+ let run { α β: Type } [FromJson α] [ToJson β] (comm: α → EMainM β): MainM Json :=
+ try
+ match fromJson? command.payload with
+ | .ok args => do
+ match (← comm args |>.run) with
+ | .ok result => return toJson result
+ | .error ierror => return toJson ierror
+ | .error error => return toJson $ errorCommand s!"Unable to parse json: {error}"
+ catch ex : IO.Error =>
+ let error : Protocol.InteractionError := { error := "io", desc := ex.toString }
+ return toJson error
match command.cmd with
| "reset" => run reset
| "stat" => run stat
@@ -180,40 +201,40 @@ def execute (command: Protocol.Command): MainM Json := do
errorIndex := errorI "index"
errorIO := errorI "io"
-- Command Functions
- reset (_: Protocol.Reset): MainM (CR Protocol.StatResult) := do
+ reset (_: Protocol.Reset): EMainM Protocol.StatResult := do
let state ← getMainState
let nGoals := state.goalStates.size
set { state with nextId := 0, goalStates := .empty }
- return .ok { nGoals }
- stat (_: Protocol.Stat): MainM (CR Protocol.StatResult) := do
+ return { nGoals }
+ stat (_: Protocol.Stat): EMainM Protocol.StatResult := do
let state ← getMainState
let nGoals := state.goalStates.size
- return .ok { nGoals }
- env_describe (args: Protocol.EnvDescribe): MainM (CR Protocol.EnvDescribeResult) := do
+ return { nGoals }
+ env_describe (args: Protocol.EnvDescribe): EMainM Protocol.EnvDescribeResult := do
let result ← runCoreM $ Environment.describe args
- return .ok result
- env_module_read (args: Protocol.EnvModuleRead): MainM (CR Protocol.EnvModuleReadResult) := do
+ return result
+ env_module_read (args: Protocol.EnvModuleRead): EMainM Protocol.EnvModuleReadResult := do
runCoreM $ Environment.moduleRead args
- env_catalog (args: Protocol.EnvCatalog): MainM (CR Protocol.EnvCatalogResult) := do
+ env_catalog (args: Protocol.EnvCatalog): EMainM Protocol.EnvCatalogResult := do
let result ← runCoreM $ Environment.catalog args
- return .ok result
- env_inspect (args: Protocol.EnvInspect): MainM (CR Protocol.EnvInspectResult) := do
+ return result
+ env_inspect (args: Protocol.EnvInspect): EMainM Protocol.EnvInspectResult := do
let state ← getMainState
- runCoreM $ Environment.inspect args state.options
- env_add (args: Protocol.EnvAdd): MainM (CR Protocol.EnvAddResult) := do
- runCoreM $ Environment.addDecl args
- env_save (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
+ runCoreM' $ Environment.inspect args state.options
+ env_add (args: Protocol.EnvAdd): EMainM Protocol.EnvAddResult := do
+ runCoreM' $ Environment.addDecl args.name args.levels args.type args.value args.isTheorem
+ env_save (args: Protocol.EnvSaveLoad): EMainM Protocol.EnvSaveLoadResult := do
let env ← MonadEnv.getEnv
environmentPickle env args.path
- return .ok {}
- env_load (args: Protocol.EnvSaveLoad): MainM (CR Protocol.EnvSaveLoadResult) := do
+ return {}
+ env_load (args: Protocol.EnvSaveLoad): EMainM Protocol.EnvSaveLoadResult := do
let (env, _) ← environmentUnpickle args.path
setEnv env
- return .ok {}
- expr_echo (args: Protocol.ExprEcho): MainM (CR Protocol.ExprEchoResult) := do
+ return {}
+ expr_echo (args: Protocol.ExprEcho): EMainM Protocol.ExprEchoResult := do
let state ← getMainState
- runCoreM $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
- options_set (args: Protocol.OptionsSet): MainM (CR Protocol.OptionsSetResult) := do
+ runCoreM' $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
+ options_set (args: Protocol.OptionsSet): EMainM Protocol.OptionsSetResult := do
let state ← getMainState
let options := state.options
set { state with
@@ -227,14 +248,15 @@ def execute (command: Protocol.Command): MainM Json := do
printAuxDecls := args.printAuxDecls?.getD options.printAuxDecls,
printImplementationDetailHyps := args.printImplementationDetailHyps?.getD options.printImplementationDetailHyps
automaticMode := args.automaticMode?.getD options.automaticMode,
+ timeout := args.timeout?.getD options.timeout,
}
}
- return .ok { }
- options_print (_: Protocol.OptionsPrint): MainM (CR Protocol.Options) := do
- return .ok (← getMainState).options
- goal_start (args: Protocol.GoalStart): MainM (CR Protocol.GoalStartResult) := do
+ return { }
+ options_print (_: Protocol.OptionsPrint): EMainM Protocol.Options := do
+ return (← getMainState).options
+ goal_start (args: Protocol.GoalStart): EMainM Protocol.GoalStartResult := do
let expr?: Except _ GoalState ← liftTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => goalStartExpr expr (args.levels.getD #[])
+ | .some expr, .none => goalStartExpr expr (args.levels.getD #[]) |>.run
| .none, .some copyFrom => do
(match (← getEnv).find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
@@ -242,16 +264,16 @@ def execute (command: Protocol.Command): MainM Json := do
| _, _ =>
return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
match expr? with
- | .error error => return .error error
+ | .error error => Protocol.throw error
| .ok goalState =>
let stateId ← newGoalState goalState
- return .ok { stateId, root := goalState.root.name.toString }
- goal_tactic (args: Protocol.GoalTactic): MainM (CR Protocol.GoalTacticResult) := do
+ return { stateId, root := goalState.root.name.toString }
+ goal_tactic (args: Protocol.GoalTactic): EMainM Protocol.GoalTacticResult := do
let state ← getMainState
let .some goalState := state.goalStates[args.stateId]? |
- return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ Protocol.throw $ errorIndex s!"Invalid state index {args.stateId}"
let .some goal := goalState.goals.get? args.goalId |
- return .error $ errorIndex s!"Invalid goal index {args.goalId}"
+ Protocol.throw $ errorIndex s!"Invalid goal index {args.goalId}"
let nextGoalState?: Except _ TacticResult ← liftTermElabM do
-- NOTE: Should probably use a macro to handle this...
match args.tactic?, args.expr?, args.have?, args.let?, args.calc?, args.conv?, args.draft? with
@@ -277,63 +299,63 @@ def execute (command: Protocol.Command): MainM Json := do
let error := errorI "arguments" "Exactly one of {tactic, expr, have, let, calc, conv, draft} must be supplied"
pure $ .error error
match nextGoalState? with
- | .error error => return .error error
+ | .error error => Protocol.throw error
| .ok (.success nextGoalState) => do
let nextGoalState ← match state.options.automaticMode, args.conv? with
| true, .none => do
let .ok result := nextGoalState.resume (nextGoalState.goals ++ goalState.goals) |
- return .error $ errorIO "Resuming known goals"
+ Protocol.throw $ errorIO "Resuming known goals"
pure result
| true, .some true => pure nextGoalState
| true, .some false => do
let .some (_, _, dormantGoals) := goalState.convMVar? |
- return .error $ errorIO "If conv exit succeeded this should not fail"
+ Protocol.throw $ errorIO "If conv exit succeeded this should not fail"
let .ok result := nextGoalState.resume (nextGoalState.goals ++ dormantGoals) |
- return .error $ errorIO "Resuming known goals"
+ Protocol.throw $ errorIO "Resuming known goals"
pure result
| false, _ => pure nextGoalState
let nextStateId ← newGoalState nextGoalState
let goals ← runCoreM $ nextGoalState.serializeGoals (parent := .some goalState) (options := state.options) |>.run'
- return .ok {
+ return {
nextStateId? := .some nextStateId,
goals? := .some goals,
}
| .ok (.parseError message) =>
- return .ok { parseError? := .some message }
+ return { parseError? := .some message }
| .ok (.invalidAction message) =>
- return .error $ errorI "invalid" message
+ Protocol.throw $ errorI "invalid" message
| .ok (.failure messages) =>
- return .ok { tacticErrors? := .some messages }
- goal_continue (args: Protocol.GoalContinue): MainM (CR Protocol.GoalContinueResult) := do
+ return { tacticErrors? := .some messages }
+ goal_continue (args: Protocol.GoalContinue): EMainM Protocol.GoalContinueResult := do
let state ← getMainState
let .some target := state.goalStates[args.target]? |
- return .error $ errorIndex s!"Invalid state index {args.target}"
- let nextState? ← match args.branch?, args.goals? with
+ Protocol.throw $ errorIndex s!"Invalid state index {args.target}"
+ let nextGoalState? : GoalState ← match args.branch?, args.goals? with
| .some branchId, .none => do
match state.goalStates[branchId]? with
- | .none => return .error $ errorIndex s!"Invalid state index {branchId}"
+ | .none => Protocol.throw $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
pure $ goalResume target goals
- | _, _ => return .error <| errorI "arguments" "Exactly one of {branch, goals} must be supplied"
- match nextState? with
- | .error error => return .error <| errorI "structure" error
+ | _, _ => Protocol.throw $ errorI "arguments" "Exactly one of {branch, goals} must be supplied"
+ match nextGoalState? with
+ | .error error => Protocol.throw $ errorI "structure" error
| .ok nextGoalState =>
let nextStateId ← newGoalState nextGoalState
let goals ← liftMetaM $ goalSerialize nextGoalState (options := state.options)
- return .ok {
+ return {
nextStateId,
goals,
}
- goal_delete (args: Protocol.GoalDelete): MainM (CR Protocol.GoalDeleteResult) := do
+ goal_delete (args: Protocol.GoalDelete): EMainM Protocol.GoalDeleteResult := do
let state ← getMainState
let goalStates := args.stateIds.foldl (λ map id => map.erase id) state.goalStates
set { state with goalStates }
- return .ok {}
- goal_print (args: Protocol.GoalPrint): MainM (CR Protocol.GoalPrintResult) := do
+ return {}
+ goal_print (args: Protocol.GoalPrint): EMainM Protocol.GoalPrintResult := do
let state ← getMainState
let .some goalState := state.goalStates[args.stateId]? |
- return .error $ errorIndex s!"Invalid state index {args.stateId}"
+ Protocol.throw $ errorIndex s!"Invalid state index {args.stateId}"
let result ← liftMetaM <| goalPrint
goalState
(rootExpr := args.rootExpr?.getD False)
@@ -341,21 +363,18 @@ def execute (command: Protocol.Command): MainM Json := do
(goals := args.goals?.getD False)
(extraMVars := args.extraMVars?.getD #[])
(options := state.options)
- return .ok result
- goal_save (args: Protocol.GoalSave): MainM (CR Protocol.GoalSaveResult) := do
+ return result
+ goal_save (args: Protocol.GoalSave): EMainM Protocol.GoalSaveResult := do
let state ← getMainState
let .some goalState := state.goalStates[args.id]? |
- return .error $ errorIndex s!"Invalid state index {args.id}"
+ Protocol.throw $ errorIndex s!"Invalid state index {args.id}"
goalStatePickle goalState args.path
- return .ok {}
- goal_load (args: Protocol.GoalLoad): MainM (CR Protocol.GoalLoadResult) := do
+ return {}
+ goal_load (args: Protocol.GoalLoad): EMainM Protocol.GoalLoadResult := do
let (goalState, _) ← goalStateUnpickle args.path (← MonadEnv.getEnv)
let id ← newGoalState goalState
- return .ok { id }
- frontend_process (args: Protocol.FrontendProcess): MainM (CR Protocol.FrontendProcessResult) := do
- try
- frontend_process_inner args
- catch e =>
- return .error $ errorI "frontend" e.toString
+ return { id }
+ frontend_process (args: Protocol.FrontendProcess): EMainM Protocol.FrontendProcessResult := do
+ frontend_process_inner args
end Pantograph.Repl
diff --git a/Test/Environment.lean b/Test/Environment.lean
index e954bc3..be4bd0a 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -103,14 +103,14 @@ def test_symbol_location : TestT IO Unit := do
(opts := {})
(trustLevel := 1)
addTest $ ← runTestCoreM env do
- let .ok result ← Environment.inspect { name := "Nat.le_of_succ_le", source? := .some true } (options := {}) | fail "Inspect failed"
+ let .ok result ← (Environment.inspect { name := "Nat.le_of_succ_le", source? := .some true } (options := {})).run | fail "Inspect failed"
checkEq "module" result.module? <| .some "Init.Data.Nat.Basic"
-- Extraction of source doesn't work for symbols in `Init` for some reason
checkTrue "file" result.sourceUri?.isNone
checkEq "pos" (result.sourceStart?.map (·.column)) <| .some 0
checkEq "pos" (result.sourceEnd?.map (·.column)) <| .some 88
- let .ok { imports, constNames, .. } ← Environment.moduleRead ⟨"Init.Data.Nat.Basic"⟩ | fail "Module read failed"
+ let { imports, constNames, .. } ← Environment.moduleRead ⟨"Init.Data.Nat.Basic"⟩
checkEq "imports" imports #["Init.SimpLemmas", "Init.Data.NeZero"]
checkTrue "constNames" $ constNames.contains "Nat.succ_add"
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9263fbe..2c59e3b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -91,6 +91,24 @@ def test_tactic : Test :=
({ tacticErrors? := .some #["tactic 'apply' failed, failed to unify\n ∀ {m : Nat}, Nat.succ ?n ≤ m → ?n ≤ m\nwith\n ∀ (q : Prop), x ∨ q → q ∨ x\nx : Prop\n⊢ ∀ (q : Prop), x ∨ q → q ∨ x"] }:
Protocol.GoalTacticResult)
]
+example : (1 : Nat) + (2 * 3) = 1 + (4 - 3) + (6 - 4) + 3 := by
+ simp
+def test_tactic_timeout : Test :=
+ [
+ step "goal.start" ({ expr := "(1 : Nat) + (2 * 3) = 1 + (4 - 3) + (6 - 4) + 3" }: Protocol.GoalStart)
+ ({ stateId := 0, root := "_uniq.319" }: Protocol.GoalStartResult),
+ -- timeout of 10 milliseconds
+ step "options.set" ({ timeout? := .some 10 } : Protocol.OptionsSet)
+ ({ }: Protocol.OptionsSetResult),
+ step "goal.tactic" ({ stateId := 0, expr? := .some "by\nsleep 1000; simp" }: Protocol.GoalTactic)
+ ({ error := "io", desc := "internal exception #6" }: Protocol.InteractionError),
+ -- ensure graceful recovery
+ step "options.set" ({ timeout? := .some 0 } : Protocol.OptionsSet)
+ ({ }: Protocol.OptionsSetResult),
+ step "goal.tactic" ({ stateId := 0, tactic? := .some "simp" }: Protocol.GoalTactic)
+ ({ nextStateId? := .some 1, goals? := .some #[], }: Protocol.GoalTacticResult),
+ ]
+
def test_automatic_mode (automatic: Bool): Test :=
let varsPQ := #[
{ name := "_uniq.10", userName := "p", type? := .some { pp? := .some "Prop" }},
@@ -280,6 +298,7 @@ def suite (env : Lean.Environment): List (String × IO LSpec.TestSeq) :=
("options.set options.print", test_option_modify),
("Malformed command", test_malformed_command),
("Tactic", test_tactic),
+ ("Tactic Timeout", test_tactic_timeout),
("Manual Mode", test_automatic_mode false),
("Automatic Mode", test_automatic_mode true),
("env.add env.inspect", test_env_add_inspect),
diff --git a/doc/repl.md b/doc/repl.md
index 93eb6ab..b0fe972 100644
--- a/doc/repl.md
+++ b/doc/repl.md
@@ -22,6 +22,9 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va
automatic mode (flag: `"automaticMode"`). By default it is turned on, with
all goals automatically resuming. This makes Pantograph act like a gym,
with no resumption necessary to manage your goals.
+
+ Set `timeout` to a non-zero number to specify timeout (milliseconds) for all `CoreM`
+ operations.
* `options.print`: Display the current set of options
* `goal.start {["name": <name>], ["expr": <expr>], ["levels": [<levels>]], ["copyFrom": <symbol>]}`:
Start a new proof from a given expression or symbol
From 0528a1592ec8541025687383910869bf6de6356f Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Fri, 28 Mar 2025 21:31:30 -0700
Subject: [PATCH 454/465] fix: Print internal exceptions nicely
---
Repl.lean | 13 +++++++++----
Test/Integration.lean | 2 +-
2 files changed, 10 insertions(+), 5 deletions(-)
diff --git a/Repl.lean b/Repl.lean
index 0518296..3c87429 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -18,8 +18,9 @@ structure State where
-- Parser state
scope : Elab.Command.Scope := { header := "" }
-/-- Main state monad for executing commands -/
+/-- Main monad for executing commands -/
abbrev MainM := ReaderT Context $ StateRefT State IO
+/-- Main with possible exception -/
abbrev EMainM := Protocol.FallibleT $ ReaderT Context $ StateRefT State IO
def getMainState : MainM State := get
@@ -54,13 +55,17 @@ def runCoreM { α } (coreM : CoreM α) : EMainM α := do
}
-- Remap the coreM to capture every exception
let coreM' : CoreM _ :=
- Core.tryCatchRuntimeEx (Except.ok <$> coreM) λ ex => do
+ try
+ Except.ok <$> coreM
+ catch ex =>
let desc ← ex.toMessageData.toString
return Except.error $ ({ error := "exception", desc } : Protocol.InteractionError)
- let io := coreM'.toIO coreCtx coreState
if let .some token := cancelTk? then
runCancelTokenWithTimeout token (timeout := .mk options.timeout)
- let (result, state') ← io
+ let (result, state') ← match ← (coreM'.run coreCtx coreState).toIO' with
+ | Except.error (Exception.error _ msg) => Protocol.throw $ { error := "core", desc := ← msg.toString }
+ | Except.error (Exception.internal id _) => Protocol.throw $ { error := "internal", desc := (← id.getName).toString }
+ | Except.ok a => pure a
if result matches .ok _ then
modifyEnv λ _ => state'.env
liftExcept result
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 2c59e3b..013554b 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -101,7 +101,7 @@ def test_tactic_timeout : Test :=
step "options.set" ({ timeout? := .some 10 } : Protocol.OptionsSet)
({ }: Protocol.OptionsSetResult),
step "goal.tactic" ({ stateId := 0, expr? := .some "by\nsleep 1000; simp" }: Protocol.GoalTactic)
- ({ error := "io", desc := "internal exception #6" }: Protocol.InteractionError),
+ ({ error := "internal", desc := "interrupt" }: Protocol.InteractionError),
-- ensure graceful recovery
step "options.set" ({ timeout? := .some 0 } : Protocol.OptionsSet)
({ }: Protocol.OptionsSetResult),
From 9ea099827fd380a10f5dbbba81809ef9b7141ebf Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 29 Mar 2025 14:39:42 -0700
Subject: [PATCH 455/465] fix(env): Adding declarations with universe levels
---
Pantograph/Environment.lean | 8 +++++---
Test/Integration.lean | 19 ++++++++++++++++++-
2 files changed, 23 insertions(+), 4 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index e18da61..d7bac21 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -148,7 +148,9 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): Protocol.
def addDecl (name: String) (levels: Array String := #[]) (type: String) (value: String) (isTheorem: Bool)
: Protocol.FallibleT CoreM Protocol.EnvAddResult := do
let env ← Lean.MonadEnv.getEnv
- let tvM: Elab.TermElabM (Except String (Expr × Expr)) := do
+ let levelParams := levels.toList.map (·.toName)
+ let tvM: Elab.TermElabM (Except String (Expr × Expr)) :=
+ Elab.Term.withLevelNames levelParams do do
let type ← match parseTerm env type with
| .ok syn => do
match ← elabTerm syn with
@@ -164,11 +166,11 @@ def addDecl (name: String) (levels: Array String := #[]) (type: String) (value:
pure $ expr
catch ex => return .error (← ex.toMessageData.toString)
| .error e => return .error e
- pure $ .ok (type, value)
+ Elab.Term.synthesizeSyntheticMVarsNoPostponing
+ pure $ .ok (← instantiateMVars type, ← instantiateMVars value)
let (type, value) ← match ← tvM.run' (ctx := {}) |>.run' with
| .ok t => pure t
| .error e => Protocol.throw $ Protocol.errorExpr e
- let levelParams := levels.toList.map (·.toName)
let decl := if isTheorem then
Lean.Declaration.thmDecl <| Lean.mkTheoremValEx
(name := name.toName)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 013554b..4778f0a 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -162,6 +162,7 @@ def test_automatic_mode (automatic: Bool): Test :=
def test_env_add_inspect : Test :=
let name1 := "Pantograph.mystery"
let name2 := "Pantograph.mystery2"
+ let name3 := "Pantograph.mystery3"
[
step "env.add"
({
@@ -190,9 +191,25 @@ def test_env_add_inspect : Test :=
value? := .some { pp? := .some "fun a => ↑a + 1" },
type := { pp? := .some "Nat → Int" },
}:
- Protocol.EnvInspectResult)
+ Protocol.EnvInspectResult),
+ step "env.add"
+ ({
+ name := name3,
+ levels := #["u"]
+ type := "(α : Type u) → α → (α × α)",
+ value := "λ (α : Type u) (x : α) => (x, x)",
+ isTheorem := false
+ }: Protocol.EnvAdd)
+ ({}: Protocol.EnvAddResult),
+ step "env.inspect" ({name := name3} : Protocol.EnvInspect)
+ ({
+ type := { pp? := .some "(α : Type u) → α → α × α" },
+ }:
+ Protocol.EnvInspectResult),
]
+def f.{u} : (α : Type u) → α → (α × α) := λ (α : Type u) (x : α) => (x, x)
+
example : ∀ (p: Prop), p → p := by
intro p h
exact h
From b9ff9e8f136fb2354b3e5262658d114602a2a949 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 29 Mar 2025 14:51:35 -0700
Subject: [PATCH 456/465] feat(repl): Optional type argument in `env.add`
---
Pantograph/Environment.lean | 19 ++++++++++++-------
Pantograph/Protocol.lean | 2 +-
Repl.lean | 2 +-
Test/Integration.lean | 5 ++---
4 files changed, 16 insertions(+), 12 deletions(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index d7bac21..21d7b37 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -144,29 +144,34 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): Protocol.
else
.pure result
return result
+/-- Elaborates and adds a declaration to the `CoreM` environment. -/
@[export pantograph_env_add_m]
-def addDecl (name: String) (levels: Array String := #[]) (type: String) (value: String) (isTheorem: Bool)
+def addDecl (name: String) (levels: Array String := #[]) (type?: Option String) (value: String) (isTheorem: Bool)
: Protocol.FallibleT CoreM Protocol.EnvAddResult := do
let env ← Lean.MonadEnv.getEnv
let levelParams := levels.toList.map (·.toName)
let tvM: Elab.TermElabM (Except String (Expr × Expr)) :=
Elab.Term.withLevelNames levelParams do do
- let type ← match parseTerm env type with
- | .ok syn => do
- match ← elabTerm syn with
- | .error e => return .error e
- | .ok expr => pure expr
+ let expectedType?? : Except String (Option Expr) ← ExceptT.run $ type?.mapM λ type => do
+ match parseTerm env type with
+ | .ok syn => elabTerm syn
+ | .error e => MonadExceptOf.throw e
+ let expectedType? ← match expectedType?? with
+ | .ok t? => pure t?
| .error e => return .error e
let value ← match parseTerm env value with
| .ok syn => do
try
- let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := .some type)
+ let expr ← Elab.Term.elabTerm (stx := syn) (expectedType? := expectedType?)
Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing
let expr ← instantiateMVars expr
pure $ expr
catch ex => return .error (← ex.toMessageData.toString)
| .error e => return .error e
Elab.Term.synthesizeSyntheticMVarsNoPostponing
+ let type ← match expectedType? with
+ | .some t => pure t
+ | .none => Meta.inferType value
pure $ .ok (← instantiateMVars type, ← instantiateMVars value)
let (type, value) ← match ← tvM.run' (ctx := {}) |>.run' with
| .ok t => pure t
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 41a6ccd..350b1de 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -205,7 +205,7 @@ structure EnvInspectResult where
structure EnvAdd where
name: String
levels: Array String := #[]
- type: String
+ type?: Option String := .none
value: String
isTheorem: Bool := false
deriving Lean.FromJson
diff --git a/Repl.lean b/Repl.lean
index 3c87429..578bd51 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -227,7 +227,7 @@ def execute (command: Protocol.Command): MainM Json := do
let state ← getMainState
runCoreM' $ Environment.inspect args state.options
env_add (args: Protocol.EnvAdd): EMainM Protocol.EnvAddResult := do
- runCoreM' $ Environment.addDecl args.name args.levels args.type args.value args.isTheorem
+ runCoreM' $ Environment.addDecl args.name args.levels args.type? args.value args.isTheorem
env_save (args: Protocol.EnvSaveLoad): EMainM Protocol.EnvSaveLoadResult := do
let env ← MonadEnv.getEnv
environmentPickle env args.path
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 4778f0a..9c3bc5e 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -167,7 +167,6 @@ def test_env_add_inspect : Test :=
step "env.add"
({
name := name1,
- type := "Prop → Prop → Prop",
value := "λ (a b: Prop) => Or a b",
isTheorem := false
}: Protocol.EnvAdd)
@@ -181,7 +180,7 @@ def test_env_add_inspect : Test :=
step "env.add"
({
name := name2,
- type := "Nat → Int",
+ type? := "Nat → Int",
value := "λ (a: Nat) => a + 1",
isTheorem := false
}: Protocol.EnvAdd)
@@ -196,7 +195,7 @@ def test_env_add_inspect : Test :=
({
name := name3,
levels := #["u"]
- type := "(α : Type u) → α → (α × α)",
+ type? := "(α : Type u) → α → (α × α)",
value := "λ (α : Type u) (x : α) => (x, x)",
isTheorem := false
}: Protocol.EnvAdd)
From 28856714905e6ba3329af69ffcd7f386e6181bc4 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 29 Mar 2025 15:01:57 -0700
Subject: [PATCH 457/465] test: Update LSpec
---
Test/Main.lean | 10 +++++-----
lake-manifest.json | 8 ++++----
lakefile.lean | 2 +-
3 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/Test/Main.lean b/Test/Main.lean
index e5cf285..8d9a87d 100644
--- a/Test/Main.lean
+++ b/Test/Main.lean
@@ -17,9 +17,9 @@ def addPrefix (pref: String) (tests: List (String × α)): List (String × α)
tests.map (λ (name, x) => (pref ++ "/" ++ name, x))
/-- Runs test in parallel. Filters test name if given -/
-def runTestGroup (filter: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
- let tests: List (String × IO LSpec.TestSeq) := match filter with
- | .some filter => tests.filter (λ (name, _) => filter.isPrefixOf name)
+def runTestGroup (nameFilter?: Option String) (tests: List (String × IO LSpec.TestSeq)): IO LSpec.TestSeq := do
+ let tests: List (String × IO LSpec.TestSeq) := match nameFilter? with
+ | .some nameFilter => tests.filter (λ (name, _) => nameFilter.isPrefixOf name)
| .none => tests
let tasks: List (String × Task _) ← tests.mapM (λ (name, task) => do
return (name, ← EIO.asTask task))
@@ -37,7 +37,7 @@ open Pantograph.Test
/-- Main entry of tests; Provide an argument to filter tests by prefix -/
def main (args: List String) := do
- let name_filter := args.head?
+ let nameFilter? := args.head?
Lean.initSearchPath (← Lean.findSysroot)
let env_default: Lean.Environment ← Lean.importModules
(imports := #[`Init])
@@ -57,4 +57,4 @@ def main (args: List String) := do
("Tactic/Prograde", Tactic.Prograde.suite env_default),
]
let tests: List (String × IO LSpec.TestSeq) := suites.foldl (λ acc (name, suite) => acc ++ (addPrefix name suite)) []
- LSpec.lspecIO (← runTestGroup name_filter tests)
+ LSpec.lspecEachIO [()] (λ () => runTestGroup nameFilter? tests)
diff --git a/lake-manifest.json b/lake-manifest.json
index e1545af..a585fc9 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,15 +1,15 @@
{"version": "1.1.0",
"packagesDir": ".lake/packages",
"packages":
- [{"url": "https://github.com/lenianiva/LSpec.git",
+ [{"url": "https://github.com/argumentcomputer/LSpec.git",
"type": "git",
"subDir": null,
"scope": "",
- "rev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
+ "rev": "a6652a48b5c67b0d8dd3930fad6390a97d127e8d",
"name": "LSpec",
"manifestFile": "lake-manifest.json",
- "inputRev": "c492cecd0bc473e2f9c8b94d545d02cc0056034f",
+ "inputRev": "a6652a48b5c67b0d8dd3930fad6390a97d127e8d",
"inherited": false,
- "configFile": "lakefile.lean"}],
+ "configFile": "lakefile.toml"}],
"name": "pantograph",
"lakeDir": ".lake"}
diff --git a/lakefile.lean b/lakefile.lean
index 2aa3986..ddf721a 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -18,7 +18,7 @@ lean_exe repl {
}
require LSpec from git
- "https://github.com/lenianiva/LSpec.git" @ "c492cecd0bc473e2f9c8b94d545d02cc0056034f"
+ "https://github.com/argumentcomputer/LSpec.git" @ "a6652a48b5c67b0d8dd3930fad6390a97d127e8d"
lean_lib Test {
}
@[test_driver]
From 91fbc4cdcad15d37d4733e6c2e2ef6607fe9f0cc Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 29 Mar 2025 15:43:49 -0700
Subject: [PATCH 458/465] chore: Remove redundant code
---
Test/Integration.lean | 2 --
1 file changed, 2 deletions(-)
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 9c3bc5e..ffb20f3 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -207,8 +207,6 @@ def test_env_add_inspect : Test :=
Protocol.EnvInspectResult),
]
-def f.{u} : (α : Type u) → α → (α × α) := λ (α : Type u) (x : α) => (x, x)
-
example : ∀ (p: Prop), p → p := by
intro p h
exact h
From cf4a5955e3c971c99fe1e929f2507ee710c62a00 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 3 Apr 2025 11:18:17 -0700
Subject: [PATCH 459/465] test: Non-matchers are not matchers
---
Test/Environment.lean | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/Test/Environment.lean b/Test/Environment.lean
index be4bd0a..a8f6cc5 100644
--- a/Test/Environment.lean
+++ b/Test/Environment.lean
@@ -114,12 +114,20 @@ def test_symbol_location : TestT IO Unit := do
checkEq "imports" imports #["Init.SimpLemmas", "Init.Data.NeZero"]
checkTrue "constNames" $ constNames.contains "Nat.succ_add"
+def test_matcher : TestT IO Unit := do
+ let env: Environment ← importModules
+ (imports := #[`Init])
+ (opts := {})
+ (trustLevel := 1)
+ checkTrue "not matcher" $ ¬ Meta.isMatcherCore env `Nat.strongRecOn
+
def suite: List (String × IO LSpec.TestSeq) :=
[
("Catalog", test_catalog),
("Symbol Visibility", test_symbol_visibility),
("Inspect", test_inspect),
("Symbol Location", runTest test_symbol_location),
+ ("Matcher", runTest test_matcher),
]
end Pantograph.Test.Environment
From 70152c7715875e74951c9a36a1022ccc3d37f323 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Thu, 3 Apr 2025 14:38:40 -0700
Subject: [PATCH 460/465] refactor: Optional levels
---
Pantograph/Protocol.lean | 6 +++---
Repl.lean | 24 ++++++++++++++++--------
Test/Integration.lean | 15 +++++++++------
3 files changed, 28 insertions(+), 17 deletions(-)
diff --git a/Pantograph/Protocol.lean b/Pantograph/Protocol.lean
index 350b1de..9371662 100644
--- a/Pantograph/Protocol.lean
+++ b/Pantograph/Protocol.lean
@@ -107,7 +107,7 @@ structure ExprEcho where
expr: String
type?: Option String := .none
-- universe levels
- levels: Option (Array String) := .none
+ levels?: Option (Array String) := .none
deriving Lean.FromJson
structure ExprEchoResult where
expr: Expression
@@ -204,7 +204,7 @@ structure EnvInspectResult where
structure EnvAdd where
name: String
- levels: Array String := #[]
+ levels?: Option (Array String) := .none
type?: Option String := .none
value: String
isTheorem: Bool := false
@@ -239,7 +239,7 @@ structure GoalStart where
-- Only one of the fields below may be populated.
expr: Option String -- Directly parse in an expression
-- universe levels
- levels: Option (Array String) := .none
+ levels?: Option (Array String) := .none
copyFrom: Option String := .none -- Copy the type from a theorem in the environment
deriving Lean.FromJson
structure GoalStartResult where
diff --git a/Repl.lean b/Repl.lean
index 578bd51..6d3295e 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -45,9 +45,10 @@ def runCoreM { α } (coreM : CoreM α) : EMainM α := do
| _ => .some <$> IO.CancelToken.new
let coreCtx : Core.Context := {
(← read).coreContext with
- currNamespace := scope.currNamespace
- openDecls := scope.openDecls
- options := scope.opts
+ currNamespace := scope.currNamespace,
+ openDecls := scope.openDecls,
+ options := scope.opts,
+ initHeartbeats := ← IO.getNumHeartbeats,
cancelTk?,
}
let coreState : Core.State := {
@@ -76,8 +77,15 @@ def runCoreM' { α } (coreM : Protocol.FallibleT CoreM α) : EMainM α := do
def liftMetaM { α } (metaM : MetaM α): EMainM α :=
runCoreM metaM.run'
-def liftTermElabM { α } (termElabM: Elab.TermElabM α) : EMainM α :=
- runCoreM $ termElabM.run' (ctx := defaultElabContext) |>.run'
+def liftTermElabM { α } (termElabM: Elab.TermElabM α) : EMainM α := do
+ let scope := (← get).scope
+ let context := {
+ isNoncomputableSection := scope.isNoncomputable,
+ }
+ let state := {
+ levelNames := scope.levelNames,
+ }
+ runCoreM $ termElabM.run' context state |>.run'
section Frontend
@@ -227,7 +235,7 @@ def execute (command: Protocol.Command): MainM Json := do
let state ← getMainState
runCoreM' $ Environment.inspect args state.options
env_add (args: Protocol.EnvAdd): EMainM Protocol.EnvAddResult := do
- runCoreM' $ Environment.addDecl args.name args.levels args.type? args.value args.isTheorem
+ runCoreM' $ Environment.addDecl args.name (args.levels?.getD #[]) args.type? args.value args.isTheorem
env_save (args: Protocol.EnvSaveLoad): EMainM Protocol.EnvSaveLoadResult := do
let env ← MonadEnv.getEnv
environmentPickle env args.path
@@ -238,7 +246,7 @@ def execute (command: Protocol.Command): MainM Json := do
return {}
expr_echo (args: Protocol.ExprEcho): EMainM Protocol.ExprEchoResult := do
let state ← getMainState
- runCoreM' $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels.getD #[]) (options := state.options)
+ runCoreM' $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels?.getD #[]) (options := state.options)
options_set (args: Protocol.OptionsSet): EMainM Protocol.OptionsSetResult := do
let state ← getMainState
let options := state.options
@@ -261,7 +269,7 @@ def execute (command: Protocol.Command): MainM Json := do
return (← getMainState).options
goal_start (args: Protocol.GoalStart): EMainM Protocol.GoalStartResult := do
let expr?: Except _ GoalState ← liftTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => goalStartExpr expr (args.levels.getD #[]) |>.run
+ | .some expr, .none => goalStartExpr expr (args.levels?.getD #[]) |>.run
| .none, .some copyFrom => do
(match (← getEnv).find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
diff --git a/Test/Integration.lean b/Test/Integration.lean
index ffb20f3..55cace6 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -30,7 +30,7 @@ abbrev Test := List (MainM LSpec.TestSeq)
def test_expr_echo : Test :=
[
step "expr.echo"
- ({ expr := "λ {α : Sort (u + 1)} => List α", levels := .some #["u"]}: Protocol.ExprEcho)
+ ({ expr := "λ {α : Sort (u + 1)} => List α", levels? := .some #["u"]}: Protocol.ExprEcho)
({
type := { pp? := .some "{α : Type u} → Type u" },
expr := { pp? := .some "fun {α} => List α" }
@@ -194,7 +194,7 @@ def test_env_add_inspect : Test :=
step "env.add"
({
name := name3,
- levels := #["u"]
+ levels? := .some #["u"]
type? := "(α : Type u) → α → (α × α)",
value := "λ (α : Type u) (x : α) => (x, x)",
isTheorem := false
@@ -273,7 +273,7 @@ def test_frontend_process_sorry : Test :=
]
def test_import_open : Test :=
- let header := "import Init\nopen Nat"
+ let header := "import Init\nopen Nat\nuniverse u"
let goal1: Protocol.Goal := {
name := "_uniq.67",
target := { pp? := .some "n + 1 = n.succ" },
@@ -287,9 +287,10 @@ def test_import_open : Test :=
inheritEnv := true,
}: Protocol.FrontendProcess)
({
- units := [{
- boundary := (12, header.utf8ByteSize),
- }],
+ units := [
+ { boundary := (12, 21) },
+ { boundary := (21, header.utf8ByteSize) },
+ ],
}: Protocol.FrontendProcessResult),
step "goal.start" ({ expr := "∀ (n : Nat), n + 1 = Nat.succ n"} : Protocol.GoalStart)
({ stateId := 0, root := "_uniq.65" }: Protocol.GoalStartResult),
@@ -297,6 +298,8 @@ def test_import_open : Test :=
({ nextStateId? := .some 1, goals? := #[goal1], }: Protocol.GoalTacticResult),
step "goal.tactic" ({ stateId := 1, tactic? := .some "apply add_one" }: Protocol.GoalTactic)
({ nextStateId? := .some 2, goals? := .some #[], }: Protocol.GoalTacticResult),
+ step "goal.start" ({ expr := "∀ (x : Sort u), Sort (u + 1)"} : Protocol.GoalStart)
+ ({ stateId := 0, root := "_uniq.65" }: Protocol.GoalStartResult),
]
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
From f42af9f6a8c95c94bbc13160663cdea4baf3f942 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Sat, 5 Apr 2025 14:26:22 -0700
Subject: [PATCH 461/465] fix: Level name capture
---
Pantograph/Library.lean | 53 ++++++++++-------------------------------
Repl.lean | 16 ++++++++-----
Test/Integration.lean | 2 +-
3 files changed, 23 insertions(+), 48 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index 3c147b0..b62a63b 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -116,17 +116,9 @@ def exprEcho (expr: String) (expectedType?: Option String := .none) (levels: Arr
liftExcept e
@[export pantograph_goal_start_expr_m]
-def goalStartExpr (expr: String) (levels: Array String): Protocol.FallibleT CoreM GoalState := do
- let e : Except Protocol.InteractionError _ ← runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
- let expr ← match ← parseElabType expr |>.run with
- | .error e => return .error e
- | .ok expr => pure $ expr
- return .ok $ .ok $ ← GoalState.create expr
- liftExcept e
-
-@[export pantograph_goal_resume]
-def goalResume (target: GoalState) (goals: Array String): Except String GoalState :=
- target.resume (goals.map (λ n => { name := n.toName }) |>.toList)
+def goalStartExpr (expr: String) : Protocol.FallibleT Elab.TermElabM GoalState := do
+ let t ← parseElabType expr
+ GoalState.create t
@[export pantograph_goal_serialize_m]
def goalSerialize (state: GoalState) (options: @&Protocol.Options): CoreM (Array Protocol.Goal) :=
@@ -164,48 +156,27 @@ def goalPrint (state: GoalState) (rootExpr: Bool) (parentExpr: Bool) (goals: Boo
extraMVars,
}
-@[export pantograph_goal_tactic_m]
-def goalTactic (state: GoalState) (goal: MVarId) (tactic: String): CoreM TacticResult :=
- runTermElabM <| state.tryTactic goal tactic
-@[export pantograph_goal_assign_m]
-def goalAssign (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult :=
- runTermElabM <| state.tryAssign goal expr
@[export pantograph_goal_have_m]
-protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult := do
+protected def GoalState.tryHave (state: GoalState) (goal: MVarId) (binderName: String) (type: String): Elab.TermElabM TacticResult := do
let type ← match (← parseTermM type) with
| .ok syn => pure syn
| .error error => return .parseError error
- runTermElabM do
- state.restoreElabM
- state.tryTacticM goal $ Tactic.evalHave binderName.toName type
+ state.restoreElabM
+ state.tryTacticM goal $ Tactic.evalHave binderName.toName type
@[export pantograph_goal_try_define_m]
-protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): CoreM TacticResult := do
+protected def GoalState.tryDefine (state: GoalState) (goal: MVarId) (binderName: String) (expr: String): Elab.TermElabM TacticResult := do
let expr ← match (← parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
- runTermElabM do
- state.restoreElabM
- state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
+ state.restoreElabM
+ state.tryTacticM goal (Tactic.evalDefine binderName.toName expr)
@[export pantograph_goal_try_draft_m]
-protected def GoalState.tryDraft (state: GoalState) (goal: MVarId) (expr: String): CoreM TacticResult := do
+protected def GoalState.tryDraft (state: GoalState) (goal: MVarId) (expr: String): Elab.TermElabM TacticResult := do
let expr ← match (← parseTermM expr) with
| .ok syn => pure syn
| .error error => return .parseError error
- runTermElabM do
- state.restoreElabM
- state.tryTacticM goal (Tactic.evalDraft expr)
-@[export pantograph_goal_let_m]
-def goalLet (state: GoalState) (goal: MVarId) (binderName: String) (type: String): CoreM TacticResult :=
- runTermElabM <| state.tryLet goal binderName type
-@[export pantograph_goal_conv_m]
-def goalConv (state: GoalState) (goal: MVarId): CoreM TacticResult :=
- runTermElabM <| state.conv goal
-@[export pantograph_goal_conv_exit_m]
-def goalConvExit (state: GoalState): CoreM TacticResult :=
- runTermElabM <| state.convExit
-@[export pantograph_goal_calc_m]
-def goalCalc (state: GoalState) (goal: MVarId) (pred: String): CoreM TacticResult :=
- runTermElabM <| state.tryCalc goal pred
+ state.restoreElabM
+ state.tryTacticM goal (Tactic.evalDraft expr)
-- Cancel the token after a timeout.
@[export pantograph_run_cancel_token_with_timeout_m]
diff --git a/Repl.lean b/Repl.lean
index 6d3295e..1971431 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -77,13 +77,14 @@ def runCoreM' { α } (coreM : Protocol.FallibleT CoreM α) : EMainM α := do
def liftMetaM { α } (metaM : MetaM α): EMainM α :=
runCoreM metaM.run'
-def liftTermElabM { α } (termElabM: Elab.TermElabM α) : EMainM α := do
+def liftTermElabM { α } (termElabM: Elab.TermElabM α) (levelNames : List Name := [])
+ : EMainM α := do
let scope := (← get).scope
let context := {
isNoncomputableSection := scope.isNoncomputable,
}
let state := {
- levelNames := scope.levelNames,
+ levelNames := scope.levelNames ++ levelNames,
}
runCoreM $ termElabM.run' context state |>.run'
@@ -268,14 +269,16 @@ def execute (command: Protocol.Command): MainM Json := do
options_print (_: Protocol.OptionsPrint): EMainM Protocol.Options := do
return (← getMainState).options
goal_start (args: Protocol.GoalStart): EMainM Protocol.GoalStartResult := do
- let expr?: Except _ GoalState ← liftTermElabM (match args.expr, args.copyFrom with
- | .some expr, .none => goalStartExpr expr (args.levels?.getD #[]) |>.run
+ let levelNames := (args.levels?.getD #[]).toList.map (·.toName)
+ let expr?: Except _ GoalState ← liftTermElabM (levelNames := levelNames) do
+ match args.expr, args.copyFrom with
+ | .some expr, .none => goalStartExpr expr |>.run
| .none, .some copyFrom => do
(match (← getEnv).find? <| copyFrom.toName with
| .none => return .error <| errorIndex s!"Symbol not found: {copyFrom}"
| .some cInfo => return .ok (← GoalState.create cInfo.type))
| _, _ =>
- return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied")
+ return .error <| errorI "arguments" "Exactly one of {expr, copyFrom} must be supplied"
match expr? with
| .error error => Protocol.throw error
| .ok goalState =>
@@ -349,7 +352,8 @@ def execute (command: Protocol.Command): MainM Json := do
| .none => Protocol.throw $ errorIndex s!"Invalid state index {branchId}"
| .some branch => pure $ target.continue branch
| .none, .some goals =>
- pure $ goalResume target goals
+ let goals := goals.toList.map (λ n => { name := n.toName })
+ pure $ target.resume goals
| _, _ => Protocol.throw $ errorI "arguments" "Exactly one of {branch, goals} must be supplied"
match nextGoalState? with
| .error error => Protocol.throw $ errorI "structure" error
diff --git a/Test/Integration.lean b/Test/Integration.lean
index 55cace6..d80c072 100644
--- a/Test/Integration.lean
+++ b/Test/Integration.lean
@@ -299,7 +299,7 @@ def test_import_open : Test :=
step "goal.tactic" ({ stateId := 1, tactic? := .some "apply add_one" }: Protocol.GoalTactic)
({ nextStateId? := .some 2, goals? := .some #[], }: Protocol.GoalTacticResult),
step "goal.start" ({ expr := "∀ (x : Sort u), Sort (u + 1)"} : Protocol.GoalStart)
- ({ stateId := 0, root := "_uniq.65" }: Protocol.GoalStartResult),
+ ({ stateId := 3, root := "_uniq.5" }: Protocol.GoalStartResult),
]
def runTest (env: Lean.Environment) (steps: Test): IO LSpec.TestSeq := do
From 9216e4fa86849f7b12115153518fc0af1f5d61b6 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 7 Apr 2025 11:51:48 -0700
Subject: [PATCH 462/465] chore: Format code
---
Pantograph/Environment.lean | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 21d7b37..3907105 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -180,7 +180,7 @@ def addDecl (name: String) (levels: Array String := #[]) (type?: Option String)
Lean.Declaration.thmDecl <| Lean.mkTheoremValEx
(name := name.toName)
(levelParams := levelParams)
- (type := type )
+ (type := type)
(value := value)
(all := [])
else
From 5df3d2bee19b0ecb2db28ef8995077fbd663a82d Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Mon, 7 Apr 2025 20:17:58 -0700
Subject: [PATCH 463/465] refactor: Remove `runTermElabM` from library
---
Pantograph/Library.lean | 28 +++++++++++-----------------
Repl.lean | 4 +++-
Test/Library.lean | 7 +++++--
3 files changed, 19 insertions(+), 20 deletions(-)
diff --git a/Pantograph/Library.lean b/Pantograph/Library.lean
index b62a63b..e26b4ff 100644
--- a/Pantograph/Library.lean
+++ b/Pantograph/Library.lean
@@ -41,8 +41,6 @@ namespace Pantograph
def runMetaM { α } (metaM: MetaM α): CoreM α :=
metaM.run'
-def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
- termElabM.run' (ctx := defaultElabContext) |>.run'
def errorI (type desc: String): Protocol.InteractionError := { error := type, desc := desc }
@@ -99,21 +97,17 @@ def parseElabExpr (expr: String) (expectedType?: Option String := .none): Protoc
| .ok expr => return (← instantiateMVars expr)
@[export pantograph_expr_echo_m]
-def exprEcho (expr: String) (expectedType?: Option String := .none) (levels: Array String := #[]) (options: @&Protocol.Options := {}):
- Protocol.FallibleT CoreM Protocol.ExprEchoResult := do
- let e : Except Protocol.InteractionError _ ← runTermElabM $ Elab.Term.withLevelNames (levels.toList.map (·.toName)) do
- let expr ← match ← parseElabExpr expr expectedType? |>.run with
- | .error e => return Except.error e
- | .ok expr => pure expr
- try
- let type ← unfoldAuxLemmas (← Meta.inferType expr)
- return .ok $ .ok ({
- type := (← serializeExpression options type),
- expr := (← serializeExpression options expr),
- }: Protocol.ExprEchoResult)
- catch exception =>
- return Except.error $ errorI "typing" (← exception.toMessageData.toString)
- liftExcept e
+def exprEcho (expr: String) (expectedType?: Option String := .none) (options: @&Protocol.Options := {}):
+ Protocol.FallibleT Elab.TermElabM Protocol.ExprEchoResult := do
+ let expr ← parseElabExpr expr expectedType?
+ try
+ let type ← unfoldAuxLemmas (← Meta.inferType expr)
+ return {
+ type := (← serializeExpression options type),
+ expr := (← serializeExpression options expr),
+ }
+ catch exception =>
+ Protocol.throw $ errorI "typing" (← exception.toMessageData.toString)
@[export pantograph_goal_start_expr_m]
def goalStartExpr (expr: String) : Protocol.FallibleT Elab.TermElabM GoalState := do
diff --git a/Repl.lean b/Repl.lean
index 1971431..bcbe8f9 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -247,7 +247,9 @@ def execute (command: Protocol.Command): MainM Json := do
return {}
expr_echo (args: Protocol.ExprEcho): EMainM Protocol.ExprEchoResult := do
let state ← getMainState
- runCoreM' $ exprEcho args.expr (expectedType? := args.type?) (levels := args.levels?.getD #[]) (options := state.options)
+ let levelNames := (args.levels?.getD #[]).toList.map (·.toName)
+ liftExcept $ ← liftTermElabM (levelNames := levelNames) do
+ (exprEcho args.expr (expectedType? := args.type?) (options := state.options)).run
options_set (args: Protocol.OptionsSet): EMainM Protocol.OptionsSetResult := do
let state ← getMainState
let options := state.options
diff --git a/Test/Library.lean b/Test/Library.lean
index df1ba4d..8763672 100644
--- a/Test/Library.lean
+++ b/Test/Library.lean
@@ -8,15 +8,18 @@ open Pantograph
namespace Pantograph.Test.Library
+def runTermElabM { α } (termElabM: Elab.TermElabM α): CoreM α :=
+ termElabM.run' (ctx := defaultElabContext) |>.run'
+
def test_expr_echo (env: Environment): IO LSpec.TestSeq := do
let inner: CoreM LSpec.TestSeq := do
let prop_and_proof := "⟨∀ (x: Prop), x → x, λ (x: Prop) (h: x) => h⟩"
let tests := LSpec.TestSeq.done
- let echoResult ← exprEcho prop_and_proof (options := {})
+ let echoResult ← runTermElabM $ exprEcho prop_and_proof (options := {})
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
type := { pp? := "?m.2" }, expr := { pp? := "?m.3" }
}))
- let echoResult ← exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := { printExprAST := true })
+ let echoResult ← runTermElabM $ exprEcho prop_and_proof (expectedType? := .some "Σ' p:Prop, p") (options := { printExprAST := true })
let tests := tests.append (LSpec.test "fail" (echoResult.toOption == .some {
type := {
pp? := "(p : Prop) ×' p",
From b6c3f7d8fdc93fa8304eb1e9b3d7117656e24dc5 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Apr 2025 10:54:23 -0700
Subject: [PATCH 464/465] chore: Update Lean to v4.18.0
---
Pantograph/Delate.lean | 2 +-
Pantograph/Environment.lean | 4 ++--
Pantograph/Goal.lean | 2 +-
Repl.lean | 4 ++--
Test/Common.lean | 4 ++--
Test/Proofs.lean | 2 +-
lean-toolchain | 2 +-
7 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/Pantograph/Delate.lean b/Pantograph/Delate.lean
index b6e016c..a745854 100644
--- a/Pantograph/Delate.lean
+++ b/Pantograph/Delate.lean
@@ -26,7 +26,7 @@ def analyzeProjection (env: Environment) (e: Expr): Projection :=
| _ => panic! "Argument must be proj"
if (getStructureInfo? env typeName).isSome then
let ctor := getStructureCtor env typeName
- let fieldName := getStructureFields env typeName |>.get! idx
+ let fieldName := (getStructureFields env typeName)[idx]!
let projector := getProjFnForField? env typeName fieldName |>.get!
.field projector ctor.numParams
else
diff --git a/Pantograph/Environment.lean b/Pantograph/Environment.lean
index 3907105..4f0a678 100644
--- a/Pantograph/Environment.lean
+++ b/Pantograph/Environment.lean
@@ -26,7 +26,7 @@ def env_catalog (env: Environment): Array Name := env.constants.fold (init := #[
def module_of_name (env: Environment) (name: Name): Option Name := do
let moduleId ← env.getModuleIdxFor? name
if h : moduleId.toNat < env.allImportedModuleNames.size then
- return env.allImportedModuleNames.get moduleId.toNat h
+ return env.allImportedModuleNames[moduleId.toNat]
else
.none
@@ -75,7 +75,7 @@ def inspect (args: Protocol.EnvInspect) (options: @&Protocol.Options): Protocol.
let info? := env.find? name
let .some info := info? | Protocol.throw $ Protocol.errorIndex s!"Symbol not found {args.name}"
let module? := env.getModuleIdxFor? name >>=
- (λ idx => env.allImportedModuleNames.get? idx.toNat)
+ (λ idx => env.allImportedModuleNames[idx.toNat]?)
let value? := match args.value?, info with
| .some true, _ => info.value?
| .some false, _ => .none
diff --git a/Pantograph/Goal.lean b/Pantograph/Goal.lean
index 9af1740..7f135f5 100644
--- a/Pantograph/Goal.lean
+++ b/Pantograph/Goal.lean
@@ -102,7 +102,7 @@ private def GoalState.restoreTacticM (state: GoalState) (goal: MVarId): Elab.Tac
@[export pantograph_goal_state_focus]
protected def GoalState.focus (state: GoalState) (goalId: Nat): Option GoalState := do
- let goal ← state.savedState.tactic.goals.get? goalId
+ let goal ← state.savedState.tactic.goals[goalId]?
return {
state with
savedState := {
diff --git a/Repl.lean b/Repl.lean
index bcbe8f9..a735c88 100644
--- a/Repl.lean
+++ b/Repl.lean
@@ -62,7 +62,7 @@ def runCoreM { α } (coreM : CoreM α) : EMainM α := do
let desc ← ex.toMessageData.toString
return Except.error $ ({ error := "exception", desc } : Protocol.InteractionError)
if let .some token := cancelTk? then
- runCancelTokenWithTimeout token (timeout := .mk options.timeout)
+ runCancelTokenWithTimeout token (timeout := .ofBitVec options.timeout)
let (result, state') ← match ← (coreM'.run coreCtx coreState).toIO' with
| Except.error (Exception.error _ msg) => Protocol.throw $ { error := "core", desc := ← msg.toString }
| Except.error (Exception.internal id _) => Protocol.throw $ { error := "internal", desc := (← id.getName).toString }
@@ -290,7 +290,7 @@ def execute (command: Protocol.Command): MainM Json := do
let state ← getMainState
let .some goalState := state.goalStates[args.stateId]? |
Protocol.throw $ errorIndex s!"Invalid state index {args.stateId}"
- let .some goal := goalState.goals.get? args.goalId |
+ let .some goal := goalState.goals[args.goalId]? |
Protocol.throw $ errorIndex s!"Invalid goal index {args.goalId}"
let nextGoalState?: Except _ TacticResult ← liftTermElabM do
-- NOTE: Should probably use a macro to handle this...
diff --git a/Test/Common.lean b/Test/Common.lean
index c32d62d..c8ffa5d 100644
--- a/Test/Common.lean
+++ b/Test/Common.lean
@@ -67,8 +67,8 @@ protected def Goal.devolatilize (goal: Goal): Goal :=
end Condensed
-def GoalState.get! (state: GoalState) (i: Nat): MVarId := state.goals.get! i
-def GoalState.tacticOn (state: GoalState) (goalId: Nat) (tactic: String) := state.tryTactic (state.goals.get! goalId) tactic
+def GoalState.get! (state: GoalState) (i: Nat): MVarId := state.goals[i]!
+def GoalState.tacticOn (state: GoalState) (goalId: Nat) (tactic: String) := state.tryTactic (state.get! goalId) tactic
def TacticResult.toString : TacticResult → String
| .success state => s!".success ({state.goals.length} goals)"
diff --git a/Test/Proofs.lean b/Test/Proofs.lean
index a760eb4..ceb8690 100644
--- a/Test/Proofs.lean
+++ b/Test/Proofs.lean
@@ -328,7 +328,7 @@ def test_or_comm: TestM Unit := do
addTest $ assertUnreachable $ msg
return ()
| .ok state => pure state
- addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals.get! 0])
+ addTest $ LSpec.test "(resume)" (state2b.goals == [state2.goals[0]!])
let state3_1 ← match ← state2b.tacticOn (goalId := 0) (tactic := "apply Or.inr") with
| .success state => pure state
| other => do
diff --git a/lean-toolchain b/lean-toolchain
index 5499a24..b2153cd 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.17.0
+leanprover/lean4:v4.18.0
From 13b03b602b262ce44d42318540b4d74999e29b72 Mon Sep 17 00:00:00 2001
From: Leni Aniva <v@leni.sh>
Date: Tue, 8 Apr 2025 10:59:37 -0700
Subject: [PATCH 465/465] chore: Update flake
---
flake.lock | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/flake.lock b/flake.lock
index 11c740e..d09589f 100644
--- a/flake.lock
+++ b/flake.lock
@@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
- "lastModified": 1741352980,
- "narHash": "sha256-+u2UunDA4Cl5Fci3m7S643HzKmIDAe+fiXrLqYsR2fs=",
+ "lastModified": 1743550720,
+ "narHash": "sha256-hIshGgKZCgWh6AYJpJmRgFdR3WUbkY04o82X05xqQiY=",
"owner": "hercules-ci",
"repo": "flake-parts",
- "rev": "f4330d22f1c5d2ba72d3d22df5597d123fdb60a9",
+ "rev": "c621e8422220273271f52058f618c94e405bb0f5",
"type": "github"
},
"original": {
@@ -44,11 +44,11 @@
]
},
"locked": {
- "lastModified": 1741472588,
- "narHash": "sha256-XnMeMZKuspEphP+fEq4soc3PY7Nz+gsMPjlsXbobyrA=",
+ "lastModified": 1743534244,
+ "narHash": "sha256-WnoYs2iyrfgh35eXErCOyos8E2YbW3LT1xm/EtT88/k=",
"owner": "lenianiva",
"repo": "lean4-nix",
- "rev": "cffeb67d58e02b50ccb9acd51b0212dc653ed6ce",
+ "rev": "5eb7f03be257e327fdb3cca9465392e68dc28a4d",
"type": "github"
},
"original": {
@@ -59,11 +59,11 @@
},
"nixpkgs": {
"locked": {
- "lastModified": 1742751704,
- "narHash": "sha256-rBfc+H1dDBUQ2mgVITMGBPI1PGuCznf9rcWX/XIULyE=",
+ "lastModified": 1743975612,
+ "narHash": "sha256-o4FjFOUmjSRMK7dn0TFdAT0RRWUWD+WsspPHa+qEQT8=",
"owner": "nixos",
"repo": "nixpkgs",
- "rev": "f0946fa5f1fb876a9dc2e1850d9d3a4e3f914092",
+ "rev": "a880f49904d68b5e53338d1e8c7bf80f59903928",
"type": "github"
},
"original": {
@@ -75,11 +75,11 @@
},
"nixpkgs-lib": {
"locked": {
- "lastModified": 1740877520,
- "narHash": "sha256-oiwv/ZK/2FhGxrCkQkB83i7GnWXPPLzoqFHpDD3uYpk=",
+ "lastModified": 1743296961,
+ "narHash": "sha256-b1EdN3cULCqtorQ4QeWgLMrd5ZGOjLSLemfa00heasc=",
"owner": "nix-community",
"repo": "nixpkgs.lib",
- "rev": "147dee35aab2193b174e4c0868bd80ead5ce755c",
+ "rev": "e4822aea2a6d1cdd36653c134cacfd64c97ff4fa",
"type": "github"
},
"original": {