From 5cedb9d88c477b5d307bafc22b62315e30eb83cf Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 13 Aug 2023 21:19:06 -0700 Subject: [PATCH 001/377] 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 ' = '" - 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 := "", 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 ' = '" + 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 -- 2.44.1 From 9eadd1d4d4a75e66e539fd76bb4c10903d693de2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 14 Aug 2023 17:07:53 -0700 Subject: [PATCH 002/377] 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 ' = '" + 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 ' = '" - 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": }`: Show the type and package of a given symbol +- `inspect {"name": , "value": }`: Show the type and package of a + given symbol; If value flag is set, the value is printed or hidden. By default + only the values of definitions are printed. - `clear`: Delete all cached expressions and proof trees - `expr.type {"expr": }`: Determine the type of an expression and round-trip it - `proof.start {["name": ], ["expr": ], ["copyFrom": ]}`: 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 -- 2.44.1 From 7771408de1ea48cf57f6fa44ccbdbee39dc6dfd1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 14 Aug 2023 21:43:40 -0700 Subject: [PATCH 003/377] 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": }`: Determine the type of an expression and round-trip it +- `expr.echo {"expr": }`: Determine the type of an expression and round-trip it - `proof.start {["name": ], ["expr": ], ["copyFrom": ]}`: Start a new proof state from a given expression or symbol - `proof.tactic {"treeId": , "stateId": , "goalId": , "tactic": string}`: Execute a tactic on a given proof state - `proof.printTree {"treeId": }`: 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 := "", + 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 := "", + fileName := "", 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 := "", + 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 -- 2.44.1 From b2ba26528d6cf8934c8a9edf825d6bbe2114a738 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 15 Aug 2023 15:40:54 -0700 Subject: [PATCH 004/377] 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 -- 2.44.1 From 96cbbf25510bd75e455c79a4f085900a9344c671 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 16 Aug 2023 19:25:32 -0700 Subject: [PATCH 005/377] 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": , "value": }`: Show the type and package of a +- `reset`: Delete all cached expressions and proof trees +- `expr.echo {"expr": }`: Determine the type of an expression and round-trip it +- `lib.catalog`: Display a list of all safe Lean symbols in the current context +- `lib.inspect {"name": , "value": }`: Show the type and package of a 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": }`: 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": ], ["expr": ], ["copyFrom": ]}`: Start a new proof state from a given expression or symbol - `proof.tactic {"treeId": , "stateId": , "goalId": , "tactic": string}`: Execute a tactic on a given proof state - `proof.printTree {"treeId": }`: 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 }: -- 2.44.1 From a8cbb3be4f768484289d66911fc17f93d8e28aa9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 22 Aug 2023 09:54:37 -0700 Subject: [PATCH 006/377] 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 -- 2.44.1 From 59c046efc6fe8911c840e7850c9f4a2effc3cad5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 23 Aug 2023 12:51:06 -0700 Subject: [PATCH 007/377] 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 -- 2.44.1 From 0c330c87784c89a8e59b66fa61b59000e7405642 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 23 Aug 2023 13:00:11 -0700 Subject: [PATCH 008/377] 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 -- 2.44.1 From ff8fed8741c88f0f4828bf9f09ae64bd43d9c755 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 24 Aug 2023 22:51:40 -0700 Subject: [PATCH 009/377] 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": }`: 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": , "stateId": , "goalId": , "tactic": string}`: Execute a tactic on a given proof state - `proof.printTree {"treeId": }`: 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: -- 2.44.1 From bd4fbcc369840237cb107765a153849eb9088aae Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 24 Aug 2023 23:12:18 -0700 Subject: [PATCH 010/377] 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)) ] -- 2.44.1 From 9c4c43a9f1118d2501c836479008b4a5dffe8927 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 23 Aug 2023 13:19:38 -0700 Subject: [PATCH 011/377] 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) -- 2.44.1 From a86af1bc57bf00360e8df6a58b302159e64d9495 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 27 Aug 2023 19:53:09 -0700 Subject: [PATCH 012/377] 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": ], ["expr": ], ["copyFrom": ]}`: Start a new proof state from a given expression or symbol -- `proof.tactic {"treeId": , "stateId": , "goalId": , "tactic": string}`: Execute a tactic on a given proof state -- `proof.printTree {"treeId": }`: Print the topological structure of a proof tree +- `proof.tactic {"goalId": , "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 := "", - 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 := "", + 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 -- 2.44.1 From a6e337a89e516e4f36d8a40f352a3adfe7b2e504 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 27 Aug 2023 19:58:52 -0700 Subject: [PATCH 013/377] 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": ], ["expr": ], ["copyFrom": ]}`: Start a new proof state from a given expression or symbol -- `proof.tactic {"goalId": , "tactic": }`: Execute a tactic string on a given proof state -- `proof.printTree`: Print the number of goals +- `goal.start {["name": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol +- `goal.tactic {"goalId": , "tactic": }`: Execute a tactic string on a given goal +- `stat`: Display resource usage ## Errors -- 2.44.1 From b98304f78ad7c508a7c21f8c9f9c8db4f8b5d224 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 27 Aug 2023 19:59:31 -0700 Subject: [PATCH 014/377] 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 -- 2.44.1 From 6b96f7893fa1b5f7f68c383e0221745281aef93a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 27 Aug 2023 22:50:18 -0700 Subject: [PATCH 015/377] 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}" -- 2.44.1 From f1f1c20ff9a9d93d318e96795da684d55d6911b2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 30 Aug 2023 19:16:33 -0700 Subject: [PATCH 016/377] 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": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol - `goal.tactic {"goalId": , "tactic": }`: Execute a tactic string on a given goal +- `goal.remove {"goalIds": []}"`: Remove a bunch of stored goals. - `stat`: Display resource usage ## Errors -- 2.44.1 From d7077ce854ee51f6fe148bd069fc133373c0d42f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 13 Sep 2023 21:02:26 -0700 Subject: [PATCH 017/377] 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 -- 2.44.1 From 35b391881efe878700bfaff7e8ca347934662901 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 1 Oct 2023 21:58:58 -0700 Subject: [PATCH 018/377] 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 -- 2.44.1 From 6d15d1e6704849c19f8dd960b0745dfb5dd6aaab Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 2 Oct 2023 10:26:19 -0700 Subject: [PATCH 019/377] 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 -- 2.44.1 From 0948e71d60df16f761337368e362ff63ba409713 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 2 Oct 2023 10:30:07 -0700 Subject: [PATCH 020/377] 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) -- 2.44.1 From a8cf94ccb142907c500d6f5bc0a5d33523e28526 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Oct 2023 17:49:43 -0700 Subject: [PATCH 021/377] 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 -- 2.44.1 From 13f3460e9a5b5666b6d9c1a150b659da9e958e77 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Oct 2023 17:51:41 -0700 Subject: [PATCH 022/377] 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) -- 2.44.1 From 7a5fe554ba0eae2fc92b73ae6781c004268bb374 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Oct 2023 17:31:36 -0700 Subject: [PATCH 023/377] 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 := "", + 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 -- 2.44.1 From 41db295ff57b85acaaa47d12b8bf184874dc1aa4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 15 Oct 2023 12:31:22 -0700 Subject: [PATCH 024/377] 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 := "", 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 := [ -- 2.44.1 From 538ba6e7d7da468de75b5840757b62842bd52519 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 15 Oct 2023 17:15:23 -0700 Subject: [PATCH 025/377] 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 := "") 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 := "") 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" }) ] -- 2.44.1 From 3d7d5d6b4dce481cf8f5dcf0f68514f0af3fbbb1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 20 Oct 2023 11:52:09 -0700 Subject: [PATCH 026/377] 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; + }; + }; +} -- 2.44.1 From a9294e0338c3e32e5d649ea562b32349a249f958 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 20 Oct 2023 12:54:35 -0700 Subject: [PATCH 027/377] 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 -- 2.44.1 From d991533170c0643093e224a6f7cfef9f888731ef Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 25 Oct 2023 16:03:45 -0700 Subject: [PATCH 028/377] 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 -- 2.44.1 From 8029298db7b253cf8d81436a623e2f9e007dc782 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 25 Oct 2023 22:18:59 -0700 Subject: [PATCH 029/377] 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" -- 2.44.1 From c852db2f46f6e28efb2b63cc72d8e77ef651fbba Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 26 Oct 2023 11:22:02 -0700 Subject: [PATCH 030/377] 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 -- 2.44.1 From 269e5c707c7bb182562d45cd6b57ccc2d6703b8d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 26 Oct 2023 22:47:42 -0700 Subject: [PATCH 031/377] 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 := "") 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) -- 2.44.1 From f064bb21a41ce62e27376887e2c0faeea253a4f0 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 27 Oct 2023 15:15:22 -0700 Subject: [PATCH 032/377] 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 := "") 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 -- 2.44.1 From 3b1746490d0ca76cbf22ca668e8b5d0046e29328 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 27 Oct 2023 15:32:59 -0700 Subject: [PATCH 033/377] 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 -- 2.44.1 From 045181356c9e906b0397b1ca0792d36663f01974 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 27 Oct 2023 15:41:12 -0700 Subject: [PATCH 034/377] 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": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol -- `goal.tactic {"goalId": , "tactic": }`: Execute a tactic string on a given goal -- `goal.remove {"goalIds": []}"`: Remove a bunch of stored goals. +- `goal.tactic {"stateId": , "goalId": , ["tactic": ], ["expr": ]}`: Execute a tactic string on a given goal +- `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. +- `goal.print {"stateId": }"`: 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 -- 2.44.1 From c0dfa04b1896915612237fe82c8cef8df2a8f0b3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 29 Oct 2023 11:18:35 -0700 Subject: [PATCH 035/377] 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)"), -- 2.44.1 From de250eafd00500677734defceb9609c9e093b4e2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 29 Oct 2023 11:56:56 -0700 Subject: [PATCH 036/377] 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)) -- 2.44.1 From e523e8bcc6b340aa8cf6edd5c9550259af47ae70 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 29 Oct 2023 11:57:24 -0700 Subject: [PATCH 037/377] 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 -- 2.44.1 From 60854525b959927fb36a3c89033d50643c0add51 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 29 Oct 2023 12:50:36 -0700 Subject: [PATCH 038/377] 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)))") -- 2.44.1 From 1a99a2e7b25d2d9c88d1c51211e6938eff1eca57 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 29 Oct 2023 13:03:48 -0700 Subject: [PATCH 039/377] 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 -- 2.44.1 From d1c0dc376fce10d1abe8d7576c2673626f828706 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 30 Oct 2023 14:44:06 -0700 Subject: [PATCH 040/377] 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 -- 2.44.1 From 59ac83f0b702c23d2c9364b84c79b122be386dd1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 30 Oct 2023 14:45:43 -0700 Subject: [PATCH 041/377] 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) := [ -- 2.44.1 From 4a4a33cea75fcdb604700b59333b79555275ce13 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 Nov 2023 15:00:51 -0700 Subject: [PATCH 042/377] 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 := "", 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 -- 2.44.1 From 333355a85ddb67bbc449f98178b4d065a6aa47af Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 Nov 2023 15:33:53 -0700 Subject: [PATCH 043/377] 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 () -- 2.44.1 From 97d658cfc5bacca50d0d959375bbbc2c4ba090fa Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 Nov 2023 15:51:09 -0700 Subject: [PATCH 044/377] 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 -- 2.44.1 From 4be9dbc84a7f07abc90cb3d99f61a11db23f3790 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 Nov 2023 15:53:57 -0700 Subject: [PATCH 045/377] 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 () -- 2.44.1 From a5b5e0185828f2f1dbd5382faf06caf1f0e1e78e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 Nov 2023 15:54:28 -0700 Subject: [PATCH 046/377] 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 -- 2.44.1 From ce1cb13e54106160e15acbeb44e645e27bafb2ff Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 Nov 2023 10:45:11 -0800 Subject: [PATCH 047/377] 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 ' = '" - 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)) -- 2.44.1 From c6bb4be59717f303840599026ae8eb02afc847c9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 Nov 2023 11:04:28 -0800 Subject: [PATCH 048/377] 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": }`: 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": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol - `goal.tactic {"stateId": , "goalId": , ["tactic": ], ["expr": ]}`: Execute a tactic string on a given goal +- `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: Continue from a proof state - `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. - `goal.print {"stateId": }"`: Print a goal state - `stat`: Display resource usage -- 2.44.1 From 8182da436ddcdfeb3569c39aa44d7d9c53da6659 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 Nov 2023 11:43:57 -0800 Subject: [PATCH 049/377] 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 := [ -- 2.44.1 From ce585f7288afc6d341f96def3c546430d52c8e57 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 Nov 2023 11:51:31 -0800 Subject: [PATCH 050/377] 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")] -- 2.44.1 From 4396da3e652e9103aeb1bdb570c054d9f99f042a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 Nov 2023 12:20:08 -0800 Subject: [PATCH 051/377] 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 := -- 2.44.1 From 53b63bf46c21c996d11fd1b0a3d08068be7f721f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 7 Nov 2023 12:04:17 -0800 Subject: [PATCH 052/377] 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 -- 2.44.1 From d9745094fa2f0706a567a70cc32920a74aed494c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 7 Nov 2023 12:09:54 -0800 Subject: [PATCH 053/377] 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 -- 2.44.1 From e654613182052affcffe355c764bef60b7c3ef6c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 7 Nov 2023 13:07:50 -0800 Subject: [PATCH 054/377] 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)) ] -- 2.44.1 From a4913165419767ff4d5fb3b03ba24a0551d24cb3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 7 Nov 2023 13:10:14 -0800 Subject: [PATCH 055/377] 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, -- 2.44.1 From a1d991f5dbe8d618214ff971534dc8fac5149076 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 9 Nov 2023 22:24:17 -0800 Subject: [PATCH 056/377] 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 -- 2.44.1 From aaebb6b121c218431f539be6e89c7765d94c23ea Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 25 Nov 2023 15:07:56 -0800 Subject: [PATCH 057/377] 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 -/ -- 2.44.1 From fe850ded9868784f65d1f6c6da82cbed93e230ab Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 26 Nov 2023 22:14:58 -0800 Subject: [PATCH 058/377] 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 := -- 2.44.1 From e0cfdfaf166c0428260f49fb924fa4cccb4a9b29 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 26 Nov 2023 23:48:47 -0800 Subject: [PATCH 059/377] 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 -- 2.44.1 From 860d2e239a7c6c966a40c3d3b2b169a3576cfcb4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 27 Nov 2023 09:54:41 -0800 Subject: [PATCH 060/377] 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 -- 2.44.1 From 35f411041eadc946c7ea4a2b9eb1c2eca5080f35 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 4 Dec 2023 16:21:02 -0800 Subject: [PATCH 061/377] 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 := "", + 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 -- 2.44.1 From f72a82a4c91fbb96b98b1f406e660e63e887211f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 4 Dec 2023 16:40:15 -0800 Subject: [PATCH 062/377] 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 -- 2.44.1 From c80d7567b6eea9ad4b1d692a3d2c902e153293af Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 4 Dec 2023 23:36:09 -0800 Subject: [PATCH 063/377] 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 -- 2.44.1 From cdb1e8576f671e5650468e6a351c9d0cd3cbc9e7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 5 Dec 2023 19:07:00 -0800 Subject: [PATCH 064/377] 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 -- 2.44.1 From dbfee00420d8ce93d152888c61c601540ec3dfb3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 5 Dec 2023 20:20:08 -0800 Subject: [PATCH 065/377] 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" [] -- 2.44.1 From 079f12d6d3378a779a91a9e99f29f7e243dd2914 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 5 Dec 2023 20:21:07 -0800 Subject: [PATCH 066/377] 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 -- 2.44.1 From 8a8db545a59dc6296a9421478ccacc3e43159f0d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 5 Dec 2023 22:45:59 -0800 Subject: [PATCH 067/377] 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"} -- 2.44.1 From 924a67f46daaaefd3f4bc91f815b6d465a4f7f23 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 6 Dec 2023 15:05:04 -0800 Subject: [PATCH 068/377] 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? -- 2.44.1 From d7fcc502f9e848ad4a36974dd694614f6e4c7a44 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 7 Dec 2023 12:36:43 -0800 Subject: [PATCH 069/377] 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 -- 2.44.1 From 2fe4fa9bc46e30ba7d9089a3ecd7c58a2a75f6c3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Dec 2023 16:17:16 -0800 Subject: [PATCH 070/377] 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 => -- 2.44.1 From bd0c66facc42700a1efe761ea1a4c40399c24bdc Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Dec 2023 17:31:25 -0800 Subject: [PATCH 071/377] 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 -- 2.44.1 From ac9f6f810c6a332fd0622e47c7f397bcb20550bb Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Dec 2023 17:32:30 -0800 Subject: [PATCH 072/377] 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 := "") +/-- 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 -- 2.44.1 From 085b12c255b2d97ec9c01dc342977689f071b604 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 12 Dec 2023 18:39:02 -0800 Subject: [PATCH 073/377] 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 -- 2.44.1 From ff4671cdd091da66668d20cf18b3fc829ad8bb1d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 12 Dec 2023 18:56:25 -0800 Subject: [PATCH 074/377] 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": }`: Determine the type of an expression and round-trip it -- `lib.catalog`: Display a list of all safe Lean symbols in the current context -- `lib.inspect {"name": , "value": }`: Show the type and package of a +- `env.catalog`: Display a list of all safe Lean symbols in the current environment +- `env.inspect {"name": , "value": }`: Show the type and package of a given symbol; If value flag is set, the value is printed or hidden. By default only the values of definitions are printed. - `options.set { key: value, ... }`: Set one or more options (not Lean options; those diff --git a/Test/Catalog.lean b/Test/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 }: -- 2.44.1 From 3c96a7c0ea9cb47e6fd8b74035704b521b133f68 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 13 Dec 2023 19:35:32 -0800 Subject: [PATCH 075/377] 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 -- 2.44.1 From 85eb42207c4d234714e87e00de3e2cc35a103483 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Dec 2023 05:52:12 -0800 Subject: [PATCH 076/377] 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 -- 2.44.1 From a540dd4540badfbc4fe2b0441ef77b314023c3d9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Dec 2023 11:11:24 -0800 Subject: [PATCH 077/377] 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 -- 2.44.1 From aef93cf5063ed5ef9a4e599728fc8dfc8bccd533 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Dec 2023 13:07:59 -0500 Subject: [PATCH 078/377] 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)) ] -- 2.44.1 From da194a1165745607468e45b9bd2c0e66d95aa7ef Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Dec 2023 13:37:55 -0500 Subject: [PATCH 079/377] 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 --- -- 2.44.1 From dc90b6b73e9e016144871d9619206d9ced04f636 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Dec 2023 13:40:36 -0500 Subject: [PATCH 080/377] 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 -- 2.44.1 From 1c370ef2ae3db85907f8870dd85532266ff513e9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 26 Dec 2023 12:22:57 -0500 Subject: [PATCH 081/377] 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 -- 2.44.1 From 6692303da616726ff9ea0b577f1ca6c42b4ccd7c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 7 Jan 2024 14:14:20 -0800 Subject: [PATCH 082/377] 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 := "", + 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 := "", - 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 := "", - 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 := "", - 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 -- 2.44.1 From 6fb1b2e78716486dd5b313d2f1349840a33c4f73 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 16 Jan 2024 13:29:30 -0800 Subject: [PATCH 083/377] 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 -- 2.44.1 From 50ac2fea4bb1cf258589daa595bbb8bc25d58ba2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 16 Jan 2024 14:11:52 -0800 Subject: [PATCH 084/377] 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 -- 2.44.1 From 6a81d83c1f824b6e975378070544054a18bf67c0 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 16 Jan 2024 16:44:54 -0800 Subject: [PATCH 085/377] 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 -- 2.44.1 From 25f3a2f19d40da37bd42a79c8a5ae7288094e23a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 24 Jan 2024 18:19:04 -0800 Subject: [PATCH 086/377] 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 -- 2.44.1 From 40d61fecc5dff01026a35485d87b12dc1a893354 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 30 Jan 2024 16:37:35 -0800 Subject: [PATCH 087/377] 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 -- 2.44.1 From fe5c1eda7d04a06b48a733f3fd11a8be5975d08a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 30 Jan 2024 17:22:20 -0800 Subject: [PATCH 088/377] 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 -- 2.44.1 From 4acd367ca7889e680d0c5d047c7f7a755442e5d4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 30 Jan 2024 17:45:32 -0800 Subject: [PATCH 089/377] 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 -- 2.44.1 From 5f5d06f1d8181e92bed6f8d928c01495076bee90 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 5 Feb 2024 11:49:01 -0800 Subject: [PATCH 090/377] 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; -- 2.44.1 From df4e044e5fd655c489b9ebe9f5face088a5cee6f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 13 Feb 2024 15:30:56 -0500 Subject: [PATCH 091/377] 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; -- 2.44.1 From 111781816f1aa3fac4cafa0c82a260f4bec96ef0 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Feb 2024 14:47:09 -0800 Subject: [PATCH 092/377] 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 -- 2.44.1 From 7e28ded23fd581e863dc718d71f7b0b78ee97a7f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 6 Mar 2024 15:14:08 -0800 Subject: [PATCH 093/377] 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 ({ -- 2.44.1 From 93b7d8b67da9ab439d1a5d6138513aab74e44751 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 6 Mar 2024 15:26:35 -0800 Subject: [PATCH 094/377] 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; }; -- 2.44.1 From 267d635c056c20c5c07d7a4b06a39d34fae86f1f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 6 Mar 2024 15:27:22 -0800 Subject: [PATCH 095/377] 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] -- 2.44.1 From 7bc0f826542048703aa88fe5de1311bf43aab3be Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Mar 2024 23:50:44 -0800 Subject: [PATCH 096/377] 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 -- 2.44.1 From 2ad7ad8778601c90d29b8d5f4cdbc455d9372137 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 9 Mar 2024 16:50:36 -0800 Subject: [PATCH 097/377] 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 ' = '" - 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 := "", - 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 ' = '" + 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 := "", + 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 -- 2.44.1 From eeb149a32cd9f01e33eae334beae90e4c7115e96 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 9 Mar 2024 19:36:25 -0800 Subject: [PATCH 098/377] 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 -- 2.44.1 From f18a9dd1d572038d4591e634e879ea63e1f6b888 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 9 Mar 2024 20:33:36 -0800 Subject: [PATCH 099/377] 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 -- 2.44.1 From 996f16bbb81b55276f25b9bba16bf1d2289769bc Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 10 Mar 2024 06:41:35 -0700 Subject: [PATCH 100/377] 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 -- 2.44.1 From a5b07214824fef185f1e9cf3484523bfb608c437 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 10 Mar 2024 08:13:10 -0700 Subject: [PATCH 101/377] 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 -- 2.44.1 From 0b91c41ad2334d9ce290a1db2f5069dafef7725e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 10 Mar 2024 15:09:38 -0700 Subject: [PATCH 102/377] 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) -- 2.44.1 From ef864ea16d5480ecfb7da2d189b3765a5eedd129 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 10 Mar 2024 15:33:32 -0700 Subject: [PATCH 103/377] 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 := -- 2.44.1 From 4eec930dd46e0f37c535a1d9a239d694a5474ad1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 11 Mar 2024 21:31:59 -0700 Subject: [PATCH 104/377] 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 => -- 2.44.1 From 3debcc021a5758cf8184c9ac59871634487ece51 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Mar 2024 16:34:01 -0700 Subject: [PATCH 105/377] 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 -- 2.44.1 From e6dbf88ce29307f08fc26053393ede5e24fe512a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Mar 2024 22:40:14 -0700 Subject: [PATCH 106/377] 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, -- 2.44.1 From 81aabc52eadb2a695b09acfd7c3f36534af918cc Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Mar 2024 06:01:25 -0700 Subject: [PATCH 107/377] 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 -- 2.44.1 From aae19ec942c5284714faca496137e45e6336cfb6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Mar 2024 18:44:28 -0700 Subject: [PATCH 108/377] 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 @ { -- 2.44.1 From f016d60d07b44950ab1effb7d3618de0c2a0f338 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 16 Mar 2024 19:00:28 -0700 Subject: [PATCH 109/377] 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 -- 2.44.1 From 516ab1596149f548df01facdd0d5317c687818fd Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 00:06:35 -0700 Subject: [PATCH 110/377] 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 := "", - 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 := "", - 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 := "", - 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 := "", - 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 := "", - 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 -- 2.44.1 From 62d20be8413bc79f7744891b816a73bec8f4c694 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 11:33:15 -0700 Subject: [PATCH 111/377] 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; }; -- 2.44.1 From 47fabf333bb6f41293dcf3c565e3c22d2f225a1d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 11:37:07 -0700 Subject: [PATCH 112/377] 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": }"`: 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. -- 2.44.1 From a698a4250f36d9408b30882547f45b07df6c72da Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 18:56:42 -0700 Subject: [PATCH 113/377] 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 -- 2.44.1 From 9e68a9cae47cfb10f4a8214c72ebdf1cf1e10a6f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 19:27:45 -0700 Subject: [PATCH 114/377] 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) ] -- 2.44.1 From 8fa1a7d383a1d6b3b10196c6f642abf405cb461f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 19:49:44 -0700 Subject: [PATCH 115/377] 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 -- 2.44.1 From e79e386b39fd6900999f60df2f4e2c9984ea97fa Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 19:56:03 -0700 Subject: [PATCH 116/377] 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 -- 2.44.1 From 46faa5c0894aac848277067bd1e1c23754e64e7e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 22:08:22 -0700 Subject: [PATCH 117/377] 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 -- 2.44.1 From 4a89aaf70eecff007a4622fabb3481f4e7fa4e62 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 22:09:56 -0700 Subject: [PATCH 118/377] 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](doc/icon.svg) +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 -- 2.44.1 From 4a1114ab00c8d1b8e33c8acf2a0e810c0323a2c5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 22:23:19 -0700 Subject: [PATCH 119/377] 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 = { -- 2.44.1 From cfd74aba918cd5d77a52fdc8768506b8c7a6cb9e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 28 Mar 2024 22:26:46 -0700 Subject: [PATCH 120/377] 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 ]; + }; }; }; } -- 2.44.1 From 252f85e66cad063d1634a1072249a26aa890ed3d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 29 Mar 2024 23:46:08 -0700 Subject: [PATCH 121/377] 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), -- 2.44.1 From 1bea2ca4e1161dc5b489fd2c1c31779418dc3261 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 29 Mar 2024 23:50:30 -0700 Subject: [PATCH 122/377] 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"; -- 2.44.1 From 140055b16bd162558246180571e30ca64819a23c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 29 Mar 2024 23:59:14 -0700 Subject: [PATCH 123/377] 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": { -- 2.44.1 From 73e4c1d81c4f230699335a9794e5612a5de32f05 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 30 Mar 2024 00:03:37 -0700 Subject: [PATCH 124/377] 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"; -- 2.44.1 From 2b71203c1e800dcd5085bf3b5ec58b5136186dc1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 30 Mar 2024 00:17:16 -0700 Subject: [PATCH 125/377] 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 -/ -- 2.44.1 From e9c9548f174d0aeb80589ea8415978538407b925 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 15:40:14 -0700 Subject: [PATCH 126/377] 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 --- -- 2.44.1 From 2802cc204f7ea63abd7b490547f05fb8d16deb8d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 15:55:08 -0700 Subject: [PATCH 127/377] 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 := "") - /-- 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 -- 2.44.1 From 7988a25ce8eba153e7caf0c1c3993e93c45b0936 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 16:06:30 -0700 Subject: [PATCH 128/377] 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" -- 2.44.1 From a1ed8f4b3dd70b17856a1a496ec4c3338b9c81aa Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 16:11:41 -0700 Subject: [PATCH 129/377] 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 -- 2.44.1 From f4628432189d88a75f635ced7d1eba64bb013ee4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 16:12:23 -0700 Subject: [PATCH 130/377] 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": }`: Determine the type of an expression and round-trip it +- `expr.echo {"expr": , "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": , "value": }`: Show the type and package of a given symbol; If value flag is set, the value is printed or hidden. By default -- 2.44.1 From 216bb9e920c18d846140f431a62326288f69065f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 16:43:30 -0700 Subject: [PATCH 131/377] 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 -- 2.44.1 From 8b43dc0f25d4423a1dd839b8618578351fc4c000 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 31 Mar 2024 17:09:24 -0700 Subject: [PATCH 132/377] 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 -- 2.44.1 From 8a447e67cd0cef71f570ad04438445d828822778 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 14:07:13 -0700 Subject: [PATCH 133/377] 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 -- 2.44.1 From 92351c9a3d11cce85dec723413e702b72b19b634 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 14:14:30 -0700 Subject: [PATCH 134/377] 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) -- 2.44.1 From 042dc8f530960098365929c1983be25069de386f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 14:15:58 -0700 Subject: [PATCH 135/377] 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. -- 2.44.1 From 1b7b6a644bc84a5d6dedc5fa797d9b852e49f193 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 16:33:20 -0700 Subject: [PATCH 136/377] 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 := "" + 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 := "") 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 := "") 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)) -- 2.44.1 From 058f5a98b2ee504274c58a7ac341f502743bd817 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 16:40:22 -0700 Subject: [PATCH 137/377] 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 -- 2.44.1 From 41cb3f68cdba1b52cbfd6a8ac99a013c46e0b5f3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 17:22:09 -0700 Subject: [PATCH 138/377] 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 -- 2.44.1 From 5a60ca74d5a455716f05efdba5d6113f97f96c81 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 17:45:36 -0700 Subject: [PATCH 139/377] 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) -- 2.44.1 From 7fe73551c33c43da308573178d1278d38886689e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Apr 2024 21:52:25 -0700 Subject: [PATCH 140/377] 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 := "" +/-- +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 -- 2.44.1 From d9ed051b4de210835445f86abba48e994cdae448 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 7 Apr 2024 14:22:20 -0700 Subject: [PATCH 141/377] 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 => -- 2.44.1 From d50720f6228638f9ee280c58b3bfb22616b40300 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 7 Apr 2024 14:32:25 -0700 Subject: [PATCH 142/377] 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, } -- 2.44.1 From 19d2f5ff3fadb7db3c005b8451ef5d3e46885822 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 7 Apr 2024 17:03:49 -0700 Subject: [PATCH 143/377] 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 -- 2.44.1 From 09189ce600385bbacb4a60d736e5a8d30de1af43 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 10:32:13 -0700 Subject: [PATCH 144/377] 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? -- 2.44.1 From 63e64a1e9f62efd6837f9222b60fe06857346117 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 12:26:22 -0700 Subject: [PATCH 145/377] 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 -- 2.44.1 From 22bb818a1c06c253e9702bdd04803a9e42bbd0c4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 12:32:27 -0700 Subject: [PATCH 146/377] 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 -- 2.44.1 From 2f48cfbc19fbb564db02baf6a775ab16a390afb6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 12:45:03 -0700 Subject: [PATCH 147/377] 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! -- 2.44.1 From d4e49310f069e30206ccc8c4998d856ca760d1a8 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 12:50:41 -0700 Subject: [PATCH 148/377] 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 := -- 2.44.1 From 0e63583a1d42cb839757519b7cae95128338bc01 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 12:54:02 -0700 Subject: [PATCH 149/377] 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 -- 2.44.1 From f02f9592d7fc4ba7967eacadbb5b3efb8e8cbac7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 8 Apr 2024 13:12:51 -0700 Subject: [PATCH 150/377] 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 -- 2.44.1 From 30c1fd894fe4433412730d2b57a74aee7d365610 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 9 Apr 2024 09:11:15 -0700 Subject: [PATCH 151/377] 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) -- 2.44.1 From 55b44c3fa141f2be64830ce24823046f131a99be Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 9 Apr 2024 10:03:36 -0700 Subject: [PATCH 152/377] 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), ] -- 2.44.1 From 823c9635c77921208e32e8bbb5bcb259d861dc85 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 9 Apr 2024 10:06:26 -0700 Subject: [PATCH 153/377] 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 -- 2.44.1 From 535770bbd7c396596a7ce11018f99e235740e05c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 14:59:55 -0700 Subject: [PATCH 154/377] 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 := [ -- 2.44.1 From 6b44d9ef1468e7782208f7e3a1d1eea35f86fcec Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 15:03:14 -0700 Subject: [PATCH 155/377] 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` -- 2.44.1 From 6d85c19589cbd060c528fff2b51158e92292cb55 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 15:04:36 -0700 Subject: [PATCH 156/377] 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 -- 2.44.1 From 7eb5419f3690b250937280fc3048aa76522235d5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 15:11:10 -0700 Subject: [PATCH 157/377] 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 -- 2.44.1 From ed220bc7fb0ff19eadcdf2da55287d8ff229efae Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 15:13:12 -0700 Subject: [PATCH 158/377] 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": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol -- `goal.tactic {"stateId": , "goalId": , ["tactic": ], ["expr": ]}`: Execute a tactic string on a given goal +- `goal.tactic {"stateId": , "goalId": , ["tactic": ], ["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": , ["branch": ], ["goals": ]}`: Continue from a proof state - `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. - `goal.print {"stateId": }"`: Print a goal state -- 2.44.1 From a11df9f2e95d41b58ab29809e2623b5a22add890 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 9 Apr 2024 21:24:08 -0700 Subject: [PATCH 159/377] 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, }) ] -- 2.44.1 From 036fab0ad6a5e137059c634e9931ea7e1724c060 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 16:11:06 -0700 Subject: [PATCH 160/377] 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 -- 2.44.1 From dc6e79def7a00e1d4a2e936a09e578c851b45bc4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 16:18:04 -0700 Subject: [PATCH 161/377] 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) => -- 2.44.1 From e834765896497e64ef0e30be576843792029f4ac Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 16:25:17 -0700 Subject: [PATCH 162/377] 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 -- 2.44.1 From a864c4d3ff72360b397ecc450805163627b91755 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 16:29:47 -0700 Subject: [PATCH 163/377] 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 -- 2.44.1 From 4d4f660f3f0e5e717104a937661bd0d80f1614c1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 11 Apr 2024 17:57:24 -0700 Subject: [PATCH 164/377] 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 -- 2.44.1 From 991ee5ad94122a06dcaa47c79eef28d4ce318d28 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 12:37:37 -0700 Subject: [PATCH 165/377] 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), -- 2.44.1 From 8e377c20929669058fa50f9fa567354e0a417806 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 16:34:21 -0700 Subject: [PATCH 166/377] 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 -- 2.44.1 From e5d55e31ff0bd51d78303c786aef0e159c45fea3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 20:51:54 -0700 Subject: [PATCH 167/377] 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 -- 2.44.1 From 4ee955c21fd7d51b0d5e2b9933a1c7854a5d1970 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 21:16:00 -0700 Subject: [PATCH 168/377] 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)) -- 2.44.1 From 77907fd0609eb5db081b25dabca4fbf4a5f98e00 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 21:30:56 -0700 Subject: [PATCH 169/377] 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)) -- 2.44.1 From b45b90b810c845629788eca844a68873305bd1fd Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 21:41:16 -0700 Subject: [PATCH 170/377] 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 -- 2.44.1 From adbb07af2d12d170fb097f8186be3526e8bade7b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 12 Apr 2024 22:39:47 -0700 Subject: [PATCH 171/377] 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) := -- 2.44.1 From b954f12526eb6eca25d1f77c5b2729ad23b447a3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 13 Apr 2024 19:41:49 -0700 Subject: [PATCH 172/377] 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 -- 2.44.1 From 75b4648ba9d53e7032c1196b55e92483ca761a24 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 14 Apr 2024 15:40:57 -0700 Subject: [PATCH 173/377] 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 -- 2.44.1 From dbd54f767938027c43427a0eb90245ccc420e26d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Apr 2024 12:47:02 -0700 Subject: [PATCH 174/377] 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)) -- 2.44.1 From 7aa7e6d7e948a22cec20a259c4f244f11711be65 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Apr 2024 12:56:28 -0700 Subject: [PATCH 175/377] 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 -- 2.44.1 From 52e5b5df50fba53ead80135926cb838fc6771dce Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Apr 2024 19:57:05 -0700 Subject: [PATCH 176/377] 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": , "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": , "value": }`: Show the type and package of a +* `reset`: Delete all cached expressions and proof trees +* `stat`: Display resource usage +* `expr.echo {"expr": , "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": , "value": }`: Show the type and package of a given symbol; If value flag is set, the value is printed or hidden. By default only the values of definitions are printed. -- `options.set { key: value, ... }`: Set one or more options (not Lean options; those +* `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": ], ["expr": ], ["copyFrom": ]}`: Start a new goal from a given expression or symbol -- `goal.tactic {"stateId": , "goalId": , ["tactic": ], ["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": , ["branch": ], ["goals": ]}`: Continue from a proof state -- `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. -- `goal.print {"stateId": }"`: Print a goal state -- `stat`: Display resource usage +* `options.print`: Display the current set of options +* `goal.start {["name": ], ["expr": ], ["copyFrom": ]}`: + Start a new proof from a given expression or symbol +* `goal.tactic {"stateId": , "goalId": , ...}`: Execute a tactic string on a + given goal. The tactic is supplied as additional key-value pairs in one of the following formats: + - `{ "tactic": }`: Executes an ordinary tactic + - `{ "expr": }`: Assigns the given proof term to the current expression + - `{ "have": , "binderName": }`: Executes `have` and create a branch goal + - `{ "calc": }`: 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": }`: Enter or exit conversion tactic mode. In the case of + exit, the goal id is ignored. +* `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: Continue from a proof state +* `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. +* `goal.print {"stateId": }"`: 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, -- 2.44.1 From 7531ad628cc7fc94a771e075cb5bc0c5c17d2730 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Apr 2024 20:00:59 -0700 Subject: [PATCH 177/377] 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": , "type": }`: Determine the type of an expression and format it +* `expr.echo {"expr": , "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": , "value": }`: 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": , "goalId": , ...}`: Execute a tactic string on a given goal. The tactic is supplied as additional key-value pairs in one of the following formats: - - `{ "tactic": }`: Executes an ordinary tactic - - `{ "expr": }`: Assigns the given proof term to the current expression - - `{ "have": , "binderName": }`: Executes `have` and create a branch goal - - `{ "calc": }`: Executes one step of a `calc` tactic. Each step must + - `{ "tactic": }`: Execute an ordinary tactic + - `{ "expr": }`: Assign the given proof term to the current goal + - `{ "have": , "binderName": }`: Execute `have` and creates a branch goal + - `{ "calc": }`: 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": }`: Enter or exit conversion tactic mode. In the case of exit, the goal id is ignored. -* `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: Continue from a proof state -* `goal.remove {"stateIds": []}"`: Remove a bunch of stored goals. +* `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: + Execute continuation/resumption + - `{ "branch": }`: Continue on branch state. The current state must have no goals. + - `{ "goals": }`: Resume the given goals +* `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list * `goal.print {"stateId": }"`: Print a goal state ### Errors -- 2.44.1 From fec13ddb5176323a2878f00be197fa976c5c7e1e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 18 Apr 2024 14:19:25 -0700 Subject: [PATCH 178/377] 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" -- 2.44.1 From 398b1c39edd070d4c14981201d630cfc30a19632 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 19 Apr 2024 12:37:17 -0700 Subject: [PATCH 179/377] 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 -- 2.44.1 From 4a92e655f6515d1c6eaaaa991721f5cfb2774154 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 20 Apr 2024 13:09:41 -0700 Subject: [PATCH 180/377] 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 -- 2.44.1 From 3812aa56ecb871a9531d3cabec61a51eab7acbde Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 22 Apr 2024 00:11:41 -0700 Subject: [PATCH 181/377] 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 -- 2.44.1 From feff62a3c53de6ba111cb6aa48371a2ae0effb7e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 22 Apr 2024 09:52:13 -0700 Subject: [PATCH 182/377] 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 -- 2.44.1 From 6ffb227cd641f77109c539152e0b38f6d2bfa125 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 22 Apr 2024 10:02:09 -0700 Subject: [PATCH 183/377] 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 -- 2.44.1 From 4cff6677d27a9629eb44d173c321977ac860e5e8 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 4 May 2024 23:36:42 -0700 Subject: [PATCH 184/377] 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 -- 2.44.1 From 63417ef179066bfd847ff5efc5e74085268b1795 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 5 May 2024 00:43:32 -0700 Subject: [PATCH 185/377] 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) -- 2.44.1 From 1e1995255a91a738f3e1ce0dc2a8f8842acc4152 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 5 May 2024 10:36:43 -0700 Subject: [PATCH 186/377] 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 -- 2.44.1 From cf1289f159ddddf85430fbdd04d47d4f3be6eeae Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 5 May 2024 13:24:29 -0700 Subject: [PATCH 187/377] 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 -- 2.44.1 From 2937675044bcefe266a9c1d1116dbec53ee3942a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 5 May 2024 13:25:48 -0700 Subject: [PATCH 188/377] 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 -- 2.44.1 From 679871cbc659ce9ff58e832d20f51f52ae3dc2f1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 5 May 2024 13:26:46 -0700 Subject: [PATCH 189/377] 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 -- 2.44.1 From aa106f7591b8719ce91baa25e7434b808b62e0d6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 May 2024 22:20:20 -0700 Subject: [PATCH 190/377] 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 -- 2.44.1 From 69ec70ffbe7caec196c549bf30018c6433e4104b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 6 May 2024 22:39:17 -0700 Subject: [PATCH 191/377] 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 -- 2.44.1 From 66a5dfcf3c615a3f5d970acd624364d3dc5551d5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 8 May 2024 12:41:21 -0700 Subject: [PATCH 192/377] 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}]" -- 2.44.1 From e58dbc66a92ef10b014a30745a542ec0dd9be6ef Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 8 May 2024 20:51:36 -0700 Subject: [PATCH 193/377] 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 -- 2.44.1 From 0b88f6708e299f0282f048364a885f7913525bc7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 9 May 2024 14:02:43 -0700 Subject: [PATCH 194/377] 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)) -- 2.44.1 From 03ecb6cf19b7741a6bb20f2eb969374ac59b8643 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 11 May 2024 20:01:02 -0700 Subject: [PATCH 195/377] 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 -- 2.44.1 From c04b363de70611f68e45c938a03dfff0be4efc34 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 12 May 2024 22:33:38 -0700 Subject: [PATCH 196/377] 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 := [ -- 2.44.1 From f813d4a8dd201a01674917b18d1d39c7ec8138af Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 13 May 2024 13:49:05 -0700 Subject: [PATCH 197/377] 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, -- 2.44.1 From bc09f4a29df6e32a1b016b6b563d58b9a26f2411 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 13 May 2024 13:58:50 -0700 Subject: [PATCH 198/377] 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 -- 2.44.1 From 5c7bb288b2914d5179fa117289e4455893b3ddd2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 14 May 2024 19:08:25 -0700 Subject: [PATCH 199/377] 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, -- 2.44.1 From cf174280014dcfa3533e15b85a455bd2146e2951 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 15 May 2024 21:34:15 -0700 Subject: [PATCH 200/377] 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, -- 2.44.1 From 6ad24b72d474f015543e425f148fb7a3dc7b81da Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 16 May 2024 10:31:38 -0700 Subject: [PATCH 201/377] 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 -- 2.44.1 From e165e41efa8a65628501f6b8390b14040eb0ac62 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 17 May 2024 20:31:45 -0700 Subject: [PATCH 202/377] 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 -- 2.44.1 From 2f951c8fefcf3566fd5f2b38c508db96ef5cba00 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 19 May 2024 15:43:10 -0700 Subject: [PATCH 203/377] 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), -- 2.44.1 From cc74d41b150343215f40f391b52f308adc14a65c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 20 May 2024 10:55:52 -0700 Subject: [PATCH 204/377] 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 -- 2.44.1 From 92acf7782c66f9efc6026a5896be35b84b202f5d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 20 May 2024 11:51:35 -0700 Subject: [PATCH 205/377] 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 -- 2.44.1 From 75df7268c5c229769c606963b2ef2bb178810bdd Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 20 May 2024 11:55:38 -0700 Subject: [PATCH 206/377] 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) -- 2.44.1 From bbc00cbbb80748a53c2741bd2e4ee1415ba92f8d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 20 May 2024 14:00:04 -0700 Subject: [PATCH 207/377] 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 -- 2.44.1 From bd42c396d71097b100852aa1f25d3759f76edfe0 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 20 May 2024 14:19:10 -0700 Subject: [PATCH 208/377] 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 -- 2.44.1 From 09628309a920ec487973afb7753c7fa4fe958f59 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 28 May 2024 17:25:22 -0700 Subject: [PATCH 209/377] 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 "" + +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 -- 2.44.1 From b9b16ba0e9d99279837527bcb40176277d11e725 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 28 May 2024 20:24:23 -0700 Subject: [PATCH 210/377] 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 "" - -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 "" + +/-- 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 -- 2.44.1 From 855e7716098667aff52e7374f6b911ba06a08578 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 31 May 2024 16:35:46 -0700 Subject: [PATCH 211/377] 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 α -- 2.44.1 From a2c5c7448c38fbc3f04523bc758a35c80bf6e12f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 31 May 2024 20:22:16 -0700 Subject: [PATCH 212/377] 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 -- 2.44.1 From 3c90c94645eca5b8ecdc50773180a3543943d2bd Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 5 Jun 2024 13:45:13 -0700 Subject: [PATCH 213/377] 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 -- 2.44.1 From 6dcff8b1518f8f6fa42095065398b879254fae09 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 5 Jun 2024 15:56:20 -0700 Subject: [PATCH 214/377] 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 -- 2.44.1 From 3a534930894490d12248c4335d42cdf3e2baca56 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 5 Jun 2024 16:14:52 -0700 Subject: [PATCH 215/377] 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 -- 2.44.1 From 773a0afbd8a354093c9576df7be19f60f75d57df Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 11 Jun 2024 12:44:42 -0700 Subject: [PATCH 216/377] 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 := "", 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": , "type": }`: Determine the - type of an expression and format it +* `expr.echo {"expr": , "type": , ["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": , "value": }`: 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": ], ["expr": ], ["copyFrom": ]}`: +* `goal.start {["name": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: Start a new proof from a given expression or symbol * `goal.tactic {"stateId": , "goalId": , ...}`: 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) := [ -- 2.44.1 From b3a60fcea84bb220a68bea045bd1a2d69041f20f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 13 Jun 2024 14:24:22 -0700 Subject: [PATCH 217/377] 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 -- 2.44.1 From f80d90ce87dfe6c1561c15aca5ecab1a8c2a1ca7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 14 Jun 2024 11:58:23 -0700 Subject: [PATCH 218/377] 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), -- 2.44.1 From 8707dbc9bb09f42a6fe8739a0846b84e4941004f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 16 Jun 2024 13:44:57 -0700 Subject: [PATCH 219/377] 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 -- 2.44.1 From 25a7025c254102da74ad89343801719769bc62b4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 23 Jun 2024 15:01:51 -0700 Subject: [PATCH 220/377] 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 -- 2.44.1 From e282d9f7815e8ea616da07185ae55062527831b4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 11:03:08 -0400 Subject: [PATCH 221/377] 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 -- 2.44.1 From ffbea41f627741e70e2b1d01ac8663b9acd12777 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 15:13:58 -0400 Subject: [PATCH 222/377] 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 := -- 2.44.1 From 8e78718447456d20b5c54e36384223ffad577bc3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 15:54:55 -0400 Subject: [PATCH 223/377] 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 -- 2.44.1 From 58f9d72288d9f2870d5fdecb8afc84d974427cd9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 16:18:31 -0400 Subject: [PATCH 224/377] 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 -- 2.44.1 From 7acf1ffdf1de629141129a077c5f10405407a81f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 16:58:35 -0400 Subject: [PATCH 225/377] 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 := "") + +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 -- 2.44.1 From 2d2ff24017151bca6f1e466e7a4cf565fc055291 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 25 Jun 2024 17:01:49 -0400 Subject: [PATCH 226/377] 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) -- 2.44.1 From fc0d872343d1290c8e6e3e6b63116157abb1d359 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 27 Jun 2024 14:34:21 -0400 Subject: [PATCH 227/377] 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 -- 2.44.1 From 6ddde2963d484176225fc4c35ddc77fdf7a621a1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 27 Jun 2024 14:51:16 -0400 Subject: [PATCH 228/377] 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 -- 2.44.1 From c404564a2b25f1ee4a0cb611904f944b0321f998 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Jul 2024 19:53:50 -0700 Subject: [PATCH 229/377] 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 -- 2.44.1 From 9b1dd0ffda4d9b9122241da31747b15a55e0754d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 6 Jul 2024 19:58:55 -0700 Subject: [PATCH 230/377] 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" } -- 2.44.1 From 193d94e7986fef4779f5ce171616a1bc3ad0d068 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Jul 2024 11:42:02 -0700 Subject: [PATCH 231/377] 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 := -- 2.44.1 From 94c7b021f77c02376ad0219cdef97b1a06bc0d1b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 15 Jul 2024 12:22:47 -0700 Subject: [PATCH 232/377] 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 -- 2.44.1 From eb5ee8c57c395f60c6c7108e629ac248a3625c89 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 22 Jul 2024 17:34:14 -0700 Subject: [PATCH 233/377] 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 -- 2.44.1 From 431ca4e481fb1856d36ed17f322419ab59ed8e25 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 22 Jul 2024 17:57:01 -0700 Subject: [PATCH 234/377] 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 := -- 2.44.1 From 3b415e8dc12485f7b2b9fa6f54329f6ad598d48f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 23 Jul 2024 05:16:46 -0700 Subject: [PATCH 235/377] 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 -- 2.44.1 From 2682ce5b7b5a7e494d166b20b17852e88bea448a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 23 Jul 2024 11:57:12 -0700 Subject: [PATCH 236/377] 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) -- 2.44.1 From bf941cd6862b2658146dbdde9db8079e7e08973e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 27 Jul 2024 17:39:51 -0700 Subject: [PATCH 237/377] 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 -- 2.44.1 From 9db546349925730b445b6cf66fff29cc9dfcc52c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 27 Jul 2024 18:20:34 -0700 Subject: [PATCH 238/377] 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) -- 2.44.1 From 4c81f226d1953aa93c131d5161b397a037f920a2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 28 Jul 2024 13:46:14 -0700 Subject: [PATCH 239/377] 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 -- 2.44.1 From 29f437f859e3c7fad5a48fdce1fddc106991e586 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 28 Jul 2024 13:58:20 -0700 Subject: [PATCH 240/377] 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 -- 2.44.1 From 7b5567d784397c9d2a33b9464b5a1dd75fceb34a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 28 Jul 2024 14:19:47 -0700 Subject: [PATCH 241/377] 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 -- 2.44.1 From 1c9a411d4d89db0bfc38cee2e2d0ff5f61a8c61b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 29 Jul 2024 18:39:22 -0700 Subject: [PATCH 242/377] 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" -- 2.44.1 From 3ca52517abe07ecd1c2036eeba4e2ba762299f9f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 30 Jul 2024 13:30:41 -0700 Subject: [PATCH 243/377] 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 => "" -- 2.44.1 From caa463f41010326d1f7c213ae2614b9fabacb73d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 30 Jul 2024 17:02:41 -0700 Subject: [PATCH 244/377] 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) := -- 2.44.1 From abef7a6f0d55de552c3c7297d25ece8121ee931d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 31 Jul 2024 00:00:21 -0700 Subject: [PATCH 245/377] 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 -- 2.44.1 From 651afa75f4cb8cbd10c77247e055177c5adeed56 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 2 Aug 2024 19:49:11 -0700 Subject: [PATCH 246/377] 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 -- 2.44.1 From 2c08ef1e23a3429cefb5aacad19819a92768a847 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 2 Aug 2024 19:53:19 -0700 Subject: [PATCH 247/377] 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 -- 2.44.1 From c0e2a592ea819389bd5a39d289aabdd3d7a26a75 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 2 Aug 2024 21:44:46 -0700 Subject: [PATCH 248/377] 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 -- 2.44.1 From 394fb731375785d268184c640cd387f44d76dac4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 2 Aug 2024 22:00:27 -0700 Subject: [PATCH 249/377] 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] -- 2.44.1 From c9ee31bbfdd215e5ceba960218c8344afd46954e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 2 Aug 2024 22:33:03 -0700 Subject: [PATCH 250/377] 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 -- 2.44.1 From 64269868d518b1211b724a46dc080d6f2f5a4a44 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 4 Aug 2024 17:32:20 -0700 Subject: [PATCH 251/377] 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 = { -- 2.44.1 From caac70f0cfedca3964f65d2dbd04a8370c5dd97f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 4 Aug 2024 17:52:36 -0700 Subject: [PATCH 252/377] 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 ]; -- 2.44.1 From 0bc7bc58565cceb839c41a11d207e4eeb64a845e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 14 Aug 2024 01:20:56 -0700 Subject: [PATCH 253/377] 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" { -- 2.44.1 From e943a4b065cc78c268fcd3ca31ff57d7d3e4b697 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Aug 2024 22:39:40 -0700 Subject: [PATCH 254/377] 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 -- 2.44.1 From 7968072097912d26bee25e35637e52f663425d10 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Aug 2024 22:53:42 -0700 Subject: [PATCH 255/377] 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? } -- 2.44.1 From 9b0456a5e0026ac5d8087a78fe3e3d5ff4f9b594 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Aug 2024 23:17:15 -0700 Subject: [PATCH 256/377] 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 -- 2.44.1 From 1e7a186bb1d423585630d0370bec8612d6fc73be Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Aug 2024 23:23:17 -0700 Subject: [PATCH 257/377] 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 -- 2.44.1 From 5b4f8a37ebbbbd435b400af11ce65ec9c96ec428 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 15 Aug 2024 23:41:17 -0700 Subject: [PATCH 258/377] 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))) = []) -- 2.44.1 From d17b21e282f9f23ac9105d2241e805a1553fde2b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 16 Aug 2024 00:32:34 -0700 Subject: [PATCH 259/377] 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) -- 2.44.1 From e1b7eaab12084371bf27d9ae68da0431de8d37b7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 00:47:12 -0700 Subject: [PATCH 260/377] 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 -- 2.44.1 From 0c469027c6ccb84f14c2c097dbc96c2e152cdbc6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 00:50:02 -0700 Subject: [PATCH 261/377] 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 -- 2.44.1 From 43e11f1ba3176c94c7a0a8f78a36da6d70aa0be2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 00:53:38 -0700 Subject: [PATCH 262/377] 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 } + } ] }]) -- 2.44.1 From f87eed817fb28ae72bf0fba863747ad5ff5750e7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 01:59:48 -0700 Subject: [PATCH 263/377] 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 ]; -- 2.44.1 From 5d43068ec3170c02d4405f2d10762cfc69641671 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 02:07:17 -0700 Subject: [PATCH 264/377] 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; }; }; -- 2.44.1 From 3733c10a4e303ead385b05c968bf3e296480d744 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 17 Aug 2024 16:47:21 -0700 Subject: [PATCH 265/377] 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 -- 2.44.1 From 76765c913c7b45330ce3bc01c899920ce630eff9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 18 Aug 2024 12:22:59 -0700 Subject: [PATCH 266/377] 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 } -- 2.44.1 From edec0f5733207bba278701ce9a13ed127742bc5b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 26 Aug 2024 13:42:14 -0400 Subject: [PATCH 267/377] 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 ← -- 2.44.1 From 8d2cd6dfc737a2ddcd6e89523e9a96f6d547ff7a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 3 Sep 2024 14:15:52 -0700 Subject: [PATCH 268/377] 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)) -- 2.44.1 From f8df2599f99b1b77816299ebdeecbff9c5758339 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 3 Sep 2024 14:18:47 -0700 Subject: [PATCH 269/377] 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 -- 2.44.1 From 9c40a839563ce5ae2235469ca473208668f5aa20 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 3 Sep 2024 19:05:16 -0700 Subject: [PATCH 270/377] 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) -- 2.44.1 From 02556f3c790f49f1556d8161257413f9e9e9bb21 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Sep 2024 11:56:06 -0700 Subject: [PATCH 271/377] 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 -- 2.44.1 From 82d99ccf9bf37106fc76d0b131738cd56fce1f9f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Sep 2024 21:07:12 -0700 Subject: [PATCH 272/377] 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 -- 2.44.1 From 37473b3efbec7be8e103b93ff343ad46dd0f4a35 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Sep 2024 21:30:11 -0700 Subject: [PATCH 273/377] 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 -- 2.44.1 From e2ad6ce6b3d2f57670313a0a975a3389d46a439f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Sep 2024 21:32:02 -0700 Subject: [PATCH 274/377] 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": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: Start a new proof from a given expression or symbol -- 2.44.1 From a7b30af36b7cf45182e6d4413018f7febcfd0396 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Sep 2024 22:01:36 -0700 Subject: [PATCH 275/377] 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 -- 2.44.1 From 9b3eef35ec40a09bba7140ecfc04dafddbd92c27 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Sep 2024 22:22:19 -0700 Subject: [PATCH 276/377] 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 -- 2.44.1 From 8394e1b4682be29ca8ff167bb3aa25314f3508e2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 7 Sep 2024 13:47:55 -0700 Subject: [PATCH 277/377] 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 -- 2.44.1 From 4042ec707ee8a0eaec685c9b71812d62bc120d59 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 7 Sep 2024 13:54:52 -0700 Subject: [PATCH 278/377] 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 -- 2.44.1 From 68dac4c951c1b6eddfa2044daffed26f9cea7fae Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 7 Sep 2024 13:55:41 -0700 Subject: [PATCH 279/377] 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 -- 2.44.1 From e4d53733d008bbda48c7d3513ac901fb4c3f3f12 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 7 Sep 2024 14:03:29 -0700 Subject: [PATCH 280/377] 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 -- 2.44.1 From f11c5ebaa331804284549091abf9377820e8bb0a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 7 Sep 2024 14:11:04 -0700 Subject: [PATCH 281/377] 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. + 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. + + + Copyright (C) + + 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 . + +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: + + Copyright (C) + 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 +. + + 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 +. -- 2.44.1 From 7c49fcff2760e8df7dbdb1c9189a3a8c4ac872c3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Sep 2024 11:53:10 -0700 Subject: [PATCH 282/377] 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 -- 2.44.1 From 25bb96460455a29630a6ac86af389a0eefd07101 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Sep 2024 11:57:39 -0700 Subject: [PATCH 283/377] 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), -- 2.44.1 From 860344f9c504d3c86d679ea9ef43e306e26a964e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Sep 2024 13:44:46 -0700 Subject: [PATCH 284/377] 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 -- 2.44.1 From 5e99237e091757e1dab76a9db012df6b9ada4b8d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Sep 2024 14:13:39 -0700 Subject: [PATCH 285/377] 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)") -- 2.44.1 From 8e3241c02ab65660169cdcb436883e27bd81e2b6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Sep 2024 15:02:43 -0700 Subject: [PATCH 286/377] 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 := "") - -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 := "") +def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do + return Parser.runParserCategory + (env := ← MonadEnv.getEnv) + (catName := `term) + (input := s) + (fileName := "") + /-- 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) -- 2.44.1 From 08fb53c0209a27fcfce95d738ab896e92b382625 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 10:18:20 -0700 Subject: [PATCH 287/377] 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 := "") + (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 ("", 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)) -- 2.44.1 From 4f5950ed7878f17de50d9b535b3bd030f1965af8 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 12:26:46 -0700 Subject: [PATCH 288/377] 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)) -- 2.44.1 From 762a139e7800bc08bc27c2f6a9aa3ba8365fcf44 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 12:30:32 -0700 Subject: [PATCH 289/377] 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. -/ -- 2.44.1 From 9f0de0957e54dbeaa94d06bbf0f4c5620429f817 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 12:39:32 -0700 Subject: [PATCH 290/377] 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": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: 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": }`: Resume the given goals * `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list * `goal.print {"stateId": }"`: Print a goal state +* `frontend.process { ["fileName": ",] ["file": ], invocations: + , sorrys: }`: 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 -``` -- 2.44.1 From 9075ded885ce03a70a05e562c6dba3789f03ac93 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 17:29:43 -0700 Subject: [PATCH 291/377] 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": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: 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. -- 2.44.1 From fe8b259e4f09817bf4b2df269d87e836d10155cf Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 17:37:59 -0700 Subject: [PATCH 292/377] 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 -- 2.44.1 From bec84f857bd4f80064213fa5646bef4699191290 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Sep 2024 18:43:34 -0700 Subject: [PATCH 293/377] 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 } -- 2.44.1 From 18cd1d038819fbb9f8985648aaf3554049822b5e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 2 Oct 2024 22:22:20 -0700 Subject: [PATCH 294/377] 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 := "" + 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), -- 2.44.1 From 143cd289bbc4ea93f0889cf05737c3b6f90a51df Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 3 Oct 2024 01:29:46 -0700 Subject: [PATCH 295/377] 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" [ -- 2.44.1 From 530a1a1a97273314bd7b01c542ce686a366aa0b9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 3 Oct 2024 11:35:54 -0700 Subject: [PATCH 296/377] 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)) -- 2.44.1 From a03eeddc9bea63caf91b20bdbbbd4cf9e5133b79 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 3 Oct 2024 11:46:09 -0700 Subject: [PATCH 297/377] 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" }, } -- 2.44.1 From d0321e72ddb477a5eea1ebee346c5ee00512d22e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 5 Oct 2024 14:49:17 -0700 Subject: [PATCH 298/377] 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 := #[":2:0: warning: declaration uses 'sorry'\n"], + }], }: Protocol.FrontendProcessResult), ] -- 2.44.1 From c3076cbb7d8c5b4c536c902f5639eea1f873ad24 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 6 Oct 2024 16:10:18 -0700 Subject: [PATCH 299/377] 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 -- 2.44.1 From 8d774d32813218ddbde55487f156c25cee4fd7b7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 4 Oct 2024 12:58:16 -0700 Subject: [PATCH 300/377] 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) => -- 2.44.1 From 9119f47a8f2d1d281975c30a7301a734fbd4eecf Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 5 Oct 2024 10:29:20 -0700 Subject: [PATCH 301/377] 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" -- 2.44.1 From c3494edc750f776689d25c0cd59a3b718583145a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 6 Oct 2024 16:46:39 -0700 Subject: [PATCH 302/377] 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" ]; -- 2.44.1 From 2e1276c21c9a3c16cc8319b19b06d9e39571fb5e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 8 Oct 2024 00:15:30 -0700 Subject: [PATCH 303/377] 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; }; }; -- 2.44.1 From 5e776a1b49e02e5ecc75d7011ac488fcc2b514ce Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 8 Oct 2024 00:17:31 -0700 Subject: [PATCH 304/377] 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 -- 2.44.1 From 05d0b7739ac12d8b031d8b0451fc74f79c8a7e08 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 8 Oct 2024 00:45:45 -0700 Subject: [PATCH 305/377] 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 -- 2.44.1 From 420e863756b7de85497d45463be780cad883b213 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 8 Oct 2024 10:32:16 -0700 Subject: [PATCH 306/377] 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) -- 2.44.1 From 0e8c9f890b1bf4746a9ba5a6e24b7a38a896f994 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 8 Oct 2024 14:28:35 -0700 Subject: [PATCH 307/377] 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' -- 2.44.1 From 641f8c38830f112e0fe7d2a7666fc368002f182e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 9 Oct 2024 15:49:10 -0700 Subject: [PATCH 308/377] 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 -- 2.44.1 From 645d9c9250bf306bdf13d085a222ce03de8aa836 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 12 Oct 2024 16:17:21 -0700 Subject: [PATCH 309/377] 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 -- 2.44.1 From 5a2ae880f4be4b4ea440ffad03d276253fc324d1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 12 Oct 2024 16:46:44 -0700 Subject: [PATCH 310/377] 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 -- 2.44.1 From 946e688dec66caca5896e4963a9004f6673ac7d3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 12 Oct 2024 16:52:36 -0700 Subject: [PATCH 311/377] 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 := "" 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)) -- 2.44.1 From d23f99fd44802ad688ba89b357a64cf8098345cc Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 14 Oct 2024 21:16:41 -0700 Subject: [PATCH 312/377] 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" ]; -- 2.44.1 From 8fe4c78c2aea194869bb7b4b7e61087b6374ff66 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 21 Oct 2024 09:59:13 -0700 Subject: [PATCH 313/377] 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. - 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. - - - Copyright (C) - - 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 . - -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: - - Copyright (C) - 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 -. - - 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 -. + 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. -- 2.44.1 From 23efed960b890ad2c8bc8e87ad30c6f539e05c40 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 26 Oct 2024 13:49:03 -0700 Subject: [PATCH 314/377] 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 ]; }; }; }; -- 2.44.1 From b99fecdb504ca6b4ea3bfb26674cd22a6b927906 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 26 Oct 2024 17:52:37 -0700 Subject: [PATCH 315/377] 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"; -- 2.44.1 From d7c95907804dcb673dd6b8f208af4369b65bed4f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 5 Nov 2024 14:37:06 -0800 Subject: [PATCH 316/377] 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"], }, ] }], -- 2.44.1 From 1c4f38e5eb76fd3442f4b3042e836c9027d1d6c7 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Nov 2024 13:04:00 -0800 Subject: [PATCH 317/377] 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 -- 2.44.1 From 0d570276816185df141518e66a74b5f9292975c3 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Nov 2024 13:05:48 -0800 Subject: [PATCH 318/377] 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 -- 2.44.1 From 70f86f6e93856ee7e57ed6c0e24c184fd66d0615 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Nov 2024 14:34:15 -0800 Subject: [PATCH 319/377] 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 -- 2.44.1 From ee8063e1f524894e196a5d13cb138568bb7e039a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Nov 2024 14:41:24 -0800 Subject: [PATCH 320/377] 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 := "") - -def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do - return Parser.runParserCategory - (env := ← MonadEnv.getEnv) - (catName := `term) - (input := s) - (fileName := "") - -/-- 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 := "") + +def parseTermM [Monad m] [MonadEnv m] (s: String): m (Except String Syntax) := do + return Parser.runParserCategory + (env := ← MonadEnv.getEnv) + (catName := `term) + (input := s) + (fileName := "") + +/-- 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 => -- 2.44.1 From 495ea1ac144f524fe585979f7561470010599180 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 8 Nov 2024 14:49:49 -0800 Subject: [PATCH 321/377] 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 -- 2.44.1 From 2790553180384fbed97d7707178f8dc72d95b1bb Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 13 Nov 2024 19:50:31 -0800 Subject: [PATCH 322/377] 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) -- 2.44.1 From e5d0459956fccc783f110e95f444a6a63ea0c3e2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Nov 2024 22:16:45 -0800 Subject: [PATCH 323/377] 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": { -- 2.44.1 From 0ee7d575709f6e08cabb54db8460d0249a57ba2f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 14 Nov 2024 22:51:25 -0800 Subject: [PATCH 324/377] 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; }; -- 2.44.1 From f9d31597ec485ba08109f45753807f38b8e347f9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Nov 2024 14:56:51 -0800 Subject: [PATCH 325/377] 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": { -- 2.44.1 From af256123f39990bb4cadd6f8d3333f3bb044a69a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Nov 2024 23:29:37 -0800 Subject: [PATCH 326/377] 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 @@ + + + + + + + + + + + + + + + id="layer4" + inkscape:label="bg" /> + + + + + + + + + + + -- 2.44.1 From ce3af887be2594e9b5a80532982fd6cc9c652909 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 15 Nov 2024 23:36:28 -0800 Subject: [PATCH 327/377] 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) + -- 2.44.1 From 5d676154f1ba1c0cdb542c9feb8d583c89643fcb Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 16 Nov 2024 21:27:40 -0800 Subject: [PATCH 328/377] 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) ``` -- 2.44.1 From 9894ad7c7e2a8e7fde305e1a542f708fd1481c5e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 26 Nov 2024 12:16:14 -0800 Subject: [PATCH 329/377] 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 -- 2.44.1 From a8e7a1a726c7fe5595c92e5c5b8ff4228628ab65 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 26 Nov 2024 12:34:52 -0800 Subject: [PATCH 330/377] 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})") -- 2.44.1 From 44aef76a10a9638caecef46326130ffd7c9fad29 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 26 Nov 2024 12:57:19 -0800 Subject: [PATCH 331/377] 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)), -- 2.44.1 From 7c9b092200ffc3365060cf7e0d6d0db1c809aeb4 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sat, 30 Nov 2024 23:21:16 -0800 Subject: [PATCH 332/377] 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 -- 2.44.1 From 0f946880ae87a5b746b188dcc946ee8c2cbefa8b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 4 Dec 2024 10:44:33 -0800 Subject: [PATCH 333/377] 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)) -- 2.44.1 From 105fb7af4bed8da4969ef1265106c239861dece9 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 14:23:55 -0800 Subject: [PATCH 334/377] 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)) -- 2.44.1 From c54ce93ef5eb745a3db7668886f35ed034f42afb Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 14:31:43 -0800 Subject: [PATCH 335/377] 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 -- 2.44.1 From 3da85b7f04fda00d98222f4f988d05461cd03dc1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 16:00:46 -0800 Subject: [PATCH 336/377] 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": , "type": , ["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": , "value": }`: Show the type and package of a - given symbol; If value flag is set, the value is printed or hidden. By default - only the values of definitions are printed. -* `options.set { key: value, ... }`: Set one or more options (not Lean options; those - 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": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: - Start a new proof from a given expression or symbol -* `goal.tactic {"stateId": , "goalId": , ...}`: Execute a tactic string on a - given goal. The tactic is supplied as additional key-value pairs in one of the following formats: - - `{ "tactic": }`: Execute an ordinary tactic - - `{ "expr": }`: Assign the given proof term to the current goal - - `{ "have": , "binderName": }`: Execute `have` and creates a branch goal - - `{ "calc": }`: 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": }`: Enter or exit conversion tactic mode. In the case of - exit, the goal id is ignored. -* `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: - Execute continuation/resumption - - `{ "branch": }`: Continue on branch state. The current state must have no goals. - - `{ "goals": }`: Resume the given goals -* `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list -* `goal.print {"stateId": }"`: Print a goal state -* `frontend.process { ["fileName": ",] ["file": ], invocations: - , sorrys: }`: 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": , "type": , ["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": , "value": }`: Show the type and package of a + given symbol; If value flag is set, the value is printed or hidden. By default + only the values of definitions are printed. +* `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": ], ["expr": ], ["levels": []], ["copyFrom": ]}`: + Start a new proof from a given expression or symbol +* `goal.tactic {"stateId": , "goalId": , ...}`: Execute a tactic string on a + given goal. The tactic is supplied as additional key-value pairs in one of the following formats: + - `{ "tactic": }`: Execute an ordinary tactic + - `{ "expr": }`: Assign the given proof term to the current goal + - `{ "have": , "binderName": }`: Execute `have` and creates a branch goal + - `{ "calc": }`: 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": }`: Enter or exit conversion tactic mode. In the case of + exit, the goal id is ignored. +* `goal.continue {"stateId": , ["branch": ], ["goals": ]}`: + Execute continuation/resumption + - `{ "branch": }`: Continue on branch state. The current state must have no goals. + - `{ "goals": }`: Resume the given goals +* `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list +* `goal.print {"stateId": }"`: 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": ",] ["file": ], invocations: + , sorrys: }`: 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. -- 2.44.1 From bfdc7dd39ee008506dafb010725fc192ccbe5287 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 16:02:00 -0800 Subject: [PATCH 337/377] 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": }`: Resume the given goals * `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list * `goal.print {"stateId": }"`: 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": ",] ["file": ], invocations: -- 2.44.1 From d00e3769430c1fe5df0c2528768738617a29efd2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 17:18:35 -0800 Subject: [PATCH 338/377] 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 $@ -- 2.44.1 From 95408d1d523aa679b544568112da8535506d14e2 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 17:21:06 -0800 Subject: [PATCH 339/377] 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": , "value": }`: Show the type and package of a given symbol; If value flag is set, the value is printed or hidden. By default only the values of definitions are printed. -* `env.save { path }`, `env.load { path }`: Save/Load the current environment - to/from a file +* `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` @@ -39,10 +39,11 @@ See `Pantograph/Protocol.lean` for a description of the parameters and return va - `{ "goals": }`: Resume the given goals * `goal.remove {"stateIds": []}"`: Drop the goal states specified in the list * `goal.print {"stateId": }"`: 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": ",] ["file": ], invocations: +* `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": ,] ["file": ], invocations: , sorrys: }`: Executes the Lean frontend on a file, collecting either the tactic invocations (`"invocations": true`) or the sorrys into goal states (`"sorrys": true`) -- 2.44.1 From 2e2658bde79aa02c6593371e098a924488ba98bf Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 21:35:37 -0800 Subject: [PATCH 340/377] 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)) -- 2.44.1 From 7aafd6956fe71770a356f3d852edc4e91cd5696a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 22:07:21 -0800 Subject: [PATCH 341/377] 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 := [ -- 2.44.1 From a62ac51c37ad5dde6c3e850aaaf1e9b9265ec652 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 22:11:37 -0800 Subject: [PATCH 342/377] 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 := "" - /-- 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 -- 2.44.1 From 34a4bf5b7321f413e12c1c1cd814d0b0e1a52e29 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 22:12:04 -0800 Subject: [PATCH 343/377] 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 -- 2.44.1 From 0415baaaff3a55475cd532749c1fe9724a16fb43 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Thu, 5 Dec 2024 22:16:20 -0800 Subject: [PATCH 344/377] 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 -- 2.44.1 From 929311a0429c2fafb5533c8f44e326c6d66b4d9c Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Fri, 6 Dec 2024 00:08:20 -0800 Subject: [PATCH 345/377] 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 -- 2.44.1 From 9ede3cf7175db43e1e660f64e58eaac4251eed8b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Dec 2024 15:38:03 -0800 Subject: [PATCH 346/377] 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 "" +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 -- 2.44.1 From b950dc9b1a278aabfb7fb2a19be60d7b1e636494 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Dec 2024 22:51:55 -0800 Subject: [PATCH 347/377] 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." -- 2.44.1 From ea813e5bc5d0116d09d9e8f43c3213fa33b2ae4d Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Sun, 8 Dec 2024 23:21:36 -0800 Subject: [PATCH 348/377] 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 := "" 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)) -- 2.44.1 From 17ab2eafd8868652d83072f074696413825ebab5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 00:03:53 -0800 Subject: [PATCH 349/377] 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 := "" 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 -- 2.44.1 From 2d068ecd5072386fd4043931b96e64fd47760aab Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 00:06:20 -0800 Subject: [PATCH 350/377] 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 -- 2.44.1 From 7fc2bd0d0fc4901b7423782b6092518ac887e38b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 08:15:01 -0800 Subject: [PATCH 351/377] 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)) -- 2.44.1 From 47d26badc82e606972a1b8a5285b78197411e067 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 17:30:33 -0800 Subject: [PATCH 352/377] 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!":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 := [ -- 2.44.1 From d040d2006c7332eee67b9a0b3d8558e18469386e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 17:58:08 -0800 Subject: [PATCH 353/377] 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!":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!":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 := [ -- 2.44.1 From 5ef2b5c11840890471db123ecce3f26642e38478 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 19:40:00 -0800 Subject: [PATCH 354/377] 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 := "" + 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)) -- 2.44.1 From 0b4ded10493585aeba2e9b345ddc9ed81d4a02ad Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 20:15:53 -0800 Subject: [PATCH 355/377] 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 := "" -- 2.44.1 From e9cbc6eab37a81e527b8d9b220a47ec1cf8debee Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 20:17:55 -0800 Subject: [PATCH 356/377] 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 -- 2.44.1 From dd00d803d1fe500f46710bb32bfcc9eeeb2d8062 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 20:38:27 -0800 Subject: [PATCH 357/377] 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 -- 2.44.1 From 9a69c48cb23f313e5986e87a8867eaf3d9b6528e Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 20:42:05 -0800 Subject: [PATCH 358/377] 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 := #[":2:0: warning: declaration uses 'sorry'\n"], }], }: Protocol.FrontendProcessResult), -- 2.44.1 From eb0374dfb3cd73df86bfcfe5a0ed1f5d03d37cce Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 20:57:25 -0800 Subject: [PATCH 359/377] 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 := [{ -- 2.44.1 From 1527743900b2af65514be9cf6a3d9f18b818874a Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 21:00:33 -0800 Subject: [PATCH 360/377] 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 := #[":2:0: warning: declaration uses 'sorry'\n"], }], }: Protocol.FrontendProcessResult), -- 2.44.1 From 37a5884be40790a946e0b8e26879ed3bbf509077 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Mon, 9 Dec 2024 21:39:33 -0800 Subject: [PATCH 361/377] 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, -- 2.44.1 From 681c3fb78d2055e4d8dbe1fcd2ef5c66d28b6469 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 12:21:56 -0800 Subject: [PATCH 362/377] 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 -- 2.44.1 From 0725d865de5dbe0195c6cafa8e81b42f9e967fc5 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 12:40:00 -0800 Subject: [PATCH 363/377] 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 -- 2.44.1 From 95503c45e4ac6217889cd21d63672d58768835f1 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 21:45:57 -0800 Subject: [PATCH 364/377] 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": ,] ["file": ], invocations: - , sorrys: }`: Executes the Lean frontend on a file, collecting - either the tactic invocations (`"invocations": true`) or the sorrys into goal - states (`"sorrys": true`) + , sorrys: , newConstants: }`: 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 -- 2.44.1 From 1d10cd2b205f8baf172384733793cd2a55a1f5d8 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 23:16:33 -0800 Subject: [PATCH 365/377] 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 ·) -- 2.44.1 From 755ba13c1b8f92d91dea492d4b8106a90f68e295 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 23:48:46 -0800 Subject: [PATCH 366/377] 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) -- 2.44.1 From e0e5c9ec681d0423a12a0c0278fef38cd8c5af80 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Tue, 10 Dec 2024 23:51:47 -0800 Subject: [PATCH 367/377] 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 ·) -- 2.44.1 From cb87fcd9dd89fdeaaaad49f0dd0111b4e7416c49 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 00:16:52 -0800 Subject: [PATCH 368/377] 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 := -- 2.44.1 From 58956d33fe25069c708213ccb625ac88c8f04a47 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 00:21:26 -0800 Subject: [PATCH 369/377] 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) -- 2.44.1 From aa122b2bb904e6cd757c1b5e0b75113510c1efaa Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 00:24:56 -0800 Subject: [PATCH 370/377] 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 -- 2.44.1 From c96df2ed1cd834f3a04374f60c852ed8a2253e8f Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 00:29:29 -0800 Subject: [PATCH 371/377] 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" ]; -- 2.44.1 From f2f71a60281f66d78687128b8fb879e0f7a11fe0 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 09:01:57 -0800 Subject: [PATCH 372/377] 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 -- 2.44.1 From ab77418e242d81e502f4ae7a88ab7decf8d6b1a6 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 09:05:47 -0800 Subject: [PATCH 373/377] 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 -- 2.44.1 From 396a787771909d722e531acf2c11ffec2dd11900 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 09:06:42 -0800 Subject: [PATCH 374/377] 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 -- 2.44.1 From f111da7de79ab8006a0bcda8a916c5785cabc8e8 Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 15:09:14 -0800 Subject: [PATCH 375/377] 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 -- 2.44.1 From bb445f4d737b3355edbe42a27be9ec782c5e3b9b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 16:38:59 -0800 Subject: [PATCH 376/377] 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 -- 2.44.1 From 2f732a7f2094b0226990d4c89cd9586b51fc6f0b Mon Sep 17 00:00:00 2001 From: Leni Aniva Date: Wed, 11 Dec 2024 16:49:52 -0800 Subject: [PATCH 377/377] 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), -- 2.44.1