├── .gitignore ├── lean-toolchain ├── lakefile.toml ├── lake-manifest.json ├── TutorialAux └── Init.lean ├── README.md ├── LICENSE ├── CustomRw.lean ├── CustomSimp.lean └── TacticProgrammingGuide.lean /.gitignore: -------------------------------------------------------------------------------- 1 | /.lake/ -------------------------------------------------------------------------------- /lean-toolchain: -------------------------------------------------------------------------------- 1 | leanprover/lean4:v4.22.0-rc4 -------------------------------------------------------------------------------- /lakefile.toml: -------------------------------------------------------------------------------- 1 | name = "tactic-programming-beginner-guide" 2 | version = "0.2.0" 3 | keywords = ["tutorial"] 4 | 5 | [leanOptions] 6 | pp.unicode.fun = true 7 | autoImplicit = false 8 | 9 | [[lean_lib]] 10 | name = "TutorialAux" 11 | 12 | [[require]] 13 | name = "Qq" 14 | scope = "leanprover-community" 15 | 16 | [[require]] 17 | name = "batteries" 18 | scope = "leanprover-community" 19 | -------------------------------------------------------------------------------- /lake-manifest.json: -------------------------------------------------------------------------------- 1 | {"version": "1.1.0", 2 | "packagesDir": ".lake/packages", 3 | "packages": 4 | [{"url": "https://github.com/leanprover-community/batteries", 5 | "type": "git", 6 | "subDir": null, 7 | "scope": "leanprover-community", 8 | "rev": "a8aacd18dc8dc1c27b4bd180ea0c9615e16f7497", 9 | "name": "batteries", 10 | "manifestFile": "lake-manifest.json", 11 | "inputRev": "main", 12 | "inherited": false, 13 | "configFile": "lakefile.toml"}, 14 | {"url": "https://github.com/leanprover-community/quote4", 15 | "type": "git", 16 | "subDir": null, 17 | "scope": "leanprover-community", 18 | "rev": "1ef3dac0f872ca6aaa7d02e015427e06dd0b6195", 19 | "name": "Qq", 20 | "manifestFile": "lake-manifest.json", 21 | "inputRev": "master", 22 | "inherited": false, 23 | "configFile": "lakefile.toml"}], 24 | "name": "«tactic-programming-beginner-guide»", 25 | "lakeDir": ".lake"} 26 | -------------------------------------------------------------------------------- /TutorialAux/Init.lean: -------------------------------------------------------------------------------- 1 | import Lean 2 | open Lean Meta 3 | 4 | /-- A custom trace for teaching debugging features -/ 5 | initialize registerTraceClass `MyTrace 6 | 7 | /-- 8 | A custom environment extension to add a theorem name, and its type. 9 | We store these pairs (expr, type) in a simple Array. 10 | -/ 11 | initialize myExt : 12 | SimpleScopedEnvExtension (Expr × Expr) (Array (Expr × Expr)) ← 13 | registerSimpleScopedEnvExtension { 14 | -- add a single element to the array 15 | addEntry := fun arr et => arr.push et 16 | -- initially, the array is empty 17 | initial := #[] 18 | } 19 | 20 | /-- 21 | Custom attribute `my_tag` adding a theorem to the `myExt` 22 | -/ 23 | initialize registerBuiltinAttribute { 24 | name := `my_tag 25 | descr := "a custom tag" 26 | -- by default, assigning an attribute runs in CoreM 27 | -- but we can invoke MetaM, if we need 28 | add := fun name stx kind ↦ MetaM.run' do 29 | -- We assume we are only registering theorems without universe levels, 30 | -- Making it work with universe levels is left as an exercise. 31 | let e : Expr := mkConst name 32 | let t : Expr ← inferType e 33 | myExt.add (e,t) -- calling `addEntry` we defined in `myExt` 34 | 35 | -- For simplicity, we are also omiting a sanity check. Usually 36 | -- you should also check here if the tagged definition makes sense 37 | -- for the particular attribute before adding it to the database. 38 | } 39 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Introduction to Tactic Writing in Lean 2 | 3 | Originally, this was a single Lean file, later we extended the tutorial with further files with more advanced topics. 4 | 5 | If you are a metaprogramming beginner, we recommend to start with `TacticProgrammingGuide.lean`. There are 762 lines coverging the basics of Lean tactic writing. 6 | We assume you already know Lean, and probably use VS Code, 7 | in that case clone this repository, or simply download [the file](TacticProgrammingGuide.lean). 8 | 9 | Alternatively, you can also copy it to [Lean 4 Web](https://live.lean-lang.org/) but you will miss the Ctrl-click feature. 10 | 11 | We tried to explain all the basic concepts but keep at least the introduction it beginner friendly. 12 | Enjoy learning Lean metaprogramming. If you are getting confused somewhere, it is probably not your fault. Let us know what needs more clarification in the [Zulip thread](https://leanprover.zulipchat.com/#narrow/channel/239415-metaprogramming-.2F-tactics/topic/Introduction.20to.20tactic.20programming/near/524164016). 13 | 14 | ## Content 15 | 16 | So far, there are three tutorials of increasing difficulty. Although you can scroll through it on Github, we indeed recommend to download the files and play with them. 17 | * [Introduction](TacticProgrammingGuide.lean): the basic introduction mentioned above. 18 | * [How imperative programs work in Lean](TacticProgrammingGuide.lean#L44) 19 | * [What is a proof state](TacticProgrammingGuide.lean#L127) 20 | * [Basic data structures around Lean metaprogramming](TacticProgrammingGuide.lean#L155) 21 | * [Implementing basic tactics](TacticProgrammingGuide.lean#L238) 22 | * [How to declare syntax for a new tactic](TacticProgrammingGuide.lean#L513) 23 | * [Implementing `rw` from scratch](CustomRw.lean): a tactic that does a single rewrite. 24 | * [What `rw` does on proof term level](CustomRw.lean#L19) 25 | * [Implementing basic `rw`](CustomRw.lean#L67) 26 | * [Options for normalization](CustomRw.lean#L235) 27 | * [Unification - rewriting a quantified equality.](CustomRw.lean#L306) 28 | * [Implementing `simp` from scratch](CustomSimp.lean): more advanced expression manipulation. 29 | * [What `simp` does on proof term level](CustomSimp.lean#L22) 30 | * [Filling implicit arguments](CustomSimp.lean#L83) 31 | * [Custom SimpResult datastructure](CustomSimp.lean#L187) 32 | * [Basic `simp` implementation](CustomSimp.lean#L250) 33 | * [Debugging with traces](CustomSimp.lean#L360) 34 | * [Implementing `simp` inside binders](CustomSimp.lean#L457) 35 | * [Collecting tagged lemmas](CustomSimp.lean#L595) 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /CustomRw.lean: -------------------------------------------------------------------------------- 1 | import Batteries 2 | import Lean 3 | import Qq 4 | 5 | /-! 6 | # Tutorial: Writing `rw` from scratch 7 | 8 | Content 9 | (1) What `rw` does on proof term level? 10 | (2) Basic implementation 11 | (3) Options for normalization 12 | (4) Unification - rewriting a quantified equality 13 | -/ 14 | 15 | open Lean Elab Meta Tactic 16 | open Qq 17 | 18 | /- 19 | ## (1) What `rw` does on proof term level 20 | 21 | Let us look at an example proof using `rw`. 22 | -/ 23 | 24 | theorem rw_example (a b : Nat) (f : Nat → Nat) (p : Nat → Prop) 25 | (h_eq : ∀ x : Nat, f x = x) (h_finish : p (a + b + a + b)) : 26 | p (f a + f b + f a + f b) := by 27 | rw [h_eq] -- rewrites two instances of `f a` 28 | rw [h_eq] -- rewrites two instances of `f b` 29 | exact h_finish 30 | 31 | -- and print its proof term 32 | #print rw_example 33 | 34 | -- it should look similar to 35 | example : ∀ (a b : Nat) (f : Nat → Nat) (p : Nat → Prop), 36 | (∀ (x : Nat), f x = x) → p (a + b + a + b) → p (f a + f b + f a + f b) := 37 | fun a b f p h_eq h_finish => 38 | Eq.mpr ( 39 | congrArg (fun X => p (X + f b + X + f b)) (h_eq a : f a = a) 40 | : p (f a + f b + f a + f b) = p (a + f b + a + f b) 41 | ) 42 | (Eq.mpr ( 43 | congrArg (fun X => p (a + X + a + X)) (h_eq b : f b = b) 44 | : p (a + f b + a + f b) = p (a + b + a + b) 45 | ) h_finish) 46 | 47 | -- You can see two main theorems used for each rewrite: 48 | #check congrArg -- digging into a subterm 49 | #check Eq.mpr -- translate equality to implication 50 | 51 | /- 52 | Because of the theorems that `rw` is using, it first instantiates 53 | the hypothesis `h_eq`, and then replaces all the instances in the goal 54 | by a single call of `congrArg`. 55 | -/ 56 | 57 | /- 58 | (intermezzo) the role of `id` 59 | You can also see some `id` in the proof which is the identity function. 60 | It is used for typing -- `id` can change a type of its value in case 61 | they are definitionally equal. 62 | On metaprogramming level, this appeared in the proof by using 63 | -/ 64 | #check mkExpectedPropHint 65 | 66 | /- 67 | ## (2) Implementing basic `rw` 68 | 69 | ### Abstracting a variable 70 | 71 | In the basic version, we will be only rewriting a term 72 | with a single equality without quantifiers. 73 | 74 | Say we are rewriting `A = B` in some expression 75 | `e := ... A ... A ...` 76 | First, we want to locate all the `a`-s in the expression, 77 | and build a mapping 78 | `fun X => ... X ... X ...` 79 | 80 | This is called an abstraction, first we need to locate all `A`s in `e`, 81 | and replace them with a corresponding `bvar`. A `bvar` is a variable 82 | pointing to a quantifier with an index where quantifiers are indexed 83 | from the inner-most to the outer-most. 84 | To determine which `bvar` index to use, we carry `offset`. 85 | -/ 86 | /-- (tutorial function) simplified `kabstract` -/ 87 | def myAbstract (e a : Expr) (offset : Nat := 0) : MetaM Expr := do 88 | if !e.hasLooseBVars then -- we cannot rewrite a subterm containing a variable bound in `e` 89 | if (← isDefEq e a) then -- check if already `a` is already the root 90 | return mkBVar offset -- replace with bvar 91 | -- otherwise, we recurse 92 | match e with -- ctrl-click on `e.update...` to see the definition 93 | | .app f x => return e.updateApp! (← myAbstract f a offset) (← myAbstract x a offset) 94 | | .mdata _ b => return e.updateMData! (← myAbstract b a offset) -- `b` = body 95 | | .proj _ _ b => return e.updateProj! (← myAbstract b a offset) 96 | | .letE _ t v b _ => 97 | return e.updateLetE! (← myAbstract t a offset) -- diving under a binder -> increase offset 98 | (← myAbstract v a offset) (← myAbstract b a (offset+1)) 99 | | .lam _ d b _ => return e.updateLambdaE! (← myAbstract d a offset) (← myAbstract b a (offset+1)) 100 | | .forallE _ d b _ => return e.updateForallE! (← myAbstract d a offset) (← myAbstract b a (offset+1)) 101 | | e => return e 102 | 103 | -- lean's implementation is slightly more advanced but still readable 104 | #check kabstract 105 | 106 | -- the difference is that `kabstract` allows choosing positions, 107 | -- where to apply the rewrite 108 | def myAbstractAt (pos : Nat) (e a : Expr) := 109 | kabstract e a (.pos [pos]) 110 | 111 | -- Let's see 112 | example (a b : Nat) (h : (2 * a + b + 1) = (2 * b + a + 1)) : True := by 113 | run_tacq 114 | let e1 ← myAbstract h.ty a 115 | let e2 ← kabstract h.ty a 116 | -- kabstract does the same as myAbstract 117 | -- the #0 represents a bvar which is not bounded in the printed term 118 | logInfo m!"e1: {e1}\ne2: {e2}" 119 | -- Let's see how we can choose the positions for `kabstract`. 120 | logInfo m!"pos1: {← myAbstractAt 1 h.ty a}" 121 | logInfo m!"pos2: {← myAbstractAt 2 h.ty a}" 122 | -- exercise: Re-implement `myAbstractAt` from scratch, 123 | -- without using `kabstract`. Can you understand how 124 | -- `kabstract` uses a State monad to do it? 125 | trivial 126 | 127 | -- Now, we can build the mapping 128 | /-- (tutorial function) Runs `kabstract`, and wraps the result to a lambda. -/ 129 | def abstractToMapping (e a : Expr) : MetaM Expr := do 130 | -- make sure that all previous mvar assignments were applied in `e` 131 | -- this is necessary to recurse the term, not for `isDefEq`, so `a` doesn't need it 132 | let e ← instantiateMVars e 133 | let body ← myAbstract e a -- replace `a` with a `bvar` 134 | return mkLambda 135 | `X -- name for the variable, due to `bvar`s, we don't have to care about collisions, 136 | BinderInfo.default -- could be also e.g. `implicit` (braces instead of parentheses) 137 | (← inferType a) -- type for the variable 138 | body 139 | 140 | -- Let's build the lambda 141 | example (A : Nat) (h : -- some crazy expression containing various constructions 142 | ∀ (y : Nat), (y = A) → 143 | let z := A + y 144 | y + A = (fun (X : Nat) => X + A - y) z -- no worry about the same name 145 | ) : True := by 146 | -- `run_tacq` is like `run_tac` but makes the context directly accessible 147 | -- not useful for writing tactics but handy for testing 148 | run_tacq 149 | logInfo m!"Before: {h.ty}" -- Qq-type (compile-time) 150 | let f ← abstractToMapping h.ty A 151 | logInfo m!"After: {f}" 152 | trivial 153 | 154 | /- 155 | ### Decomposing equality 156 | -/ 157 | /-- (tutorial function) 158 | `decomposeEq` takes a proof of equality `pf : a = b`, where `(a b : α : Sort u)`, 159 | and returns (u, α, a b) 160 | -/ 161 | def decomposeEq (pf : Expr) : MetaM (Level × Expr × Expr × Expr) := do 162 | let t ← inferType pf 163 | -- `whnf` helps to get `Eq` at the root, removing mdata, 164 | -- instantiating mvars, expanding definitions... 165 | let t ← whnf t 166 | match t with 167 | | .app (.app (.app (.const ``Eq [u]) α) a) b => 168 | return (u, α, a, b) 169 | | _ => throwError "given term {pf} : {t} is not a proof of equality" 170 | 171 | -- we also could have used `Expr.app3? ``Eq`, or 172 | -- `matchEq?` but that doesn't give us the level 173 | #check Expr.app3? 174 | 175 | /- 176 | ### Building proof term 177 | -/ 178 | 179 | /-- 180 | (tutorial function) 181 | Takes a term `t := ... A ...`, and an equation 182 | `eq : A = B`, and returns a proof of `... B ... → ... A ...`. 183 | -/ 184 | def proveRwImp (eq t : Expr) : 185 | MetaM Expr := do 186 | let (u, α, a, b) ← decomposeEq eq 187 | -- find the abstract function 188 | let f ← abstractToMapping t a 189 | logInfo m!"lhs := {a}, rhs := {b}\nabstr := {f}" 190 | -- we also detect the sort level of t (usually Prop) 191 | let tt ← inferType t 192 | let v := (← inferType tt).sortLevel! 193 | let rw_eq := mkApp6 -- build `@congrArg.{u,v} α tt a b f eq : f a = f b` 194 | (mkConst ``congrArg [u,v]) 195 | α tt a b f eq 196 | logInfo m!"rw_eq := {rw_eq}" 197 | -- We know `f a = t` (definitionally) 198 | -- Now let's calculate `f b` using famous "beta reduction". 199 | let fb := f.beta #[b] 200 | -- semantically it is the same as f.app b but the goal is not as pretty ;-) 201 | -- try to uncomment the following line to see the difference: 202 | -- let fb := f.app b 203 | if !tt.isSort then -- why `t` must be a sort to build an implication? 204 | throwError m!"Cannot convert equality between {tt} to an implication" 205 | -- finally, let's build the implication 206 | return mkApp3 -- build `Eq.mpr.{v-1} (f a) (f b) rw_eq` 207 | (mkConst ``Eq.mpr [tt.sortLevel!]) 208 | t fb rw_eq 209 | 210 | #check congrArg 211 | #check Eq.mpr 212 | 213 | /- 214 | Let's test the function `proveRwImp`, and finish 215 | the goal rewrite inside `run_tacq` script 216 | -/ 217 | example (a b : Nat) (h : a = b) : 2*a + b = 2*b + a := by 218 | run_tacq goal => 219 | let t := q($a + 5 - $a) 220 | -- try what happens with a non-prop term by uncommenting the next line 221 | let imp ← proveRwImp h goal.ty 222 | let imp_t ← inferType imp 223 | -- test the result of `proveRwImp` 224 | logInfo m!"imp : {imp_t}" 225 | -- finish rewriting the goal 226 | let mt := imp_t.bindingDomain! 227 | logInfo m!"Build mvar of type {mt}" 228 | let m ← mkFreshExprSyntheticOpaqueMVar mt 229 | goal.mvarId!.assign (mkApp imp m) 230 | replaceMainGoal [m.mvarId!] 231 | -- check that we have successfully rewritten the main goal 232 | rfl 233 | 234 | /- 235 | ## (3) Options for normalization 236 | 237 | There are two places where normalization happens in the code of `rw` above. 238 | * Calling `whnf` in decomposing equality 239 | * The `isDefEq` check to determine whether to perform the abstraction. 240 | 241 | Full normalization is not always desired, let us see an example of what can happen. 242 | -/ 243 | def myAdd (a b : Nat) : Nat := a + b 244 | def myEq (a b : Nat) : Prop := (a = b) 245 | 246 | example (a b c : Nat) (h : myEq (myAdd a b) (myAdd b c)) 247 | (h2 : a + b = c) : True := by 248 | run_tacq 249 | let htn ← whnf h.ty 250 | logInfo m!"{h.ty}\n→ {htn}" -- whnf unpacks `myEq` 251 | let (u,α,lhs,rhs) ← decomposeEq h 252 | logInfo m!"lhs := {lhs}, rhs := {rhs}" -- so `decomposeEq` splits the equality 253 | -- This is a nice feature :-) 254 | 255 | -- similarly isDefEq unpacks the definition 256 | logInfo m!"({h.ty}) ?= ({htn}) : {← isDefEq h.ty htn}" 257 | -- so myAbstract catches such occurence too 258 | logInfo m!"Abstracting ({lhs}) in ({h2.ty}):\n{← abstractToMapping h2.ty lhs}" 259 | -- This is rather confusing, we see no `(myAdd a b)` in `a + b = c`. 260 | trivial 261 | 262 | -- In both cases, normalization is performed based on the Meta.Config 263 | #check Meta.Config 264 | /- 265 | To see all the options, Ctrl-click on that type to see all the options with their 266 | explanation. There are many options to look at such as `beta`, `zeta`, `zetaDelta`. 267 | For example, to prevent `1 + 3` being identified with 4, we need 268 | `offsetCnstrs := false` 269 | 270 | Here, we focus on the example of transparency -- expanding definitions. 271 | -/ 272 | #check Meta.Config.transparency 273 | -- The most typical options are 274 | #check TransparencyMode.default 275 | #check TransparencyMode.reducible -- prevent the above definition expansion 276 | 277 | /- 278 | Let us see how to set reducible transparency. The config lives 279 | in a Reader monad, meaning it is read-only. We cannot change the config 280 | for the outside code but we can run a local piece of code with a changed config. 281 | -/ 282 | #check withConfig 283 | #check withTransparency 284 | 285 | example (a b : Nat) (h1 : a = b) (h2 : myEq a b) : True := by 286 | run_tacq 287 | logInfo m!"isDefEq default: {← isDefEq h1.ty h2.ty}" 288 | -- general context-changing scope 289 | withConfig (fun cfg => {cfg with transparency := .reducible}) do 290 | -- anything running here has reducible trnasparency 291 | logInfo m!"isDefEq reducible1: {← isDefEq h1.ty h2.ty}" 292 | -- setting transparency in particular has a shortcut 293 | withTransparency .reducible do 294 | logInfo m!"isDefEq reducible2: {← isDefEq h1.ty h2.ty}" 295 | -- we should do this when matching `lhs` to an expression 296 | 297 | -- the same works with whnf 298 | logInfo m!"whnf default: {← whnf h2.ty}" 299 | withTransparency .reducible do 300 | logInfo m!"whnf reducible1: {← whnf h2.ty}" 301 | -- `whnfR` is a shortcut for above 302 | logInfo m!"whnf reducible2: {← whnfR h2.ty}" 303 | trivial 304 | 305 | /- 306 | ## (4) Unification - rewriting a quantified equality. 307 | 308 | Now, we want to be able to rewrite quantified equality, for example we have a rule 309 | `∀ a b : Nat, p a + b = a + q b`, 310 | and we want to use it to rewrite `p 1 + 2` to `1 + q 2`. 311 | The main idea is to first replace the quantified variables with metavariables to obtain 312 | `p ?a + ?b = p ?b + ?a` 313 | Now the left hand side is structurally the same as `p 1 + 2` up to the 314 | metavariables, so we need to find the right value for them. 315 | 316 | ### Unification 317 | 318 | Finding values for metavariables actually happens automatically: 319 | -/ 320 | example (p : Nat → Nat) : True := by 321 | run_tacq 322 | let a ← mkFreshExprMVarQ q(Nat) (userName := `a) -- just a Qq-sugar on top 323 | let b ← mkFreshExprMVarQ q(Nat) (userName := `b) -- of `mkFreshExprMVar` 324 | let pattern := q($p $a + $b) 325 | let rhs := q($a + $p $b) 326 | let target := q($p 1 + 2) 327 | logInfo m!"matching {target} with {pattern}\n→ {rhs}" -- not assigned 328 | if ← isDefEq pattern target then -- The magic happens here! 329 | logInfo m!"matched {target} with {pattern}\n→ {rhs}" -- assigned 330 | else 331 | logInfo "Couldn't match" 332 | logInfo m!"If match succeeded, the mvars are now assigned: a = {a}, b = {b}" 333 | -- Note that using MessageData is crucial - the expressions `a`, `b` didn't change, 334 | -- only the way we look at them inside MetaM Monad. 335 | logInfo s!"As a string, we still see the metavariables:\na = {a}, b = {b}" 336 | let a2 ← instantiateMVars a 337 | let b2 ← instantiateMVars b 338 | logInfo s!"Unless we instantiate:\na2 = {a2}, b2 = {b2}" 339 | trivial 340 | 341 | /- 342 | As we saw, `isDefEq` is not just an innocent check, it can modify the proofstate 343 | by assiging metavariables. 344 | Besides checking modulo basic reductions, it tries to find variable assignment that 345 | satisfies the equality. If there exist an assignment, the asignment is performed in 346 | the proofstate, and `isDefEq` return `true`. On the other hand, if the return value 347 | is `false`, we know there was no change in the proof state. 348 | 349 | ### Controling assignable meta-variables 350 | 351 | There are two factors deciding whether a metavariable can be automatically 352 | assigned with `isDefEq`. We have already seen the meta-variable kind. 353 | -/ 354 | run_meta 355 | let mNat1 ← mkFreshExprMVarQ q(Nat) .natural `mNat1 356 | let mNat2 ← mkFreshExprMVarQ q(Nat) .natural `mNat2 357 | let mSyn1 ← mkFreshExprMVarQ q(Nat) .synthetic `mSyn1 358 | let mSyn2 ← mkFreshExprMVarQ q(Nat) .synthetic `mSyn2 359 | -- natural mvars prefer to be assigned over synthetic 360 | logInfo m!"mNat1 = mSyn1: {← isDefEq mNat1 mSyn1}" 361 | logInfo m!"mNat2 = mSyn2: {← isDefEq mNat2 mSyn2}" 362 | logInfo m!"{mNat1} = {mSyn1}, {mNat2} = {mSyn2}" 363 | -- but synthetic can be assigned too if needed 364 | logInfo m!"mSyn1 = mSyn2: {← isDefEq mSyn1 mSyn2}" 365 | logInfo m!"{mSyn1} = {mSyn2}" 366 | -- contrary to synthetic opaque 367 | let mSO1 ← mkFreshExprMVarQ q(Nat) .syntheticOpaque `mSO1 368 | let mSO2 ← mkFreshExprMVarQ q(Nat) .syntheticOpaque `mSO2 369 | logInfo m!"mSO1 = mSO2: {← isDefEq mSO1 mSO2}" 370 | 371 | /- 372 | Often, we also want to prevent previously created mvars to be assigned no matter 373 | of their kind. This can be done by entering a new `MetavarContext.depth`. 374 | -/ 375 | #check withNewMCtxDepth 376 | run_meta 377 | let mNat1 ← mkFreshExprMVarQ q(Nat) .natural `mNat1 378 | let mNat2 ← mkFreshExprMVarQ q(Nat) .natural `mNat2 379 | -- normally, mNat would be prefered to be assigned, 380 | -- we block it by entering a new level 381 | withNewMCtxDepth do 382 | logInfo m!"mNat1 = mNat2: {← isDefEq mNat1 mNat2}" -- now, they cannot be assigned 383 | let mSyn ← mkFreshExprMVarQ q(Nat) .synthetic `mSyn 384 | -- but a new synthetic can be assigned to them 385 | logInfo m!"mSyn = mNat1: {← isDefEq mSyn mNat1}" 386 | logInfo m!"{mSyn} = {mNat1}" 387 | /- 388 | 389 | ### Quantified `rw` 390 | 391 | Since we used `isDefEq` in `myAbstract`, it should be no surprise now why 392 | rewriting with a quantified equality matches its first instantiation. 393 | The unification happens the first moment it can, and later `f a` cannot 394 | get unified with `f b`. 395 | 396 | Let us finish the implementation by turning quantifiers into metavariables. 397 | The function to do it is `forallMetaTelescope` 398 | -/ 399 | #check forallMetaTelescope 400 | -- rewrite a quantified equality 401 | example (a b : Nat) (f : Nat → Nat) (p : Nat → Prop) 402 | (h_eq : ∀ x : Nat, f x = x) (h_finish : p (a + b + a + b)) : 403 | p (f a + f b + f a + f b) := by 404 | run_tacq goal => 405 | let imp ← withNewMCtxDepth do 406 | let (mvars, _, eq) ← forallMetaTelescope h_eq.ty -- turn quantifiers into mvars 407 | let pf_eq := mkAppN h_eq mvars -- build the proof term 408 | logInfo m!"before: {pf_eq} : {eq}" 409 | -- the same rewrite code as before 410 | let imp ← withTransparency .reducible <| proveRwImp pf_eq goal.ty 411 | logInfo m!"after: {pf_eq} : {eq}" 412 | -- we need to instantiate the variables before exiting the MCtx context 413 | instantiateMVars imp 414 | let imp_t ← inferType imp 415 | logInfo m!"imp_t2 := {imp_t}" 416 | let mt := imp_t.bindingDomain! 417 | let m ← mkFreshExprSyntheticOpaqueMVar mt 418 | goal.mvarId!.assign (mkApp imp m) 419 | replaceMainGoal [m.mvarId!] 420 | -- successfully rewritten `f a` → `a` 421 | rw [h_eq b] -- let's do the second step with a simple `rw` :-) 422 | trivial 423 | 424 | -- Exercise: Implement the full `my_rw` tactic 425 | example (a b : Nat) (f : Nat → Nat) (p : Nat → Prop) 426 | (h_eq : ∀ x : Nat, f x = x) (h_finish : p (a + b + a + b)) : 427 | p (f a + f b + f a + f b) := by 428 | my_rw h_eq 429 | my_rw h_eq 430 | exact h_finish 431 | -------------------------------------------------------------------------------- /CustomSimp.lean: -------------------------------------------------------------------------------- 1 | import Batteries 2 | import Lean 3 | import Qq 4 | import TutorialAux.Init -- for Sections (5, 7) 5 | 6 | /-! 7 | # Tutorial: Writing `simp` from scratch 8 | 9 | Content 10 | (1) What `simp` does on proof term level? 11 | (2) Filling implicit arguments 12 | (3) Custom SimpResult datastructure 13 | (4) Basic `simp` implementation 14 | (5) Debugging with traces 15 | (6) Implementing `simp` inside binders 16 | (7) Collecting tagged lemmas 17 | -/ 18 | 19 | open Lean Meta Elab Tactic Qq 20 | 21 | /- 22 | ## (1) What `simp` does on proof term level 23 | 24 | Simp doesn't do all its equal rewrites in one go like `rw`. 25 | Instead, it recursively dives into the term, and when 26 | it combines two branches in which both terms got 27 | updated, it uses 28 | -/ 29 | #check congr 30 | 31 | theorem simp_example (a b c : Nat) (f : Nat → Nat) (p : Nat → Prop) 32 | (h_eq : ∀ x : Nat, f x = x) (h_finish : p (a + c + b + c + a + c)) : 33 | p (f a + c + f b + c + f a + c) := by 34 | simp only [h_eq] 35 | exact h_finish 36 | 37 | #print simp_example 38 | 39 | /- 40 | This is much more messy than rw's but after prettification, 41 | you could get the following proof term. 42 | -/ 43 | example (a b c : Nat) (f : Nat → Nat) (p : Nat → Prop) 44 | (h_eq : ∀ x : Nat, f x = x) (h_finish : p (a + c + b + c + a + c)) : 45 | p (f a + c + f b + c + f a + c) := 46 | Eq.mpr 47 | (congrArg (fun X => p (X + c)) 48 | (congr 49 | (congrArg (fun X => (X + c + ·)) 50 | (congr 51 | (congrArg 52 | (fun X => (X + c + ·)) (h_eq a : f a = a) 53 | : (f a + c + ·) = (a + c + ·) 54 | ) 55 | (h_eq b : f b = b) 56 | : f a + c + f b = a + c + b) 57 | : (f a + c + f b + c + ·) = (a + c + b + c + ·) 58 | ) 59 | (h_eq a : f a = a) 60 | : f a + c + f b + c + f a = a + c + b + c + a) 61 | : p (f a + c + f b + c + f a + c) = p (a + c + b + c + a + c) 62 | ) 63 | h_finish 64 | /- 65 | You can notice that 66 | * The expression is build gradually, not in one go. 67 | * We actually run `h_eq a` twice in the proof term, because 68 | we are rewriting with it on two places, contrary to `rw`. 69 | 70 | You might think that the `simp` approach is the more 71 | flexible / general but there are cases where `simp` doesn't work, 72 | and `rw` succeeds. This is due to type dependency issues such as in 73 | the following example. 74 | -/ 75 | 76 | example (a b : Nat) (h_eq : a = b) (p : ∀ n : Nat, Fin n → Prop) 77 | (h : ∀ y : Fin b, p b y) : ∀ x : Fin a, p a x := by 78 | try simp only [h_eq] -- simp cannot do the rewrite 79 | rw [h_eq] -- rw can, because it rewrites at several places at once 80 | exact h 81 | 82 | /- 83 | ## (2) Filling implicit arguments 84 | 85 | When we were applying `congrArg` and `Eq.mpr` in `rw`, we were explicitly filling 86 | the universe levels, and implicit argument. Already there, it was a bit annoying, 87 | and with `simp`, we will need to build much more terms. Fortunatelly, there are 88 | ways to avoid this work. 89 | -/ 90 | example (a b c : Nat) (pf1 : a = b) (pf2 : b = c) : True := by 91 | -- we would like to emulate calling 92 | have pf3 : a = c := Eq.trans pf1 pf2 93 | -- but the full expression we want to build is 94 | have pf3' := @Eq.trans.{1} Nat a b c pf1 pf2 95 | -- on tactic level, we have several ways to build it 96 | run_tacq 97 | -- (a) low-level constructing the term, we have to provide all the arguments 98 | let lowlev := mkApp6 ((mkConst ``Eq.trans [1])) (mkConst ``Nat) a b c pf1 pf2 99 | logInfo m!"lowlev = {lowlev}" 100 | -- (b) using `Qq` 101 | let pfQ : Q($a = $c) := q(Eq.trans $pf1 $pf2) 102 | logInfo m!"pfq = {pfQ}" 103 | -- (c) using `mkAppM` 104 | let pfAppM ← mkAppM ``Eq.trans #[pf1, pf2] 105 | logInfo m!"pfAppM = {pfAppM}" 106 | -- (d) using `mkEqTrans` -- common functions already have their meta-versions 107 | let pfEqT ← mkEqTrans pf1 pf2 108 | logInfo m!"pfEqT = {pfEqT}" 109 | trivial 110 | 111 | /- 112 | The crucial difference between `Qq` and `mkAppM` is that `Qq` does the type inference 113 | in compile-time whereas `mkAppM` does it in runtime. Let us implement both as functions. 114 | -/ 115 | 116 | def buildTransQ {u : Level} {α : Q(Sort u)} {a b c : Q($α)} 117 | (pf1 : Q($a = $b)) (pf2 : Q($b = $c)) : Q($a = $c) := 118 | q(Eq.trans $pf1 $pf2) 119 | 120 | def buildTransM (pf1 pf2 : Expr) : MetaM Expr := 121 | mkAppM ``Eq.trans #[pf1, pf2] 122 | 123 | /- 124 | Notice that `buildTransM` needs to run in MetaM -- only that way it will have enough 125 | data to correctly infer the types of the given expressions, and hence the correct 126 | implicit arguments. 127 | 128 | On the other hand, `buildTransQ` doesn't need MetaM. It needs to get all the data 129 | that makes `pf1` and `pf2` correctly annotated: `u α a b c`. 130 | Even if these arguments are passed implicitly (so the meta-programmer doesn't 131 | have to write them), they are indeed passed, and play a crucial role in runtime 132 | to build the resulting term. 133 | 134 | We will use `mkAppM` to finish the implementation of `simp`. 135 | Using `Qq` requires taking care of the annotations which can become 136 | a bit finicky (doable but perhaps not as well suited for a tutorial). 137 | On the other hand, we encourage you to try building terms with `Qq` too, 138 | and see what suits your needs better. 139 | -/ 140 | 141 | /- 142 | ### Exercise 143 | 144 | Define a function `myCalculation` which takes two numbers 145 | `a b : Nat / Int / Rat`, and builds `a + b * a` 146 | automatically infering their type, and the appropriate typeclass 147 | instance. Try: 148 | * specific functions, you can find them ;-) 149 | * `mkAppM` 150 | * `Qq` 151 | 152 | Tip: when editing the middle of the file, it might help to prevent 153 | Lean to from recompiling the rest of the file by typing `#exit` 154 | at the end of the section. 155 | Just don't forget to delete it when you move on ;-). 156 | 157 | Hint for Qq: Qq can infer the instance too but you cannot (!!) 158 | pass it implicitly as `[Q(HAdd $α $α $α)]` (as you might have discovered). 159 | So first, try to pass `Q(HAdd $α $α $α)` as an explicit argument, 160 | and insert `q(inferInstance)` to the call (analogously multiplication). 161 | Later, you can do a trick with a default argument filled with 162 | an `exact` tactic -- you need to fill it with a tactic to postpone 163 | the type inference. 164 | -/ 165 | 166 | def myCalculation (a b : Expr) : MetaM Expr := do 167 | return a 168 | 169 | -- preliminary, you will have to change the type signature to some `Q(...)` 170 | def myCalcQ2 (a : Expr) (b : Expr) : Expr := a 171 | 172 | example (a b : Nat) (c d : Int) (e f : Rat) : True := by 173 | run_tacq 174 | let ab ← myCalculation a b 175 | -- let ab := myCalcQ a b 176 | let cd ← myCalculation c d 177 | -- let cd := myCalcQ c d 178 | let ef ← myCalculation e f 179 | -- let ef := myCalcQ e f 180 | logInfo m!"ab := {ab}, cd := {cd}, ef := {ef}" 181 | unless ← isDefEq ab q($a + $b*$a) do throwError "ab := {ab} != a+b*a" 182 | unless ← isDefEq cd q($c + $d*$c) do throwError "cd := {cd} != c+d*c" 183 | unless ← isDefEq ef q($e + $f*$e) do throwError "ef := {ef} != e+f*e" 184 | trivial 185 | 186 | /- 187 | ## (3) Custom SimpResult datastructure 188 | 189 | First, we define a structure capturing the result. 190 | 191 | The output of a simplification run on `a` is a new expression `expr` 192 | of the same type, and a proof `pf : a = expr`. Sometimes, `simp` doesn't 193 | perform any simplification, in that case, we allow `pf` to be `none` 194 | (although we could also close it using `rfl`) 195 | -/ 196 | structure SimpResult where 197 | expr : Expr 198 | pf? : Option Expr 199 | 200 | -- Note that the library Simp also has very similar Result structure, both 201 | -- in basic library, and with Qq hints. 202 | #check Simp.Result 203 | #check Simp.ResultQ 204 | 205 | /- 206 | Let's prepare some ways to combine results together. There are not too much 207 | iteresting ideas, going on so you can skip to the next section. 208 | -/ 209 | 210 | def SimpResult.empty (e : Expr) : SimpResult := {expr := e, pf? := none} 211 | 212 | #check Eq.refl 213 | /-- (tutorial function) 214 | Gets the proof, possibly building `rfl` if it was none. -/ 215 | def SimpResult.getProof (r : SimpResult) : MetaM Expr := 216 | match r.pf? with 217 | | some pf => pure pf 218 | | none => mkAppM ``Eq.refl #[r.expr] 219 | -- see also `mkEqRefl` 220 | 221 | #check Eq.trans 222 | /-- (tutorial function) 223 | Combines two `SimpResults` using `Eq.trans` -/ 224 | def SimpResult.trans (r1 r2 : SimpResult) : MetaM SimpResult := do 225 | match r1.pf? with 226 | | none => return r2 227 | | some pf1 => match r2.pf? with 228 | | none => return {expr := r2.expr, pf? := some pf1} 229 | | some pf2 => 230 | let pf ← mkAppM ``Eq.trans #[pf1, pf2] 231 | return {expr := r2.expr, pf? := some pf} 232 | 233 | #check congr 234 | #check congrArg 235 | #check congrFun 236 | /-- (tutorial function) 237 | Combines `f = g`, and `a = b` into `f a = g b` using `congr` -/ 238 | def SimpResult.app (rf rArg : SimpResult) : MetaM SimpResult := do 239 | let expr := mkApp rf.expr rArg.expr 240 | match rf.pf? with 241 | | none => match rArg.pf? with 242 | | none => return .empty expr 243 | | some pfArg => return {expr := expr, pf? := ← mkAppM ``congrArg #[rf.expr, pfArg]} 244 | | some pff => match rArg.pf? with 245 | | none => return {expr := expr, pf? := ← mkAppM ``congrFun #[pff, rArg.expr]} 246 | | some pfArg => return {expr := expr, pf? := ← mkAppM ``congr #[pff, pfArg]} 247 | -- see also `mkCongr`, `mkCongrArg`, `mkCongrFun` 248 | 249 | /- 250 | ## (4) Basic `simp` implementation 251 | 252 | We split the simplification algorithm into two functions. 253 | 254 | * Function `simProcBasic (...) a` only tries to make a single rewrite step 255 | of the root of `a` to `b` and build a proof of `a = b`. 256 | * Recursive function `simpRec0` gets a specific root-rewriting function as 257 | an argument (currently `simProcBasic`), tries to apply it anywhere inside 258 | the term, and returns the proof of equality in the same format. 259 | -/ 260 | 261 | /-- (tutorial function) 262 | Root-rewriting function analogous to `simp only`. 263 | It gets a list of equalities `rules`, and tries to find a matching 264 | rule `rule : a = b` that matches the given expression `a`. 265 | The `rule` also can be quantified. 266 | On the other hand, we do not look to subexpressions of `a`, 267 | and only try to perform the step once. (that is the job of `simpRec`) 268 | -/ 269 | def simProcBasic (rules : List Expr) (a : Expr) : 270 | MetaM SimpResult := 271 | withNewMCtxDepth do 272 | for rule in rules do 273 | let eq ← whnf (← inferType rule) 274 | let (mvars, _, eq) ← forallMetaTelescope eq -- turn quantifiers into mvars 275 | -- let pf := mkAppN eq mvars -- build the proof term 276 | let some (_, ar, br) := eq.app3? ``Eq | throwError "Not an equality: {rule} : {eq}" 277 | if ← withTransparency .reducible (isDefEq a ar) then 278 | let br ← instantiateMVars br 279 | let pf := mkAppN rule (← mvars.mapM instantiateMVars) 280 | return {expr := br, pf? := some pf} 281 | return .empty a 282 | 283 | -- Test! 284 | example (a b : Nat) (f : Nat → Nat) (h : ∀ x, f x = x) : True := by 285 | run_tacq 286 | let e := q($f ($a + $b)) 287 | let res ← simProcBasic [h] e 288 | logInfo m!"Simplify ({e}) to: {res.expr}" 289 | logInfo m!"Proof term: {res.pf?}" 290 | trivial 291 | 292 | /-- (tutorial function) 293 | Recursive rewrite inside a term. 294 | -/ 295 | partial -- simplification could repeat indefinitely, `partial` skips termination check 296 | def simpRec0 (simProc : Expr → MetaM SimpResult) 297 | (a : Expr) : MetaM SimpResult := do 298 | let an ← whnfR a 299 | let res ← match an with -- try to simplify the inside of the expression 300 | | .app f arg => 301 | let rf ← simpRec0 simProc f 302 | let rArg ← simpRec0 simProc arg 303 | rf.app rArg 304 | | _ => pure <| .empty an 305 | let resProc ← simProc res.expr -- This is the step actually doing the rewrite! 306 | if resProc.pf?.isNone then 307 | return res 308 | -- if rewrite was successful, we repeat in case there is more to do 309 | let res ← res.trans resProc 310 | let resRepeat ← simpRec0 simProc res.expr 311 | res.trans resRepeat 312 | 313 | -- Test rewriting inside the term. 314 | example (a b : Nat) (f : Nat → Nat) (h : ∀ x, f x = x) 315 | (h_test : 2 * f a = f b * 3): True := by 316 | run_tacq 317 | let res ← simpRec0 (simProcBasic [h]) h_test.ty 318 | logInfo m!"Simplify ({h_test.ty}) to: {res.expr}" 319 | logInfo m!"Proof term: {res.pf?}" 320 | trivial 321 | 322 | /- 323 | ### Using `simp` infrastructure 324 | 325 | The library `simp` is similarly modular as ours, with a few extra features. Often, 326 | we don't have to implement the entire `simpRec` from scratch. Let us show how 327 | to perform the same simplification using our own `simProcBasic` 328 | but library's `simp` instead of our own `simpRec`. Notice that 329 | `simp` can simplify inside a binder. 330 | -/ 331 | 332 | #print Simp.Simproc 333 | #check Simp.main 334 | #check applySimpResultToTarget 335 | 336 | example (a b c : Nat) (p : Nat → Nat → Prop) 337 | (h₁ : a = b) (h₂ : b = c) (finish : ∀ x, p x c → p x c) : 338 | (∀ x, p x a → p x a) := by 339 | -- simp only [h₁, h₂] 340 | run_tacq goal => 341 | let ctx : Simp.Context ← Simp.mkContext -- optionally lemmas & extra congruence lemmas 342 | let method : Simp.Simproc := fun e : Expr => do 343 | let res ← simProcBasic [h₁, h₂] e 344 | -- Very straightforward translation from our `SimpResult` to the library 345 | -- `Simp.Step`. In general, `Simp.Step` can guard the repetition inside 346 | -- `simp` by deciding on `done` / `visit` / `continue` 347 | if res.pf?.isNone then return Simp.Step.continue 348 | else return Simp.Step.visit { expr := res.expr, proof? := res.pf? } 349 | let methods : Simp.Methods := { pre := method } 350 | let (res, _stats) ← Simp.main goal.ty ctx (methods := methods) 351 | logInfo m!"Simplify ({goal.ty}) to: {res.expr}" 352 | logInfo m!"Proof term: {res.proof?}" 353 | -- we could match on `res.proof?` but we can also use library function 354 | let mvarIdNew ← applySimpResultToTarget goal.mvarId! goal.ty res 355 | if mvarIdNew == goal.mvarId! then throwError "simp made no progress" 356 | replaceMainGoal [mvarIdNew] 357 | exact finish 358 | 359 | /- 360 | ## (5) Debugging with traces 361 | 362 | For basic debug prints, we can use `logInfo`, however: 363 | * we have to delete it when we want to hide the debug, 364 | * it can get messy when we print too many messages. 365 | 366 | Lean offers a system of traces for debugging purposes. We can 367 | display traces for many standard Lean functions. For example, 368 | `whnf` sometimes calls `trace[trace.Meta.whnf]`, so let us look 369 | at the debug prints. 370 | -/ 371 | run_meta 372 | let e1 : Q(Nat) := q(let x := 3; x^2) 373 | -- setting the option manually, otherwise we would get much more 374 | -- traces 375 | let e2 ← withOptions (fun opt => opt.setBool `trace.Meta.whnf true) do 376 | whnf e1 377 | logInfo m!"logInfo e2: {e2}" 378 | 379 | -- We can also do this ourself 380 | run_meta 381 | withOptions (fun opt => opt.setBool `trace.WhateverName true) do 382 | trace[WhateverName] m!"Hello trace" 383 | 384 | /- 385 | But usually, we want to turn the trace on using `set_option`. 386 | Such option must be defined in another imported file. Here, 387 | we registered `MyTrace` in `TutorialAux/Init.Lean`. You get 388 | get to the definition by ctrl-clicking on `trace.MyTrace` 389 | in `set_option`. 390 | -/ 391 | set_option trace.MyTrace true in -- try to comment out this line 392 | run_meta 393 | trace[MyTrace] m!"Hello trace" 394 | 395 | -- as with any other option, we can also set the option globally with 396 | set_option trace.MyTrace true 397 | -- or unset 398 | set_option trace.MyTrace false 399 | 400 | /- 401 | ### Tree Structure 402 | 403 | The traces can be packed into a tree with 404 | -/ 405 | #check withTraceNode 406 | #check withTraceNode' 407 | #check withTraceNodeBefore 408 | 409 | -- for example 410 | set_option trace.MyTrace true in 411 | run_meta 412 | trace[MyTrace] "Start" 413 | let res? : Option Nat ← withTraceNodeBefore `MyTrace (pure "Pack 1") do 414 | trace[MyTrace] "Start inside" 415 | let a : Nat ← withTraceNode' `MyTrace do 416 | trace[MyTrace] "Double inside" 417 | pure (40, m!"obtaining 40") 418 | trace[MyTrace] "Subresult {a}" 419 | pure (some a) -- also try one of the following lines instead 420 | -- return none 421 | -- throwError "Crashed" 422 | trace[MyTrace] "Result is {res?}" 423 | 424 | /- 425 | Notice that `withTraceNodeBefore` calculates the packed message 426 | at the beginning but the emoticon at the end. This emoticon depends 427 | on the calculated value, which is why we need `Option` or `Bool` 428 | as a return type. Alternatively, we can define `ExceptToEmoji` on 429 | a custom data type. 430 | -/ 431 | 432 | instance simpResultToEmoji : ExceptToEmoji Exception SimpResult where 433 | toEmoji x := exceptOptionEmoji (x.map SimpResult.pf?) 434 | 435 | set_option trace.MyTrace true in 436 | run_meta 437 | let _res : SimpResult ← withTraceNodeBefore `MyTrace (pure "Pack") do 438 | let expr := q(2) 439 | let pf : Q(1 + 1 = 2) := q(rfl) 440 | trace[MyTrace] "expr := {expr}" 441 | trace[MyTrace] "pf := {pf}" 442 | pure ⟨expr, some pf⟩ 443 | -- pure ⟨expr, none⟩ 444 | -- throwError "oops" 445 | 446 | /-- (tutorial function) Trace SimpResult if nonempty -/ 447 | def SimpResult.trace (res : SimpResult) : MetaM Unit := do 448 | match res.pf? with 449 | | some pf => 450 | trace[MyTrace] "=> {res.expr}" 451 | withTraceNode' `MyTrace do 452 | trace[MyTrace] pf 453 | pure ((), "(proof term)") 454 | | _ => pure () 455 | 456 | /- 457 | ## (6) Implementing `simp` inside binders 458 | 459 | Here, we look how to implement `simp` inside binders on our own without using 460 | library's `Simp.main`. Let's look again how library's simp does it. 461 | -/ 462 | theorem simp_example2 (a b c : Nat) (p : Nat → Nat → Prop) 463 | (h₁ : a = b) (h₂ : b = c) (finish : ∀ x, p x c → p x c) : 464 | (∀ x, p x a → p x a) := by 465 | simp only [h₁, h₂] 466 | exact finish 467 | 468 | #print simp_example2 469 | 470 | -- The proof term uses special theorems digging into forall & implication: 471 | #check implies_congr 472 | #check forall_congr 473 | 474 | -- Let's start with using these lemmas to build `SimpResult` 475 | 476 | #check implies_congr 477 | /-- (tutorial function) 478 | from `a = b`, `c = d` proves `a → c = b → d` using `implies_congr` on `SimpResult`s -/ 479 | def SimpResult.impl (r1 r2 : SimpResult) : MetaM SimpResult := do 480 | let expr := mkForall Name.anonymous BinderInfo.default r1.expr r2.expr 481 | if r1.pf?.isNone && r2.pf?.isNone then return .empty expr 482 | return {expr := expr, pf? := some <| 483 | ← mkAppM ``implies_congr #[← r1.getProof, ← r2.getProof] 484 | } 485 | -- see also `mkImpCongr` 486 | 487 | #check forall_congr 488 | /-- (tutorial function) 489 | Gets a proof of `p fv = q fv` where `fv` is a free variable, and `p fv` is a `Prop`. 490 | and builds a proof of `(∀ x, p x) = (∀ x, q x)` using forall_congr. 491 | -/ 492 | def SimpResult.forall (fv : Expr) (r : SimpResult) : 493 | MetaM SimpResult := do 494 | let expr ← mkForallFVars #[fv] r.expr -- bind `fv` into forall `expr := ∀ x, q x` 495 | match r.pf? with 496 | | none => return .empty expr 497 | | some pf => 498 | let pf ← mkLambdaFVars #[fv] pf -- bind `fv` into lambda, `pf : ∀ x, p x = q x` 499 | let pf ← mkAppM ``forall_congr #[pf] -- `pf : (∀ x, p x) = (∀ x, q x)` 500 | return {expr := expr, pf? := some pf} 501 | -- see also `mkForallCongr` 502 | 503 | -- Now, we need to update `simpRec0` to use them. 504 | 505 | /-- (tutorial function) 506 | Recursive simplification inside a term with implications. 507 | -/ 508 | partial 509 | def simpRec (simProc : Expr → MetaM SimpResult) 510 | (a : Expr) : MetaM SimpResult := do 511 | trace[MyTrace] "Simplifying {a}" 512 | let an ← whnfR a 513 | let res ← -- try to simplify the inside of the expression 514 | withTraceNodeBefore `MyTrace (pure "inside") do 515 | match an with 516 | | .app f arg => 517 | let rf ← simpRec simProc f 518 | let rArg ← simpRec simProc arg 519 | rf.app rArg 520 | | .forallE _name t body _bi => 521 | if !body.hasLooseBVars then -- not a dependent implication -> impl_congr 522 | let rt ← simpRec simProc t 523 | let rBody ← simpRec simProc body 524 | rt.impl rBody 525 | else -- dependent implication -> forall_congr 526 | if !(← isProp an) then -- forall_congr only works on a Prop 527 | pure <| .empty an 528 | else 529 | -- In general, `forallTelescope` unpacks forall a bit like `intros` creating 530 | -- new free variables and putting them into the local context within 531 | -- the inner do scope. Here we want just a single step, hence 532 | -- `forallBoundedTelescope` with `maxFVars? := some 1` 533 | forallBoundedTelescope an (some 1) (fun fvars body => do 534 | -- this `body` has a fvar, contrary to the bare `body` 535 | -- we got by unpacking the `Expr` which uses a `bvar` 536 | let res ← simpRec simProc body 537 | res.forall fvars[0]! 538 | ) 539 | | _ => pure <| .empty an 540 | res.trace 541 | let resProc ← 542 | withTraceNodeBefore `MyTrace (pure "root") do 543 | simProc res.expr -- This is the step actually doing the rewrite! 544 | resProc.trace 545 | if resProc.pf?.isNone then 546 | return res 547 | -- if rewrite was successful, we repeat in case there is more to do 548 | let res ← res.trans resProc 549 | let resRepeat ← simpRec simProc res.expr 550 | res.trans resRepeat 551 | 552 | /-- 553 | (tutorial function) Simplifies the goal with a `simProc` 554 | -/ 555 | def mySimpGoal (simProc : Expr → MetaM SimpResult) : TacticM Unit := do 556 | let goal ← getMainGoal 557 | goal.withContext do 558 | let target ← goal.getType 559 | let res ← 560 | withTraceNodeBefore `MyTrace (pure "Build simp equation") do 561 | simpRec simProc target -- run simplification 562 | match res.pf? with 563 | | none => throwError "mySimpGoal made no progress" 564 | | some pf => 565 | trace[MyTrace] target 566 | res.trace 567 | -- use Eq.mpr as with `rw`, this time using `mkAppM` 568 | let m ← mkFreshExprSyntheticOpaqueMVar res.expr 569 | goal.assign <| ← mkAppM ``Eq.mpr #[pf, m] 570 | replaceMainGoal [m.mvarId!] 571 | 572 | -- Test! 573 | set_option trace.MyTrace true in 574 | example (a b c : Nat) (p : Nat → Nat → Prop) 575 | (h₁ : a = b) (h₂ : b = c) (finish : ∀ x, p x c → p x c) : 576 | (∀ x, p x a → p x a) := by 577 | -- simp only [h₁, h₂] 578 | run_tacq mySimpGoal (simProcBasic [h₁, h₂]) 579 | exact finish 580 | 581 | /- 582 | Exercise: The implementation above works with ∀ but not with ∃. 583 | Update the function `simpRec` so that the following proof passes. 584 | -/ 585 | set_option trace.MyTrace true in 586 | example (a b : Nat) (p : Nat → Nat → Prop) 587 | (h : a = b) (finish : ∃ x, p x b) : 588 | (∃ x, p x a) := by 589 | -- simp only [h] 590 | run_tacq mySimpGoal (simProcBasic [h]) 591 | exact finish 592 | 593 | 594 | /- 595 | ## (7) Collecting tagged lemmas 596 | 597 | The standard `simp` doesn't need to be given the lemmas each usage, it uses 598 | all the lemmas tagged with `@[simp]`. Let us show an example to introduce 599 | a custom attribute `my_tag`. 600 | 601 | This requires two `initialize` steps. 602 | * Creating an environment extension `myExt` using 603 | `registerSimpleScopedEnvExtension`. This will store the array of tagged theorems. 604 | * Registering the attribute `my_tag` itself using `registerBuiltinAttribute`. 605 | 606 | Little annoyingly, every `initialize` must be done in another file than 607 | where it is tested (i.e. where we tag theorems with the attribute). 608 | 609 | Look at the file `TutorialAux/Tag.lean` where these two steps are done. 610 | -/ 611 | #check myExt 612 | 613 | -- Since we imported `TutorialAux/Tag.lean`, we can tag some theorems with `my_tag` 614 | 615 | @[my_tag] theorem add_assoc_rev (a b c : Nat) : 616 | a + (b + c) = (a + b) + c := (Nat.add_assoc a b c).symm 617 | @[my_tag] theorem two_mul_rev (a : Nat) : a + a = 2 * a := a.two_mul.symm 618 | -- even some theorems are defined without `@[my_tag]` 619 | theorem two_mul_rev' (a b : Nat) : (b + a) + a = b + 2 * a := by omega 620 | theorem two_two_four (a : Nat) : 2 * (2 * a) = 4 * a := by omega 621 | -- we can add the attribute later 622 | attribute [my_tag] two_mul_rev' 623 | attribute [my_tag] two_two_four 624 | 625 | -- look at the theorems stored at `customExt` 626 | run_meta 627 | let state := myExt.getState (← getEnv) 628 | for (e,t) in state do 629 | logInfo m!"{e} : {t}" 630 | 631 | /- 632 | Now, we have all the ingredients to an alternative to `simProcBasic`. 633 | This will use tagged theorems (tagged when the is run), and allow 634 | quantified theorems. 635 | -/ 636 | #check simProcBasic 637 | def simProcTag (expr : Expr) : MetaM SimpResult := 638 | withNewMCtxDepth do 639 | let state := myExt.getState (← getEnv) 640 | for (e,t) in state do 641 | let (mvars, _, eq) ← forallMetaTelescope t -- turn quantifiers into mvars 642 | let pf := mkAppN e mvars -- build the proof term 643 | let some (_, ar, br) := eq.app3? ``Eq | throwError "Not an equality: {pf} : {eq}" 644 | if ← withTransparency .reducible (isDefEq expr ar) then 645 | let br ← instantiateMVars br 646 | let pf ← instantiateMVars pf 647 | return {expr := br, pf? := some pf} 648 | return .empty expr 649 | 650 | set_option trace.MyTrace true in 651 | example (a : Nat) (p : Nat → Prop) (h : p (4*a + 2*a + a)) : 652 | p ( (a+a+a)+a+(a+a+a) ) := by 653 | run_tac mySimpGoal simProcTag 654 | exact h 655 | 656 | /- 657 | Exercise: Update the code for `Tag.lean` & `simProcTag` so that 658 | it can accept theorems with universe levels. 659 | -/ 660 | 661 | #check eq_self 662 | attribute [my_tag] eq_self 663 | 664 | example (a : Nat) : a + a = 2 * a := by 665 | run_tac mySimpGoal simProcTag 666 | exact True.intro 667 | 668 | -- Hints: 669 | #check getConstInfo 670 | #check mkFreshLevelMVarsFor 671 | -- Feel free to change the type (Expr × Expr) stored in `myTag` 672 | -- the pair `(e,t)` might not be ideal. Also remember that the metavariables 673 | -- must be introduced when trying to apply a theorem, not at initialization 674 | -- because we want different mvar instantiations at different places. 675 | -------------------------------------------------------------------------------- /TacticProgrammingGuide.lean: -------------------------------------------------------------------------------- 1 | import Lean -- Lean's metaprogramming 2 | import Batteries 3 | import Qq -- convenient term building / matching 4 | 5 | namespace MetaProgrammingTutorial 6 | 7 | /- 8 | This tutorial is intended for people who have basic knowledge of the Lean theorem prover, 9 | as well as some basic programming experience, and would be interested to know how to 10 | implement a custom tactic in Lean. 11 | 12 | Ideally open this file in VSCode to see how Lean reacts. 13 | 14 | After going through this tutorial, you should have a decent overview of what 15 | Lean metaprogramming is about, and be able to write some simple tactics. 16 | 17 | # Beginner's Guide to Lean Tactic Programming 18 | 19 | Tactics are in principle arbitrary programs that operate on the proof state. 20 | We can write such programs in-place in the tactic proof, such as in the following example. 21 | 22 | This example tactic doesn't do anything except logging "Hello world". 23 | Put your cursor at the blue-underlined `run_tac` to see the message. 24 | 25 | Do not bother with the type of `Lean.logInfo` too much so far, 26 | it is simply a logging / printing function. 27 | -/ 28 | 29 | example : True := by 30 | run_tac 31 | Lean.logInfo "Hello world!" 32 | trivial 33 | 34 | /- 35 | To understand how to write tactics, we need to understand 36 | (1) How imperative programs work in Lean 37 | (2) What really is a proof state 38 | (3) What are the basic data structures around Lean metaprogramming 39 | (4) Some API to modify the proof state 40 | (5) How to declare syntax for a new tactic 41 | 42 | Let us answer them. 43 | 44 | ## (1) How imperative programs work in Lean 45 | 46 | Lean is a pure functional language - compared to imperative languages (C, Python, ...), 47 | its definitions cannot change, and its functions depend only on their arguments, 48 | and cannot have side effects. 49 | 50 | However, functional programming languages (such as Haskell) developed 51 | a way to write imperative style through 52 | * the theory of monads 53 | * "do notation" to hide most of monads from the user. 54 | 55 | We will keep the monad theory hidden, here we just say that a monad in general denotes 56 | an imperative program. There are several monads depending on what state they have access to. 57 | In the following example, we show two monads. 58 | 59 | `Lean.Elab.Tactic.TacticM` - the top level tactic monad, has access to all the data 60 | from the proofstate 61 | `Lean.Meta.MetaM` - a monad that only has access to information about metavariables 62 | (not important for now). This is a part of the entire proofstate, so a `TacticM` 63 | can call a `MetaM` but not the other way around (we would have to provide the 64 | `TacticM` all the extra data it needs) 65 | 66 | We will now demonstrate imperative programming in Lean with some examples. So far, 67 | we are not using any API to access the proofstate, only showcasing 68 | Lean as an imperative programming language. 69 | -/ 70 | 71 | -- parameters monad type return value 72 | -- v v v 73 | def myCode1 (n : Nat) : Lean.Meta.MetaM Nat := do 74 | if n = 0 then -- since we are in a do notation, we can skip "else" 75 | return 42 76 | let k := n^2 -- we use ":=" to assign a value 77 | Lean.logInfo m!"{n} -> {k}" 78 | return k 79 | 80 | -- parameters monad type no return value (like void in C) 81 | -- v v v 82 | def myCode2 (n : Nat) : Lean.Elab.Tactic.TacticM Unit := do 83 | Lean.logInfo m!"Calling myCode2 {n}" 84 | 85 | -- Array is basically the same thing as List with a different 86 | -- implementation (analogous to C++ vectors) 87 | def myCode3 : Lean.Elab.Tactic.TacticM (Array Nat) := do 88 | Lean.logInfo "Calling myCode3" 89 | myCode2 7 90 | -- lean variables are immutable but the do notation 91 | -- allows to break this using "let mut" 92 | let mut a : Array Nat := #[] -- "#" denotes it is an empty Array instead of empty List 93 | for i in [:5] do -- `[:5]` or `[0:5]` loops through `0,1,2,3,4` using `Std.Range` 94 | let res ← myCode1 i -- we use "←" to retrieve a value from a monad execution 95 | a := a.push res -- an assignment without "let" is only allowed for mutable variables 96 | -- Note: since we immediately replace `a` with `a.push res`, 97 | -- Lean's inner optimization will avoid duplicating the array 98 | -- Note for imperative programmers: 99 | -- `a.push res` alone cannot work, an external function cannot change the value of "a". 100 | -- Lean is a pure functional language after all 101 | Lean.logInfo m!"got: {res}" 102 | myCode2 15 103 | return a 104 | 105 | /- 106 | Look at what Lean prints, and see if you can understand where all the messages 107 | come from. 108 | -/ 109 | example : True := by 110 | run_tac 111 | Lean.logInfo "Running some tactic programs 2!" 112 | let x ← myCode3 113 | -- Notice that it is possible to inline monad evaluation 114 | -- inside an expression, using `← someTactic` 115 | Lean.logInfo m!"result: {x} %% {← myCode1 5}" 116 | trivial 117 | 118 | /- 119 | Of course, this is not exhaustive. Advanced topics include 120 | * What is the theory behind monads, how to use custom monads. 121 | * What are further programming-focused functions & datastructures in Lean, 122 | such as `Std.HashMap`, `foldM`, the `IO` monad, etc. 123 | * different types of exceptions -- `throwError`, `panic!` 124 | * `partial` functions to bypass Lean's termination checker 125 | ... 126 | 127 | ## (2) What is a proof state 128 | 129 | On the core level, a proof is a term, a so called "proof term" that testifies the truth 130 | of the given proposition. When we are proving a theorem, at every moment, we have 131 | a partially built proof term with holes, so called metavariables. 132 | Most tactic steps fill one hole (formally assign one metavariable) with a subterm, 133 | possibly containing further metavariables. 134 | 135 | The proof is finished once all metavariables are assigned, 136 | i.e. all holes are filled, i.e all goals are closed. 137 | Metavariables are the variables with a question mark before their name. 138 | 139 | As an example, we will show a proof of `p → p ∧ True`, and write 140 | the partially filled proof term in between. 141 | -/ 142 | 143 | theorem p_imp_p_true (p : Prop) : p → p ∧ True := by 144 | -- p_imp_p_true : p → p ∧ True := ?_ 145 | intro h 146 | -- p_imp_p_true : p → p ∧ True := (fun h => ?_) 147 | constructor 148 | -- p_imp_p_true : p → p ∧ True := (fun h => And.intro ?left ?right) 149 | assumption 150 | -- p_imp_p_true : p → p ∧ True := (fun h => And.intro h ?right) 151 | trivial 152 | -- p_imp_p_true : p → p ∧ True := (fun h => And.intro h True.intro) 153 | 154 | /- 155 | ## (3) Basic data structures around Lean metaprogramming 156 | 157 | * Expressions - `Lean.Expr`, `Qq` 158 | * data in expressions: `Lean.Name`, `Lean.MVarId`, `Lean.FVarId` 159 | * printing: `String`, `Format`, `MessageData` 160 | -/ 161 | 162 | -- The data structure that is used to represent Lean expressions is `Lean.Expr`. 163 | -- Due to the nature of dependent type theory, `Lean.Expr` is used to encode types, terms and proofs. 164 | -- Thus, `Lean.Expr` is also what is checked by the Lean kernel when checking proofs. 165 | -- ctrl-click on `Lean.Expr` below to see its definition in the library. 166 | #check Lean.Expr 167 | 168 | -- Lean has a handy library `Qq` to help you build `Lean.Expr` terms with a convenient notation. 169 | open Qq 170 | 171 | -- `Q(...)` is a type annotation of an expression, and 172 | -- `q(...)` is an expression 173 | def t1 : Q(Prop) := q(True) 174 | def t2 : Q(Prop) := q(∀ p : Prop, p → p ∧ True) 175 | 176 | -- Writing expressions directly is possible 177 | -- but can take a bit of effort. 178 | #eval t1 179 | #eval t2 180 | 181 | -- The type `Q(...)` is not explicitly `Lean.Expr` but it is definitionally equal to it, 182 | -- and it is not forced to have a correct type annotation. So you can think of Qq 183 | -- as of Python type annotations - it can catch basic errors but it is not forced at all. 184 | def t1e : Lean.Expr := t1 185 | def t1x : Q(Nat) := t1 186 | 187 | #check t1e 188 | #check t1x 189 | 190 | -- Basically all metaprogramming API is in the namespace `Lean` 191 | -- repeating the prefix is getting annoying 192 | open Lean 193 | 194 | -- Another important type in metaprogramming is `Lean.Name` 195 | def n1 : Name := `Nat.blah -- single backtick: arbitrary name 196 | def n2 : Name := ``t1e -- double backtick: resolved name (resolved in the current context) 197 | 198 | #print n1 199 | #print n2 200 | 201 | -- The way Expr handles variables might seem messy at first - there are 202 | #check Expr.bvar -- variable bound / quantified inside that `Expr`, represented with an index 203 | #check Expr.fvar -- named variable in the context 204 | #check Expr.mvar -- metavariable 205 | #check Expr.const -- a defined constant 206 | 207 | -- Moreover, user facing names of free variables and metavariables are not a unique 208 | -- identifier of a variable - Lean wants to allow multiple variables with the same name. 209 | -- So, free variables are identified by 210 | #check FVarId 211 | -- and metavariables are identified by 212 | #check MVarId 213 | -- these datatypes hide a name inside too but that name (such as `_uniq.13541`) 214 | -- should never be ever exposed to the user. 215 | 216 | /- 217 | ### Showing / printing. 218 | Our basic printing function `logInfo` is a bit fancier than what you might expect. 219 | In normal programming languages, we are used to a print function that takes a `String`. 220 | However, in Lean, `logInfo` takes a `Lean.MessageData`. This means that it can show a term 221 | with mouse hover showing types and ctrl+click to go to definitions. 222 | -/ 223 | #check MessageData -- interactive expression 224 | #check String -- standard list of characters 225 | #check Format -- string with information about how to line-wrap nicely 226 | 227 | -- Examine the print of the following logInfo. 228 | example : True := by 229 | run_tac 230 | logInfo m!"Interactive MessageData: t2 = {t2}" 231 | logInfo s!"String: t2 = {t2}" 232 | -- the function `repr` allows us to print the underlying data type. 233 | -- it returns a `Format`. 234 | logInfo f!"Format : repr t2 = {repr t2}" 235 | trivial 236 | 237 | /- 238 | ## (4) Implementing basic tactics 239 | 240 | Let us write the code for the 4 tactics used in 241 | -/ 242 | #check p_imp_p_true 243 | example (p : Prop) : p → p ∧ True := by 244 | intro h; constructor; assumption; trivial 245 | 246 | /- 247 | A lot of the functions / types are hidden in namespaces 248 | * Lean 249 | * Lean.Meta 250 | * Lean.Elab.Tactic 251 | so let's open them 252 | -/ 253 | 254 | open Lean Meta Elab.Tactic Qq 255 | 256 | -- The easiest tactic to replace is "trivial" 257 | def runTrivial0 : TacticM Unit := do 258 | -- we retrieve the metavariable representing the current goal 259 | let goal : MVarId ← getMainGoal 260 | -- and assign it to be True.intro 261 | goal.assign q(True.intro) -- !!! first attempt, not ideal 262 | -- better to avoid low-level `MVarId.assign`, we will see why 263 | 264 | example (p : Prop) : p → p ∧ True := by 265 | intro h; constructor; assumption 266 | run_tac runTrivial0 267 | -- Goals closed :-). 268 | 269 | /- 270 | This works nicely but the assignment is unsafe, 271 | it doesn't perform a type check! 272 | Let's try to close also the goal (?left : p) with 273 | runTrivial0 to see what happens. 274 | -/ 275 | 276 | example (p : Prop) : p → p ∧ True := by -- !!! 277 | intro h; constructor 278 | run_tac runTrivial0 279 | run_tac runTrivial0 280 | 281 | /- 282 | MVarId.assign happily closed the goal. Then we correctly closed the goal 283 | `?right : True`, and at the very end, after the Lean kernel checked 284 | the entire proof term, we got a mysterious error that we cannot apply 285 | `@And.intro p True` to `True.intro` because it expects a proof of `p`, 286 | and not a proof of `True`. 287 | 288 | Such errors are hard to decode, so it is better to ensure that we only 289 | assign a metavariable if the assignment has the correct type. 290 | Fortunately, Batteries has a function that checks if something can be assigned. 291 | ctrl+click on it to see the implementation. 292 | -/ 293 | #check MVarId.assignIfDefEq 294 | 295 | -- version throwing an error if the goal isn't `True` 296 | def runTrivial1 : TacticM Unit := do 297 | -- we retrieve the metavariable representing the current goal 298 | let goal : MVarId ← getMainGoal 299 | -- and assign it to be True.intro 300 | goal.assignIfDefEq q(True.intro) 301 | 302 | -- now we get an error in the correct place if we try to run `runTrivial1` 303 | -- on the wrong goal 304 | example (p : Prop) : p → p ∧ True := by 305 | intro h; constructor 306 | run_tac runTrivial1 -- error where it should be :-) 307 | run_tac runTrivial1 308 | 309 | /- 310 | However, the error message "failed", is not very helpful. 311 | To improve this, we can catch that error, and provide our own, more useful error. 312 | We can catch errors using a `try ... catch _ => ...` block. 313 | And we can throw errors using `throwError`. 314 | -/ 315 | def runTrivial : TacticM Unit := do 316 | -- we retrieve the metavariable representing the current goal 317 | let goal : MVarId ← getMainGoal 318 | -- and assign it to be True.intro 319 | try 320 | goal.assignIfDefEq q(True.intro) 321 | catch _ => 322 | let goalType ← goal.getType 323 | throwError "tactic runTrivial1 failed, the goal has type `{goalType}` instead of `True`" 324 | 325 | example (p : Prop) : p → p ∧ True := by 326 | intro h; constructor 327 | run_tac runTrivial -- now we get a useful error message here 328 | run_tac runTrivial 329 | 330 | 331 | /- 332 | To implement `assumption`, we want to loop through all the assumptions, 333 | and try to use them one by one. 334 | The list of assumptions, which appears above the `⊢` in the infoview, is called 335 | the local context. How do we get the local context? In general each metavariable 336 | (i.e. goal) has its own local context, but we can just use `withMainContext`. 337 | This puts the local context of the current goal into the monadic context, 338 | and then we can retrieve the context using `getLCtx` 339 | 340 | First, we can just print the assumptions. 341 | -/ 342 | 343 | example (n : Nat) (hn : n > 5) : True := by 344 | run_tac 345 | -- Note: You will see _example in the list, which is there in case 346 | -- we wanted to build a recursive definition 347 | withMainContext do 348 | let ctx ← getLCtx 349 | -- go through all local declarations 350 | for (decl : LocalDecl) in ctx do 351 | logInfo m!"{Expr.fvar decl.fvarId} : {decl.type} -- {repr decl.kind}" 352 | trivial 353 | 354 | -- We have all the components, so let's implement the assumption tactic. 355 | 356 | def runAssumption : TacticM Unit := -- we don't have to start with do here (but can) 357 | withMainContext do -- but have to "do" it here 358 | let goal ← getMainGoal 359 | let ctx ← getLCtx 360 | for (decl : LocalDecl) in ctx do 361 | if decl.kind != .default then continue 362 | try 363 | goal.assignIfDefEq (Expr.fvar decl.fvarId) 364 | return -- if succeeded, we are done 365 | catch _ => 366 | pure () -- ignore the exception 367 | throwError "Assumption not found" 368 | 369 | -- let's test 370 | example (p : Prop) : p → p ∧ True := by 371 | intro h; constructor 372 | run_tac runAssumption 373 | run_tac runTrivial 374 | 375 | /- 376 | The remaining two tactics require creating a new metavariable. 377 | A new metavariable is created using 378 | -/ 379 | #check mkFreshExprMVar 380 | /- 381 | However a good practice is to make the goal variables "syntheticOpaque" - then Lean 382 | knows that they are somewhat important, and doesn't assign them willy-nilly. 383 | 384 | One way is to use the following function 385 | -/ 386 | #check mkFreshExprSyntheticOpaqueMVar 387 | /- 388 | although if you Ctrl-click on it, you find that it just 389 | calls `mkFreshExprMVar` with a specific kind. 390 | -/ 391 | 392 | /- 393 | Now let us define `runConstructor`, in which we will decompose `And`. 394 | (we will not attempt general constructor) 395 | First, we just write the function that reads the type `A ∧ B` from the goal, 396 | and extracts the two type expressions `A` and `B`. 397 | -/ 398 | def extractAndGoals1 : TacticM (Expr × Expr) := do 399 | let tgt ← getMainTarget -- equivalent to `(← getGoal).getType` 400 | -- add a `Q(...)` annotation to `tgt`, !! must use `have`, not `let` 401 | have quotedTgt : Q(Prop) := tgt 402 | match quotedTgt with 403 | | ~q($p ∧ $q) => -- Qq match, must run in MetaM or higher 404 | return (p, q) 405 | | _ => throwError "Goal {tgt} is not of the form (?_ ∧ ?_)" 406 | 407 | -- Qq is handy but it is worth knowing how to do these things "manually" 408 | def extractAndGoals2 : TacticM (Expr × Expr) := do 409 | let tgt ← getMainTarget 410 | -- an alternative syntax to match ... with 411 | let (`And, #[p, q]) := tgt.getAppFnArgs 412 | | throwError "Goal {tgt} is not of the form (?_ ∧ ?_)" 413 | return (p, q) 414 | -- Note that the non-Qq version requires the term to be more "exactly matching". 415 | -- Before matching, you might want to call the following two functions 416 | #check instantiateMVars 417 | #check whnf 418 | -- however digging deeper into them exceeds the scope of this tutorial. 419 | 420 | -- let's check that our decomposition of "And" works. 421 | example (p q : Prop) (h : p ∧ q) : p ∧ q := by 422 | run_tac 423 | let (a1, b1) ← extractAndGoals1 424 | logInfo m!"Qq extraction: {a1} AND {b1}" 425 | let (a2, b2) ← extractAndGoals2 426 | logInfo m!"Expr extraction: {a1} AND {b1}" 427 | assumption 428 | 429 | /-- 430 | Replaces the main goal (?_ : A ∧ B) with 431 | And.intro (?left : A) (?right : B) 432 | -/ 433 | def runConstructor : TacticM Unit := do 434 | withMainContext do -- try to comment out this line to see what breaks 435 | let goal ← getMainGoal 436 | let ((a : Q(Prop)), (b : Q(Prop))) ← extractAndGoals1 437 | let left : Q($a) ← mkFreshExprSyntheticOpaqueMVar a (tag := `left) -- build new metavariables 438 | let right : Q($b) ← mkFreshExprSyntheticOpaqueMVar b (tag := `right) 439 | goal.assign q(And.intro $left $right) -- can we be brave here with `.assign`? :-) 440 | -- the list of active goals is not maintained automatically, 441 | -- we need to tell the proof state that we created two new goals 442 | replaceMainGoal [left.mvarId!, right.mvarId!] 443 | 444 | -- let's test 445 | example (p : Prop) : p → p ∧ True := by 446 | intro h; 447 | run_tac runConstructor 448 | run_tac runAssumption 449 | run_tac runTrivial 450 | 451 | /- 452 | The implementation of intro has the most hidden intricacies. Do not worry 453 | too much if you don't fully understand it. 454 | -/ 455 | def runIntro (name : Name) : TacticM Unit := 456 | withMainContext do 457 | let goal ← getMainGoal 458 | let lctx ← getLCtx 459 | let .forallE _ type body c ← goal.getType 460 | | throwError "Goal not of the form `_ → _` or `∀ _, _`" 461 | let fvarId : FVarId ← mkFreshFVarId -- allocate new variable 462 | let lctx' := lctx.mkLocalDecl fvarId name type c -- put into a new context 463 | let fvar : Expr := .fvar fvarId 464 | let body := body.instantiate1 fvar -- convert bvar to fvar 465 | withLCtx' lctx' do 466 | -- `mkFreshExprSyntheticOpaqueMVar` uses the monadic context to determine the 467 | -- local context of the new metavariable 468 | let newMVar ← mkFreshExprSyntheticOpaqueMVar body 469 | let newVal ← mkLambdaFVars #[fvar] newMVar 470 | goal.assign newVal 471 | replaceMainGoal [newMVar.mvarId!] 472 | 473 | -- Note: Since Lean already implemented intro, 474 | -- there is a shortcut ;-) 475 | def runIntro2 (name : Name) : TacticM Unit := do 476 | let goal ← getMainGoal 477 | let (_, m) ← goal.intro name 478 | replaceMainGoal [m] 479 | 480 | example (p : Prop) : p → p ∧ True := by 481 | run_tac runIntro `h 482 | run_tac runConstructor 483 | run_tac runAssumption 484 | run_tac runTrivial 485 | 486 | /- 487 | In this example, we did goal-oriented tactics, 488 | so let us show how we could add a new have element 489 | to the local context -- a custom "have" 490 | -/ 491 | example (a b : Prop) (ha : a) (hab : a → b) : b := by 492 | run_tac -- we want to emulate: "have hb := hab ha" 493 | withMainContext do 494 | let goal ← getMainGoal 495 | let lctx ← getLCtx 496 | -- find appropriate free variables 497 | let some ehab := lctx.findFromUserName? `hab | throwError "hab not found" 498 | let some eha := lctx.findFromUserName? `ha | throwError "ha not found" 499 | let e : Expr := (.app -- build the term "hab ha" 500 | (.fvar ehab.fvarId) 501 | (.fvar eha.fvarId) 502 | ) 503 | let t ← inferType e -- t = "b", e = "hab hb" 504 | -- goal: ctx ⊢ mainGoal 505 | let goal2 ← goal.assert `hb t e 506 | -- goal2: ctx ⊢ t -> mainGoal 507 | let (_, goal3) ← goal2.intro `hb 508 | -- goal3: ctx, t ⊢ mainGoal 509 | replaceMainGoal [goal3] 510 | exact hb 511 | 512 | /- 513 | ## (5) How to declare syntax for a new tactic 514 | 515 | So far, we have discussed how tactics work internally, but another important part of 516 | tactics is the syntax that we use to call them. When dealing with syntax, 517 | we use the types `Lean.Syntax` and `Lean.TSyntax`. Don't worry about the implementation 518 | of `Lean.Syntax`, as it is quite messy. 519 | -/ 520 | #check Lean.Syntax 521 | #check Lean.TSyntax 522 | /-- 523 | Just like `Q(...)` is an annotated version of `Expr`, `TSyntax ..` is an annotated version 524 | of `Syntax`. However, syntax annotations (so called syntax categories) are just a `Name`. 525 | The most common ones are 526 | - `term`, which represents a lean expression (of any type) 527 | - `tactic`, which represents a tactic 528 | - `num`, which represents a natural number literal 529 | - `ident`, which represents a name/identifier literal 530 | Other less important examples of syntax categories include 531 | - `command`, which represents a top-level command (e.g. `def ..` or `#eval ..`) 532 | - `doElem`, which represent a command in "do notation" 533 | 534 | We can construct `Syntax` using quotations like `` `(kind| syntax)``. This only works 535 | in a monad similar to `MetaM` (above `CoreM` to be precise). 536 | -/ 537 | def s1 : MetaM (TSyntax `tactic) := `(tactic| apply And.intro) 538 | def s2 : MetaM (TSyntax `term) := `(1+2+3) -- equivalent to `(term| 1+2+3) 539 | 540 | -- As you can see, the produced `Syntax` is quite messy; but all the data is somewhere inside 541 | #eval s1 542 | #eval s2 543 | 544 | /- 545 | Now that we can construct syntax, we can make a macro. A macro is a rule that operates on 546 | syntax, and these rules are used when the syntax is being elaborated. 547 | -/ 548 | 549 | /-- `my_constructor` is a version of `constructor` that only applies to `And` goals -/ 550 | macro "my_constructor" : tactic => `(tactic| apply And.intro) 551 | /-- `my_trivial` solves goal `True` -/ 552 | macro "my_trivial" : tactic => `(tactic| exact True.intro) 553 | 554 | -- note that by hovering you can see the doc-strings of the macros 555 | example (p : Prop) : p → p ∧ True := by 556 | intro h; my_constructor; assumption; my_trivial 557 | 558 | /- 559 | For `intro` and `assumption`, we show how to assign the monadic programs 560 | to the appropriate syntax using the `elab` command. 561 | 562 | Be aware that the syntax-defining syntax is quite sensitive to whitespace characters. 563 | In the following example, you cannot put a space between `a` and `:`. 564 | Also, the `` `(tactic| `` notation as shown earlier is best kept without spaces. 565 | -/ 566 | 567 | /-- Our variant of `intro`. -/ 568 | elab "my_intro" a:ident : tactic => do 569 | -- `a` has type ``TSyntax `ident``. This is the syntax kind for identifiers 570 | let aName : Name := a.getId 571 | runIntro aName 572 | 573 | /-- Our variant of `assumption`. -/ 574 | elab "my_assumption" : tactic => do 575 | runAssumption 576 | 577 | example (p : Prop) : p → p ∧ True := by 578 | my_intro h; my_constructor; my_assumption; my_trivial 579 | 580 | /- 581 | Let us show how to extract more kinds of arguments from Syntax 582 | with the following example tactics. 583 | -/ 584 | 585 | /-- Print a string as a message -/ 586 | elab "echo" s:str : tactic => do 587 | -- convert ``TSyntax `str`` to `String` 588 | let s : String := s.getString 589 | Lean.logInfo s 590 | 591 | /-- Print a square of a given natural number -/ 592 | elab "square_nat" n:num : tactic => do 593 | -- convert ``TSyntax `num`` to `Nat` 594 | let n : Nat := n.getNat 595 | Lean.logInfo s!"{n^2}" 596 | 597 | /-- Print a square of a given non-negative decimal number -/ 598 | elab "square_float" n:scientific : tactic => do 599 | let (m,s,e) := n.getScientific 600 | let q : Rat := Rat.ofScientific m s e 601 | let f : Float := Float.ofScientific m s e 602 | Lean.logInfo s!"Rat: {q*q}, Float: {f^2}" 603 | -- Note: negative numbers are not supported as native syntax. 604 | 605 | /-- Display a type of a given term -/ 606 | elab "my_check" e:term : tactic => do 607 | withMainContext do -- term parsing can depend on the context 608 | -- convert ``TSyntax `term`` to `Expr`, without a given expected type 609 | let e : Expr ← elabTerm e none 610 | -- Note that there are many analogous `Lean.Elab.Tactic.elab*` 611 | -- such as `elabTermEnsuringType`, `elabTermWithHoles`... 612 | let t ← inferType e 613 | Lean.logInfo m!"{e} : {t}" 614 | 615 | example (n : Nat) : True := by 616 | echo "Hello world!" 617 | square_nat 5 618 | square_float 0.5 619 | my_check n+5 620 | trivial 621 | 622 | elab "my_have" n:ident ":=" e:term : tactic => do 623 | throwError "Not implemented, left as an exercise" 624 | 625 | example (x y : Prop) (hx : x) (hxy : x → y) : y := by 626 | my_have hy := hxy hx 627 | exact hy 628 | 629 | /- 630 | The `macro` and `elab` commands are nice, but for more complicated syntax, you may need 631 | a bit more flexibility. This can be achieved by first defining the syntax with a 632 | `syntax` command, and then defining the meaning of that syntax with a `macro_rules` or 633 | `elab_rules` command. For example, the above tactics can be defined as follows: 634 | -/ 635 | 636 | /-- Doc-string for `my_constructor'`. -/ 637 | syntax "my_constructor'" : tactic 638 | syntax "my_trivial'" : tactic 639 | syntax "my_intro'" ident : tactic 640 | syntax "my_assumption'" : tactic 641 | 642 | macro_rules 643 | | `(tactic| my_constructor') => `(tactic| apply And.intro) 644 | | `(tactic| my_trivial') => `(tactic| exact True.intro) 645 | 646 | elab_rules : tactic 647 | -- to match a variable, we use the `$` anti-quotation. 648 | -- we can optionally annotate the syntax kind `ident` with `$h:ident` instead of `$h`. 649 | | `(tactic| my_intro' $h:ident) => runIntro h.getId 650 | | `(tactic| my_assumption') => runAssumption 651 | 652 | example (p : Prop) : p → p ∧ True := by 653 | my_intro' h; my_constructor'; my_assumption'; my_trivial' 654 | 655 | /- 656 | For example, these `macro_rules` come in handy when working with syntax arrays. 657 | To illustrate this, let's define a simple form of the `simp_rw` tactic. 658 | We will use the syntax kind `Lean.Parser.Tactic.location`, so let's open the namespace: 659 | -/ 660 | open Parser.Tactic 661 | syntax "my_simp_rw " "[" term,* "]" (location)? : tactic 662 | /- 663 | In the syntax `term,*` 664 | - `*` signifies that it is a possibly empty list. `+` instead gives a nonempty list. 665 | - `,` signifies that it is a comma-separated list. Omitting the `,` gives a space separated list. 666 | In the syntax `(Parser.Tactic.location)?` 667 | - `Parser.Tactic.location` is the syntax of specifying a hypothesis (like in `simp at h`) 668 | - `(...)?` means that the inner syntax is optional: either it is there or it isn't 669 | 670 | Now we can use `macro_rules` to define the tactic 671 | -/ 672 | 673 | macro_rules 674 | /- 675 | To match optional syntax, or a list of syntax, we use the `$[...]` anti-quotation. 676 | - `$[...]?` matches optional syntax 677 | - `$[...],*` matches a possibly empty comma-separated list of syntax 678 | Square brackets without a dollar represent explicit `[` and `]` symbols in the syntax. 679 | Not all syntax kind annotations are required here. They have been added for clarity. 680 | -/ 681 | | `(tactic| my_simp_rw [$e:term, $[$es:term],*] $[$loc:location]?) => 682 | `(tactic| simp only [$e:term] $[$loc:location]?; my_simp_rw [$[$es:term],*] $[$loc:location]?) 683 | | `(tactic| my_simp_rw [$e:term] $[$loc:location]?) => `(tactic| simp only [$e:term] $[$loc:location]?) 684 | | `(tactic| my_simp_rw [] $[$_loc:location]?) => `(tactic| skip) 685 | 686 | -- Let's test it 687 | example : ∀ n m : Nat, m + n + 1 - 1 = n + m := by 688 | my_simp_rw [Nat.add_one_sub_one, Nat.add_comm, implies_true] 689 | 690 | -- or we can use `elab_rules` to loop through the array of terms directly 691 | 692 | syntax "my_simp_rw' " "[" term,* "]" (Parser.Tactic.location)? : tactic 693 | 694 | elab_rules : tactic 695 | | `(tactic| my_simp_rw' [$[$es:term],*] $[$loc:location]?) => 696 | for e in es do 697 | let simpOnlyTactic ← `(tactic| simp only [$e:term] $[$loc:location]?) 698 | evalTactic simpOnlyTactic 699 | 700 | -- Let's test it 701 | example : ∀ n m : Nat, m + n + 1 - 1 = n + m := by 702 | my_simp_rw' [Nat.add_one_sub_one, Nat.add_comm, implies_true] 703 | 704 | /- 705 | As you can see, the syntax matching can get quite complicated. Unfortunately there is 706 | no universal guide on these intricacies 707 | 708 | Here are some more advanced things you can do: 709 | -/ 710 | 711 | -- ### Defining syntax 712 | -- we could have defined the `my_simp_rw` syntax like this instead: 713 | syntax rwRule := ("← " <|> "<- ")? term 714 | syntax rwRuleSeq := "[" rwRule,* "]" 715 | syntax "my_simp_rw " rwRuleSeq (location)? : tactic 716 | 717 | -- ### Defining a syntax category 718 | -- As a toy example, if you want to be able to write terms in natural language 719 | 720 | declare_syntax_cat my_syntax_cat 721 | 722 | syntax my_syntax_cat " plus " my_syntax_cat : my_syntax_cat 723 | syntax my_syntax_cat " times " my_syntax_cat : my_syntax_cat 724 | syntax "(" my_syntax_cat ")" : my_syntax_cat 725 | syntax num : my_syntax_cat -- the `num` syntax category is used for number literals like `42` 726 | syntax "language[" my_syntax_cat "]" : term 727 | 728 | macro_rules 729 | | `(language[$a plus $b]) => `(language[$a] + language[$b]) 730 | | `(language[$a times $b]) => `(language[$a] * language[$b]) 731 | | `(language[($a)]) => `((language[$a])) 732 | | `(language[$n:num]) => `($n:num) 733 | 734 | /- 735 | If we now write down the term `language[1 plus (2 times 4)]`, 736 | then the `macro_rules` will turn this into `1 + (2 * 4)`. 737 | -/ 738 | #check (language[1 plus (2 times 4)] : Int) 739 | 740 | /- 741 | ## Finishing notes 742 | 743 | There is much more to say, 744 | You can check out a more advanced Lean Metaprogramming book 745 | https://leanprover-community.github.io/lean4-metaprogramming-book/ 746 | Another nice resource of what could be a problem when you get stuck 747 | on a mysterious metaprogramming bug: 748 | https://github.com/leanprover-community/mathlib4/wiki/Metaprogramming-gotchas 749 | You can also learn more about Qq on its own github 750 | https://github.com/leanprover-community/quote4 751 | 752 | But also, just be curious - ctrl-click on the functions we are using 753 | to see what they are doing. 754 | 755 | You can also ctrl-click on a monad, such as `TacticM` or `MetaM` 756 | (and others you may run into such as `TermElabM`, `CoreM`, `IO`, `MacroM`, `DelabM`), 757 | and you will see the extra states it has (as `Context` & `State`), as well as 758 | what other monad it extends, if any. 759 | These states can be a bit scary but all the information Lean 760 | has to its disposal must be somewhere in them... 761 | -/ 762 | end MetaProgrammingTutorial 763 | --------------------------------------------------------------------------------