├── .github └── workflows │ └── check_proofs.yml ├── .gitignore ├── .vscode └── settings.json ├── AUTHORS ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject └── src ├── Brzozowski ├── Alphabet.v ├── CompareRegex.v ├── ConcatLang.v ├── Decidable.v ├── Derivatives of Regular Expressions - Janusz A Brzozowski.md ├── Derivatives of Regular Expressions - Janusz A Brzozowski.pdf ├── Derive.v ├── DeriveCommutes.v ├── ExampleR.v ├── FiniteDerive.v ├── Language.v ├── LogicOp.v ├── Makefile ├── Null.v ├── NullCommutes.v ├── Readme.md ├── Regex.v ├── Ring.v ├── Setoid.v ├── Simplify.v ├── SplitEmptyStr.v └── StarLang.v ├── Coinduction ├── Bisimilar.v ├── DeriveTree.v ├── Readme.md ├── Setoid.v ├── Simplify.v └── Trace.v ├── CoqStock ├── DubStep.v ├── Invs.v ├── Lem.v ├── List.v ├── Listerine.v ├── Readme.md ├── TacticState.v ├── Truthy.v ├── Untie.v ├── WreckIt.v ├── comparable.v ├── compare_nat.v ├── dup.v ├── list_set.v ├── reduce_orb.v ├── reorder.v └── sort.v └── Reexamined ├── Readme.md ├── SimplificationRules.v ├── compare_regex.v ├── derive.v ├── derive_def.v ├── main.v ├── matches_pred.v ├── matches_pred_proofs.v ├── nullable.v ├── regex.v ├── set_of_sequences.v ├── setoid.v ├── simple.v ├── simplified.v ├── size.v ├── smart.v └── smart_or.v /.github/workflows/check_proofs.yml: -------------------------------------------------------------------------------- 1 | name: Check Proofs 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | 9 | steps: 10 | - uses: actions/checkout@v2 11 | - name: set environment variables 12 | run: | 13 | echo "CACHE_BIN=$GITHUB_WORKSPACE/.cache/bin" >> $GITHUB_ENV 14 | echo "OPAMROOT=$GITHUB_WORKSPACE/.cache/.opam" >> $GITHUB_ENV 15 | echo "$GITHUB_WORKSPACE/.cache/bin" >> $GITHUB_PATH 16 | - name: Cache Opam 17 | id: cache-opam-pin 18 | uses: actions/cache@v1 19 | with: 20 | path: .cache 21 | key: opam-coq-8-13-0 22 | - name: install opam 23 | if: steps.cache-opam-pin.outputs.cache-hit != 'true' 24 | run: | 25 | mkdir -p $CACHE_BIN 26 | cd $CACHE_BIN 27 | wget https://github.com/ocaml/opam/releases/download/2.0.6/opam-2.0.6-x86_64-linux 28 | mv opam-2.0.6-x86_64-linux opam 29 | chmod +x opam 30 | - name: Install coq 31 | if: steps.cache-opam-pin.outputs.cache-hit != 'true' 32 | run: | 33 | sudo apt-get install bubblewrap 34 | opam init -c 4.11.1+flambda 35 | eval $(opam env) 36 | opam repo add coq-released https://coq.inria.fr/opam/released 37 | opam pin add coq 8.13.0 -y 38 | coqc --version 39 | - name: Check proofs with Coq 40 | run: | 41 | eval $(opam env) 42 | coqc --version 43 | cd $GITHUB_WORKSPACE 44 | make 45 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .idea 3 | *.glob 4 | *.aux 5 | *.vo 6 | *.vok 7 | *.vos 8 | *.lia.cache 9 | \#*.v\# 10 | /.Makefile.d 11 | /Makefile.conf 12 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "files.exclude": { 3 | "**/.*.aux": true, 4 | "**/.lia.cache": true, 5 | "**/.Makefile.d": true, 6 | "**/*.glob": true, 7 | "**/*.vo": true, 8 | "**/*.vok": true, 9 | "**/*.vos": true, 10 | "**/Makefile.conf": true 11 | } 12 | } -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Walter Schulze 2 | Paul Cadman 3 | Niels uit de Bos 4 | Ayman Osman 5 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing Guidelines 2 | 3 | ## How to start 4 | 5 | 1. Create a pull request on master 6 | 2. Make sure the github action that automatically checks your proofs passes. 7 | 3. Wait for at least one approval from a reviewer 8 | 4. Merge (or poke for a merge, depending on your permissions) 9 | 5. Add yourself to the AUTHORS file 10 | 11 | ## FAQ 12 | 13 | ### Where to jump in 14 | 15 | 1. Find a TODO or Admitted or Abort proof and try to prove it. 16 | 2. Read the paper and find something we haven't proved yet. 17 | 3. Open an github issue, if you would like to prove something different that you still feels belong here. 18 | 19 | ### I have an alternative proof 20 | 21 | The more the merrier. 22 | 23 | We welcome alternative proofs. Please submit your proof with a new name, by adding a tick `'` at the end of the function name. 24 | 25 | Reason: This is a learning repo and seeing alternatives to the same proof is helpful. This is not just helpful in pull requests, but also to new comers to the repo and that is why it is still useful to merge them into master. 26 | 27 | ### Comments 28 | 29 | - Do we like comments? Yes we do. 30 | - Are they required? No. 31 | 32 | ### When to use a separate file 33 | 34 | Now. When you are starting to ask this question, it is time to start using a separate file. Please make sure to add it to the Makefile, so that the proofs are checked in the pull request. 35 | 36 | ### TODO, Admitted and Abort 37 | 38 | Yes we can merge an Admitted or Abort proof with a TODO comment. This is where reviewing the code is important. We need to believe that the Admitted proof is provable by us in future and we prefer an Abort proof as a way of documenting an interesting theorem to prove, but we understand that sometimes an Admitted proof is needed. 39 | 40 | A proof may be left out if: 41 | 42 | - you are lazy, for example maybe you see the proof will be similar to other proofs (this gives beginners an opportunity to also contribute). In this case please add `(* TODO: Good First Issue *)` 43 | - you need help (this gives beginners who are up for a challenge, a chance to contribute). In this case please add `(* TODO: Help Wanted *)` 44 | 45 | ### Tactics 46 | 47 | Tactics unlike proofs, definitions, etc. don't have any types. 48 | This means they lack some documentation and type checking. 49 | For this reason, we prefer that new tactics come with: 50 | - some comments above that describe the tactic. 51 | - some examples below that use the tactic. 52 | 53 | If you see a tactic that doesn't meet these requirements at the moment, consider it a Good First Issue. 54 | 55 | ### Examples 56 | 57 | Examples are especially useful for checking that our tactics are working as predicted. 58 | 59 | Examples should use the `Example` keyword and the name should be prefixed with `example_`. 60 | 61 | ``` 62 | Example example_: 63 | ``` 64 | -------------------------------------------------------------------------------- /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 2020 regex-reexamined-coq/AUTHORS 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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![Check Proofs](https://github.com/awalterschulze/regex-reexamined-coq/workflows/Check%20Proofs/badge.svg) 2 | 3 | **This learning exercise has come to an end. We are continuing work in this area [here](https://github.com/katydid/proofs)** 4 | 5 | # Derivatives for Regular Expressions with Coq 6 | 7 | This repo reexamines a few papers on regular expressions using Coq as a learning exercise. 8 | We try to prove some things that are mentioned in the papers as a way to teach ourselves some Coq. 9 | 10 | - [Brzozowski](./src/Brzozowski) 11 | In this folder we explore proving theorems from the original paper [Derivatives of Regular Expressions - Janusz A Brzozowski](./src/Brzozowski/Derivatives%20of%20Regular%20Expressions%20-%20Janusz%20A%20Brzozowski.md) 12 | We have retyped and modified it a bit to aid readability. 13 | - [Coinduction](./src/Coinduction) 14 | In this folder we explore using coinduction to prove regular expressions are equivalent. 15 | - [Reexamined](./src/Reexamined) 16 | In this folder we explore a modern version of derivatives defined in the paper [Regular-expression derivatives reexamined](https://www.ccs.neu.edu/home/turon/re-deriv.pdf) 17 | This paper is a great introduction to using derivatives for regular expressions, 18 | since it has been not only been updated, but is also one of the easier papers to read. 19 | - [CoqStock](./src/CoqStock) standard library. 20 | 21 | ## Background 22 | 23 | ### Brzozowski's Derivatives of Regular Expressions 24 | 25 | If you are unfamiliar with Brzozowski's Derivatives you can watch this video. 26 | 27 | 28 | Watch the video 29 | 30 | 31 | ## Setup 32 | 33 | 1. Install Coq 8.13.0 34 | 2. Remember to set coq in your PATH. For example, in your `~/.bash_profile` add `PATH="/Applications/CoqIDE_8.13.0.app/Contents/Resources/bin/:${PATH}"` and run `$ source ~/.bash_profile`. 35 | 3. Run make in this folder. 36 | 37 | Note: 38 | 39 | - `make cleanall` cleans all files even `.aux` files. 40 | 41 | ## Contributing 42 | 43 | Please read the [contributing guidelines](https://github.com/awalterschulze/regex-reexamined-coq/blob/master/CONTRIBUTING.md). They are short and shouldn't be surprising. 44 | 45 | ## Regenerate Makefile 46 | 47 | Coq version upgrade requires regenerating the Makefile with the following command: 48 | 49 | ``` 50 | $ coq_makefile -f _CoqProject -o Makefile 51 | ``` 52 | 53 | ## Pair Programming 54 | 55 | We used to pair program. The schedule was posted as meetups events on [meetup.com](https://www.meetup.com/London-TyDD/) 56 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -R src "" 2 | 3 | 4 | src/CoqStock/comparable.v 5 | src/CoqStock/compare_nat.v 6 | src/CoqStock/dup.v 7 | src/CoqStock/DubStep.v 8 | src/CoqStock/reorder.v 9 | src/CoqStock/reduce_orb.v 10 | src/CoqStock/sort.v 11 | src/CoqStock/Invs.v 12 | src/CoqStock/Lem.v 13 | src/CoqStock/List.v 14 | src/CoqStock/Listerine.v 15 | src/CoqStock/list_set.v 16 | src/CoqStock/TacticState.v 17 | src/CoqStock/Truthy.v 18 | src/CoqStock/Untie.v 19 | src/CoqStock/WreckIt.v 20 | 21 | src/Brzozowski/Alphabet.v 22 | src/Brzozowski/Decidable.v 23 | src/Brzozowski/CompareRegex.v 24 | src/Brzozowski/ConcatLang.v 25 | src/Brzozowski/Derive.v 26 | src/Brzozowski/DeriveCommutes.v 27 | src/Brzozowski/ExampleR.v 28 | src/Brzozowski/FiniteDerive.v 29 | src/Brzozowski/Language.v 30 | src/Brzozowski/LogicOp.v 31 | src/Brzozowski/Null.v 32 | src/Brzozowski/NullCommutes.v 33 | src/Brzozowski/Regex.v 34 | src/Brzozowski/Ring.v 35 | src/Brzozowski/Setoid.v 36 | src/Brzozowski/Simplify.v 37 | src/Brzozowski/SplitEmptyStr.v 38 | src/Brzozowski/StarLang.v 39 | 40 | src/Coinduction/Bisimilar.v 41 | src/Coinduction/DeriveTree.v 42 | src/Coinduction/Setoid.v 43 | src/Coinduction/Simplify.v 44 | src/Coinduction/Trace.v 45 | 46 | src/Reexamined/compare_regex.v 47 | src/Reexamined/derive.v 48 | src/Reexamined/derive_def.v 49 | src/Reexamined/nullable.v 50 | src/Reexamined/main.v 51 | src/Reexamined/matches_pred.v 52 | src/Reexamined/matches_pred_proofs.v 53 | src/Reexamined/regex.v 54 | src/Reexamined/setoid.v 55 | src/Reexamined/set_of_sequences.v 56 | src/Reexamined/simple.v 57 | src/Reexamined/simplified.v 58 | src/Reexamined/size.v 59 | src/Reexamined/smart.v 60 | src/Reexamined/smart_or.v 61 | src/Reexamined/SimplificationRules.v -------------------------------------------------------------------------------- /src/Brzozowski/Alphabet.v: -------------------------------------------------------------------------------- 1 | (* Alphabet is Sigma_k *) 2 | (* We are defining it here as A1 and A0, but we could do any disjoint set *) 3 | Inductive alphabet := A0 | A1. 4 | 5 | Lemma alphabet_disjoint: forall (x y: alphabet), 6 | x = y \/ x <> y. 7 | Proof. 8 | (* This is the exact usecase for the decide equality tactic. 9 | It only works when the type of x and y is a simple inductive type. 10 | *) 11 | decide equality. 12 | Qed. 13 | 14 | Lemma alphabet_disjoint': forall (x y: alphabet), 15 | x = y \/ x <> y. 16 | Proof. 17 | destruct x, y. 18 | - left. reflexivity. 19 | - right. discriminate. 20 | - right. discriminate. 21 | - left. reflexivity. 22 | Qed. 23 | 24 | Definition eqa (x y: alphabet): bool := 25 | match (x, y) with 26 | | (A0, A0) => true 27 | | (A1, A1) => true 28 | | _ => false 29 | end. 30 | 31 | Definition compare_alphabet (x y: alphabet): comparison := 32 | match (x, y) with 33 | | (A0, A0) => Eq 34 | | (A1, A1) => Eq 35 | | (A0, A1) => Lt 36 | | (A1, A0) => Gt 37 | end. -------------------------------------------------------------------------------- /src/Brzozowski/CompareRegex.v: -------------------------------------------------------------------------------- 1 | Require Import Brzozowski.Alphabet. 2 | Require Import Brzozowski.Regex. 3 | 4 | Fixpoint compare_regex (p q: regex) : comparison := 5 | match p with 6 | | emptyset => match q with 7 | | emptyset => Eq 8 | | _ => Lt 9 | end 10 | | emptystr => match q with 11 | | emptyset => Gt 12 | | emptystr => Eq 13 | | _ => Lt 14 | end 15 | | symbol x => match q with 16 | | emptyset => Gt 17 | | emptystr => Gt 18 | | symbol y => compare_alphabet x y 19 | | _ => Lt 20 | end 21 | | or p1 p2 => match q with 22 | | emptyset => Gt 23 | | emptystr => Gt 24 | | symbol _ => Gt 25 | | or q1 q2 => 26 | match compare_regex p1 q1 with 27 | | Lt => Lt 28 | | Eq => compare_regex p2 q2 29 | | Gt => Gt 30 | end 31 | | _ => Lt 32 | end 33 | | neg p1 => match q with 34 | | emptyset => Gt 35 | | emptystr => Gt 36 | | symbol _ => Gt 37 | | or _ _ => Gt 38 | | neg q1 => compare_regex p1 q1 39 | | _ => Lt 40 | end 41 | | concat p1 p2 => match q with 42 | | emptyset => Gt 43 | | emptystr => Gt 44 | | symbol _ => Gt 45 | | or _ _ => Gt 46 | | neg _ => Gt 47 | | concat q1 q2 => 48 | match compare_regex p1 q1 with 49 | | Lt => Lt 50 | | Eq => compare_regex p2 q2 51 | | Gt => Gt 52 | end 53 | | _ => Lt 54 | end 55 | | star p1 => match q with 56 | | star q1 => compare_regex p1 q1 57 | | _ => Gt 58 | end 59 | end. -------------------------------------------------------------------------------- /src/Brzozowski/ConcatLang.v: -------------------------------------------------------------------------------- 1 | (* 2 | This module shows off different possible definitions of concat_lang and how they are all equivalent 3 | to the defintion we use in Language.v, namely `concat_lang`. 4 | This also includes the tactic `destruct_concat_lang`, which is a useful replacement for the constructor tactic when concat_lang is in the goal. 5 | *) 6 | 7 | Require Import CoqStock.DubStep. 8 | Require Import CoqStock.Invs. 9 | Require Import CoqStock.List. 10 | Require Import CoqStock.Listerine. 11 | Require Import CoqStock.Untie. 12 | Require Import CoqStock.WreckIt. 13 | 14 | Require Import Brzozowski.Alphabet. 15 | Require Import Brzozowski.Language. 16 | Require Import Brzozowski.Regex. 17 | 18 | (* 19 | concat_lang_ex uses exists to define concat, 20 | instead of forall as is done by `concat_lang`. 21 | This is arguably closer to the mathematical definition of concat. 22 | 23 | $(P.Q) = \{ s | s = p.q; p \in P, q \in Q \}$. 24 | 25 | *) 26 | Inductive concat_lang_ex (P Q: lang): lang := 27 | | mk_concat_ex: forall (s: str), 28 | (exists 29 | (p: str) 30 | (q: str) 31 | (pqs: p ++ q = s), 32 | p \in P /\ 33 | q \in Q 34 | ) -> 35 | concat_lang_ex P Q s 36 | . 37 | 38 | (* 39 | concat_ex_equivalent shows how `concat_lang_ex` is equivalent to 40 | the main definition of `concat_lang`. 41 | *) 42 | Theorem concat_ex_equivalent (P Q: lang): 43 | concat_lang_ex P Q {<->} concat_lang P Q. 44 | Proof. 45 | split. 46 | - intros. 47 | destruct H. 48 | destruct H as [p [q [H [Hp Hq]]]]. 49 | apply (mk_concat P Q p q s); assumption. 50 | - intros. 51 | destruct H. 52 | constructor. 53 | exists p. 54 | exists q. 55 | exists H. 56 | split; assumption. 57 | Qed. 58 | 59 | (* 60 | When concat is in the goal, it can be harder to apply the tactic, 61 | since now some variables need to be provided to mk_concat. 62 | The destruct_concat_lang tactic solves this by replacing the 63 | concat_lang definition with the concat_lang_ex definition, 64 | which can be easily deconstructed. 65 | *) 66 | Ltac destruct_concat_lang := 67 | apply concat_ex_equivalent; 68 | fold denote_regex; 69 | apply mk_concat_ex. 70 | 71 | (* example_destruct_concat_lang shows how the destruct_concat_lang can be used. *) 72 | Example example_destruct_concat_lang: 73 | forall (p q: regex), 74 | [] \in {{p}} /\ [] \in {{q}} -> 75 | [] \in {{concat p q}}. 76 | Proof. 77 | intros. 78 | destruct_concat_lang. 79 | exists []. 80 | exists []. 81 | listerine. 82 | exists eq_refl. 83 | assumption. 84 | Qed. -------------------------------------------------------------------------------- /src/Brzozowski/Derivatives of Regular Expressions - Janusz A Brzozowski.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/katydid/regex-deriv-coq/305b6d084db977e080c65cc25d6541298de55761/src/Brzozowski/Derivatives of Regular Expressions - Janusz A Brzozowski.pdf -------------------------------------------------------------------------------- /src/Brzozowski/Derive.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.List. 2 | 3 | Require Import Brzozowski.Alphabet. 4 | Require Import Brzozowski.Null. 5 | Require Import Brzozowski.Regex. 6 | Require Import Brzozowski.Language. 7 | 8 | (* 9 | **Definition 3.1.** 10 | Given a language $R$ of and a finite sequence $s$, 11 | the derivative of $R$ with respect to $s$ is denoted by $D_s R$ and is 12 | $D_s R = \{t | s.t \in R \}$. 13 | *) 14 | Definition derive_langs (s: str) (R: lang) (t: str): Prop := 15 | (s ++ t) \in R. 16 | 17 | (* 18 | D_a R = { t | a.t \in R} 19 | *) 20 | Definition derive_lang (a: alphabet) (R: lang) (t: str): Prop := 21 | (a :: t) \in R. 22 | 23 | (* Alternative inductive predicate for derive_lang *) 24 | Inductive derive_lang' (a: alphabet) (R: lang) (t: str): Prop := 25 | | mk_derive_lang: 26 | (a :: t) \in R -> 27 | t \in (derive_lang' a R) 28 | . 29 | 30 | (* 31 | **THEOREM 3.1.** If $R$ is a regular expression, 32 | the derivative of $R$ with respect to a character $a \in \Sigma_k$ is found 33 | recursively as follows: 34 | 35 | $$ 36 | \begin{aligned} 37 | \text{(3.4)}&\ D_a a &=&\ \epsilon, \\ 38 | \text{(3.5)}&\ D_a b &=&\ \emptyset,\ \text{for}\ b = \epsilon\ \text{or}\ b = \emptyset\ \text{or}\ b \in A_k\ \text{and}\ b \neq a, \\ 39 | \text{(3.6)}&\ D_a (P^* ) &=&\ (D_a P)P^*, \\ 40 | \text{(3.7)}&\ D_a (PQ) &=&\ (D_a P)Q + \nu(P)(D_a Q). \\ 41 | \text{(3.8)}&\ D_a (f(P, Q)) &=&\ f(D_a P, D_a Q). \\ 42 | \end{aligned} 43 | $$ 44 | *) 45 | Fixpoint derive_def (r: regex) (a: alphabet) : regex := 46 | match r with 47 | | emptyset => emptyset 48 | | emptystr => emptyset 49 | | symbol b => 50 | if (eqa b a) 51 | then emptystr 52 | else emptyset 53 | | or s t => or (derive_def s a) (derive_def t a) 54 | | neg s => neg (derive_def s a) 55 | | concat s t => 56 | or (concat (derive_def s a) t) 57 | (concat (null_def s) (derive_def t a)) 58 | | star s => concat (derive_def s a) (star s) 59 | end. 60 | 61 | Definition derive_defs (r: regex) (s: str) : regex := 62 | fold_left derive_def s r. 63 | -------------------------------------------------------------------------------- /src/Brzozowski/ExampleR.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.Invs. 2 | Require Import CoqStock.List. 3 | Require Import CoqStock.Listerine. 4 | Require Import CoqStock.Untie. 5 | Require Import CoqStock.WreckIt. 6 | 7 | Require Import Brzozowski.Alphabet. 8 | Require Import Brzozowski.ConcatLang. 9 | Require Import Brzozowski.Language. 10 | Require Import Brzozowski.LogicOp. 11 | Require Import Brzozowski.Regex. 12 | 13 | (* 14 | The introduction of arbitrary Boolean functions enriches the language of regular expressions. 15 | For example, suppose we desire to represent the set of all sequences having three consecutive 1's 16 | but not those ending in 01 or consisting of 1's only. 17 | The desired expression is easily seen to be: 18 | 19 | R = (I.1.1.1.I)\&(I.0.1+1.1^{*})'. 20 | *) 21 | Definition x1 := symbol A1. 22 | Definition x0 := symbol A0. 23 | Definition xI111I := concat I (concat x1 (concat x1 (concat x1 I))). 24 | Definition xI01 := concat I (concat x0 x1). 25 | Definition x11star := concat x1 (star x1). 26 | Definition exampleR := and xI111I (neg (or xI01 x11star)). 27 | 28 | Theorem notelem_emptyset: forall (s: str), 29 | s \notin emptyset_lang. 30 | Proof. 31 | intros. 32 | untie. 33 | Qed. 34 | 35 | Lemma test_elem_xI01_101: 36 | ([A1] ++ [A0] ++ [A1]) \in {{xI01}}. 37 | Proof. 38 | unfold xI01. 39 | destruct_concat_lang. 40 | exists [A1]. 41 | exists ([A0] ++ [A1]). 42 | assert ([A1] ++ [A0] ++ [A1] = [A1; A0; A1]). reflexivity. 43 | exists H. 44 | constructor. 45 | - constructor. 46 | apply notelem_emptyset. 47 | - destruct_concat_lang. 48 | exists [A0]. 49 | exists [A1]. 50 | exists eq_refl. 51 | wreckit. 52 | Qed. 53 | 54 | Lemma test_notelem_xI01_101_false: 55 | ([A1] ++ [A0] ++ [A1]) \notin {{xI01}} -> False. 56 | Proof. 57 | unfold not. 58 | intros. 59 | apply H. 60 | apply test_elem_xI01_101. 61 | Qed. 62 | 63 | Lemma test_notleme_xI01_empty: 64 | [] \notin {{xI01}}. 65 | Proof. 66 | unfold not. 67 | intros. 68 | wreckit. 69 | listerine. 70 | Qed. 71 | 72 | Lemma test_notelem_xI01_10: 73 | ([A1] ++ [A0]) \notin {{xI01}}. 74 | Proof. 75 | unfold not. 76 | intros. 77 | wreckit. 78 | listerine. 79 | Qed. 80 | 81 | Lemma test_notelem_xI01_1110: 82 | ([A1] ++ [A1] ++ [A1] ++ [A0]) \notin {{xI01}}. 83 | Proof. 84 | unfold not. 85 | intros. 86 | wreckit. 87 | listerine. 88 | Qed. 89 | 90 | Lemma test_notelem_x11star_0: 91 | [A0] \notin {{ x11star }}. 92 | Proof. 93 | unfold not. 94 | intros. 95 | wreckit. 96 | listerine. 97 | Qed. 98 | 99 | Lemma test_notelem_starx1_0: 100 | [A0] \notin {{star x1}}. 101 | Proof. 102 | untie. 103 | invs H. 104 | - listerine. 105 | + apply H1. 106 | reflexivity. 107 | + inversion H2. 108 | Qed. 109 | 110 | Lemma test_notelem_starx1_10: 111 | [A1; A0] \notin {{star x1}}. 112 | Proof. 113 | untie. 114 | invs H. 115 | - listerine. 116 | + contradiction. 117 | + invs H3. 118 | wreckit. 119 | listerine. 120 | + wreckit. 121 | Qed. 122 | 123 | Lemma test_notelem_starx1_110: 124 | [A1; A1; A0] \notin {{star x1}}. 125 | Proof. 126 | untie. 127 | invs H. 128 | wreckit. 129 | listerine. 130 | apply test_notelem_starx1_10. 131 | assumption. 132 | Qed. 133 | 134 | Lemma test_notelem_x11star_1110: 135 | ([A1] ++ [A1] ++ [A1] ++ [A0]) \notin {{x11star}}. 136 | Proof. 137 | untie. 138 | invs H. 139 | wreckit. 140 | listerine; wreckit. 141 | - apply test_notelem_starx1_110. 142 | assumption. 143 | Qed. 144 | 145 | Lemma test_elem_xI111I_1110: 146 | ([A1] ++ [A1] ++ [A1] ++ [A0]) \in {{xI111I}}. 147 | Proof. 148 | destruct_concat_lang. 149 | exists []. 150 | exists ([A1] ++ [A1] ++ [A1] ++ [A0]). 151 | exists eq_refl. 152 | wreckit. 153 | - constructor. 154 | untie. 155 | - destruct_concat_lang. 156 | exists [A1]. 157 | exists ([A1] ++ [A1] ++ [A0]). 158 | exists eq_refl. 159 | wreckit. 160 | destruct_concat_lang. 161 | exists [A1]. 162 | exists ([A1] ++ [A0]). 163 | exists eq_refl. 164 | wreckit. 165 | destruct_concat_lang. 166 | exists [A1]. 167 | exists [A0]. 168 | exists eq_refl. 169 | wreckit. 170 | constructor. 171 | untie. 172 | Qed. 173 | 174 | Theorem test_exampleR_1110_elem: 175 | ([A1] ++ [A1] ++ [A1] ++ [A0]) \in {{exampleR}}. 176 | Proof. 177 | constructor. 178 | untie. 179 | wreckit. 180 | - invs H. 181 | apply H5. 182 | apply test_elem_xI111I_1110. 183 | - invs H. 184 | apply H5. 185 | constructor. 186 | untie. 187 | invs H. 188 | destruct H0. 189 | + apply test_notelem_xI01_1110. 190 | assumption. 191 | + apply test_notelem_x11star_1110. 192 | assumption. 193 | Qed. 194 | 195 | Theorem test_exampleR_111_notelem: 196 | [A1; A1; A1] \notin {{exampleR}}. 197 | Proof. 198 | untie. 199 | invs H. 200 | apply H0. 201 | constructor. 202 | right. 203 | constructor. 204 | untie. 205 | invs H. 206 | apply H1. 207 | constructor. 208 | right. 209 | unfold x11star. 210 | destruct_concat_lang. 211 | exists [A1]. 212 | exists [A1; A1]. 213 | assert ([A1] ++ [A1; A1] = [A1; A1; A1]). listerine; reflexivity. 214 | exists H. 215 | split. 216 | - constructor. 217 | - apply mk_star_more with (p := [A1]) (q := [A1]). 218 | + listerine. reflexivity. 219 | + listerine. 220 | + constructor. 221 | + apply mk_star_more with (p := [A1]) (q := []). 222 | * listerine. reflexivity. 223 | * listerine. 224 | * constructor. 225 | * constructor. 226 | Qed. 227 | -------------------------------------------------------------------------------- /src/Brzozowski/FiniteDerive.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.List. 2 | 3 | Require Import Brzozowski.Alphabet. 4 | Require Import Brzozowski.CompareRegex. 5 | Require Import Brzozowski.Language. 6 | Require Import Brzozowski.Null. 7 | Require Import Brzozowski.Regex. 8 | 9 | (* finite_or merges two regexes. 10 | It applies a merge sort on the root ors, while removing duplicates. 11 | It can do this because of the following properties: 12 | idempotency: r + r = r 13 | commutativity: r + s = s + r 14 | associativity: (r + s) + t = r + (s + t) 15 | It does this to normalize the regular expression. 16 | It assumes the two regexes that is provided as input is already sorted with duplicates removed. 17 | 18 | For a Fixpoint function Coq always needs to know which argument is decreasing. 19 | For finite_or either `r` or `s` is decreasing, which is confusing to the termination checker, we need to be consistent. 20 | We introduce a closure fixpoint `finite_or_r` inside of our fixpoint `finite_or`. 21 | finite_or's descreasing argument is always `r` and 22 | finite_or_r's decreasing argument is always `s`, while `r` is not decreasing and is the original `r`, hence `_or_r`. 23 | 24 | For another example for a closure fixpoint inside a fixpoint, see the merge function in: 25 | https://coq.inria.fr/library/Coq.Sorting.Mergesort.html 26 | *) 27 | Fixpoint finite_or (r s: regex) : regex := 28 | let fix finite_or_r s := 29 | match r with 30 | | or r_1 r_next => 31 | match s with 32 | | or s_1 s_next => 33 | match compare_regex r_1 s_1 with 34 | | Lt => or r_1 (finite_or r_next s) 35 | | Eq => or r_1 (finite_or r_next s_next) 36 | | Gt => or s_1 (finite_or_r s_next) 37 | end 38 | | _ => 39 | match compare_regex r_1 s with 40 | | Lt => or r_1 (finite_or r_next s) 41 | | Eq => r 42 | | Gt => or s r 43 | end 44 | end 45 | | _ => 46 | match s with 47 | | or s_1 s_next => 48 | match compare_regex r s_1 with 49 | | Lt => or r s 50 | | Eq => s 51 | | Gt => or s_1 (finite_or_r s_next) 52 | end 53 | | _ => 54 | match compare_regex r s with 55 | | Lt => or r s 56 | | Eq => s 57 | | Gt => or s r 58 | end 59 | end 60 | end 61 | in finite_or_r s. 62 | 63 | Fixpoint finite_derive_def (r: regex) (a: alphabet) : regex := 64 | match r with 65 | | emptyset => emptyset 66 | | emptystr => emptyset 67 | | symbol b => 68 | if (eqa b a) 69 | then emptystr 70 | else emptyset 71 | | or s t => finite_or (finite_derive_def s a) (finite_derive_def t a) 72 | | neg s => neg (finite_derive_def s a) 73 | | concat s t => 74 | or (concat (finite_derive_def s a) t) 75 | (concat (null_def s) (finite_derive_def t a)) 76 | | star s => concat (finite_derive_def s a) (star s) 77 | end. 78 | 79 | Definition finite_derive_defs (r: regex) (s: str) : regex := 80 | fold_left finite_derive_def s r. 81 | 82 | (* finite_or_step rewrite finite_or without an fix closure, 83 | which was just there so Coq can see that the function is terminating. 84 | This way the function is easier to read and smaller steps can be taken inside proofs. 85 | *) 86 | Theorem finite_or_step: forall (r s: regex), 87 | finite_or r s = match r with 88 | | or r_1 r_next => 89 | match s with 90 | | or s_1 s_next => 91 | match compare_regex r_1 s_1 with 92 | | Lt => or r_1 (finite_or r_next s) 93 | | Eq => or r_1 (finite_or r_next s_next) 94 | | Gt => or s_1 (finite_or r s_next) 95 | end 96 | | _ => 97 | match compare_regex r_1 s with 98 | | Lt => or r_1 (finite_or r_next s) 99 | | Eq => r 100 | | Gt => or s r 101 | end 102 | end 103 | | _ => 104 | match s with 105 | | or s_1 s_next => 106 | match compare_regex r s_1 with 107 | | Lt => or r s 108 | | Eq => s 109 | | Gt => or s_1 (finite_or r s_next) 110 | end 111 | | _ => 112 | match compare_regex r s with 113 | | Lt => or r s 114 | | Eq => s 115 | | Gt => or s r 116 | end 117 | end 118 | end. 119 | Proof. 120 | induction r, s; simpl; trivial. 121 | Qed. 122 | -------------------------------------------------------------------------------- /src/Brzozowski/Language.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.DubStep. 2 | Require Import CoqStock.Invs. 3 | Require Import CoqStock.List. 4 | Require Import CoqStock.Listerine. 5 | Require Import CoqStock.Untie. 6 | Require Import CoqStock.WreckIt. 7 | 8 | Require Import Brzozowski.Alphabet. 9 | Require Import Brzozowski.Regex. 10 | 11 | Create HintDb lang. 12 | 13 | (* A string is a list of characters. *) 14 | Definition str := list alphabet. 15 | (* A regular expression denotes a set of strings called a _language_. *) 16 | Definition lang := str -> Prop. 17 | 18 | Definition elem (s: str) (l: lang): Prop := l s. 19 | 20 | Notation " p \in P " := (elem p P) (at level 20). 21 | Notation " p \notin P " := (not (elem p P)) (at level 20). 22 | 23 | #[export] 24 | Hint Unfold elem: lang. 25 | 26 | Definition lang_if (s1 s2: lang): Prop := 27 | forall (s: str), 28 | s \in s1 -> s \in s2. 29 | 30 | Notation "s1 {->} s2" := (lang_if s1 s2) (at level 80). 31 | 32 | #[export] 33 | Hint Unfold lang_if: lang. 34 | 35 | Definition lang_iff (s1 s2: lang): Prop := 36 | forall (s: str), 37 | s \in s1 <-> s \in s2. 38 | 39 | Notation "s1 {<->} s2" := (lang_iff s1 s2) (at level 80). 40 | 41 | #[export] 42 | Hint Unfold lang_iff: lang. 43 | 44 | Inductive emptyset_lang: lang := 45 | . 46 | (* 47 | This is equivalent to: 48 | ``` 49 | | mk_emptyset: forall (s: str), 50 | False -> 51 | emptyset_lang s 52 | ``` 53 | *) 54 | 55 | #[export] 56 | Hint Constructors emptyset_lang: lang. 57 | 58 | Inductive emptystr_lang: lang := 59 | | mk_emptystr: emptystr_lang [] 60 | . 61 | (* 62 | This is equivalent to: 63 | ``` 64 | | mk_emptystr: 65 | forall (s: str), 66 | s = [] -> 67 | emptystr_lang s 68 | ``` 69 | *) 70 | 71 | #[export] 72 | Hint Constructors emptystr_lang: lang. 73 | 74 | Inductive symbol_lang (a: alphabet): lang := 75 | | mk_symbol: symbol_lang a [a]. 76 | (* 77 | This is equivalent to: 78 | ``` 79 | | mk_symbol: 80 | forall (s: str), 81 | s = [a] -> 82 | symbol_lang a s 83 | ``` 84 | *) 85 | 86 | #[export] 87 | Hint Constructors symbol_lang: lang. 88 | 89 | (* 90 | *Boolean function*. We shall denote any Boolean function of $P$ and $Q$ by $f(P, Q)$. 91 | Of course, all the laws of Boolean algebra apply. 92 | `neg` and `or` are used to emulate `f`, since they can be used to emulate all boolean functions. 93 | *) 94 | Inductive or_lang (P Q: lang): lang := 95 | | mk_or : forall s, 96 | s \in P \/ s \in Q -> 97 | or_lang P Q s 98 | . 99 | 100 | #[export] 101 | Hint Constructors or_lang: lang. 102 | 103 | Inductive neg_lang (P: lang): lang := 104 | | mk_neg : forall s, 105 | s \notin P -> 106 | neg_lang P s 107 | . 108 | 109 | #[export] 110 | Hint Constructors neg_lang: lang. 111 | 112 | (* Concatenation*. $(P.Q) = \{ s | s = p.q; p \in P, q \in Q \}$. *) 113 | Inductive concat_lang (P Q: lang): lang := 114 | | mk_concat: forall (p q s: str), 115 | p ++ q = s -> 116 | p \in P -> 117 | q \in Q -> 118 | concat_lang P Q s 119 | . 120 | 121 | #[export] 122 | Hint Constructors concat_lang: lang. 123 | 124 | Inductive star_lang (R: lang): lang := 125 | | mk_star_zero : star_lang R [] 126 | | mk_star_more : forall (s p q: str), 127 | p ++ q = s -> 128 | p <> [] -> 129 | p \in R -> 130 | q \in (star_lang R) -> 131 | s \in star_lang R. 132 | 133 | #[export] 134 | Hint Constructors star_lang: lang. 135 | 136 | (* 137 | Here we use a mix of Fixpoint and Inductive predicates to define the denotation of regular expressions. 138 | *) 139 | Reserved Notation "{{ r }}" (r at level 60, no associativity). 140 | Fixpoint denote_regex (r: regex): lang := 141 | match r with 142 | | emptyset => emptyset_lang 143 | | emptystr => emptystr_lang 144 | | symbol y => symbol_lang y 145 | | or r1 r2 => or_lang {{r1}} {{r2}} 146 | | neg r1 => neg_lang {{r1}} 147 | | concat r1 r2 => concat_lang {{r1}} {{r2}} 148 | | star r1 => star_lang {{r1}} 149 | end 150 | where "{{ r }}" := (denote_regex r). 151 | 152 | #[export] 153 | Hint Unfold denote_regex: lang. -------------------------------------------------------------------------------- /src/Brzozowski/LogicOp.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Setoids.Setoid. 2 | 3 | Require Import CoqStock.Invs. 4 | Require Import CoqStock.Untie. 5 | Require Import CoqStock.WreckIt. 6 | 7 | Require Import Brzozowski.Decidable. 8 | Require Import Brzozowski.Language. 9 | Require Import Brzozowski.Regex. 10 | Require Import Brzozowski.Setoid. 11 | 12 | (* We chose to include `nor`, since it can represent any possible boolean expression, 13 | which is one of the selling points of Brzozowski's derivatives for regular expressions. 14 | *) 15 | 16 | Definition nor (r s: regex) : regex := 17 | neg (or r s). 18 | 19 | Definition and (r s: regex) : regex := 20 | neg (or (neg r) (neg s)). 21 | 22 | Definition xor (r s: regex) : regex := 23 | or (and r (neg s)) (and (neg r) s). 24 | 25 | (* I matches all strings *) 26 | Definition I: regex := 27 | neg (emptyset). 28 | 29 | Inductive nor_lang (P Q: lang): lang := 30 | | mk_nor : forall s, 31 | s \notin P /\ s \notin Q -> 32 | nor_lang P Q s. 33 | 34 | Inductive and_lang (P Q: lang): lang := 35 | | mk_and : forall s, 36 | s \in P /\ s \in Q -> 37 | and_lang P Q s. 38 | 39 | Lemma nor_denotes_nor_lang: 40 | forall (p q: regex), 41 | {{nor p q}} {<->} nor_lang {{p}} {{q}}. 42 | Proof. 43 | intros. 44 | cbn. 45 | split; intros. 46 | - specialize denotation_is_decidable with (s := s) (r := p) as Dp. 47 | specialize denotation_is_decidable with (s := s) (r := q) as Dq. 48 | invs H. 49 | constructor. 50 | split. 51 | + destruct Dp. 52 | * exfalso. 53 | apply H0. 54 | constructor. 55 | left. 56 | assumption. 57 | * assumption. 58 | + destruct Dq. 59 | * exfalso. 60 | apply H0. 61 | constructor. 62 | right. 63 | assumption. 64 | * assumption. 65 | - constructor. 66 | invs H. 67 | untie. 68 | invs H. 69 | invs H0. 70 | invs H1; contradiction. 71 | Qed. 72 | 73 | Lemma and_denotes_and_lang: 74 | forall (p q: regex), 75 | {{and p q}} {<->} and_lang {{p}} {{q}}. 76 | Proof. 77 | intros. 78 | cbn. 79 | split. 80 | - intros. 81 | specialize denotation_is_decidable with (r := p) (s := s) as Dp. 82 | specialize denotation_is_decidable with (r := q) (s := s) as Dq. 83 | destruct Dp, Dq. 84 | + constructor. auto. 85 | + constructor. 86 | split. 87 | * assumption. 88 | * exfalso. 89 | invs H. 90 | apply H2. 91 | constructor. 92 | right. 93 | constructor. 94 | assumption. 95 | + constructor. 96 | split. 97 | * exfalso. 98 | invs H. 99 | apply H2. 100 | constructor. 101 | left. 102 | constructor. 103 | assumption. 104 | * assumption. 105 | + exfalso. 106 | invs H. 107 | apply H2. 108 | constructor. 109 | left. 110 | constructor. 111 | assumption. 112 | - intros. 113 | invs H. 114 | destruct H0. 115 | constructor. 116 | untie. 117 | invs H1. 118 | invs H2. 119 | + invs H1. 120 | contradiction. 121 | + invs H1. 122 | contradiction. 123 | Qed. 124 | 125 | Add Parametric Morphism: nor_lang 126 | with signature lang_iff ==> lang_iff ==> lang_iff as nor_lang_morph. 127 | Proof. 128 | intros. 129 | unfold lang_iff in *. 130 | intros. 131 | specialize H with (s := s). 132 | specialize H0 with (s := s). 133 | split; intros. 134 | - constructor. 135 | invs H1. 136 | destruct H2. 137 | rewrite H in H1. 138 | rewrite H0 in H2. 139 | auto. 140 | - constructor. 141 | invs H1. 142 | destruct H2. 143 | rewrite <- H in H1. 144 | rewrite <- H0 in H2. 145 | auto. 146 | Qed. 147 | 148 | Existing Instance nor_lang_morph_Proper. 149 | 150 | Add Parametric Morphism: and_lang 151 | with signature lang_iff ==> lang_iff ==> lang_iff as and_lang_morph. 152 | Proof. 153 | intros. 154 | unfold lang_iff in *. 155 | intros. 156 | specialize H with s. 157 | specialize H0 with s. 158 | split; intros. 159 | - invs H1. 160 | constructor. 161 | rewrite <- H. 162 | rewrite <- H0. 163 | auto. 164 | - invs H1. 165 | constructor. 166 | rewrite H. 167 | rewrite H0. 168 | auto. 169 | Qed. 170 | 171 | Existing Instance and_lang_morph_Proper. 172 | 173 | Theorem or_denotes_or_lang: 174 | forall (p q: regex), 175 | {{or p q}} {<->} or_lang {{p}} {{q}}. 176 | Proof. 177 | intros. 178 | split; intros; constructor; inversion H; assumption. 179 | Qed. 180 | 181 | Theorem neg_denotes_neg_lang: 182 | forall (p : regex), 183 | {{neg p}} {<->} neg_lang {{p}}. 184 | Proof. 185 | intros. 186 | split; intros; constructor; inversion H; assumption. 187 | Qed. -------------------------------------------------------------------------------- /src/Brzozowski/Makefile: -------------------------------------------------------------------------------- 1 | generate_pdf: 2 | pandoc "Derivatives of Regular Expressions - Janusz A Brzozowski.md" --pdf-engine=xelatex -o "Derivatives of Regular Expressions - Janusz A Brzozowski.pdf" 3 | 4 | -------------------------------------------------------------------------------- /src/Brzozowski/Null.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.List. 2 | 3 | Require Import Brzozowski.Alphabet. 4 | Require Import Brzozowski.Regex. 5 | Require Import Brzozowski.Language. 6 | 7 | (* 8 | **Definition 3.2.** 9 | Given any language $R$ we define $\nu(R)$ to be 10 | 11 | $$ 12 | \begin{aligned} 13 | \nu(R) & = \epsilon\ \text{if}\ \epsilon \in R \\ 14 | & = \emptyset\ \text{if}\ \epsilon \notin R \\ 15 | \end{aligned} 16 | $$ 17 | *) 18 | 19 | Inductive null: regex -> regex -> Prop := 20 | | null_emptystr (r: regex): 21 | [] \in {{r}} -> 22 | null r emptystr 23 | | null_emptyset (r: regex): 24 | [] \notin {{r}} -> 25 | null r emptyset 26 | . 27 | 28 | (* 29 | null_and is only true when both regexes are true, where 30 | true = emptystr 31 | false = emptyset 32 | *) 33 | Definition null_and (p q: regex): regex := 34 | match (p, q) with 35 | | (emptystr, emptystr) => emptystr 36 | | _ => emptyset 37 | end. 38 | 39 | (* 40 | null_nor is only true when both regexes are false, where 41 | true = emptystr 42 | false = emptyset 43 | *) 44 | Definition null_nor (p q: regex): regex := 45 | match (p, q) with 46 | | (emptyset, emptyset) => emptystr 47 | | _ => emptyset 48 | end. 49 | 50 | (* 51 | If $R = f(P, Q)$ it is also easy to determine $\nu(R)$. For example, 52 | 53 | $$ 54 | \begin{aligned} 55 | \text{(3.1)}&\ \nu(P + Q) &= \nu(P) + \nu(Q). \\ 56 | \text{(3.2)}&\ \nu(P\ \&\ Q) &= \nu(P)\ \&\ \nu(Q). \\ 57 | \text{(3.3)}&\ \nu(P') &= \epsilon\ \text{if}\ \nu(P) = \emptyset \\ 58 | & &= \emptyset\ \text{if}\ \nu(P) = \epsilon \\ 59 | \end{aligned} 60 | $$ 61 | 62 | where $\&$ and $+$ is defined for $\nu$ similar to 63 | $\epsilon$ being True and $\emptyset$ being False in a boolean equation. 64 | 65 | $$ 66 | \begin{aligned} 67 | A\ \&\ B = \epsilon\ \text{if and only if}\ A = \epsilon\ \text{and}\ B = \epsilon \\ 68 | A + B = \emptyset\ \text{if and only if}\ A = \emptyset\ \text{and}\ B = \emptyset 69 | \end{aligned} 70 | $$ 71 | *) 72 | 73 | (* 74 | null_or is only true when one of the regexes are true, where 75 | true = emptystr 76 | false = emptyset 77 | *) 78 | Definition null_or (p q: regex): regex := 79 | match (p, q) with 80 | | (emptystr, _) => emptystr 81 | | (_, emptystr) => emptystr 82 | | _ => emptyset 83 | end. 84 | 85 | (* 86 | null_neg is only true if input is false and vice versa, where 87 | true = emptystr 88 | false = emptyset 89 | *) 90 | Definition null_neg (p: regex): regex := 91 | match p with 92 | | emptystr => emptyset 93 | | _ => emptystr 94 | end. 95 | 96 | Fixpoint null_def (r: regex): regex := 97 | match r with 98 | | emptyset => emptyset 99 | | emptystr => emptystr 100 | | symbol _ => emptyset 101 | | or s t => null_or (null_def s) (null_def t) 102 | | neg s => null_neg (null_def s) 103 | | concat s t => null_and (null_def s) (null_def t) 104 | | star s => emptystr 105 | end. -------------------------------------------------------------------------------- /src/Brzozowski/Readme.md: -------------------------------------------------------------------------------- 1 | # Derivatives of Regular Expressions - Janusz A Brzozowski 2 | 3 | This folder contains the original paper for [Derivatives of Regular Expressions - Janusz A Brzozowski](./Derivatives%20of%20Regular%20Expressions%20-%20Janusz%20A%20Brzozowski.md) 4 | 5 | We also redefine regular expressions in this folder in terms of this original paper. 6 | The goal of this folder, is to prove Theorem 4.3 (a). 7 | 8 | The included paper has some modifications, to help make it easier to read and use, these include: 9 | 10 | - rewritten in markdown 11 | - removal of some less interesting parts: 12 | + references to Mealy model 13 | + section 6 14 | - rephrased A_k as Sigma_k, to make it clear that Sigma_k is the input alphabet 15 | - renaming of variables 16 | - extra explanations and clarifications 17 | - added TODO exercises 18 | 19 | This markdown is then rendered to pdf using pandoc [here](./Derivatives%20of%20Regular%20Expressions%20-%20Janusz%20A%20Brzozowski.pdf) 20 | 21 | The real original paper can be found [here](http://maveric.uwaterloo.ca/reports/1964_JACM_Brzozowski.pdf) 22 | 23 | ## Regeneration 24 | 25 | - Install pandoc 26 | - Install xelatex 27 | - run `$ make` -------------------------------------------------------------------------------- /src/Brzozowski/Regex.v: -------------------------------------------------------------------------------- 1 | Require Import Brzozowski.Alphabet. 2 | 3 | Inductive regex := 4 | (* emptyset matches absolutely no strings *) 5 | | emptyset : regex 6 | (* lambda matches only the empty string *) 7 | | emptystr : regex 8 | (* symbol matches only strings of length 1 containing the exact alphabet symbol *) 9 | | symbol : alphabet -> regex 10 | (* or takes the union of two regular expressions *) 11 | | or : regex -> regex -> regex 12 | (* 13 | neg or negation is the `not` or `complement` operator, that we use to avoid confusion with 14 | the `not` function for properties. 15 | Using the two logical operators `or` and `neg` we can represent all other logical operators 16 | *) 17 | | neg : regex -> regex 18 | (* concat is used to build of regular expressions that can match longer strings *) 19 | | concat : regex -> regex -> regex 20 | (* zero or more, as you are familiar with from regular expressions *) 21 | | star : regex -> regex 22 | . 23 | -------------------------------------------------------------------------------- /src/Brzozowski/Ring.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Classes.Morphisms. 2 | Require Import Coq.setoid_ring.Ring. 3 | Require Import Coq.setoid_ring.Ring_theory. 4 | Require Import Coq.Setoids.Setoid. 5 | 6 | Require Import CoqStock.DubStep. 7 | Require Import CoqStock.Invs. 8 | Require Import CoqStock.List. 9 | Require Import CoqStock.Listerine. 10 | Require Import CoqStock.Untie. 11 | Require Import CoqStock.WreckIt. 12 | 13 | Require Import Brzozowski.Alphabet. 14 | Require Import Brzozowski.Language. 15 | Require Import Brzozowski.LogicOp. 16 | Require Import Brzozowski.Regex. 17 | Require Import Brzozowski.Setoid. 18 | Require Import Brzozowski.Simplify. 19 | 20 | (* TODOs in this file 21 | Some are theorems that need to be proven or simply applied from Simplify.v 22 | Other parts are uncommentable once the theorems are proven. 23 | *) 24 | 25 | Theorem or_lang_emptyset_l: 26 | forall n : lang, or_lang emptyset_lang n {<->} n. 27 | Proof. 28 | exact or_lang_emptyset_l_is_r. 29 | Qed. 30 | 31 | Theorem or_lang_comm: 32 | forall n m : lang, or_lang n m {<->} or_lang m n. 33 | Proof. 34 | intros. 35 | split; intros; constructor; invs H; invs H0; auto. 36 | Qed. 37 | 38 | Theorem or_lang_assoc: 39 | forall n m p : lang, or_lang n (or_lang m p) {<->} or_lang (or_lang n m) p. 40 | Proof. 41 | intros. 42 | split; intros; invs H. invs H0; apply mk_or. 43 | - left. apply mk_or. auto. 44 | - invs H. invs H0. 45 | + left. apply mk_or. auto. 46 | + right. assumption. 47 | - apply mk_or. 48 | invs H0. 49 | + invs H. 50 | invs H0. 51 | * left. assumption. 52 | * right. apply mk_or. auto. 53 | + right. apply mk_or. auto. 54 | Qed. 55 | 56 | Theorem and_lang_neg_emptyset_l: 57 | forall n : lang, and_lang (neg_lang emptyset_lang) n {<->} n. 58 | Proof. 59 | intros. 60 | split; intros. 61 | - invs H. invs H0. assumption. 62 | - constructor. split. 63 | + constructor. 64 | untie. 65 | + assumption. 66 | Qed. 67 | 68 | Theorem and_lang_emptyset_l: 69 | forall n : lang, and_lang emptyset_lang n {<->} emptyset_lang. 70 | Proof. 71 | intros. 72 | split; intros. 73 | - invs H. 74 | invs H0. 75 | invs H. 76 | - invs H. 77 | Qed. 78 | 79 | Theorem and_lang_comm: 80 | forall n m : lang, and_lang n m {<->} and_lang m n. 81 | Proof. 82 | intros. 83 | split; intros. 84 | - constructor. 85 | invs H. 86 | invs H0. 87 | constructor; assumption. 88 | - constructor. 89 | invs H. 90 | invs H0. 91 | constructor; assumption. 92 | Qed. 93 | 94 | Theorem and_lang_assoc: 95 | forall n m p : lang, 96 | and_lang n (and_lang m p) {<->} and_lang (and_lang n m) p. 97 | Proof. 98 | intros. 99 | split; intros. 100 | - invs H. 101 | invs H0. 102 | invs H1. 103 | invs H0. 104 | constructor. 105 | split. 106 | + split. 107 | auto. 108 | + assumption. 109 | - invs H. 110 | invs H0. 111 | invs H. 112 | invs H0. 113 | constructor. 114 | split. 115 | + assumption. 116 | + constructor. 117 | split; assumption. 118 | Qed. 119 | 120 | Theorem and_lang_or_lang_distrib_l: 121 | forall n m p : lang, 122 | and_lang (or_lang n m) p {<->} or_lang (and_lang n p) (and_lang m p). 123 | Proof. 124 | intros. split; intros. 125 | - invs H. invs H0. invs H. 126 | constructor. 127 | invs H0. 128 | + left. 129 | constructor. 130 | auto. 131 | + right. 132 | constructor. 133 | auto. 134 | - invs H. 135 | constructor. 136 | invs H0. 137 | + split. 138 | * constructor. 139 | left. 140 | invs H. 141 | invs H0. 142 | assumption. 143 | * invs H. 144 | invs H0. 145 | assumption. 146 | + invs H. 147 | invs H0. 148 | split. 149 | * constructor. 150 | right. 151 | assumption. 152 | * assumption. 153 | Qed. 154 | 155 | Lemma lang_semi_ring: 156 | semi_ring_theory emptyset_lang (neg_lang emptyset_lang) or_lang and_lang (lang_iff). 157 | Proof. 158 | constructor. 159 | - exact or_lang_emptyset_l. 160 | - exact or_lang_comm. 161 | - exact or_lang_assoc. 162 | - exact and_lang_neg_emptyset_l. 163 | - exact and_lang_emptyset_l. 164 | - exact and_lang_comm. 165 | - exact and_lang_assoc. 166 | - exact and_lang_or_lang_distrib_l. 167 | Qed. 168 | 169 | Lemma Eq_lang_s_ext: sring_eq_ext or_lang and_lang lang_iff. 170 | Proof. 171 | constructor. 172 | - exact or_lang_morph_Proper. 173 | - exact and_lang_morph_Proper. 174 | Qed. 175 | 176 | Add Ring lang_semi_ring: lang_semi_ring 177 | (abstract, setoid lang_setoid Eq_lang_s_ext). 178 | 179 | Lemma or_lang_diag: forall b: lang, 180 | or_lang b b {<->} b. 181 | Proof. 182 | intros. 183 | split; intros. 184 | - invs H. 185 | invs H0; assumption. 186 | - constructor. 187 | left. 188 | assumption. 189 | Qed. 190 | 191 | Lemma or_lang_false_r: forall b:lang, 192 | or_lang b emptyset_lang {<->} b. 193 | Proof. 194 | intros. 195 | split; intros. 196 | - invs H. invs H0. 197 | + assumption. 198 | + invs H. 199 | - constructor. 200 | left. 201 | assumption. 202 | Qed. 203 | 204 | Lemma or_lang_false_l: forall b:lang, 205 | or_lang emptyset_lang b {<->} b. 206 | Proof. 207 | intros. 208 | split; intros. 209 | - invs H. 210 | invs H0. 211 | + invs H. 212 | + assumption. 213 | - constructor. 214 | right. 215 | assumption. 216 | Qed. 217 | 218 | Lemma or_lang_true_r: forall b:lang, 219 | or_lang b (neg_lang emptyset_lang) {<->} neg_lang emptyset_lang. 220 | Proof. 221 | intros. 222 | split; intros. 223 | - constructor. 224 | untie. 225 | - constructor. 226 | right. 227 | constructor. 228 | untie. 229 | Qed. 230 | 231 | Lemma or_lang_true_l: forall b:lang, 232 | or_lang (neg_lang emptyset_lang) b {<->} neg_lang emptyset_lang. 233 | Proof. 234 | intros. 235 | split; intros. 236 | - constructor. 237 | untie. 238 | - constructor. 239 | left. 240 | constructor. 241 | untie. 242 | Qed. 243 | 244 | (* 245 | truthy is a tactic that repeatedly applies: 246 | - the semi ring with or_lang tactic 247 | - removes duplicates in or_lang expressions 248 | - removes all emptyset values in or_lang expressions 249 | - returns neg (emptyset), if a neg (emptyset) is found in an or expression 250 | *) 251 | Ltac truthy := repeat 252 | ( ring 253 | || rewrite or_lang_diag 254 | || rewrite or_lang_false_r 255 | || rewrite or_lang_false_l 256 | || rewrite or_lang_true_r 257 | || rewrite or_lang_true_l 258 | ). 259 | 260 | Example example_or_lang_commutativity: forall (a b: lang), 261 | or_lang a b {<->} or_lang b a. 262 | Proof. 263 | intros. 264 | ring. 265 | Qed. 266 | 267 | Example example_or_lang_idempotency_1: forall (a b: lang), 268 | or_lang a (or_lang a b) {<->} or_lang a b. 269 | Proof. 270 | intros. 271 | (* TODO: Help Wanted 272 | ring/truthy does not solve this, 273 | but does solve it in CoqStock/Truthy.v 274 | *) 275 | Abort. 276 | 277 | Example example_or_lang_idempotency_2: forall (a b: lang), 278 | or_lang (or_lang a b) a {<->} or_lang a b. 279 | Proof. 280 | intros. 281 | (* TODO: Help Wanted 282 | ring/truthy does not solve this, 283 | but does solve it in CoqStock/Truthy.v 284 | *) 285 | Abort. 286 | 287 | Example example_or_associativity_1: forall (a b c: lang), 288 | or_lang (or_lang a b) c {<->} or_lang a (or_lang b c). 289 | Proof. 290 | intros. 291 | ring. 292 | Qed. 293 | 294 | Example example_or_associativity_2: forall (a b c: lang), 295 | or_lang a (or_lang b c) {<->} or_lang b (or_lang a c). 296 | Proof. 297 | intros. 298 | ring. 299 | Qed. 300 | 301 | Example example_or_3: forall (a b c: lang), 302 | or_lang a (or_lang b (or_lang a c)) {<->} or_lang a (or_lang b c). 303 | Proof. 304 | intros. 305 | (* TODO: Help Wanted 306 | ring/truthy does not solve this, 307 | but does solve it in CoqStock/Truthy.v 308 | *) 309 | Abort. 310 | 311 | Example example_or_4: forall (a b c d: lang), 312 | or_lang a (or_lang b (or_lang c d)) {<->} 313 | or_lang a (or_lang d (or_lang b (or_lang c d ))). 314 | Proof. 315 | intros. 316 | (* TODO: Help Wanted 317 | ring/truthy does not solve this, 318 | but does solve it in CoqStock/Truthy.v 319 | *) 320 | Abort. 321 | 322 | Example example_or_false: forall (a: lang), 323 | or_lang a emptyset_lang {<->} a. 324 | Proof. 325 | intros. 326 | ring. 327 | Qed. 328 | 329 | Example example_or_true: forall (a: lang), 330 | or_lang (neg_lang emptyset_lang) a {<->} neg_lang emptyset_lang. 331 | Proof. 332 | intros. 333 | truthy. 334 | Qed. -------------------------------------------------------------------------------- /src/Brzozowski/Setoid.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Setoids.Setoid. 2 | 3 | Require Import CoqStock.DubStep. 4 | Require Import CoqStock.Invs. 5 | Require Import CoqStock.List. 6 | Require Import CoqStock.Listerine. 7 | Require Import CoqStock.Untie. 8 | Require Import CoqStock.WreckIt. 9 | 10 | Require Import Brzozowski.Alphabet. 11 | Require Import Brzozowski.Derive. 12 | Require Import Brzozowski.Language. 13 | Require Import Brzozowski.Regex. 14 | 15 | (* lang_setoid makes it possible to use: 16 | - rewrite for proven lang_iff theorems 17 | - reflexivity for lang_iff relations where both sides are equal 18 | see Example LangSetoidRewriteReflexivity 19 | *) 20 | 21 | Section LangSetoid. 22 | 23 | Theorem lang_iff_refl : forall A:lang, A {<->} A. 24 | Proof. 25 | split; auto. 26 | Qed. 27 | 28 | Theorem lang_iff_trans : forall A B C:lang, (A {<->} B) -> (B {<->} C) -> (A {<->} C). 29 | Proof. 30 | intros. 31 | unfold "{<->}" in *. 32 | intros. 33 | specialize H with s. 34 | specialize H0 with s. 35 | unfold "\in" in *. 36 | apply iff_trans with (A := A s) (B := B s); assumption. 37 | Qed. 38 | 39 | Theorem lang_iff_sym : forall A B:lang, (A {<->} B) -> (B {<->} A). 40 | Proof. 41 | intros. 42 | unfold "{<->}" in *. 43 | intros. 44 | specialize H with s. 45 | unfold "\in" in *. 46 | apply iff_sym. 47 | assumption. 48 | Qed. 49 | 50 | Add Parametric Relation: lang lang_iff 51 | reflexivity proved by lang_iff_refl 52 | symmetry proved by lang_iff_sym 53 | transitivity proved by lang_iff_trans as lang_setoid. 54 | 55 | End LangSetoid. 56 | 57 | Existing Instance lang_setoid. 58 | 59 | (* 60 | nor_lang_morph allows rewrite to work inside nor_lang parameters 61 | see Example NorLangMorphSetoidRewrite 62 | *) 63 | Add Parametric Morphism: or_lang 64 | with signature lang_iff ==> lang_iff ==> lang_iff as or_lang_morph. 65 | Proof. 66 | intros. 67 | unfold "{<->}" in *. 68 | unfold "\in" in *. 69 | intros. 70 | specialize H with s. 71 | specialize H0 with s. 72 | constructor. 73 | - intros. 74 | constructor. 75 | invs H1. 76 | rewrite <- H. 77 | rewrite <- H0. 78 | assumption. 79 | - intros. 80 | constructor. 81 | invs H1. 82 | rewrite H. 83 | rewrite H0. 84 | assumption. 85 | Qed. 86 | 87 | Add Parametric Morphism: neg_lang 88 | with signature lang_iff ==> lang_iff as neg_lang_morph. 89 | Proof. 90 | intros. 91 | unfold "{<->}" in *. 92 | intros. 93 | specialize H with s. 94 | split. 95 | - intros. 96 | constructor. 97 | invs H0. 98 | rewrite <- H. 99 | assumption. 100 | - intros. 101 | constructor. 102 | invs H0. 103 | rewrite H. 104 | assumption. 105 | Qed. 106 | 107 | (* 108 | concat_lang_morph allows rewrite to work inside concat_lang parameters 109 | *) 110 | Add Parametric Morphism: concat_lang 111 | with signature lang_iff ==> lang_iff ==> lang_iff as concat_lang_morph. 112 | Proof. 113 | intros. 114 | split. 115 | - intros. 116 | destruct H1. 117 | apply (mk_concat _ _ p q s). 118 | + assumption. 119 | + apply H. assumption. 120 | + apply H0. assumption. 121 | - intros. 122 | destruct H1. 123 | apply (mk_concat _ _ p q s). 124 | + assumption. 125 | + apply H. assumption. 126 | + apply H0. assumption. 127 | Qed. 128 | 129 | Lemma star_lang_morph_helper: 130 | forall (x y : lang) (s: str), 131 | (x {<->} y) 132 | -> (s \in star_lang x -> s \in star_lang y). 133 | Proof. 134 | intros. 135 | induction H0. 136 | - constructor. 137 | - constructor 2 with (p := p) (q := q); try assumption. 138 | + apply H. assumption. 139 | Qed. 140 | 141 | Theorem star_lang_morph': 142 | forall (x y : lang) (s: str), 143 | (x {<->} y) 144 | -> (s \in star_lang x <-> s \in star_lang y). 145 | Proof. 146 | intros. 147 | split. 148 | - apply star_lang_morph_helper. assumption. 149 | - apply star_lang_morph_helper. 150 | symmetry. 151 | assumption. 152 | Qed. 153 | 154 | (* 155 | star_lang_morph allows rewrite to work inside star_lang parameters 156 | *) 157 | Add Parametric Morphism: star_lang 158 | with signature lang_iff ==> lang_iff as star_lang_morph. 159 | Proof. 160 | intros R R' Riff. 161 | unfold "{<->}" in *. 162 | intro s. 163 | apply star_lang_morph'. 164 | assumption. 165 | Qed. 166 | 167 | (* This lemma is only here to show off the setoid rewrite example below. *) 168 | Example lemma_for_setoid_example_concat_lang_emptyset_l_is_emptyset: forall (r: lang), 169 | concat_lang emptyset_lang r 170 | {<->} 171 | emptyset_lang. 172 | Proof. 173 | split. 174 | - intros. 175 | invs H. 176 | invs H1. 177 | - intros. 178 | invs H. 179 | Qed. 180 | 181 | (* 182 | The implementation of Setoid for lang allows the use of rewrite and reflexivity. 183 | *) 184 | Example LangSetoidRewriteReflexivity: forall (r: lang), 185 | concat_lang emptyset_lang r 186 | {<->} 187 | emptyset_lang. 188 | Proof. 189 | intros. 190 | rewrite lemma_for_setoid_example_concat_lang_emptyset_l_is_emptyset. 191 | reflexivity. 192 | Qed. 193 | 194 | (* 195 | The implementation of or_lang_morph allows the use of rewrite inside or_lang parameters. 196 | *) 197 | Example OrLangMorphSetoidRewrite: forall (r s: lang), 198 | or_lang (concat_lang emptyset_lang r) s 199 | {<->} 200 | or_lang emptyset_lang s. 201 | Proof. 202 | intros. 203 | rewrite lemma_for_setoid_example_concat_lang_emptyset_l_is_emptyset. 204 | reflexivity. 205 | Qed. 206 | 207 | Example StarLangOrLangMorphSetoidRewrite: forall (r s: lang), 208 | star_lang (or_lang (concat_lang emptyset_lang r) s) 209 | {<->} 210 | star_lang (or_lang emptyset_lang s). 211 | Proof. 212 | intros. 213 | rewrite lemma_for_setoid_example_concat_lang_emptyset_l_is_emptyset. 214 | reflexivity. 215 | Qed. 216 | 217 | (* Allow \in expressions to also be rewritten using lang_iff expressions: *) 218 | 219 | Example example_fail_rewriting_using_lang_iff_in_iff: 220 | forall (p q: regex) 221 | (pq: {{p}} {<->} {{q}}), 222 | forall s: str, 223 | s \in {{q}} <-> s \in {{p}}. 224 | Proof. 225 | intros. 226 | Fail rewrite pq. 227 | Abort. 228 | 229 | Add Parametric Morphism {s: str}: (elem s) 230 | with signature lang_iff ==> iff 231 | as elem_morph. 232 | Proof. 233 | intros. 234 | unfold elem. 235 | unfold "{<->}" in H. 236 | specialize H with (s := s). 237 | unfold "\in" in H. 238 | assumption. 239 | Qed. 240 | 241 | Example example_rewriting_using_lang_iff_in_iff: 242 | forall (p q: regex) 243 | (pq: {{p}} {<->} {{q}}), 244 | forall s: str, 245 | s \in {{q}} <-> s \in {{p}}. 246 | Proof. 247 | intros. 248 | rewrite pq. 249 | reflexivity. 250 | Qed. 251 | 252 | Example example_rewriting_using_lang_iff_in_iff': 253 | forall (P Q: lang) 254 | (pq: P {<->} Q), 255 | forall s: str, 256 | s \in Q <-> s \in P. 257 | Proof. 258 | intros. 259 | rewrite pq. 260 | reflexivity. 261 | Qed. 262 | 263 | Example example_rewriting_using_lang_iff_in_iff'': 264 | forall (P Q: lang) 265 | (pq: P {<->} Q), 266 | forall s: str, 267 | s \in neg_lang Q <-> s \in neg_lang P. 268 | Proof. 269 | intros. 270 | rewrite pq. 271 | reflexivity. 272 | Qed. 273 | 274 | Example example_rewriting_using_lang_iff_in_iff''': 275 | forall (R: lang) 276 | (nnr: R {<->} neg_lang (neg_lang R)), 277 | forall s: str, 278 | s \in neg_lang R <-> s \in neg_lang (neg_lang (neg_lang R)). 279 | Proof. 280 | intros. 281 | rewrite <- nnr. 282 | reflexivity. 283 | Qed. 284 | 285 | (* Allow derive_langs expressions to also be rewritten using lang_iff expressions: *) 286 | 287 | Add Parametric Morphism {s: str}: (derive_langs s) 288 | with signature lang_iff ==> lang_iff 289 | as derive_langs_morph. 290 | Proof. 291 | unfold derive_langs. 292 | unfold "{<->}" in *. 293 | intros. 294 | unfold "\in" in *. 295 | specialize H with (s := (s ++ s0)). 296 | assumption. 297 | Qed. 298 | 299 | Example example_rewriting_using_lang_iff_in_derive_langs: 300 | forall (p q: regex) 301 | (pq: {{p}} {<->} {{q}}), 302 | forall s: str, 303 | derive_langs s {{q}} {<->} derive_langs s {{p}}. 304 | Proof. 305 | intros. 306 | rewrite pq. 307 | reflexivity. 308 | Qed. 309 | 310 | (* Allow derive_lang expressions to also be rewritten using lang_iff expressions: *) 311 | 312 | Add Parametric Morphism {a: alphabet}: (derive_lang a) 313 | with signature lang_iff ==> lang_iff 314 | as derive_lang_morph. 315 | Proof. 316 | unfold derive_lang. 317 | unfold "{<->}" in *. 318 | intros. 319 | unfold "\in" in *. 320 | specialize H with (s := (a :: s)). 321 | assumption. 322 | Qed. 323 | 324 | Example example_rewriting_using_lang_iff_in_derive_lang: 325 | forall (p q: regex) 326 | (pq: {{p}} {<->} {{q}}), 327 | forall a: alphabet, 328 | derive_lang a {{q}} {<->} derive_lang a {{p}}. 329 | Proof. 330 | intros. 331 | rewrite pq. 332 | reflexivity. 333 | Qed. -------------------------------------------------------------------------------- /src/Brzozowski/Simplify.v: -------------------------------------------------------------------------------- 1 | (* Simplify contains theorems that show that 2 | Language definitions of regular expressions are equivalent. 3 | *) 4 | 5 | Require Import CoqStock.DubStep. 6 | Require Import CoqStock.Invs. 7 | Require Import CoqStock.List. 8 | Require Import CoqStock.Listerine. 9 | Require Import CoqStock.Untie. 10 | Require Import CoqStock.WreckIt. 11 | 12 | Require Import Brzozowski.Alphabet. 13 | Require Import Brzozowski.ConcatLang. 14 | Require Import Brzozowski.Decidable. 15 | Require Import Brzozowski.Language. 16 | Require Import Brzozowski.LogicOp. 17 | Require Import Brzozowski.Regex. 18 | 19 | (* 20 | TODO: Good First Issue 21 | Create a theorem for and prove a simplification rule below: 22 | 23 | ## Simplification rules mentioned in the Brzozowski paper. 24 | 25 | R + R = R 26 | P + Q = Q + P 27 | (P + Q) + R = P + (Q + R) 28 | 29 | R + ∅ = R 30 | ∅ + R = R 31 | concat_lang_emptyset_r_is_emptyset: R,∅ = ∅ 32 | concat_lang_emptyset_l_is_emptyset: ∅,R = ∅ 33 | concat_lang_emptystr_r_is_r: R,λ = R 34 | concat_lang_emptystr_l_is_l: λ,R = R 35 | 36 | ~∅+X = ~∅ 37 | ~∅&X = X 38 | 39 | ~(P+Q) = ~P&~Q 40 | ~(P&Q) = ~P+~Q 41 | 42 | Q&~λ = Q where nullable(Q) = false 43 | 44 | ## Extra simplification from the Scott Owen's regular expression re-examined paper 45 | 46 | r&r = r 47 | r&s = s&r 48 | (r&s)&t = r&(s&t) 49 | ∅&r = ∅ 50 | 51 | (r,s),t = r,(s,t) 52 | 53 | r** = r* 54 | λ* = λ 55 | ∅* = λ 56 | neg_lang_neg_lang_is_lang: ~~r = r 57 | *) 58 | 59 | Theorem neg_lang_neg_lang_is_lang: forall (r: regex), 60 | neg_lang (neg_lang {{r}}) 61 | {<->} 62 | {{r}}. 63 | Proof. 64 | unfold lang_iff. 65 | intros. 66 | specialize denotation_is_decidable with (s := s) (r := r) as D. 67 | destruct D. 68 | - split. 69 | + auto. 70 | + intros. 71 | constructor. 72 | untie. 73 | invs H1. 74 | contradiction. 75 | - split. 76 | + intros. 77 | invs H0. 78 | exfalso. 79 | apply H1. 80 | constructor. 81 | assumption. 82 | + intros. 83 | contradiction. 84 | Qed. 85 | 86 | Theorem concat_lang_emptyset_l_is_emptyset: forall (r: lang), 87 | concat_lang emptyset_lang r 88 | {<->} 89 | emptyset_lang. 90 | Proof. 91 | split. 92 | - intros. 93 | invs H. 94 | invs H1. 95 | - intros. 96 | invs H. 97 | Qed. 98 | 99 | Theorem concat_lang_emptyset_r_is_emptyset: forall (r: lang), 100 | concat_lang r emptyset_lang 101 | {<->} 102 | emptyset_lang. 103 | Proof. 104 | split. 105 | - intros. 106 | invs H. 107 | invs H2. 108 | - intros. 109 | invs H. 110 | Qed. 111 | 112 | Theorem concat_lang_emptystr_l_is_l: forall (r: lang), 113 | concat_lang emptystr_lang r 114 | {<->} 115 | r. 116 | Proof. 117 | split. 118 | - intros. 119 | invs H. 120 | inversion_clear H1. 121 | cbn. 122 | assumption. 123 | - intros. 124 | destruct_concat_lang. 125 | exists []. 126 | exists s. 127 | exists eq_refl. 128 | split. 129 | + constructor. 130 | + assumption. 131 | Qed. 132 | 133 | Theorem concat_lang_emptystr_r_is_r: forall (r: lang), 134 | concat_lang r emptystr_lang 135 | {<->} 136 | r. 137 | Proof. 138 | split. 139 | - intros. 140 | invs H. 141 | wreckit. 142 | subst. 143 | inversion_clear H2. 144 | listerine. 145 | assumption. 146 | - intros. 147 | destruct_concat_lang. 148 | exists s. 149 | exists []. 150 | assert (s ++ [] = s). listerine. reflexivity. 151 | exists H0. 152 | split. 153 | + assumption. 154 | + constructor. 155 | Qed. 156 | 157 | Theorem lift_or_lang_over_concat_lang_r: forall (p q r: lang), 158 | (concat_lang p (or_lang q r)) 159 | {<->} 160 | or_lang (concat_lang p q) (concat_lang p r). 161 | Proof. 162 | split; intros. 163 | - constructor. 164 | invs H. 165 | invs H2. 166 | destruct H. 167 | + left. 168 | destruct_concat_lang. 169 | exists p0. 170 | exists q0. 171 | exists eq_refl. 172 | auto. 173 | + right. 174 | destruct_concat_lang. 175 | exists p0. 176 | exists q0. 177 | exists eq_refl. 178 | auto. 179 | - invs H. 180 | invs H0. 181 | + destruct_concat_lang. 182 | invs H. 183 | exists p0. 184 | exists q0. 185 | exists eq_refl. 186 | split. 187 | * assumption. 188 | * constructor. 189 | left. 190 | assumption. 191 | + destruct_concat_lang. 192 | invs H. 193 | exists p0. 194 | exists q0. 195 | exists eq_refl. 196 | split. 197 | * assumption. 198 | * constructor. 199 | right. 200 | assumption. 201 | Qed. 202 | 203 | Theorem lift_or_lang_over_concat_lang_l: forall (p q r: lang), 204 | (concat_lang (or_lang p q) r) 205 | {<->} 206 | or_lang (concat_lang p r) (concat_lang q r). 207 | Proof. 208 | split; intros. 209 | - constructor. 210 | invs H. 211 | invs H1. 212 | destruct H. 213 | + left. 214 | destruct_concat_lang. 215 | exists p0. 216 | exists q0. 217 | exists eq_refl. 218 | auto. 219 | + right. 220 | destruct_concat_lang. 221 | exists p0. 222 | exists q0. 223 | exists eq_refl. 224 | auto. 225 | - invs H. 226 | invs H0. 227 | + destruct_concat_lang. 228 | invs H. 229 | exists p0. 230 | exists q0. 231 | exists eq_refl. 232 | split. 233 | * constructor. 234 | left. 235 | assumption. 236 | * assumption. 237 | + destruct_concat_lang. 238 | invs H. 239 | exists p0. 240 | exists q0. 241 | exists eq_refl. 242 | split. 243 | * constructor. 244 | right. 245 | assumption. 246 | * assumption. 247 | Qed. 248 | 249 | Theorem or_lang_emptyset_r_is_l: forall (r: lang), 250 | or_lang r emptyset_lang 251 | {<->} 252 | r. 253 | Proof. 254 | intros. 255 | split. 256 | - intros. 257 | invs H. 258 | destruct H0. 259 | + assumption. 260 | + invs H. 261 | - intros. 262 | constructor. 263 | left. 264 | assumption. 265 | Qed. 266 | 267 | Theorem or_lang_emptyset_l_is_r: forall (r: lang), 268 | or_lang emptyset_lang r 269 | {<->} 270 | r. 271 | Proof. 272 | intros. 273 | split. 274 | - intros. 275 | invs H. 276 | destruct H0. 277 | + invs H. 278 | + assumption. 279 | - intros. 280 | constructor. 281 | right. 282 | assumption. 283 | Qed. 284 | 285 | Theorem or_lang_idemp: forall (R: lang), 286 | or_lang R R {<->} R. 287 | Proof. 288 | intros. 289 | split; intros. 290 | - invs H. invs H0; assumption. 291 | - constructor. left. assumption. 292 | Qed. 293 | 294 | Theorem or_lang_comm: forall (P Q: lang), 295 | or_lang P Q {<->} or_lang Q P. 296 | Proof. 297 | intros. 298 | split; intros; invs H; constructor; destruct H0; auto. 299 | Qed. -------------------------------------------------------------------------------- /src/Brzozowski/SplitEmptyStr.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.DubStep. 2 | Require Import CoqStock.Invs. 3 | Require Import CoqStock.List. 4 | Require Import CoqStock.Listerine. 5 | Require Import CoqStock.Untie. 6 | Require Import CoqStock.WreckIt. 7 | 8 | Require Import Brzozowski.Alphabet. 9 | Require Import Brzozowski.ConcatLang. 10 | Require Import Brzozowski.Decidable. 11 | Require Import Brzozowski.Null. 12 | Require Import Brzozowski.NullCommutes. 13 | Require Import Brzozowski.Language. 14 | Require Import Brzozowski.LogicOp. 15 | Require Import Brzozowski.Regex. 16 | Require Import Brzozowski.Ring. 17 | Require Import Brzozowski.Simplify. 18 | Require Import Brzozowski.StarLang. 19 | 20 | (* 21 | null_split_emptystr_or splits a regular expression into 22 | a possible emptystr and the regular expression that does not match emptystr. 23 | This theorem is needed for finding the derive function for the concat operator. 24 | Let: 25 | R = null_def(R) or R' 26 | where null_def(R') = emptyset 27 | => 28 | Let: 29 | R = E or R' 30 | E = null_def(R) 31 | where null_def(R') = emptyset 32 | *) 33 | 34 | Definition split_into_null_or (r: regex) := 35 | exists (e r': regex), 36 | null r e /\ 37 | null r' emptyset /\ 38 | {{r}} {<->} {{or e r'}}. 39 | 40 | Lemma split_emptyset_into_emptyset_or_emptyset: 41 | split_into_null_or emptyset. 42 | Proof. 43 | unfold split_into_null_or. 44 | exists emptyset. 45 | exists emptyset. 46 | split; try split. 47 | - constructor. untie. 48 | - constructor. untie. 49 | - cbn. 50 | rewrite or_lang_emptyset_l_is_r. 51 | reflexivity. 52 | Qed. 53 | 54 | Lemma split_emptystr_into_emptystr_or_emptyset: 55 | split_into_null_or emptystr. 56 | Proof. 57 | unfold split_into_null_or. 58 | exists emptystr. 59 | exists emptyset. 60 | split; try split. 61 | - constructor. constructor. 62 | - constructor. untie. 63 | - cbn. 64 | rewrite or_lang_emptyset_r_is_l. 65 | reflexivity. 66 | Qed. 67 | 68 | Lemma split_symbol_into_emptyset_or_symbol: 69 | forall (a: alphabet), 70 | split_into_null_or (symbol a). 71 | Proof. 72 | unfold split_into_null_or. 73 | intros. 74 | exists emptyset. 75 | exists (symbol a). 76 | split; try split. 77 | - constructor. untie. invs H. 78 | - constructor. untie. invs H. 79 | - cbn. 80 | rewrite or_lang_emptyset_l_is_r. 81 | reflexivity. 82 | Qed. 83 | 84 | Lemma split_or_into_null_or: 85 | forall 86 | (p q: regex) 87 | (IHp: split_into_null_or p) 88 | (IHq: split_into_null_or q), 89 | split_into_null_or (or p q). 90 | Proof. 91 | unfold split_into_null_or. 92 | intros. 93 | destruct IHp as [pn [p' [nullp [nullp' IHp]]]]. 94 | destruct IHq as [qn [q' [nullq [nullq' IHq]]]]. 95 | exists (null_or pn qn). 96 | exists (or p' q'). 97 | split; try split. 98 | - apply null_or_is_or; assumption. 99 | - constructor. 100 | untie. 101 | invs H. 102 | invs nullq'. 103 | invs nullp'. 104 | destruct H0; contradiction. 105 | - invs nullq'. 106 | invs nullp'. 107 | invs nullp; invs nullq. 108 | + cbn. 109 | rewrite IHp. 110 | rewrite IHq. 111 | cbn. 112 | rewrite or_lang_assoc. 113 | rewrite or_lang_assoc. 114 | rewrite (or_lang_comm emptystr_lang _). 115 | rewrite <- (or_lang_assoc {{p'}} emptystr_lang emptystr_lang). 116 | truthy. 117 | + cbn. 118 | rewrite IHp. 119 | rewrite IHq. 120 | cbn. 121 | truthy. 122 | + cbn. 123 | rewrite IHp. 124 | rewrite IHq. 125 | cbn. 126 | truthy. 127 | + cbn. 128 | rewrite IHp. 129 | rewrite IHq. 130 | cbn. 131 | truthy. 132 | Qed. 133 | 134 | (* 135 | We can split a regex (not r) into 136 | null_neg r 137 | or 138 | neg (or r (null_neg r)) 139 | 140 | Consider the two cases: 141 | 1. 142 | [] \in r rn = emptystr 143 | [] \notin (neg r) 144 | [] \notin r' nullr' = emptyset 145 | [] \in (neg r') 146 | neg r = or emptyset r 147 | neg r = or (null_neg rn) r 148 | neg r = or (null_neg rn) (neg r) 149 | 2. 150 | [] \notin r rn = emptyset 151 | [] \in (neg r) 152 | [] \notin r' nullr' = emptyset 153 | [] \in (neg r') 154 | neg r = or emptystr (neg r) 155 | neg r = or (null_neg rn) (neg (or r emptystr)) 156 | *) 157 | Lemma split_neg_into_null_or: 158 | forall 159 | (r: regex) 160 | (IHr: split_into_null_or r), 161 | split_into_null_or (neg r). 162 | Proof. 163 | unfold split_into_null_or. 164 | intros. 165 | destruct IHr as [rn [r' [nullr [nullr' IHr]]]]. 166 | exists (null_neg rn). 167 | exists (neg (or r (null_neg rn))). 168 | split; try split. 169 | - apply null_neg_is_neg. assumption. 170 | - constructor. 171 | untie. 172 | invs H. 173 | apply H0. 174 | constructor. 175 | invs nullr. 176 | + left. assumption. 177 | + right. cbn. constructor. 178 | - invs nullr. 179 | + cbn. 180 | rewrite IHr. 181 | cbn. 182 | rewrite or_lang_emptyset_l_is_r. 183 | rewrite or_lang_emptyset_r_is_l. 184 | reflexivity. 185 | + simpl null_neg. 186 | split; intros. 187 | * invs H0. 188 | constructor. 189 | specialize denotation_is_decidable with (r := emptystr) (s := s) as Demptystr. 190 | destruct Demptystr. 191 | --- left. assumption. 192 | --- right. constructor. untie. invs H2. destruct H3. 193 | +++ contradiction. 194 | +++ contradiction. 195 | * constructor. 196 | untie. 197 | invs H0. 198 | invs H2. 199 | --- invs H0. 200 | contradiction. 201 | --- invs H0. 202 | apply H2. 203 | constructor. 204 | left. 205 | assumption. 206 | Qed. 207 | 208 | Lemma split_concat_into_null: 209 | forall 210 | (p q pn qn: regex) 211 | (Hnp: [] \notin {{p}}) 212 | (Hnq: [] \notin {{q}}) 213 | (Hpn: pn = emptyset \/ pn = emptystr) 214 | (Hqn: qn = emptyset \/ qn = emptystr), 215 | concat_lang 216 | (or_lang {{pn}} {{p}}) 217 | (or_lang {{qn}} {{q}}) 218 | {<->} 219 | or_lang 220 | {{null_and pn qn}} 221 | (or_lang 222 | (concat_lang 223 | {{p}} 224 | (or_lang {{qn}} {{q}}) 225 | ) 226 | (concat_lang 227 | (or_lang {{pn}} {{p}}) 228 | {{q}} 229 | ) 230 | ). 231 | Proof. 232 | intros. 233 | destruct Hpn, Hqn. 234 | - subst. 235 | rewrite or_lang_emptyset_l_is_r. 236 | cbn. 237 | rewrite or_lang_emptyset_l_is_r. 238 | rewrite or_lang_emptyset_l_is_r. 239 | rewrite or_lang_idemp. 240 | reflexivity. 241 | - subst. 242 | rewrite or_lang_emptyset_l_is_r. 243 | cbn. 244 | rewrite or_lang_emptyset_l_is_r. 245 | rewrite lift_or_lang_over_concat_lang_r. 246 | rewrite concat_lang_emptystr_r_is_r. 247 | rewrite <- or_lang_assoc. 248 | truthy. 249 | - subst. 250 | cbn. 251 | truthy. 252 | rewrite lift_or_lang_over_concat_lang_l. 253 | truthy. 254 | rewrite or_lang_assoc. 255 | rewrite (or_lang_comm (concat_lang {{p}} {{q}}) (concat_lang emptystr_lang {{q}})). 256 | rewrite <- or_lang_assoc. 257 | truthy. 258 | - subst. 259 | cbn. 260 | repeat rewrite lift_or_lang_over_concat_lang_l. 261 | repeat rewrite lift_or_lang_over_concat_lang_r. 262 | repeat rewrite concat_lang_emptystr_r_is_r. 263 | repeat rewrite concat_lang_emptystr_l_is_l. 264 | (* or (or emptystr q) (or p (concat p q)) *) 265 | (* or 266 | emptystr 267 | (or 268 | (or 269 | p 270 | (concat p q) 271 | ) 272 | (or 273 | q 274 | (concat p q) 275 | ) 276 | ) 277 | *) 278 | symmetry. 279 | rewrite <- or_lang_assoc. 280 | rewrite (or_lang_comm (concat_lang {{p}} {{q}}) _). 281 | rewrite <- or_lang_assoc. 282 | truthy. 283 | Qed. 284 | 285 | Lemma split_concat_into_null_or: 286 | forall 287 | (p q: regex) 288 | (IHp: split_into_null_or p) 289 | (IHq: split_into_null_or q), 290 | split_into_null_or (concat p q). 291 | Proof. 292 | unfold split_into_null_or. 293 | intros. 294 | destruct IHp as [pn [p' [nullp [nullp' IHp]]]]. 295 | destruct IHq as [qn [q' [nullq [nullq' IHq]]]]. 296 | exists (null_and pn qn). 297 | exists (or (concat p' q) (concat p q')). 298 | split; try split. 299 | - rewrite <- null_iff_null_def in nullq. 300 | rewrite <- null_iff_null_def in nullp. 301 | rewrite <- null_iff_null_def. 302 | cbn. 303 | subst. 304 | reflexivity. 305 | - rewrite <- null_iff_null_def in *. 306 | cbn. 307 | rewrite nullp'. 308 | rewrite nullq'. 309 | specialize null_is_emptystr_or_emptyset with (r := p) as Dp. 310 | invs Dp. 311 | + rewrite H. 312 | reflexivity. 313 | + rewrite H. 314 | reflexivity. 315 | - simpl denote_regex. 316 | rewrite IHp. 317 | rewrite IHq. 318 | simpl denote_regex. 319 | apply split_concat_into_null. 320 | + invs nullp'. assumption. 321 | + invs nullq'. assumption. 322 | + invs nullp; auto. 323 | + invs nullq; auto. 324 | Qed. 325 | 326 | (* 327 | If r does not contain emptystr then (r, star r) does not contain emptystr. 328 | If r contains emptystr then (r', star r) does not contain the emptystr. 329 | *) 330 | Lemma split_star_into_null_or: 331 | forall 332 | (r: regex) 333 | (IHr: split_into_null_or r), 334 | split_into_null_or (star r). 335 | Proof. 336 | unfold split_into_null_or. 337 | intros. 338 | destruct IHr as [rn [r' [nullr [nullr' IHr]]]]. 339 | exists emptystr. 340 | exists (concat r' (star r)). 341 | split; try split. 342 | - constructor. constructor. 343 | - constructor. untie. 344 | invs H. 345 | listerine. 346 | invs nullr'. 347 | contradiction. 348 | - split; intros. 349 | + constructor. 350 | inversion H. 351 | * subst. 352 | left. 353 | constructor. 354 | * subst. 355 | right. 356 | destruct_concat_lang. 357 | exists p. 358 | exists q. 359 | exists eq_refl. 360 | split. 361 | --- unfold lang_iff in IHr. 362 | specialize IHr with (s := p). 363 | apply IHr in H2 as H7. 364 | inversion H7. 365 | inversion nullr. 366 | +++ subst. 367 | invs H0. 368 | *** invs H4. 369 | contradiction. 370 | *** assumption. 371 | +++ subst. 372 | invs H0. 373 | *** invs H4. 374 | *** assumption. 375 | --- assumption. 376 | + invs H. 377 | invs H0. 378 | * invs H. 379 | constructor. 380 | * inversion H. 381 | invs nullr. 382 | --- unfold lang_iff in IHr. 383 | specialize IHr with (s := p). 384 | cbn. 385 | apply (mk_star_more {{r}} (p ++ q) p q). 386 | +++ reflexivity. 387 | +++ invs nullr'. 388 | untie. 389 | +++ rewrite IHr. 390 | constructor. 391 | right. 392 | assumption. 393 | +++ assumption. 394 | --- unfold lang_iff in IHr. 395 | specialize IHr with (s := p). 396 | apply (mk_star_more {{r}} (p ++ q) p q). 397 | +++ reflexivity. 398 | +++ invs nullr'. 399 | untie. 400 | +++ rewrite IHr. 401 | constructor. 402 | right. 403 | assumption. 404 | +++ assumption. 405 | Qed. 406 | 407 | Theorem null_split_emptystr_or (r: regex): 408 | exists 409 | (e r': regex), 410 | null r e /\ 411 | null r' emptyset /\ 412 | {{r}} {<->} {{or e r'}}. 413 | Proof. 414 | induction r. 415 | - apply split_emptyset_into_emptyset_or_emptyset. 416 | - apply split_emptystr_into_emptystr_or_emptyset. 417 | - apply split_symbol_into_emptyset_or_symbol. 418 | - apply split_or_into_null_or; assumption. 419 | - apply split_neg_into_null_or; assumption. 420 | - apply split_concat_into_null_or; assumption. 421 | - apply split_star_into_null_or; assumption. 422 | Qed. 423 | -------------------------------------------------------------------------------- /src/Brzozowski/StarLang.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.Invs. 2 | Require Import CoqStock.List. 3 | Require Import CoqStock.Listerine. 4 | 5 | Require Import Brzozowski.Alphabet. 6 | Require Import Brzozowski.ConcatLang. 7 | Require Import Brzozowski.Language. 8 | Require Import Brzozowski.Setoid. 9 | 10 | (* 11 | This module shows off different possible definitions of star_lang and how they are all equivalent 12 | to the defintion we use in Language.v, namely `star_lang`. 13 | The 4 varieties include switching these options on and off: 14 | 15 | - allowing empty prefixes in `mk_star_more` 16 | - using an existence statement 17 | 18 | Where the definition of the `star_lang` we use in Language.v: 19 | 20 | - does not allow empty prefixes in `mk_star_more` 21 | - prefers using forall over existence 22 | 23 | The reason for preferring forall over existence in this case is that, 24 | the definitions that use an existence statement (e.g. the existence statement 25 | that is part of `concat_lang` and `concat_ex_prefix_not_empty_lang`) require you to 26 | prove your own induction principle, because Coq is not smart enough to figure it 27 | out by itself. The definitions that allow empty prefixes make induction more 28 | difficult if the regular expression matches the empty string. 29 | 30 | Therefore, the easiest definition is the one that does not have an existence 31 | statement and that does not allow empty prefixes, so we will use that as our main definition. 32 | 33 | Below, we define all these definitions and prove their equivalence. As part of 34 | the proofs, we prove a stronger induction principle for the two definitions that 35 | use an existence statement. 36 | 37 | For reference here follows our main definition of `star_lang` 38 | 39 | Inductive star_lang (R: lang): lang := 40 | | mk_star_zero : star_lang R [] 41 | | mk_star_more : forall (s p q: str), 42 | p ++ q = s -> 43 | p <> [] -> 44 | p \in R -> 45 | q \in (star_lang R) -> 46 | s \in star_lang R. 47 | 48 | The other definitions are: 49 | - star_lang_ex_empty 50 | - star_lang_empty 51 | - star_lang_ex 52 | *) 53 | 54 | (* 55 | star_lang_ex_empty is the original definition of star_lang: 56 | - Uses existence 57 | - Allows empty prefixes in mk_star_more 58 | It contains more recursion, since it allows R to match the empty string. 59 | The definition allowing empty prefixes and using the existence statement is hidden in `concat_lang_ex`. 60 | This is the most difficult definition to use in Coq, but arguably the closest to the mathematical definition: 61 | *Star*. $P^{*} = \cup_{0}^{\infty} P^n$ , where $P^2 = P.P$, etc. 62 | and $P^0 = \epsilon$, the set consisting of the string of zero length. 63 | *) 64 | Inductive star_lang_ex_empty (R: lang): lang := 65 | | mk_star_zero_ex_empty : forall (s: str), 66 | s = [] -> star_lang_ex_empty R s 67 | | mk_star_more_ex_empty : forall (s: str), 68 | s \in (concat_lang_ex R (star_lang_ex_empty R)) -> 69 | star_lang_ex_empty R s. 70 | 71 | (* star_lang_empty is a middle ground: 72 | - Does not use existence 73 | - Allows empty prefixes 74 | *) 75 | Inductive star_lang_empty (R: lang): lang := 76 | | mk_star_zero_empty : forall (s: str), 77 | s = [] -> star_lang_empty R s 78 | | mk_star_more_empty : forall (s p q: str), 79 | p ++ q = s -> 80 | p \in R -> 81 | q \in (star_lang_empty R) -> 82 | s \in star_lang_empty R. 83 | 84 | (* concat_ex_prefix_not_empty_lang is a helper for star_lang_ex 85 | It uses existence to define concat and 86 | the prefix language is not allowed to match the empty string 87 | *) 88 | Inductive concat_ex_prefix_not_empty_lang (P Q: lang): lang := 89 | | mk_concat_prefix_is_not_empty: forall (s: str), 90 | (exists 91 | (p: str) 92 | (a: alphabet) 93 | (q: str) 94 | (pqs: (a :: p) ++ q = s), 95 | (a :: p) \in P /\ 96 | q \in Q 97 | ) -> 98 | concat_ex_prefix_not_empty_lang P Q s 99 | . 100 | 101 | (* star_lang_ex is another middle ground: 102 | - Uses existence that is hidden in concat_ex_prefix_not_empty_lang 103 | - Does not allow empty prefixes in mk_star_more, which is also hidden in concat_ex_prefix_not_empty_lang 104 | *) 105 | Inductive star_lang_ex (R: lang): lang := 106 | | mk_star_zero_ex : forall (s: str), 107 | s = [] -> star_lang_ex R s 108 | | mk_star_more_ex : forall (s: str), 109 | s \in (concat_ex_prefix_not_empty_lang R (star_lang_ex R)) -> 110 | star_lang_ex R s. 111 | 112 | (* The Propositions below shows how each of the 4 definitions are equivalent to star_lang. *) 113 | 114 | Proposition star_lang_empty_equivalent (R: lang): 115 | star_lang R {<->} star_lang_empty R. 116 | Proof. 117 | split. 118 | - intro Hmatch. 119 | induction Hmatch. 120 | + subst. now constructor. 121 | + eapply (mk_star_more_empty R s); try (exact H); try assumption. 122 | - intro Hmatch. 123 | induction Hmatch as [| s p q Hp_match Hq_match IH]. 124 | + subst. now constructor. 125 | + destruct p. 126 | * (* If the prefix is empty, the induction hypothesis is exactly what we want. *) 127 | subst. 128 | cbn. 129 | assumption. 130 | * (* Otherwise, we only have to apply the constructor and use the IH. *) 131 | apply (mk_star_more R s (a :: p) q); try assumption. 132 | trivial. 133 | listerine. 134 | Qed. 135 | 136 | Local Proposition star_lang_ex_ind_better: 137 | forall (R : lang) (P : str -> Prop), 138 | (* base case *) 139 | P [] -> 140 | (* induction step *) 141 | (forall s: str, (exists (p q: str), 142 | p ++ q = s /\ 143 | p <> [] /\ 144 | p \in R /\ 145 | q \in star_lang_ex R /\ 146 | P q) -> 147 | P s) -> 148 | (* conclusion *) 149 | forall s: str, star_lang_ex R s -> P s. 150 | Proof. 151 | intros R P Hbase Hstep s0 Hs_match0. 152 | refine ( 153 | (fix f s (Hs_match: star_lang_ex R s) {struct Hs_match}: P s := 154 | _) s0 Hs_match0 155 | ). 156 | destruct Hs_match. 157 | - subst. 158 | exact Hbase. 159 | - specialize Hstep with s. 160 | destruct H as [s [p [a [q [Hconcat [Hp_match Hq_match]]]]]]. 161 | pose (f q Hq_match) as IH. 162 | apply Hstep. 163 | exists (a :: p). 164 | exists q. 165 | repeat split; try assumption. 166 | listerine. 167 | Qed. 168 | 169 | Proposition star_lang_ex_equivalent (R: lang): 170 | star_lang R {<->} star_lang_ex R. 171 | Proof. 172 | split. 173 | - intro Hmatch. 174 | induction Hmatch. 175 | + subst. now constructor. 176 | + eapply (mk_star_more_ex R s); try (exact H). 177 | constructor. 178 | destruct p. 179 | * contradiction. 180 | * exists p. 181 | exists a. 182 | exists q. 183 | exists H. 184 | split; assumption. 185 | - intro Hmatch. 186 | apply (star_lang_ex_ind_better R (star_lang R)). 187 | + now constructor. 188 | + intros. 189 | destruct H as [p [q [Hconcat [ Hnon_empty [ Hp_match [Hq_match IH]]]]]]. 190 | constructor 2 with (p := p) (q := q); assumption. 191 | + assumption. 192 | Qed. 193 | 194 | Local Proposition star_lang_ex_empty_ind_better: 195 | forall (R : lang) (P : str -> Prop), 196 | (* base case *) 197 | P [] -> 198 | (* induction step *) 199 | (forall s: str, (exists (p q: str), 200 | p ++ q = s /\ 201 | p \in R /\ 202 | q \in star_lang_ex_empty R /\ 203 | P q) -> 204 | P s) -> 205 | (* conclusion *) 206 | forall s: str, star_lang_ex_empty R s -> P s. 207 | Proof. 208 | intros R P Hbase Hstep s0 Hs_match0. 209 | refine ( 210 | (fix f s (Hs_match: star_lang_ex_empty R s) {struct Hs_match}: P s := 211 | _) s0 Hs_match0 212 | ). 213 | destruct Hs_match. 214 | - subst. 215 | exact Hbase. 216 | - specialize Hstep with s. 217 | destruct H as [s [p [q [Hconcat [Hp_match Hq_match]]]]]. 218 | pose (f q Hq_match) as IH. 219 | apply Hstep. 220 | exists p. 221 | exists q. 222 | repeat split; try assumption. 223 | Qed. 224 | 225 | Proposition star_lang_ex_empty_equivalent (R: lang): 226 | star_lang R {<->} star_lang_ex_empty R. 227 | Proof. 228 | split. 229 | - intro Hmatch. 230 | induction Hmatch. 231 | + subst. now constructor. 232 | + eapply (mk_star_more_ex_empty R s); try (exact H). 233 | constructor. 234 | destruct p. 235 | * contradiction. 236 | * exists (a :: p). 237 | exists q. 238 | exists H. 239 | split; assumption. 240 | - intro Hmatch. 241 | apply (star_lang_ex_empty_ind_better R (star_lang R)). 242 | + now constructor. 243 | + intros. 244 | destruct H as [p [q [Hconcat [ Hp_match [Hq_match IH]]]]]. 245 | destruct p. 246 | * subst. cbn. assumption. 247 | * constructor 2 with (p := (a :: p)) (q := q); try assumption. 248 | listerine. 249 | + assumption. 250 | Qed. 251 | 252 | Proposition decompose_star_lang (R: lang): 253 | forall (s: str), 254 | s \in star_lang R 255 | <-> 256 | ( 257 | s = [] 258 | \/ 259 | (exists 260 | (p: str) 261 | (a: alphabet) 262 | (q: str) 263 | (splits: (a :: p) ++ q = s), 264 | (a :: p) \in R 265 | /\ 266 | q \in (star_lang R) 267 | ) 268 | ). 269 | Proof. 270 | intros. 271 | rewrite star_lang_ex_equivalent. 272 | split; intros. 273 | - invs H. 274 | + auto. 275 | + right. 276 | invs H0. 277 | destruct H as [p [a [q [splits [inr instarr]]]]]. 278 | exists p, a, q, splits. 279 | rewrite <- star_lang_ex_equivalent in instarr. 280 | auto. 281 | - invs H. 282 | + constructor. reflexivity. 283 | + destruct H0 as [p [a [q [splits [inr instarr]]]]]. 284 | apply mk_star_more_ex. 285 | constructor. 286 | exists p, a, q, splits. 287 | rewrite star_lang_ex_equivalent in instarr. 288 | auto. 289 | Qed. 290 | -------------------------------------------------------------------------------- /src/Coinduction/Bisimilar.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.Invs. 2 | Require Import CoqStock.List. 3 | 4 | Require Import Brzozowski.Alphabet. 5 | Require Import Brzozowski.Derive. 6 | Require Import Brzozowski.Language. 7 | 8 | CoInductive bisimilar : lang -> lang -> Prop := 9 | | bisim : forall (P Q: lang), 10 | ([] \in P <-> [] \in Q) 11 | /\ 12 | (forall (a: alphabet), 13 | bisimilar (derive_lang a P) (derive_lang a Q) 14 | ) 15 | -> bisimilar P Q. 16 | 17 | Notation "P <<->> Q" := (bisimilar P Q) (at level 80). 18 | 19 | Lemma equivalence_impl_derive_lang_is_equivalent: 20 | forall (P Q: lang) (a: alphabet), 21 | P {<->} Q -> 22 | derive_lang a P {<->} derive_lang a Q. 23 | Proof. 24 | unfold lang_iff. 25 | intros. 26 | unfold derive_lang. 27 | unfold elem. 28 | specialize H with (s := (a :: s)). 29 | assumption. 30 | Qed. 31 | 32 | Lemma equivalence_impl_bisimilar: 33 | forall (P Q: lang), 34 | P {<->} Q -> P <<->> Q. 35 | Proof. 36 | cofix G. 37 | intros. 38 | constructor. 39 | unfold lang_iff in H. 40 | split. 41 | - apply H. 42 | - intros. 43 | apply G. 44 | apply equivalence_impl_derive_lang_is_equivalent. 45 | assumption. 46 | Qed. 47 | 48 | Lemma fold_derive_lang: 49 | forall (R: lang) (a: alphabet) (s: str), 50 | (a :: s) \in R <-> s \in (derive_lang a R). 51 | Proof. 52 | intros. 53 | unfold derive_lang. 54 | unfold elem. 55 | reflexivity. 56 | Qed. 57 | 58 | Lemma bisimilar_impl_equivalence: 59 | forall (P Q: lang), 60 | P <<->> Q -> P {<->} Q. 61 | Proof. 62 | unfold lang_iff. 63 | intros. 64 | generalize dependent P. 65 | generalize dependent Q. 66 | induction s. 67 | - intros. 68 | inversion H. 69 | destruct H0. 70 | assumption. 71 | - intros. 72 | inversion H. 73 | destruct H0. 74 | specialize H3 with (a := a). 75 | subst. 76 | rewrite (fold_derive_lang P a s). 77 | rewrite (fold_derive_lang Q a s). 78 | apply IHs. 79 | assumption. 80 | Qed. 81 | 82 | Theorem bisimilar_is_equivalence: 83 | forall (P Q: lang), 84 | P <<->> Q <-> P {<->} Q. 85 | Proof. 86 | split. 87 | - apply bisimilar_impl_equivalence. 88 | - apply equivalence_impl_bisimilar. 89 | Qed. -------------------------------------------------------------------------------- /src/Coinduction/DeriveTree.v: -------------------------------------------------------------------------------- 1 | Require Import Brzozowski.Alphabet. 2 | Require Import Brzozowski.Derive. 3 | Require Import Brzozowski.Language. 4 | Require Import Brzozowski.Regex. 5 | 6 | CoInductive DeriveTree: Type := 7 | | mk_derive: lang -> (alphabet -> DeriveTree) -> DeriveTree. 8 | 9 | CoFixpoint build_regex_tree (r: regex): DeriveTree := 10 | mk_derive {{r}} (fun a => (build_regex_tree (derive_def r a))). 11 | 12 | CoFixpoint build_lang_tree (l: lang): DeriveTree := 13 | mk_derive l (fun a => (build_lang_tree (derive_lang a l))). -------------------------------------------------------------------------------- /src/Coinduction/Readme.md: -------------------------------------------------------------------------------- 1 | # Automata and Coinduction (An Exercise in Coalgebra) - J.J.M.M. Rutten 2 | 3 | In this we try to play with coinduction on regular expressions to prove simplification rules. We base the idea of the paper: [Automata and Coinduction (An Exercise in Coalgebra) - J.J.M.M. Rutten](https://homepages.cwi.nl/~janr/papers/files-of-papers/1998_CONCUR_automata_and_coinduction.pdf) -------------------------------------------------------------------------------- /src/Coinduction/Setoid.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Setoids.Setoid. 2 | 3 | Require Import Brzozowski.Alphabet. 4 | Require Import Brzozowski.Derive. 5 | Require Import Brzozowski.Language. 6 | Require Import Brzozowski.Setoid. 7 | 8 | Require Import Coinduction.Bisimilar. 9 | 10 | (* bisimilar_setoid makes it possible to use: 11 | - rewrite for proven bisimilar theorems 12 | - reflexivity for bisimilar relations where both sides are equal 13 | *) 14 | 15 | Section BisimilarSetoid. 16 | 17 | Theorem bisimilar_refl : forall A:lang, A <<->> A. 18 | Proof. 19 | intros. 20 | rewrite bisimilar_is_equivalence. 21 | apply Brzozowski.Setoid.lang_iff_refl. 22 | Qed. 23 | 24 | Theorem bisimilar_trans : forall A B C:lang, (A <<->> B) -> (B <<->> C) -> (A <<->> C). 25 | Proof. 26 | intros. 27 | rewrite bisimilar_is_equivalence in *. 28 | apply (Brzozowski.Setoid.lang_iff_trans A B C); assumption. 29 | Qed. 30 | 31 | Theorem bisimilar_sym : forall A B:lang, (A <<->> B) -> (B <<->> A). 32 | Proof. 33 | intros. 34 | rewrite bisimilar_is_equivalence in *. 35 | apply (Brzozowski.Setoid.lang_iff_sym A B); assumption. 36 | Qed. 37 | 38 | Add Parametric Relation: lang bisimilar 39 | reflexivity proved by bisimilar_refl 40 | symmetry proved by bisimilar_sym 41 | transitivity proved by bisimilar_trans as bisimilar_setoid. 42 | 43 | End BisimilarSetoid. 44 | 45 | Existing Instance bisimilar_setoid. 46 | 47 | Add Parametric Morphism : bisimilar 48 | with signature lang_iff ==> lang_iff ==> iff as bisimilar_lang_morphism. 49 | Proof. 50 | intros ?? H ?? H'. 51 | apply bisimilar_is_equivalence in H, H'. 52 | split; intro H0. 53 | now rewrite <- H, H0. 54 | now rewrite H, H'. 55 | Qed. 56 | 57 | Example example_rewriting_using_lang_iff_in_bisimilar: 58 | forall (P Q: lang) 59 | (pq: P {<->} Q), 60 | bisimilar Q P. 61 | Proof. 62 | intros. 63 | rewrite pq. 64 | reflexivity. 65 | Qed. 66 | 67 | Add Parametric Morphism: or_lang 68 | with signature bisimilar ==> bisimilar ==> bisimilar as or_bisim_morph. 69 | Proof. 70 | intros. 71 | rewrite bisimilar_is_equivalence in *. 72 | apply or_lang_morph; assumption. 73 | Qed. 74 | 75 | Add Parametric Morphism: neg_lang 76 | with signature bisimilar ==> bisimilar as neg_bisim_morph. 77 | Proof. 78 | intros. 79 | rewrite bisimilar_is_equivalence in *. 80 | apply neg_lang_morph; assumption. 81 | Qed. 82 | 83 | Add Parametric Morphism: concat_lang 84 | with signature bisimilar ==> bisimilar ==> bisimilar as concat_bisim_morph. 85 | Proof. 86 | intros. 87 | rewrite bisimilar_is_equivalence in *. 88 | apply concat_lang_morph; assumption. 89 | Qed. 90 | 91 | Add Parametric Morphism: star_lang 92 | with signature bisimilar ==> bisimilar as star_bisim_morph. 93 | Proof. 94 | intros. 95 | rewrite bisimilar_is_equivalence in *. 96 | apply star_lang_morph; assumption. 97 | Qed. 98 | 99 | Add Parametric Morphism {s: str}: (elem s) 100 | with signature bisimilar ==> iff 101 | as elem_bisim_morph. 102 | Proof. 103 | intros. 104 | rewrite bisimilar_is_equivalence in *. 105 | apply elem_morph; assumption. 106 | Qed. 107 | 108 | Add Parametric Morphism {s: str}: (derive_langs s) 109 | with signature bisimilar ==> bisimilar 110 | as derive_langs_bisim_morph. 111 | Proof. 112 | intros. 113 | rewrite bisimilar_is_equivalence in *. 114 | apply derive_langs_morph; assumption. 115 | Qed. 116 | 117 | Add Parametric Morphism {a: alphabet}: (derive_lang a) 118 | with signature bisimilar ==> bisimilar 119 | as derive_lang_bism_morph. 120 | Proof. 121 | intros. 122 | rewrite bisimilar_is_equivalence in *. 123 | apply derive_lang_morph; assumption. 124 | Qed. 125 | -------------------------------------------------------------------------------- /src/Coinduction/Simplify.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.micromega.Lia. 2 | 3 | Require Import CoqStock.Invs. 4 | Require Import CoqStock.List. 5 | Require Import CoqStock.Untie. 6 | 7 | Require Import Brzozowski.Alphabet. 8 | Require Import Brzozowski.Decidable. 9 | Require Import Brzozowski.Derive. 10 | Require Import Brzozowski.DeriveCommutes. 11 | Require Import Brzozowski.Language. 12 | Require Import Brzozowski.LogicOp. 13 | Require Import Brzozowski.Regex. 14 | 15 | Require Import Coinduction.Bisimilar. 16 | Require Import Coinduction.Setoid. 17 | 18 | Lemma or_emptyset_is_l_helper: 19 | forall (r: regex), 20 | [] \in or_lang {{r}} emptyset_lang <-> [] \in {{r}}. 21 | Proof. 22 | intros. 23 | split; intros. 24 | - invs H. 25 | invs H0. 26 | + assumption. 27 | + invs H. 28 | - auto with lang. 29 | Qed. 30 | 31 | 32 | (* First example from the paper *) 33 | Theorem or_emptyset_is_l: forall (r: regex), 34 | bisimilar 35 | (or_lang {{r}} emptyset_lang) 36 | {{r}}. 37 | Proof. 38 | cofix G. 39 | intros. 40 | constructor. 41 | split. 42 | - apply or_emptyset_is_l_helper. 43 | - intros. 44 | specialize G with (r := (derive_def r a)). 45 | rewrite <- (derive_commutes_a r a) in G. 46 | specialize (derive_commutes_a (or r emptyset) a) as D. 47 | rewrite D. 48 | Fail Guarded. 49 | cbn. 50 | specialize (derive_commutes_a r a) as D1. 51 | rewrite <- D1. 52 | assumption. 53 | (* TODO: Help Wanted *) 54 | Abort. 55 | 56 | Theorem star_star_bisimilar: forall (r: lang), 57 | bisimilar 58 | (star_lang r) 59 | (star_lang (star_lang r)). 60 | Proof. 61 | (* TODO: Help Wanted *) 62 | Abort. 63 | 64 | Theorem or_lang_commutativity_bisimilar: forall (a b: lang), 65 | bisimilar 66 | (or_lang a b) 67 | (or_lang b a). 68 | Proof. 69 | (* TODO: Help Wanted *) 70 | Abort. 71 | 72 | Theorem concat_lang_assoc_bisimilar: forall (a b c: lang), 73 | bisimilar 74 | (concat_lang a (concat_lang b c)) 75 | (concat_lang (concat_lang a b) c). 76 | Proof. 77 | (* TODO: Help Wanted *) 78 | Abort. 79 | 80 | Theorem concat_lang_emptyset_l_bisimilar_emptyset: forall (r: lang), 81 | bisimilar 82 | (concat_lang emptyset_lang r) 83 | emptyset_lang. 84 | Proof. 85 | (* TODO: Help Wanted *) 86 | Abort. -------------------------------------------------------------------------------- /src/Coinduction/Trace.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.Invs. 2 | Require Import CoqStock.List. 3 | 4 | Require Import Brzozowski.Alphabet. 5 | Require Import Brzozowski.Derive. 6 | Require Import Brzozowski.DeriveCommutes. 7 | Require Import Brzozowski.Language. 8 | Require Import Brzozowski.Null. 9 | Require Import Brzozowski.NullCommutes. 10 | Require Import Brzozowski.Regex. 11 | 12 | CoInductive Trace: regex -> lang := 13 | | empty_trace : forall q:regex, null_def q = emptystr -> Trace q [] 14 | | cons_trace : 15 | forall (q q':regex) (a:alphabet) (s:str), 16 | derive_def q a = q' -> Trace q' s -> Trace q (a :: s). 17 | 18 | Theorem trace_is_equivalent: 19 | forall (p: regex), 20 | {{p}} {<->} Trace p. 21 | Proof. 22 | intros. 23 | split; intros. 24 | - generalize dependent p. 25 | generalize dependent s. 26 | cofix G. 27 | intros. 28 | unfold "\in". 29 | (* `induction s` would break Guarded *) 30 | destruct s. 31 | + constructor. 32 | rewrite null_iff_null_def. 33 | constructor. 34 | assumption. 35 | Guarded. 36 | + apply (cons_trace p (derive_def p a) a). 37 | * reflexivity. 38 | * specialize G with (s := s) (p := (derive_def p a)). 39 | apply G. 40 | rewrite <- derive_commutes_a. 41 | assumption. 42 | Guarded. 43 | - generalize dependent p. 44 | induction s. 45 | + intros. 46 | inversion H. 47 | rewrite null_iff_null_def in H0. 48 | invs H0. 49 | assumption. 50 | + intros. 51 | specialize IHs with (p := (derive_def p a)). 52 | replace ((a :: s) \in {{p}}) with (s \in (derive_lang a {{p}})). 53 | * rewrite derive_commutes_a. 54 | apply IHs. 55 | invs H. 56 | assumption. 57 | * unfold derive_lang. 58 | unfold "\in". 59 | reflexivity. 60 | Qed. 61 | -------------------------------------------------------------------------------- /src/CoqStock/DubStep.v: -------------------------------------------------------------------------------- 1 | (* DubStep 2 | "Beware of the drop!" 3 | 4 | Essentially the dubstep tactic evaluates a targeted function. 5 | Before this tactic used to unfold and fold a targeted function. 6 | It sounds like this would not really do much, 7 | but if used correctly it makes the targeted function take a step forward. 8 | Unlike the cbn in general and simpl tactics, which would make all functions calculate as much as they can. 9 | 10 | If you are unfamiliar with dubstep, here is a tutorial: 11 | [UKF Dubstep Tutorial - Dubba Jonny](https://www.youtube.com/watch?v=CJzfTZlEl40) 12 | *) 13 | 14 | Ltac dubstep_goal F := 15 | cbn [F]. 16 | (* unfold F; fold F. *) 17 | 18 | Ltac dubstep_in F H := 19 | cbn [F] in H. 20 | (* unfold F in H; fold F in H. *) 21 | 22 | Tactic Notation "dubstep" constr(F) := (dubstep_goal F). 23 | Tactic Notation "dubstep" constr(F) "in" hyp(H) := (dubstep_in F H). 24 | 25 | Require Import Nat. 26 | Require Import Arith. 27 | 28 | Fixpoint sum_n (n: nat): nat := 29 | match n with 30 | | O => 0 31 | | (S n') => n + sum_n n' 32 | end. 33 | 34 | Example example_sum_n_is_n_mul_sn: forall (n: nat), 35 | 2 * sum_n n = n * (n + 1). 36 | Proof. 37 | induction n. 38 | - simpl. 39 | reflexivity. 40 | - (* 2 * sum_n (S n) = S n * (S n + 1) *) 41 | dubstep sum_n. 42 | (* 2 * (S n + sum_n n) = S n * (S n + 1) *) 43 | rewrite Nat.mul_add_distr_l. 44 | rewrite IHn. 45 | ring. 46 | Qed. 47 | 48 | Example example_sum_n_is_n_mul_ssn: forall (n: nat), 49 | 2 * sum_n (S n) = (S n) * ((S n) + 1). 50 | Proof. 51 | induction n. 52 | - simpl. 53 | reflexivity. 54 | - dubstep sum_n in IHn. 55 | dubstep sum_n. 56 | rewrite Nat.mul_add_distr_l. 57 | rewrite IHn. 58 | ring. 59 | Qed. -------------------------------------------------------------------------------- /src/CoqStock/Invs.v: -------------------------------------------------------------------------------- 1 | (* 2 | invs tactic is like inversion, but cleans up after itself and is shorter to type. 3 | *) 4 | 5 | Ltac invs H := 6 | inversion H; 7 | clear H; 8 | subst. 9 | 10 | Example example_invs_exists: forall (x: nat) (e: exists (y: nat), x = S y /\ y = O), 11 | x = S O. 12 | Proof. 13 | intros. 14 | invs e. 15 | invs H. 16 | reflexivity. 17 | Qed. -------------------------------------------------------------------------------- /src/CoqStock/Lem.v: -------------------------------------------------------------------------------- 1 | (* LEM: Law of excluded middle 2 | This module contains Theorems that are surprising to see 3 | requires LEM: `P /\ ~ P` 4 | or does not require LEM. 5 | *) 6 | 7 | Require Import CoqStock.WreckIt. 8 | 9 | Theorem move_forall_inside_orl: forall (A: Type) (P: A -> Prop) (Q: Prop) (a : A), 10 | (forall x, P x) \/ Q 11 | -> (forall x, P x \/ Q). 12 | Proof. 13 | intros. 14 | wreckit. 15 | - specialize H with x. 16 | left. 17 | assumption. 18 | - right. 19 | assumption. 20 | Qed. 21 | 22 | Theorem move_forall_outside_orl: forall (A: Type) (P: A -> Prop) (Q: Prop) (a : A), 23 | Q \/ ~ Q 24 | -> ( 25 | (forall x, P x \/ Q) 26 | -> (forall x, P x) \/ Q 27 | ). 28 | Proof. 29 | intros. 30 | wreckit. 31 | - right. 32 | assumption. 33 | - left. 34 | intros. 35 | specialize H0 with x. 36 | wreckit. 37 | + assumption. 38 | + contradiction. 39 | Qed. 40 | -------------------------------------------------------------------------------- /src/CoqStock/List.v: -------------------------------------------------------------------------------- 1 | (* 2 | This module replaces the standard library's List module. 3 | It reexports Coq.Lists.List and Coq.Lists.List.ListNotations. 4 | It includes extra theorems about lists. 5 | *) 6 | 7 | Require Export Coq.Lists.List. 8 | Export Coq.Lists.List.ListNotations. 9 | Require Import Coq.micromega.Lia. 10 | 11 | Create HintDb list. 12 | 13 | Theorem length_zero_string_is_empty {A: Type} (xs: list A): 14 | length xs = 0 -> xs = []. 15 | Proof. 16 | apply length_zero_iff_nil. 17 | Qed. 18 | 19 | (* The command Hint Resolve adds a new candidate proof step *) 20 | #[export] 21 | Hint Resolve length_zero_string_is_empty: list. 22 | 23 | Example example_length_zero_string_is_empty_with_auto {A: Type} (xs: list A): 24 | length xs = 0 -> xs = []. 25 | Proof. 26 | debug auto with list. (* To see steps taken, see: debug auto with list *) 27 | Qed. 28 | 29 | #[export] 30 | Hint Resolve 31 | Coq.Lists.List.nil_cons (* [] <> x :: l *) 32 | Coq.Lists.List.app_nil_l (* [] ++ l = l *) 33 | Coq.Lists.List.app_nil_r (* l ++ [] = l *) 34 | Coq.Lists.List.app_assoc (* l ++ m ++ n = (l ++ m) ++ n *) 35 | Coq.Lists.List.app_assoc_reverse (* (l ++ m) ++ n = l ++ m ++ n *) 36 | Coq.Lists.List.app_comm_cons (* a :: (x ++ y) = (a :: x) ++ y *) 37 | Coq.Lists.List.app_cons_not_nil (* [] <> x ++ a :: y *) 38 | Coq.Lists.List.app_eq_unit (* x ++ y = [a] -> x = [] /\ y = [a] \/ x = [a] /\ y = [] *) 39 | Coq.Lists.List.app_inj_tail (* x ++ [a] = y ++ [b] -> x = y /\ a = b *) 40 | Coq.Lists.List.app_nil_end (* l = l ++ [] *) 41 | Coq.Lists.List.app_length (* length (l++l') = length l + length l' *) 42 | Coq.Lists.List.last_length (* length (l ++ a :: nil) = S (length l) *) 43 | : list. 44 | 45 | Hint Rewrite 46 | Coq.Lists.List.app_nil_l (* [] ++ l = l *) 47 | Coq.Lists.List.app_nil_r (* l ++ [] = l *) 48 | Coq.Lists.List.app_length (* length (l++l') = length l + length l' *) 49 | Coq.Lists.List.last_length (* length (l ++ a :: nil) = S (length l) *) 50 | : list. 51 | 52 | #[export] 53 | Hint Unfold 54 | Init.Logic.iff 55 | Init.Logic.not 56 | : list. 57 | 58 | #[export] 59 | Hint Constructors 60 | Coq.Init.Logic.and 61 | Coq.Init.Logic.or 62 | : list. 63 | 64 | Theorem lessthan_zero_is_zero: 65 | forall (n: nat), 66 | n <= 0 -> n = 0. 67 | Proof. 68 | intros. 69 | inversion H. 70 | reflexivity. 71 | Qed. 72 | 73 | #[export] 74 | Hint Resolve 75 | lessthan_zero_is_zero 76 | : list. 77 | 78 | Theorem length_zero_or_smaller_string_is_empty {A: Type} (xs: list A): 79 | length xs <= 0 -> xs = []. 80 | Proof. 81 | intros. 82 | assert (length xs = 0). 83 | lia. 84 | rewrite length_zero_iff_nil in *. 85 | assumption. 86 | Qed. 87 | 88 | (* 89 | We can now prove the same theorem as 90 | `length_zero_or_smaller_string_is_empty` 91 | simply with `auto with list`, 92 | given all the hints we have added to the `list` database. 93 | *) 94 | Example example_length_zero_or_smaller_string_is_empty_with_auto {A: Type} (xs: list A): 95 | length xs <= 0 -> xs = []. 96 | Proof. 97 | auto with list. 98 | Qed. 99 | 100 | #[export] 101 | Hint Resolve 102 | Coq.Lists.List.firstn_nil (* firstn n [] = [] *) 103 | Coq.Lists.List.firstn_cons (* firstn (S n) (a::l) = a :: (firstn n l) *) 104 | Coq.Lists.List.firstn_all (* firstn (length l) l = l *) 105 | Coq.Lists.List.firstn_all2 (* (length l) <= n -> firstn n l = l *) 106 | Coq.Lists.List.firstn_O (* firstn 0 l = [] *) 107 | Coq.Lists.List.firstn_le_length (* length (firstn n l) <= n *) 108 | Coq.Lists.List.firstn_length_le (* n <= length l -> length (firstn n l) = n *) 109 | Coq.Lists.List.firstn_app (* firstn n (l1 ++ l2) = (firstn n l1) ++ (firstn (n - length l1) l2) *) 110 | Coq.Lists.List.firstn_app_2 (* firstn ((length l1) + n) (l1 ++ l2) = l1 ++ firstn n l2 *) 111 | Coq.Lists.List.firstn_firstn (* firstn i (firstn j l) = firstn (min i j) l *) 112 | Coq.Lists.List.firstn_skipn_comm (* firstn m (skipn n l) = skipn n (firstn (n + m) l) *) 113 | Coq.Lists.List.skipn_firstn_comm (* skipn m (firstn n l) = firstn (n - m) (skipn m l) *) 114 | Coq.Lists.List.skipn_O (* skipn 0 l = l *) 115 | Coq.Lists.List.skipn_nil (* skipn n ([] : list A) = [] *) 116 | Coq.Lists.List.skipn_cons (* skipn (S n) (a::l) = skipn n l *) 117 | Coq.Lists.List.skipn_all (* skipn (length l) l = nil *) 118 | Coq.Lists.List.skipn_all2 (* length l <= n -> skipn n l = [] *) 119 | Coq.Lists.List.firstn_skipn (* firstn n l ++ skipn n l = l *) 120 | Coq.Lists.List.firstn_length (* length (firstn n l) = min n (length l) *) 121 | Coq.Lists.List.skipn_length (* length (skipn n l) = length l - n *) 122 | Coq.Lists.List.skipn_app (* skipn n (l1 ++ l2) = (skipn n l1) ++ (skipn (n - length l1) l2) *) 123 | : list. 124 | 125 | Hint Rewrite 126 | Coq.Lists.List.firstn_nil (* firstn n [] = [] *) 127 | Coq.Lists.List.firstn_cons (* firstn (S n) (a::l) = a :: (firstn n l) *) 128 | Coq.Lists.List.firstn_all (* firstn (length l) l = l *) 129 | Coq.Lists.List.firstn_O (* firstn 0 l = [] *) 130 | Coq.Lists.List.skipn_O (* skipn 0 l = l *) 131 | Coq.Lists.List.skipn_nil (* skipn n ([] : list A) = [] *) 132 | Coq.Lists.List.skipn_cons (* skipn (S n) (a::l) = skipn n l *) 133 | Coq.Lists.List.skipn_all (* skipn (length l) l = nil *) 134 | Coq.Lists.List.skipn_length (* length (skipn n l) = length l - n *) 135 | Coq.Lists.List.firstn_skipn (* firstn n l ++ skipn n l = l *) 136 | : list. 137 | 138 | Theorem firstn_app_length {A: Type} (xs ys: list A): 139 | firstn (length xs) (xs ++ ys) = xs. 140 | Proof. 141 | intros. 142 | set (firstn_app (length xs) xs ys) as Hfirst. 143 | replace (length xs - length xs) with 0 in * by lia. 144 | rewrite app_nil_r in Hfirst. 145 | replace (firstn (length xs) xs) with xs in Hfirst by (symmetry; apply firstn_all). 146 | assumption. 147 | Qed. 148 | 149 | Theorem skipn_app_length {A: Type} (xs ys: list A): 150 | skipn (length xs) (xs ++ ys) = ys. 151 | Proof. 152 | intros. 153 | set (skipn_app (length xs) xs ys) as Hlast. 154 | replace (length xs - length xs) with 0 in * by lia. 155 | replace (skipn (length xs) xs) with (nil: list A) in Hlast by (symmetry; apply skipn_all). 156 | rewrite app_nil_l in Hlast. 157 | replace (skipn 0 ys) with ys in Hlast by (apply skipn_O). 158 | assumption. 159 | Qed. 160 | 161 | #[export] 162 | Hint Resolve 163 | firstn_app_length 164 | skipn_app_length 165 | : list. 166 | 167 | Theorem split_list {A: Type} (xs: list A) (n : nat): 168 | forall (ys zs: list A), 169 | length ys = n -> 170 | xs = ys ++ zs -> 171 | ys = firstn n xs /\ 172 | zs = skipn n xs. 173 | Proof. 174 | intros. 175 | subst. 176 | auto with list. 177 | Qed. 178 | 179 | Lemma prefix_leq_length {A: Type} (xs ys zs: list A): 180 | xs = ys ++ zs -> length ys <= length xs. 181 | Proof. 182 | intro H. 183 | subst. 184 | autorewrite with list. 185 | lia. 186 | Qed. 187 | 188 | #[export] 189 | Hint Resolve 190 | split_list 191 | prefix_leq_length 192 | : list. 193 | 194 | Lemma skipn_length_prefix_is_suffix {A: Type} (prefix suffix: list A): 195 | skipn (length prefix) (prefix ++ suffix) = suffix. 196 | Proof. 197 | auto with list. 198 | Qed. 199 | 200 | (* TODO: Help Wanted 201 | Cannot infer the implicit parameter A of skipn_length_prefix_is_suffix 202 | whose type is "Type". 203 | Hint Rewrite 204 | skipn_length_prefix_is_suffix 205 | : list. 206 | *) 207 | 208 | Lemma firstn_length_prefix_is_prefix {A: Type} (prefix suffix: list A): 209 | firstn (length prefix) (prefix ++ suffix) = prefix. 210 | Proof. 211 | auto with list. 212 | Qed. 213 | 214 | (* TODO: Help Wanted 215 | Cannot infer the implicit parameter A of firstn_length_prefix_is_prefix 216 | whose type is "Type". 217 | Hint Rewrite 218 | firstn_length_prefix_is_prefix 219 | : list. 220 | *) 221 | 222 | Theorem prefix_length_leq: 223 | forall {A: Type} (prefix suffix list: list A), 224 | prefix ++ suffix = list -> length prefix <= length list. 225 | Proof. 226 | intros. 227 | rewrite <- H. 228 | autorewrite with list. 229 | auto with arith. 230 | Qed. 231 | 232 | #[export] 233 | Hint Resolve 234 | prefix_length_leq 235 | : list. 236 | 237 | Theorem length_gt_zero: 238 | forall {A: Type} (xs: list A), 239 | xs <> [] -> 0 < length xs. 240 | Proof. 241 | induction xs. 242 | - contradiction. 243 | - cbn. 244 | lia. 245 | Qed. 246 | 247 | #[export] 248 | Hint Resolve 249 | length_gt_zero 250 | : list. 251 | 252 | Theorem prefix_is_gt_zero_and_leq: 253 | forall {A: Type} (prefix suffix list: list A), 254 | (prefix <> []) -> prefix ++ suffix = list -> 255 | (0 < length prefix <= length list). 256 | Proof. 257 | intros. 258 | remember (prefix_length_leq prefix suffix list). 259 | remember (length_gt_zero prefix). 260 | (* This theorem clearly follows by the above theorems. *) 261 | auto. 262 | Qed. 263 | 264 | #[export] 265 | Hint Resolve 266 | prefix_is_gt_zero_and_leq 267 | : list. 268 | 269 | Theorem prefix_is_not_empty_with_index_gt_zero: 270 | forall {A: Type} (xs: list A) (index: nat) (index_range: 0 < index <= length xs), 271 | firstn index xs <> []. 272 | Proof. 273 | intros. 274 | induction index. 275 | - lia. 276 | - destruct index_range. 277 | induction xs. 278 | + cbn in H0. lia. 279 | + cbn. auto with list. 280 | Qed. 281 | 282 | #[export] 283 | Hint Resolve 284 | prefix_is_not_empty_with_index_gt_zero 285 | : list. 286 | -------------------------------------------------------------------------------- /src/CoqStock/Readme.md: -------------------------------------------------------------------------------- 1 | # CoqStock (Standard Library) 2 | 3 | CoqStock refers to chicken stock and is a base (standard library) for our "curry". 4 | 5 | This library is for proofs, tactics, classes, definitions, etc. that we wish existed in the Coq standard library. This wish might come from being naive, since we are still learning Coq, or it might be a legitimate wish. We aren't here to judge. 6 | 7 | The requirement is that it is has nothing to do with regular expressions, but we possibly want to use it to help us prove things about regular expressions. 8 | 9 | Examples include: 10 | - tactics for list 11 | - proofs about list_set 12 | - comparable class 13 | - a semi ring that includes orb 14 | -------------------------------------------------------------------------------- /src/CoqStock/TacticState.v: -------------------------------------------------------------------------------- 1 | (* 2 | TacticState is a tactic helper. 3 | It is used to avoid infinitely loops in your tactic 4 | by marking that a hypothesis has already been visited by your tactic. 5 | The API features 3 tactics: 6 | - add_state: adds a state to the hypothesis as `mk_state (type of H) H` 7 | - has_state: fails if the state has not been added yet 8 | - clear_states: removes all states from the hypothesis 9 | *) 10 | 11 | Inductive state (T: Type) (x: T): Prop := 12 | | mk_state: state T x. 13 | 14 | Ltac is_hyp H := 15 | let T := type of H in 16 | match goal with 17 | | [ HName: T |- _ ] => idtac 18 | | _ => fail 19 | end. 20 | 21 | Ltac add_state E := 22 | tryif is_hyp E 23 | then 24 | let T := type of E in 25 | pose (mk_state _ T) 26 | else 27 | pose (mk_state _ E). 28 | 29 | Ltac has_state E := 30 | tryif is_hyp E 31 | then 32 | let T := type of E in 33 | match goal with 34 | | [ S : state _ T |- _ ] => idtac 35 | | _ => fail "State doesn't contain hypothesis:" E 36 | end 37 | else 38 | match goal with 39 | | [ S : state _ E |- _ ] => idtac 40 | | _ => fail "State doesn't contain:" E 41 | end. 42 | 43 | Ltac clear_states := 44 | repeat ( 45 | match goal with 46 | | [H : state _ _ |- _] => clear H 47 | end 48 | ). 49 | 50 | Example example_state_api: 51 | forall (P Q : Prop), 52 | (P /\ Q) -> P. 53 | Proof. 54 | intros. 55 | Fail (has_state H). 56 | add_state H. 57 | has_state H. 58 | clear_states. 59 | Fail (has_state H). 60 | destruct H. 61 | assumption. 62 | Qed. 63 | 64 | Theorem example_state_api_2: 1 = 1. 65 | Proof. 66 | add_state False. 67 | add_state 2. 68 | add_state (3 = 2). 69 | assert True by constructor. 70 | add_state nat. 71 | has_state 2. 72 | Fail has_state 3. 73 | has_state nat. 74 | Fail has_state Set. 75 | add_state Set. 76 | has_state Set. 77 | clear_states. 78 | Fail has_state 2. 79 | reflexivity. 80 | Qed. 81 | 82 | (* This example resulted in endless loop in previous version of wreck_one *) 83 | Example example_one_is_one: 84 | forall (x: nat), x = 1 -> 1 = 1. 85 | Proof. 86 | intros. 87 | inversion H as [H0]. 88 | add_state H. 89 | (* This failed before. 90 | We now use Tactic Notation to detect the type of expression 91 | and call the appropriate add_state and has_state 92 | *) 93 | has_state H0. 94 | inversion H0 as [H1]. 95 | add_state H1. 96 | inversion s. 97 | has_state H. 98 | Fail has_state nat. 99 | reflexivity. 100 | Qed. -------------------------------------------------------------------------------- /src/CoqStock/Truthy.v: -------------------------------------------------------------------------------- 1 | (* truthy is a module specifically created for the truthy tactic, 2 | which simplifies orb and andb expressions. 3 | *) 4 | 5 | Set Implicit Arguments. 6 | Set Asymmetric Patterns. 7 | 8 | Require Import Coq.Bool.Bool. 9 | Require Import Coq.setoid_ring.Ring. 10 | 11 | (* bool_semi_ring creates a semi ring 12 | , using `or` and `and` boolean expressions 13 | that can be used with the `ring` tactic 14 | *) 15 | Lemma bool_semi_ring: 16 | semi_ring_theory false true orb andb (@eq bool). 17 | Proof. 18 | constructor. 19 | exact Bool.orb_false_l. 20 | exact Bool.orb_comm. 21 | exact Bool.orb_assoc. 22 | exact Bool.andb_true_l. 23 | exact Bool.andb_false_l. 24 | exact Bool.andb_comm. 25 | exact Bool.andb_assoc. 26 | exact Bool.andb_orb_distrib_l. 27 | Qed. 28 | 29 | Add Ring bool_semi_ring: bool_semi_ring 30 | (decidable bool_eq_ok, constants [bool_cst]). 31 | 32 | (* 33 | truthy is a tactic that repeatedly applies: 34 | - the semi ring with orb tactic 35 | - removes duplicates in or expressions 36 | - removes all false values in or expressions 37 | - returns true, if a true is found in an or expression 38 | *) 39 | Ltac truthy := repeat 40 | ( ring 41 | || rewrite orb_diag 42 | || rewrite orb_false_r 43 | || rewrite orb_false_l 44 | || rewrite orb_true_r 45 | || rewrite orb_true_l 46 | ). 47 | 48 | Example example_or_commutativity: forall (a b: bool), 49 | a || b = b || a. 50 | Proof. 51 | intros. 52 | truthy. 53 | Qed. 54 | 55 | Example example_or_idempotency_1: forall (a b: bool), 56 | a || (a || b) = a || b. 57 | Proof. 58 | intros. 59 | truthy. 60 | Qed. 61 | 62 | Example example_or_idempotency_2: forall (a b: bool), 63 | a || b || a = a || b. 64 | Proof. 65 | intros. 66 | truthy. 67 | Qed. 68 | 69 | Example example_or_associativity_1: forall (a b c: bool), 70 | a || b || c = a || (b || c). 71 | Proof. 72 | intros. 73 | truthy. 74 | Qed. 75 | 76 | Example example_or_associativity_2: forall (a b c: bool), 77 | a || (b || c) = b || (a || c). 78 | Proof. 79 | intros. 80 | truthy. 81 | Qed. 82 | 83 | Example example_or_3: forall (a b c: bool), 84 | a || b || (a || c) = a || (b || c). 85 | Proof. 86 | intros. 87 | truthy. 88 | Qed. 89 | 90 | Example example_or_4: forall (a b c d: bool), 91 | a || b || (c || d ) = 92 | a || d || (b || (c || d )). 93 | Proof. 94 | intros. 95 | truthy. 96 | Qed. 97 | 98 | Example example_or_false: forall (a: bool), 99 | a || false = a. 100 | Proof. 101 | intros. 102 | truthy. 103 | Qed. 104 | 105 | Example example_or_true: forall (a: bool), 106 | true || a = true. 107 | Proof. 108 | intros. 109 | truthy. 110 | Qed. 111 | -------------------------------------------------------------------------------- /src/CoqStock/Untie.v: -------------------------------------------------------------------------------- 1 | (* 2 | untie the not 3 | 4 | untie tactic: 5 | unfolds the not in the goal, if there is one. 6 | ``` 7 | ~x => x -> False 8 | ``` 9 | It then turns the expression inside the not, into an hypothesis 10 | ``` 11 | H: x 12 | False 13 | ``` 14 | It attempts to rewrite with the hypothesis, if possible. 15 | If rewrite succeeds, the hypothesis is cleared. 16 | If the resulting hypothesis is also a not, that is applied to the goal again, 17 | thus untying a double not. 18 | Finally tries to apply discriminate and contradiction. 19 | *) 20 | 21 | Ltac untie_step := 22 | match goal with 23 | | [ H: context [?X] |- ?X <> _ ] => 24 | let Heq := fresh "Heq" 25 | in unfold not; 26 | intro Heq; 27 | try (discriminate || contradiction); 28 | rewrite Heq in *; 29 | clear Heq 30 | | [ H: context [?X] |- _ <> ?X ] => 31 | let Heq := fresh "Heq" 32 | in unfold not; 33 | intro Heq; 34 | try (discriminate || contradiction); 35 | rewrite <- Heq in *; 36 | clear Heq 37 | | [ |- not (_) -> False ] => 38 | let H := fresh "H" 39 | in unfold not; 40 | intro H; 41 | apply H 42 | | [ |- ~ _ ] => 43 | unfold not; intro 44 | | [ |- _ ] => 45 | discriminate || contradiction 46 | end. 47 | 48 | Ltac untie := repeat untie_step. 49 | 50 | Example example_subst_0: forall (x: nat), 51 | x = 1 -> x <> 2. 52 | Proof. 53 | intros. 54 | untie. 55 | Qed. 56 | 57 | Example example_subst_1: forall (x: nat), 58 | 1 = x -> x <> 2. 59 | Proof. 60 | intros. 61 | untie. 62 | Qed. 63 | 64 | Example example_subst_2: forall (x: nat), 65 | 1 = x -> 2 <> x. 66 | Proof. 67 | intros. 68 | untie. 69 | Qed. 70 | 71 | Example example_subst_3: forall (x: nat), 72 | x = 1 -> 2 <> x. 73 | Proof. 74 | intros. 75 | untie. 76 | Qed. 77 | 78 | Example example_untie_neq: 5 <> 4. 79 | Proof. 80 | intros. 81 | untie. 82 | Qed. 83 | 84 | Example example_untie_not: forall (x: nat), 85 | x = 4 -> ~ (5 = 4). 86 | Proof. 87 | intros. 88 | untie. 89 | Qed. 90 | 91 | Example example_untie_double_neq: 5 <> 5 -> False. 92 | Proof. 93 | untie. 94 | Qed. -------------------------------------------------------------------------------- /src/CoqStock/WreckIt.v: -------------------------------------------------------------------------------- 1 | (* 2 | WreckIt Ralph 3 | 4 | ████████████████████████████████ 5 | ██████▓▓▓▓█████▓▓▓▓████▓▓▓▓█████ 6 | ████████▓▓▓▓▓▓▓▓▓▓▓██▓▓▓▓███████ 7 | ███▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓███ 8 | █████▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓█████ 9 | █▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓█ 10 | ███▓▓▓▓▓▓▓▓░░░░░░░░░░▓▓▓▓▓▓▓▓███ 11 | █████▓▓▓▓▒▒██░░░░░░██▒▒▓▓▓▓█████ 12 | ███▓▓▓▓▓▓▒▒▒▒██▓▓██▒▒▒▒▓▓▓▓▓▓███ 13 | █▓▓▒▒▒▒▓▓▒▒────▒▒────▒▒▓▓▒▒▒▒▓▓█ 14 | ███░░▒▒▓▓░░──██░▒██──░░▓▓▒▒░░███ 15 | ███░░░░▓▓░░░░▓▓▓▓▓▓░░░░▓▓░░░░███ 16 | ███████░░░░░░▓▓▓▓▓▓░░░░░░███████ 17 | ███████░░░░░░░░░░░░░░░░░░███████ 18 | █████░░░░██▀▀▀▀▀▀▀▀▀▀██░░░░█████ 19 | █████░░████▄▄▄▄▄▄▄▄▄▄████░░█████ 20 | █████░░██████████████████░░█████ 21 | █████░░██▒▒██▓▓▓▓▓▓██▒▒██░░█████ 22 | █████░░██▓█▀▀▀▀▀▀▀▀▀▀█▓██░░█████ 23 | █████░░████▄▄▄▄▄▄▄▄▄▄████░░█████ 24 | ███████░░░░░░░░░░░░░░░░░░███████ 25 | █████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒█████████ 26 | ████████████████████████████████ 27 | 28 | "I'm Gonna Wreck It!" 29 | 30 | wreckit is a tactic to break down: 31 | - exists in hypotheses 32 | - conjuction in hypotheses 33 | - disjunction in hypotheses 34 | - conjuction in the goal 35 | - constructors in the goal that solve the goal. 36 | - inductive predicates that when inverted do not create more goals. 37 | *) 38 | 39 | Require Import CoqStock.TacticState. 40 | 41 | (* wreck_exists: 42 | - finds an exists in the hypotheses 43 | - inverts that hypothesis 44 | - removes that hypothesis and 45 | - substitutes all variables 46 | ``` 47 | H: exists x : ?X, ?Y 48 | -> 49 | x: ?X 50 | H: ?Y 51 | ``` 52 | *) 53 | Ltac wreck_exists H := 54 | match type of H with 55 | | exists E, _ = _ => 56 | destruct H as [E H]; 57 | try rewrite H in *; 58 | try wreck_exists H 59 | | exists E, _ => 60 | destruct H as [E H]; 61 | try wreck_exists H 62 | end. 63 | 64 | Tactic Notation "wreck_exists" "in" hyp(H) := 65 | wreck_exists H. 66 | 67 | Tactic Notation "wreck_exists" "in" "*" := 68 | match goal with 69 | | [ H: exists _, _ = _ |- _ ] => 70 | wreck_exists in H 71 | | [ H: exists _, _ |- _ ] => 72 | wreck_exists in H 73 | end. 74 | 75 | Example example_wreck_exists: forall (x: nat) (e: exists (y: nat) (z: nat), x = S y /\ y = O), 76 | x = S O. 77 | Proof. 78 | intros. 79 | wreck_exists in e. 80 | inversion_clear e. 81 | subst. 82 | reflexivity. 83 | Qed. 84 | 85 | Example example_wreck_exists_neq: forall (x: nat) (e: exists (y: nat), x = S y), 86 | x <> O. 87 | Proof. 88 | intros. 89 | wreck_exists in *. 90 | discriminate. 91 | Qed. 92 | 93 | (* wreck_conj: 94 | - finds a conjunction in the hypotheses 95 | - inverts that hypothesis 96 | - clears that hypothesis 97 | - substitutes all variables 98 | ``` 99 | H: ?X /\ ?Y -> 100 | H_left: ?X 101 | H_right: ?Y 102 | ``` 103 | *) 104 | Ltac wreck_conj H := 105 | match type of H with 106 | | _ /\ _ => 107 | let L := fresh H in 108 | destruct H as [L H]; 109 | try rewrite L in *; 110 | try rewrite H in *; 111 | try wreck_conj H 112 | end. 113 | 114 | Tactic Notation "wreck_conj" "in" hyp(H) := 115 | wreck_conj H. 116 | 117 | Tactic Notation "wreck_conj" "in" "*" := 118 | match goal with 119 | | [ H: _ /\ _ |- _ ] => 120 | wreck_conj in H 121 | end. 122 | 123 | Example example_wreck_conj: forall (x: nat) (e: exists (y: nat), x = S y /\ y = O), 124 | x = S O. 125 | Proof. 126 | intros. 127 | wreck_exists in *. 128 | wreck_conj in e. 129 | reflexivity. 130 | Qed. 131 | 132 | Example example_wreck_conj2: forall (P Q R :Prop), 133 | P /\ Q /\ R -> R. 134 | Proof. 135 | intros. 136 | wreck_conj in H. 137 | assumption. 138 | Qed. 139 | 140 | Ltac wreck_conj_as H I := 141 | match type of H with 142 | | _ /\ _ => 143 | destruct H as I 144 | end. 145 | 146 | Tactic Notation "wreck_conj" "in" hyp(H) "as" simple_intropattern(I) := 147 | wreck_conj_as H I. 148 | 149 | Example example_wreck_conj2_as: forall (P Q R :Prop), 150 | P /\ Q /\ R -> R. 151 | Proof. 152 | intros. 153 | wreck_conj in H as [Hone [Htwo Hthree]]. 154 | assumption. 155 | Qed. 156 | 157 | (* wreck_disj: 158 | - finds a disjunction in the hypotheses 159 | - inverts that hypothesis 160 | - clears that hypothesis 161 | ``` 162 | H: ?X \/ ?Y -> 163 | 2 goals 164 | - H1: ?X 165 | - H2: ?Y 166 | ``` 167 | *) 168 | Ltac wreck_disj H := 169 | match type of H with 170 | | _ \/ _ => 171 | let L := fresh H 172 | in destruct H as [H | H]; 173 | try rewrite H in *; 174 | try wreck_disj H 175 | end. 176 | 177 | Tactic Notation "wreck_disj" "in" hyp(H) := 178 | wreck_disj H. 179 | 180 | Tactic Notation "wreck_disj" "in" "*" := 181 | match goal with 182 | | [ H: _ \/ _ |- _ ] => 183 | wreck_disj in H 184 | end. 185 | 186 | Example example_wreck_disj: forall (x: nat) (p: x = 0 \/ x = 1), 187 | x < 2. 188 | Proof. 189 | intros. 190 | wreck_disj in p. 191 | - auto. 192 | - auto. 193 | Qed. 194 | 195 | Example example_wreck_disj2: forall (x: nat) (p: x = 0 \/ x = 1 \/ x = 2), 196 | x < 3. 197 | Proof. 198 | intros. 199 | wreck_disj in p. 200 | - auto. 201 | - auto. 202 | - auto. 203 | Qed. 204 | 205 | Ltac wreck_disj_as H I := 206 | match type of H with 207 | | _ \/ _ => 208 | destruct H as I 209 | end. 210 | 211 | Tactic Notation "wreck_disj" "in" hyp(H) "as" simple_intropattern(I) := 212 | wreck_disj_as H I. 213 | 214 | Example example_wreck_disj2_as: forall (x: nat) (p: x = 0 \/ x = 1 \/ x = 2), 215 | x < 3. 216 | Proof. 217 | intros. 218 | wreck_disj in p as [p | [p | p]]. 219 | - subst. auto. 220 | - subst. auto. 221 | - subst. auto. 222 | Qed. 223 | 224 | Local Theorem conj2: forall (P: Prop), 225 | P -> P /\ P. 226 | Proof. 227 | intros. 228 | constructor; assumption. 229 | Qed. 230 | 231 | (* constructor_conj 232 | If the goal is a conjuction, 233 | then deconstruct it into two goals. 234 | ``` 235 | ?X /\ ?Y -> 236 | 2 goals 237 | - ?X 238 | - ?Y 239 | ``` 240 | or one goal if possible 241 | ``` 242 | ?X /\ ?X -> ?X 243 | ``` 244 | *) 245 | Ltac constructor_conj := 246 | match goal with 247 | | [ |- ?X /\ ?X ] => 248 | apply conj2 249 | | [ |- _ /\ _ ] => 250 | apply conj 251 | end. 252 | 253 | Example example_constructor_conj: forall (x: nat) (p: x = 0), 254 | x < 2 /\ x < 3. 255 | Proof. 256 | intros. 257 | constructor_conj. 258 | - rewrite p. 259 | auto. 260 | - rewrite p. 261 | auto. 262 | Qed. 263 | 264 | Example example_duplicate_conj: forall (x: nat) (p: x = 0), 265 | x < 2 /\ x < 2. 266 | Proof. 267 | intros. 268 | constructor_conj. 269 | rewrite p. 270 | auto. 271 | Qed. 272 | 273 | (* constructor_zero 274 | apply constructor only if it solves the goal 275 | *) 276 | Ltac constructor_zero := 277 | constructor; fail. 278 | 279 | Example example_constructor_zero: 280 | True -> True. 281 | Proof. 282 | intros. 283 | constructor_zero. 284 | Qed. 285 | 286 | Example example_constructor_zero_fail: 287 | True -> True /\ True. 288 | Proof. 289 | intros. 290 | Fail constructor_zero. 291 | Abort. 292 | 293 | (* wreck_one 294 | If the goal is an inductive predicate, 295 | then deconstruct it only if it does not create extra goals. 296 | ``` 297 | H: ?X /\ ?Y -> 298 | H0: ?X 299 | H1: ?Y 300 | ``` 301 | or given the following inductive type, 302 | which simply boxes a type: 303 | ``` 304 | Inductive box (T: Type) := 305 | | mk_box: T -> box T. 306 | ``` 307 | inverts the box: 308 | ``` 309 | box False -> 310 | False 311 | ``` 312 | *) 313 | Ltac wreck_one H := 314 | tryif has_state H 315 | then 316 | fail 317 | else 318 | ( 319 | (* inversion completes the proof *) 320 | inversion H; fail 321 | ) || ( 322 | (* inversion doesn't create an extra goal *) 323 | let Hi := fresh H in 324 | inversion H as [Hi]; 325 | add_state H; 326 | try wreck_one Hi 327 | ). 328 | (* TODO: Help Wanted 329 | Question: 330 | We found that `tryif has_state H then fail` is necessary, 331 | but we would think that `has_state H ||` would have worked. 332 | Why is tryif necessary in this case? 333 | *) 334 | 335 | Tactic Notation "wreck_one" "in" hyp(H) := 336 | wreck_one H. 337 | 338 | Tactic Notation "wreck_one" "in" "*" := 339 | match goal with 340 | | [ H: _ |- _ ] => 341 | wreck_one H 342 | end. 343 | 344 | Inductive example_type_for_inversion (T: Type) := 345 | | example_constructor: T -> example_type_for_inversion T. 346 | 347 | Example example_invert_one: 348 | example_type_for_inversion (example_type_for_inversion (2 = 3)) -> False. 349 | Proof. 350 | intros. 351 | wreck_one in H. 352 | Qed. 353 | 354 | Example example_invert_one_conj: 355 | forall (P Q : Prop), 356 | (P /\ Q) -> P. 357 | Proof. 358 | intros. 359 | wreck_one in H. 360 | assumption. 361 | Qed. 362 | 363 | Example example_invert_zero: 364 | forall (P: Prop), 365 | False -> P. 366 | Proof. 367 | intros. 368 | wreck_one in H. 369 | Qed. 370 | 371 | Example example_invert_one_disj_fail: 372 | forall (P Q : Prop), 373 | (P \/ Q) -> Q \/ P. 374 | Proof. 375 | intros. 376 | Fail wreck_one in H. 377 | Abort. 378 | 379 | Example example_invert_one_noop_because_two_goals: 380 | forall (P Q : Prop), 381 | (P \/ Q) -> Q \/ P. 382 | Proof. 383 | intros. 384 | Fail wreck_one in H. 385 | Abort. 386 | 387 | Example example_invert_one_multiple_hypotheses: 388 | forall (P Q R : Prop), 389 | (P /\ Q) -> P /\ R -> P. 390 | Proof. 391 | intros. 392 | wreck_one in *. 393 | wreck_one in *. 394 | has_state H0. 395 | Fail wreck_one. 396 | assumption. 397 | Qed. 398 | 399 | Ltac wreck_one_as H I := 400 | inversion H as I. 401 | 402 | Tactic Notation "wreck_one" "in" hyp(H) "as" simple_intropattern(I) := 403 | wreck_one_as H I. 404 | 405 | Example example_wreck_one_as: 406 | forall (P Q : Prop), 407 | (P /\ Q) -> P. 408 | Proof. 409 | intros. 410 | wreck_one in H as [H1 H2]. 411 | exact H1. 412 | Qed. 413 | 414 | (* wreckit_step is helpful for seeing what wreckit does step by step *) 415 | Ltac wreckit_step := 416 | wreck_exists in * 417 | || wreck_conj in * 418 | || wreck_disj in * 419 | || constructor_conj 420 | || constructor_zero 421 | || wreck_one in * 422 | . 423 | 424 | Ltac wreckit := repeat wreckit_step ; clear_states. 425 | 426 | Tactic Notation "wreckit" "in" hyp(H) := 427 | wreck_exists in H 428 | || wreck_conj in H 429 | || wreck_disj in H 430 | || wreck_one in H 431 | . 432 | 433 | Example example_wreckit: forall (x: nat) (e: exists (y: nat), x = S y /\ y = O), 434 | x = S O /\ S O = x. 435 | Proof. 436 | intros. 437 | wreckit; reflexivity. 438 | Qed. 439 | 440 | (* This example resulted in endless loop in previous version of wreck_one *) 441 | Example example_one_is_one: 442 | forall (x: nat), x = 1 -> 1 = 1. 443 | Proof. 444 | intros. 445 | wreckit; auto. 446 | Qed. 447 | 448 | Example example_wreckit_disj: forall (x: nat) (e: exists (y: nat), (x = S y \/ S y = x) /\ y = O), 449 | x = S O \/ S O = x. 450 | Proof. 451 | intros. 452 | wreckit; auto. 453 | Qed. 454 | 455 | Example example_wreckit_inversion: example_type_for_inversion (example_type_for_inversion (2 = 3)) -> False. 456 | Proof. 457 | intros. 458 | wreckit in H. 459 | Qed. 460 | 461 | Tactic Notation "wreckit" "in" hyp(H) "as" simple_intropattern(I) := 462 | wreck_conj in H as I 463 | || wreck_disj in H as I 464 | || wreck_one in H as I 465 | . 466 | 467 | Example example_wreckit_as: example_type_for_inversion (example_type_for_inversion (2 = 3)) -> False. 468 | Proof. 469 | intros. 470 | wreckit in H as [H1]. 471 | wreckit in H1 as [H2]. 472 | discriminate. 473 | Qed. -------------------------------------------------------------------------------- /src/CoqStock/comparable.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import Coq.Lists.List. 5 | 6 | Class comparable (A : Type) := 7 | { compare : A -> A -> comparison (* Eq | Lt | Gt *) 8 | 9 | ; proof_compare_eq_is_equal 10 | : forall (x y: A) 11 | (p: compare x y = Eq) 12 | , x = y 13 | ; proof_compare_eq_reflex 14 | : forall (x: A) 15 | , compare x x = Eq 16 | ; proof_compare_eq_trans 17 | : forall (x y z: A) 18 | (p: compare x y = Eq) 19 | (q: compare y z = Eq) 20 | , compare x z = Eq 21 | ; proof_compare_lt_trans 22 | : forall (x y z: A) 23 | (p: compare x y = Lt) 24 | (q: compare y z = Lt) 25 | , compare x z = Lt 26 | ; proof_compare_gt_trans 27 | : forall (x y z: A) 28 | (p: compare x y = Gt) 29 | (q: compare y z = Gt) 30 | , compare x z = Gt 31 | }. 32 | 33 | (* compare_to_eq turns an hypothesis: 34 | `Eq = compare x y` or `compare x y = Eq` into: 35 | into: 36 | `x = y` 37 | and then tries to rewrite with it. 38 | *) 39 | Ltac compare_to_eq := 40 | match goal with 41 | | [ H_Eq_Compare : Eq = ?Compare |- _ ] => 42 | symmetry in H_Eq_Compare; 43 | let Heq := fresh "Heq" 44 | in apply proof_compare_eq_is_equal in H_Eq_Compare as Heq; 45 | try (rewrite Heq) 46 | | [ H_Eq_Compare : ?Compare = Eq |- _ ] => 47 | let Heq := fresh "Heq" 48 | in apply proof_compare_eq_is_equal in H_Eq_Compare as Heq; 49 | try (rewrite Heq) 50 | end. 51 | 52 | Lemma test_tactic_compare_to_eq 53 | : forall {A: Type} 54 | {cmp: comparable A} 55 | (x y: A) 56 | (p: Eq = compare x y), 57 | x = y. 58 | Proof. 59 | intros. 60 | set (Heq := cmp). 61 | compare_to_eq. 62 | reflexivity. 63 | Qed. 64 | 65 | (* induction_on_compare starts induction on a `compare` expression in the goal. 66 | It makes sense to remember this comparison, so that it be rewritten to an 67 | equality in the Eq induction goal. 68 | *) 69 | Ltac induction_on_compare := 70 | (* 71 | Find an expression (compare ?X ?Y) 72 | inside the goal and remember it. 73 | *) 74 | match goal with 75 | | [ |- context [(compare ?X ?Y)] ] => 76 | remember (compare X Y) 77 | end; 78 | (* remember (compare a b) => 79 | [ 80 | c: comparison 81 | Heqc: c = compare a b 82 | |- _ ] 83 | *) 84 | match goal with 85 | | [ C: comparison |- _ ] => 86 | induction C; [ (* Eq *) compare_to_eq | (* Lt *) | (* Gt *)] 87 | end 88 | . 89 | 90 | Theorem proof_compare_eq_symm 91 | : forall {A: Type} 92 | {cmp: comparable A} 93 | (x y: A) 94 | (p: compare x y = Eq) 95 | , compare y x = Eq. 96 | Proof. 97 | intros. 98 | assert (p1 := p). 99 | apply proof_compare_eq_is_equal in p. 100 | rewrite p. 101 | rewrite p in p1. 102 | assumption. 103 | Qed. 104 | 105 | Theorem compare_eq_is_only_equal 106 | : forall {A: Type} 107 | {cmp: comparable A} 108 | (x1 x2: A) 109 | (p: compare x1 x2 = compare x2 x1) 110 | , compare x1 x2 = Eq. 111 | Proof. 112 | intros. 113 | induction_on_compare. 114 | - reflexivity. 115 | - symmetry in Heqc. 116 | symmetry in p. 117 | remember (proof_compare_lt_trans x1 x2 x1 Heqc p). 118 | rewrite <- e. 119 | apply proof_compare_eq_reflex. 120 | - symmetry in Heqc. 121 | symmetry in p. 122 | remember (proof_compare_gt_trans x1 x2 x1 Heqc p). 123 | rewrite <- e. 124 | apply proof_compare_eq_reflex. 125 | Qed. 126 | 127 | Theorem compare_lt_not_symm_1 128 | : forall {A: Type} 129 | {cmp: comparable A} 130 | (x1 x2: A) 131 | (c12: compare x1 x2 = Lt) 132 | (c21: compare x2 x1 = Lt) 133 | , False. 134 | Proof. 135 | intros. 136 | assert (p1 := proof_compare_lt_trans x1 x2 x1 c12 c21). 137 | assert (p2 := proof_compare_eq_reflex x1). 138 | rewrite p1 in p2. 139 | discriminate. 140 | Qed. 141 | 142 | Theorem compare_lt_not_symm_2 143 | : forall {A: Type} 144 | {cmp: comparable A} 145 | (x1 x2: A) 146 | (c12: compare x1 x2 = Lt) 147 | (c21: compare x2 x1 = Lt) 148 | , False. 149 | Proof. 150 | intros. 151 | assert (c := c21). 152 | rewrite <- c12 in c. 153 | apply compare_eq_is_only_equal in c. 154 | rewrite c21 in c. 155 | discriminate. 156 | Qed. 157 | 158 | Theorem compare_gt_not_symm 159 | : forall {A: Type} 160 | {cmp: comparable A} 161 | (x1 x2: A) 162 | (c12: compare x1 x2 = Gt) 163 | (c21: compare x2 x1 = Gt) 164 | , False. 165 | Proof. 166 | intros. 167 | assert (c := c12). 168 | rewrite <- c21 in c. 169 | apply compare_eq_is_only_equal in c. 170 | rewrite c12 in c. 171 | discriminate. 172 | Qed. 173 | 174 | Theorem compare_lt_gt_symm 175 | : forall {A: Type} 176 | {cmp: comparable A} 177 | (x1 x2: A) 178 | (p: compare x1 x2 = Lt) 179 | , compare x2 x1 = Gt. 180 | Proof. 181 | intros. 182 | remember (compare x2 x1) as iH. 183 | induction iH. 184 | - symmetry in HeqiH. 185 | apply proof_compare_eq_symm in HeqiH. 186 | rewrite HeqiH in p. 187 | discriminate. 188 | - symmetry in HeqiH. 189 | assert (a := proof_compare_lt_trans x1 x2 x1 p HeqiH). 190 | rewrite proof_compare_eq_reflex in a. 191 | discriminate. 192 | - reflexivity. 193 | Qed. 194 | 195 | Theorem compare_gt_lt_symm 196 | : forall {A: Type} 197 | {cmp: comparable A} 198 | (x1 x2: A) 199 | (p: compare x1 x2 = Gt) 200 | , compare x2 x1 = Lt. 201 | Proof. 202 | intros. 203 | induction_on_compare. 204 | - rewrite Heq in p. 205 | rewrite proof_compare_eq_reflex in p. 206 | discriminate. 207 | - trivial. 208 | - symmetry in Heqc. 209 | set (a := proof_compare_gt_trans x1 x2 x1 p Heqc). 210 | rewrite proof_compare_eq_reflex in a. 211 | discriminate. 212 | Qed. 213 | 214 | Fixpoint comparable_list {A: Type} {cmp: comparable A} (xs: list A) (ys: list A) : comparison := 215 | match xs with 216 | | nil => match ys with 217 | | nil => Eq 218 | | _ => Lt 219 | end 220 | | x :: xs => match ys with 221 | | nil => Gt 222 | | y :: ys => match compare x y with 223 | | Eq => comparable_list xs ys 224 | | Lt => Lt 225 | | Gt => Gt 226 | end 227 | end 228 | end. 229 | 230 | 231 | Definition compare_leq {A: Type} {cmp: comparable A} (x y: A) : Prop := 232 | (compare x y = Eq) \/ (compare x y = Lt). 233 | 234 | Lemma compare_leq_trans {A: Type} {cmp: comparable A} (x y z: A) : 235 | (compare_leq x y) -> (compare_leq y z) -> (compare_leq x z). 236 | Proof. 237 | intros. 238 | unfold compare_leq in *. 239 | 240 | destruct H; destruct H0; 241 | try ((left; apply proof_compare_eq_trans with (y0 := y); assumption) 242 | || (right; apply proof_compare_lt_trans with (y0 := y); assumption)); 243 | try (compare_to_eq; subst); 244 | try (left; assumption); 245 | try (right; assumption). 246 | Qed. 247 | 248 | Lemma compare_lt_leq_trans {A: Type} {cmp: comparable A} (x y z: A) : 249 | (compare x y = Lt) 250 | -> (compare_leq y z) 251 | -> (compare x z = Lt). 252 | Proof. 253 | intros H1 H2. 254 | destruct H2 as [H2 | H2]. 255 | - compare_to_eq. 256 | subst. assumption. 257 | - apply proof_compare_lt_trans with (y0 := y); assumption. 258 | Qed. 259 | 260 | Lemma compare_leq_reflex {A: Type} {cmp: comparable A} (x : A) : 261 | (compare_leq x x). 262 | Proof. 263 | intros. 264 | unfold compare_leq. 265 | left. 266 | apply proof_compare_eq_reflex. 267 | Qed. 268 | 269 | Lemma compare_eq_dec {A: Type} {cmp: comparable A} (x y : A): 270 | {x = y} + {x <> y}. 271 | Proof. 272 | destruct (compare x y) eqn:Heqc; 273 | try (right; 274 | unfold not; intro; 275 | subst; 276 | rewrite proof_compare_eq_reflex in Heqc; 277 | discriminate). 278 | - compare_to_eq. 279 | left. 280 | reflexivity. 281 | Qed. 282 | 283 | (* If there is a pair of hypotheses 284 | compare ?x0 ?x1 = Gt and compare ?x0 ?x1 = Lt (or = Eq) 285 | then this tactic derives a contradiction. 286 | *) 287 | Ltac contradiction_from_compares := 288 | match goal with 289 | | [ H1: compare ?x0 ?x1 = Gt , H2: compare ?x0 ?x1 = Lt |- _ ] 290 | => exfalso; assert (Gt = Lt); try (rewrite <- H1; rewrite <- H2; reflexivity); discriminate 291 | | [ H1: compare ?x0 ?x1 = Gt , H2: compare ?x0 ?x1 = Eq |- _ ] 292 | => exfalso; assert (Gt = Eq); try (rewrite <- H1; rewrite <- H2; reflexivity); discriminate 293 | | [ H1: compare ?x0 ?x1 = Eq , H2: compare ?x0 ?x1 = Lt |- _ ] 294 | => exfalso; assert (Eq = Lt); try (rewrite <- H1; rewrite <- H2; reflexivity); discriminate 295 | | [ H1: compare_leq ?x0 ?x1, H2: compare ?x0 ?x1 = Gt |- _ ] 296 | => destruct H1; contradiction_from_compares 297 | end. 298 | -------------------------------------------------------------------------------- /src/CoqStock/compare_nat.v: -------------------------------------------------------------------------------- 1 | (* 2 | compare_nat contains comparable_nat, 3 | which is a instance of comparable for nat. 4 | *) 5 | 6 | Set Implicit Arguments. 7 | Set Asymmetric Patterns. 8 | 9 | Require Import Coq.Lists.List. 10 | 11 | Require Import CoqStock.comparable. 12 | 13 | Definition nat_compare := Nat.compare. 14 | 15 | Lemma nat_proof_compare_eq_is_equal: 16 | forall (x y: nat) 17 | (p: nat_compare x y = Eq), 18 | x = y. 19 | Proof. 20 | induction x, y. 21 | - compute. trivial. 22 | - compute. intros. discriminate. 23 | - compute. intros. discriminate. 24 | - simpl. 25 | intros. 26 | remember (IHx y p). 27 | rewrite e. 28 | reflexivity. 29 | Qed. 30 | 31 | Lemma nat_proof_compare_eq_is_equal' x y: 32 | nat_compare x y = Eq -> 33 | x = y. 34 | Proof. 35 | (* Because of how the lemma is stated, `x' and `y' are already introduced into 36 | the context, causing our inductive hypothesis to become too weak to solve the 37 | goal. `generalize dependent y' returns `y' to the goal and makes sure any 38 | dependent terms are updated. *) 39 | generalize dependent y. 40 | induction x, y. 41 | - compute. trivial. 42 | - compute. intros. discriminate. 43 | - compute. intros. discriminate. 44 | - simpl. 45 | intros. 46 | remember (IHx y H). 47 | rewrite e. 48 | reflexivity. 49 | Qed. 50 | 51 | Lemma nat_proof_compare_eq_reflex 52 | : forall (x: nat) 53 | , nat_compare x x = Eq. 54 | Proof. 55 | (* TODO *) 56 | Admitted. 57 | 58 | Lemma nat_proof_compare_eq_trans 59 | : forall (x y z: nat) 60 | (p: nat_compare x y = Eq) 61 | (q: nat_compare y z = Eq) 62 | , nat_compare x z = Eq. 63 | Proof. 64 | (* TODO *) 65 | Admitted. 66 | 67 | Lemma nat_proof_compare_lt_trans 68 | : forall (x y z: nat) 69 | (p: nat_compare x y = Lt) 70 | (q: nat_compare y z = Lt) 71 | , nat_compare x z = Lt. 72 | Proof. 73 | (* TODO *) 74 | Admitted. 75 | 76 | Lemma nat_proof_compare_gt_trans 77 | : forall (x y z: nat) 78 | (p: nat_compare x y = Gt) 79 | (q: nat_compare y z = Gt) 80 | , nat_compare x z = Gt. 81 | Proof. 82 | (* TODO *) 83 | Admitted. 84 | 85 | Instance comparable_nat : comparable nat := 86 | { compare := nat_compare 87 | ; proof_compare_eq_is_equal := nat_proof_compare_eq_is_equal 88 | ; proof_compare_eq_reflex := nat_proof_compare_eq_reflex 89 | ; proof_compare_eq_trans := nat_proof_compare_eq_trans 90 | ; proof_compare_lt_trans := nat_proof_compare_lt_trans 91 | ; proof_compare_gt_trans := nat_proof_compare_gt_trans 92 | }. 93 | 94 | (* test_compare_list simply tests whether nat can be used 95 | with a function that expects a comparable instance. 96 | compare_list is defined in comparable, 97 | specifically for this use case. 98 | *) 99 | Definition test_compare_list : Prop := 100 | comparable_list (1 :: 2 :: nil) (1 :: 3 :: nil) = Lt. 101 | 102 | -------------------------------------------------------------------------------- /src/CoqStock/dup.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import Coq.Lists.List. 5 | Import Coq.Lists.List.ListNotations. 6 | 7 | Require Import CoqStock.comparable. 8 | Require Import CoqStock.sort. 9 | Require Import CoqStock.list_set. 10 | 11 | Section inductive_predicate_strictly_sorted. 12 | (* The following two properties of lists are equivalent: 13 | 1. being sorted and having no duplicates; and 14 | 2. being strictly sorted, i.e., every element is strictly smaller than the next. 15 | 16 | I think the second is easier to capture in an inductive predicate (it's 17 | almost the same as our definition of is_sorted), so that's what I'll use. 18 | *) 19 | 20 | Context {A: Type}. 21 | Context {cmp: comparable A}. 22 | 23 | Inductive is_strictly_sorted: list A -> Prop := 24 | | empty_strictly_sorted : is_strictly_sorted nil 25 | | singleton_strictly_sorted (x : A) : is_strictly_sorted [x] 26 | | tail_strictly_sorted (x y : A) (xs : list A): 27 | (compare x y = Lt) 28 | -> is_strictly_sorted (y :: xs) 29 | -> is_strictly_sorted (x :: y :: xs). 30 | 31 | Hint Constructors is_strictly_sorted : strictly_sorted. 32 | 33 | Lemma is_strictly_sorted_tail: forall (ls : list A), 34 | is_strictly_sorted ls -> is_strictly_sorted (tl ls). 35 | Proof. 36 | intro ls. intro H. 37 | destruct H; auto with strictly_sorted. 38 | Qed. 39 | 40 | Local Ltac extract_info_from_strictly_sorted := 41 | unfold not; intros; subst; 42 | match goal with 43 | | [ H: is_strictly_sorted (?x0 :: ?xs) |- _ ] 44 | => inversion H; subst; 45 | try discriminate (* this eliminates some impossible cases *) 46 | end; 47 | destruct_list_equality. 48 | 49 | Lemma is_strictly_sorted_implies_sorted: forall (ls : list A), 50 | is_strictly_sorted ls -> is_sorted ls. 51 | Proof. 52 | induction ls. 53 | - constructor. 54 | - extract_info_from_strictly_sorted. 55 | + constructor. 56 | + constructor. right. assumption. 57 | apply IHls. assumption. 58 | Qed. 59 | 60 | (* If (x :: xs) is strictly sorted, then xs is also strictly sorted. 61 | This tactic uses that fact to derive a contradiction if possible. 62 | *) 63 | Local Ltac is_strictly_sorted_contradiction_via_tail := 64 | match goal with 65 | | [ H: is_strictly_sorted (?x0 :: ?xs), 66 | Hcon: ~(is_strictly_sorted ?xs) 67 | |- False ] 68 | => apply Hcon; 69 | apply is_strictly_sorted_tail; 70 | exact H 71 | | [ H: ~(is_strictly_sorted ?xs) 72 | |- ~(is_strictly_sorted (?x0 :: ?xs))] 73 | (* in this case, just apply the contrapositive of is_strictly_sorted_tail *) 74 | => contradict H; 75 | apply is_strictly_sorted_tail with (ls := (x0 :: xs)); 76 | assumption 77 | end. 78 | (* TODO: Good First Issue *) 79 | (* Change this tactic so that it also works with sorted lists, 80 | not only strictly sorted lists. *) 81 | 82 | Definition is_strictly_sorted_dec: forall (ls :list A), 83 | {is_strictly_sorted ls} + {~(is_strictly_sorted ls)}. 84 | 85 | 86 | refine ( 87 | fix F (ls: list A) : {is_strictly_sorted ls} + {~(is_strictly_sorted ls)} := 88 | (match ls 89 | return {is_strictly_sorted ls} + 90 | {~(is_strictly_sorted ls)} 91 | with 92 | | nil => left _ 93 | | (x0::ls') => 94 | (match ls' as l 95 | return (ls' = l) -> 96 | {is_strictly_sorted (x0::ls')} + 97 | {~(is_strictly_sorted (x0::ls'))} 98 | with 99 | | nil => (fun _ => left _) 100 | | (x1::ls'') => 101 | (fun ls0 => 102 | (match (compare x0 x1) as cmp 103 | return (compare x0 x1 = cmp) -> 104 | {is_strictly_sorted (x0::ls')} + 105 | {~(is_strictly_sorted (x0::ls'))} 106 | with 107 | | Lt => 108 | (fun Hcmp => if (F ls') 109 | then left _ 110 | else right _) 111 | | _ => 112 | (fun Hcmp => right _) 113 | end) eq_refl) 114 | end) eq_refl 115 | end)); 116 | try (subst; constructor; assumption); 117 | try is_strictly_sorted_contradiction_via_tail; 118 | try (extract_info_from_strictly_sorted; contradiction_from_compares). 119 | Defined. 120 | End inductive_predicate_strictly_sorted. 121 | 122 | Section remove_duplicates_from_sorted. 123 | (* 124 | The main definition of this section is remove_duplicates_from_sorted, which 125 | is a verified decision procedure that removes all duplicates from a sorted 126 | list. 127 | 128 | To fully specify this in the type system, we first define list_set_eq, which 129 | is a type that represents the proposition that two lists are equal as sets 130 | (i.e., they have exactly the same elements). 131 | *) 132 | Context {A: Type}. 133 | Context {cmp: comparable A}. 134 | 135 | (* This lemma solves the bulk of oen of the cases of remove_duplicates_from_sorted. 136 | Short description: 137 | - we know x < y (with x, y of type A) 138 | - ls is a strictly sorted list that starts with y (b/c as a set, it is 139 | equal to something of the form (y :: ls')) 140 | Therefore, (x :: ls) is strictly sorted. 141 | *) 142 | Lemma consing_smaller_than_smallest_to_strictly_sorted (ls ls' : list A) (x y : A): 143 | compare x y = Lt -> 144 | is_strictly_sorted ls -> 145 | is_sorted (y :: ls') -> 146 | list_set_eq (y :: ls') ls -> 147 | is_strictly_sorted (x :: ls). 148 | Proof. 149 | intros Hcomp Hssortls Hsort Hseteq. 150 | destruct ls eqn:?. 151 | - constructor. 152 | - constructor. 153 | apply compare_lt_leq_trans with (y0 := y). 154 | assumption. 155 | 156 | apply is_sorted_first_element_smallest with (xs := (y :: ls')) (default := y). 157 | assumption. 158 | apply Hseteq. 159 | unfold In. auto. 160 | assumption. 161 | Qed. 162 | 163 | (* A verified decision procedure to remove all duplicate elements from a list 164 | that is sorted. The type tells you: given an input list ls, it returns a 165 | strictly sorted list (hence, without any duplicates) that is equal to the 166 | original list ls as set. *) 167 | Definition remove_duplicates_from_sorted: forall (ls : list A), 168 | is_sorted ls -> { lres : list A | is_strictly_sorted lres & list_set_eq ls lres }. 169 | intros ls0 Hsort0. 170 | 171 | refine 172 | ((fix F (ls : list A) (Hsort : is_sorted ls) : 173 | { lres : list A | is_strictly_sorted lres & list_set_eq ls lres } := 174 | let 175 | restype := ({ lres : list A | is_strictly_sorted lres & list_set_eq ls lres }) 176 | in 177 | match ls as l return ((ls = l) -> restype) with 178 | | nil => 179 | (fun H => (exist2 _ _ (* These two holes correspond to the two propositions about (ls : list A) 180 | that are part of the sigma type: the first proposition is is_strictly_sorted, 181 | the second is the list_eq. 182 | Even though they are not implicit arguments, Coq can infer them 183 | from the context. *) 184 | nil (* the actual element *) 185 | empty_strictly_sorted (* proof for the first proposition (strictly sorted) *) 186 | _ (* proof for the second proposition (equal as lists) *) 187 | )) 188 | | (x :: ls') => 189 | (fun H => 190 | (match ls' as l return (ls' = l) -> restype with 191 | | nil => (fun H' => (exist2 _ _ (x::nil) _ _)) 192 | | (y :: ls'') => 193 | (fun H' => 194 | (match (compare x y) as cmp 195 | return (compare x y = cmp -> restype) with 196 | | Gt => (fun Hcomp => False_rect _ _) 197 | | Eq => 198 | let recres := (F ls' _) in 199 | let (recres_list, recres_sorted, recres_listeq) := recres in 200 | (fun Hcomp => 201 | (exist2 _ _ 202 | recres_list 203 | recres_sorted 204 | _)) 205 | | Lt => 206 | let recres := (F ls' _) in 207 | let (recres_list, recres_sorted, recres_listeq) := recres in 208 | (fun Hcomp => 209 | (exist2 _ _ 210 | (x :: recres_list) 211 | _ 212 | _)) 213 | end) eq_refl) 214 | end) eq_refl) 215 | end eq_refl (* this eq_refl provides the proof for (ls = l) (see match statement) *) 216 | ) ls0 Hsort0). 217 | - subst. apply list_set_eq_refl. 218 | - constructor. 219 | - subst. apply list_set_eq_refl. 220 | 221 | - (* Case Eq *) 222 | Unshelve. 223 | 2: { 224 | subst. apply (tail_of_is_sorted_is_sorted Hsort). 225 | } 226 | apply list_set_eq_trans with (ys := ls'). 227 | subst. 228 | compare_to_eq. 229 | apply list_set_eq_symm. 230 | apply list_set_eq_step. 231 | 232 | assumption. 233 | subst. apply (tail_of_is_sorted_is_sorted Hsort). 234 | 235 | - (* Case Lt, proof of strictly *) 236 | (* This proof is actually quite elaborate to prove in Coq. 237 | The idea is: 238 | - recres_list has the same elements as ls' 239 | - x is smaller than everything in ls' 240 | (because it is smaller than the first element fo ls', and ls' is sorted) 241 | - hence, x is smaller than everything in recres_list 242 | *) 243 | 244 | apply consing_smaller_than_smallest_to_strictly_sorted with (y := y) (ls' := ls''); try assumption. 245 | apply tail_of_is_sorted_is_sorted with (x0 := x). subst. assumption. 246 | subst. assumption. 247 | 248 | - (* Case Lt, proof of list equality *) 249 | subst. 250 | apply list_set_eq_ind_step. 251 | assumption. 252 | 253 | - (* Case Gt, proof of contradiction *) 254 | subst. 255 | remember (first_two_of_is_sorted_are_sorted Hsort). 256 | contradiction_from_compares. 257 | Qed. 258 | 259 | (* A convenience function that extracts the list from the above sigma type. *) 260 | Definition remove_duplicates_from_sorted_list (ls : list A) (Hsort: is_sorted ls): list A 261 | := (proj1_sig (sig_of_sig2 (remove_duplicates_from_sorted Hsort))). 262 | 263 | 264 | (* remove_duplicates_from_sorted removes duplicates from a sorted list *) 265 | (* This is an alternative to remove_duplicates_from_sorted. 266 | The basic structure is the same, except that here the case 267 | compare x' x'' = Gt 268 | is treated differently: here we treat it the same as Lt, whereas 269 | in the other we show that that case is contradictory. 270 | *) 271 | Fixpoint remove_duplicates_from_sorted' (xs: list A): list A := 272 | match xs with 273 | | nil => nil 274 | | (x'::xs') => match xs' with 275 | | nil => xs 276 | | (x''::xs'') => 277 | match compare x' x'' with 278 | | Eq => remove_duplicates_from_sorted' xs' 279 | | _ => x'::(remove_duplicates_from_sorted' xs') 280 | end 281 | end 282 | end. 283 | 284 | Lemma remove_duplicates_from_sorted_both_are_same (xs: list A) (Hsort: is_sorted xs): 285 | remove_duplicates_from_sorted' xs = remove_duplicates_from_sorted_list Hsort. 286 | Proof. 287 | (* TODO: Good First Issue *) 288 | Abort. 289 | End remove_duplicates_from_sorted. 290 | -------------------------------------------------------------------------------- /src/CoqStock/list_set.v: -------------------------------------------------------------------------------- 1 | (* This file contains some definitions and lemmas on using lists as sets. Mainly 2 | we want to know whether two lists have the same set of elements (see the 3 | definition of `list_set_eq`). 4 | *) 5 | 6 | (* TODO: Help Wanted: isn't there some library that more or less does this? 7 | The ones I found don't seem to have a notation of equality of sets. *) 8 | 9 | Set Implicit Arguments. 10 | Set Asymmetric Patterns. 11 | 12 | Require Import Coq.Lists.List. 13 | Import Coq.Lists.List.ListNotations. 14 | 15 | Section list_set_eq. 16 | Context {A: Type}. 17 | 18 | Definition list_set_eq (xs ys : list A): Prop := 19 | forall (a : A), (In a xs) <-> (In a ys). 20 | 21 | Hint Unfold list_set_eq: list_set_db. 22 | 23 | (* Hint Extern extends an auto database with a tactic. 24 | You can specify a cost (the natural number 0 in this case) and a 25 | pattern to apply the tactic to. 26 | See https://coq.inria.fr/refman/proof-engine/tactics.html#coq:cmdv.hint-extern *) 27 | Hint Extern 0 (_ <-> _) => split : list_set_db. 28 | 29 | Lemma list_set_eq_refl (xs: list A): 30 | list_set_eq xs xs. 31 | Proof. 32 | auto with list_set_db. 33 | Qed. 34 | 35 | Hint Resolve list_set_eq_refl: list_set_db. 36 | 37 | Lemma list_set_eq_symm (xs ys: list A): 38 | list_set_eq xs ys <-> list_set_eq ys xs. 39 | Proof. 40 | easy. 41 | (* Interesting note: auto doesn't solve this (even auto 10), but easy does. *) 42 | Qed. 43 | 44 | Lemma list_set_eq_step (a : A) (xs: list A): 45 | list_set_eq (a::xs) (a::(a::xs)). 46 | Proof. 47 | (* From the manual: "This tactic unfolds constants that were declared through a 48 | Hint Unfold in the given databases." 49 | https://coq.inria.fr/distrib/current/refman/proof-engine/tactics.html#coq:tacn.autounfold 50 | 51 | In this case, I wanted to unfold list_set_eq. (We did `Hint Unfold list_set_eq: 52 | list_set_db.` before.) 53 | *) 54 | autounfold with list_set_db. 55 | intros. 56 | split. 57 | - intro H. 58 | unfold In. 59 | auto. 60 | - intro H. 61 | unfold In in *. 62 | destruct H; auto. 63 | (* TODO: Help Wanted 64 | Is there a way to do this entire proof in an automatised way? 65 | We're only introducing, unfolding and destructing the logical disjunction H. 66 | *) 67 | Qed. 68 | 69 | Lemma list_set_eq_trans (xs ys zs : list A): 70 | list_set_eq xs ys 71 | -> list_set_eq ys zs 72 | -> list_set_eq xs zs. 73 | Proof. 74 | intros. 75 | unfold list_set_eq in *. 76 | intro. 77 | split. 78 | - intro. 79 | auto using H, H0 with list_set_db. 80 | (* TODO: Help Wanted 81 | How can the above auto statement fail to just apply the hints 82 | I told it to apply? 83 | The Coq manual does say (https://coq.inria.fr/distrib/current/refman/proof-engine/tactics.html#automation): 84 | 85 | "auto uses a weaker version of apply that is closer to simple apply so it 86 | is expected that sometimes auto will fail even if applying manually one 87 | of the hints would succeed." 88 | 89 | And indeed, `simple apply H0` does not work. So maybe that is the reason? 90 | 91 | But then that raises the question: how do we get it to work? Should be 92 | possible. 93 | *) 94 | apply H0. 95 | apply H. 96 | assumption. 97 | - intro. 98 | apply H. 99 | apply H0. 100 | assumption. 101 | Qed. 102 | 103 | Lemma list_set_eq_ind_step (xs ys: list A) (x : A): 104 | list_set_eq xs ys -> 105 | list_set_eq (x::xs) (x::ys). 106 | Proof. 107 | intros. 108 | unfold list_set_eq. 109 | intros. 110 | split. 111 | - intros H0. 112 | destruct H0. 113 | + subst. cbn. auto. 114 | + subst. cbn. right. 115 | apply H. assumption. 116 | - intros H0. 117 | destruct H0. 118 | + subst. cbn. auto. 119 | + subst. cbn. right. 120 | apply H. assumption. 121 | Qed. 122 | End list_set_eq. 123 | -------------------------------------------------------------------------------- /src/CoqStock/reduce_orb.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Bool.Bool. 2 | 3 | Ltac reduce_orb_step := 4 | match goal with 5 | | [ |- context [?X || ?Y || (?Z || ?Y)]] => 6 | rewrite orb_comm with Z Y 7 | | [ |- context [?X || ?Y || (?Y || ?Z)]] => 8 | rewrite orb_assoc with (X||Y) Y Z 9 | | [ |- context [?X || ?Y || ?Y]] => 10 | rewrite <- orb_assoc with X Y Y 11 | | [ |- context [?Y || ?Y]] => 12 | rewrite orb_diag 13 | | [|- context [?X || ?Y || ?Z = ?X || ?Z || ?Y]] => 14 | rewrite <- orb_assoc with X Z Y; 15 | rewrite orb_comm with Z Y; 16 | rewrite orb_assoc with X Y Z 17 | end. 18 | 19 | Ltac reduce_orb := repeat (try reduce_orb_step). 20 | 21 | Example example_reduce_orb_step: forall (a b c: bool), 22 | a || b || (c || b) = a || b || c. 23 | Proof. 24 | intros. 25 | reduce_orb_step. 26 | reduce_orb_step. 27 | reduce_orb_step. 28 | reduce_orb_step. 29 | reflexivity. 30 | Qed. 31 | 32 | Example example_reduce_orb: forall (a b c: bool), 33 | a || b || (c || b) = a || b || c. 34 | Proof. 35 | intros. 36 | reduce_orb. 37 | reflexivity. 38 | Qed. 39 | 40 | (* TODO: Good First Issue 41 | Add more examples of using reduce_orb_step, 42 | by creating theorems that are proved using reduce_orb_step 43 | The theorem names should start with example_ 44 | *) -------------------------------------------------------------------------------- /src/Reexamined/Readme.md: -------------------------------------------------------------------------------- 1 | # Regular-expression derivatives reexamined 2 | 3 | [Regular-expression derivatives reexamined](https://www.ccs.neu.edu/home/turon/re-deriv.pdf) is a very readable paper by Scott Owens, John Reppy and Aaron Turon. 4 | 5 | In this folder we try to reexamine this reexamining using Coq. -------------------------------------------------------------------------------- /src/Reexamined/SimplificationRules.v: -------------------------------------------------------------------------------- 1 | (* 2 | TODO: Good First Issue 3 | Proving these equivalences will be good first issues in future. 4 | First the definition of regular expressions in this folder, need to be revisited. 5 | 6 | Simplification rules from re-examined 7 | 8 | r&r = r 9 | r&s = s&r 10 | (r&s)&t = r&(s&t) 11 | ∅&r = ∅ 12 | ~∅&r = ~@ 13 | 14 | r+r = r 15 | r+s = s+r 16 | (r+s)+t = r+(s+t) 17 | ~∅+r = ~∅ 18 | ∅+r = r 19 | 20 | (r,s),t = r,(s,t) 21 | ∅,r = ∅ 22 | r,∅ = ∅ 23 | ε,r = r 24 | r,ε = r 25 | 26 | r** = r* 27 | ε* = ε 28 | ∅* = ε 29 | ~~r = r 30 | *) -------------------------------------------------------------------------------- /src/Reexamined/compare_regex.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | Require Import Reexamined.regex. 6 | 7 | Fixpoint compare_regex {A: Type} {cmp: comparable A} (r s: regex A) : comparison := 8 | match r with 9 | | fail => match s with 10 | | fail => Eq 11 | | _ => Lt 12 | end 13 | | empty => match s with 14 | | fail => Gt 15 | | empty => Eq 16 | | _ => Lt 17 | end 18 | | char x => match s with 19 | | fail => Gt 20 | | empty => Gt 21 | | char y => compare x y 22 | | _ => Lt 23 | end 24 | | or r1 r2 => match s with 25 | | fail => Gt 26 | | empty => Gt 27 | | char _ => Gt 28 | | or s1 s2 => 29 | match compare_regex r1 s1 with 30 | | Lt => Lt 31 | | Eq => compare_regex r2 s2 32 | | Gt => Gt 33 | end 34 | | _ => Lt 35 | end 36 | | and r1 r2 => match s with 37 | | fail => Gt 38 | | empty => Gt 39 | | char _ => Gt 40 | | or _ _ => Gt 41 | | and s1 s2 => 42 | match compare_regex r1 s1 with 43 | | Lt => Lt 44 | | Eq => compare_regex r2 s2 45 | | Gt => Gt 46 | end 47 | | _ => Lt 48 | end 49 | | concat r1 r2 => match s with 50 | | fail => Gt 51 | | empty => Gt 52 | | char _ => Gt 53 | | or _ _ => Gt 54 | | and _ _ => Gt 55 | | concat s1 s2 => 56 | match compare_regex r1 s1 with 57 | | Lt => Lt 58 | | Eq => compare_regex r2 s2 59 | | Gt => Gt 60 | end 61 | | _ => Lt 62 | end 63 | | not r1 => match s with 64 | | fail => Gt 65 | | empty => Gt 66 | | char _ => Gt 67 | | or _ _ => Gt 68 | | and _ _ => Gt 69 | | concat _ _ => Gt 70 | | not s1 => compare_regex r1 s1 71 | | _ => Lt 72 | end 73 | | star r1 => match s with 74 | | star s1 => compare_regex r1 s1 75 | | _ => Gt 76 | end 77 | end. 78 | 79 | Lemma test_compare_regex_char : forall 80 | {A: Type} 81 | {cmp: comparable A} 82 | (x1 x2: A) 83 | (p: compare x1 x2 = Lt), 84 | compare_regex (char x1) (char x2) = Lt. 85 | Proof. intros. simpl. now (rewrite p). Qed. 86 | 87 | (* 88 | (or (char x1) (or (char x2) (or (char x2) (char x1)))) 89 | or 90 | - x1 91 | - or 92 | - x2 93 | - or 94 | - x2 95 | - x1 96 | *) 97 | Example example_compare_regex_or_all_left : forall {A: Type} {cmp: comparable A} (x1 x2: A) (p: compare x1 x2 = Lt), 98 | compare_regex (char x1) (or (char x2) (or (char x2) (char x1))) = Lt. 99 | Proof. intros. simpl. reflexivity. Qed. 100 | 101 | (* 102 | (or (or (char x1) (char x2)) (or (char x2) (char x1))) 103 | or 104 | - or 105 | - x1 106 | - x2 107 | - or 108 | - x2 109 | - x1 110 | *) 111 | Example example_compare_regex_or_symmetric: forall {A: Type} {cmp: comparable A} (x1 x2: A) (p: compare x1 x2 = Lt), 112 | compare_regex (or (char x1) (char x2)) (or (char x2) (char x1)) = Lt. 113 | Proof. intros. simpl. now (rewrite p). Qed. 114 | 115 | Lemma regex_proof_compare_eq_is_equal 116 | : forall {A: Type} 117 | {cmp: comparable A} 118 | (r1 r2: regex A) 119 | (p: compare_regex r1 r2 = Eq) 120 | , r1 = r2. 121 | Proof. 122 | induction r1. 123 | - induction r2; simpl; trivial; discriminate. (* fail *) 124 | - induction r2; simpl; trivial; discriminate. (* empty *) 125 | - induction r2; simpl; try discriminate. (* char *) 126 | + remember (compare a a0). 127 | induction c; simpl; try discriminate. 128 | * symmetry in Heqc. 129 | apply proof_compare_eq_is_equal in Heqc. 130 | rewrite <- Heqc. 131 | reflexivity. 132 | - induction r2; simpl; try discriminate. (* or *) 133 | + remember (compare_regex r1_1 r2_1). 134 | remember (compare_regex r1_2 r2_2). 135 | induction c; try discriminate. 136 | * induction c0; try discriminate. 137 | -- symmetry in Heqc. 138 | symmetry in Heqc0. 139 | remember (IHr1_1 r2_1). 140 | remember (e Heqc). 141 | rewrite e. 142 | remember (IHr1_2 r2_2). 143 | remember (e1 Heqc0). 144 | rewrite e2. 145 | reflexivity. 146 | apply Heqc. 147 | - induction r2; simpl; try discriminate. (* and *) 148 | + remember (compare_regex r1_1 r2_1). 149 | remember (compare_regex r1_2 r2_2). 150 | induction c; try discriminate. 151 | * induction c0; try discriminate. 152 | -- symmetry in Heqc. 153 | symmetry in Heqc0. 154 | remember (IHr1_1 r2_1). 155 | remember (e Heqc). 156 | rewrite e. 157 | remember (IHr1_2 r2_2). 158 | remember (e1 Heqc0). 159 | rewrite e2. 160 | reflexivity. 161 | apply Heqc. 162 | - induction r2; simpl; try discriminate. (* concat *) 163 | + remember (compare_regex r1_1 r2_1). 164 | remember (compare_regex r1_2 r2_2). 165 | induction c; try discriminate. 166 | * induction c0; try discriminate. 167 | -- symmetry in Heqc. 168 | symmetry in Heqc0. 169 | remember (IHr1_1 r2_1). 170 | remember (e Heqc). 171 | rewrite e. 172 | remember (IHr1_2 r2_2). 173 | remember (e1 Heqc0). 174 | rewrite e2. 175 | reflexivity. 176 | apply Heqc. 177 | - induction r2; simpl; try discriminate. (* not *) 178 | + remember (IHr1 r2). 179 | remember (IHr1 (not r2)). 180 | intros. 181 | remember (e p). 182 | rewrite e1. 183 | reflexivity. 184 | - induction r2; simpl; try discriminate. (* star *) 185 | + remember (IHr1 r2). 186 | remember (IHr1 (star r2)). 187 | intros. 188 | remember (e p). 189 | rewrite e1. 190 | reflexivity. 191 | Qed. 192 | 193 | Theorem regex_proof_compare_eq_reflex : forall {A: Type} {cmp: comparable A} (r: regex A), 194 | compare_regex r r = Eq. 195 | Proof. 196 | induction r; try reflexivity; simpl. 197 | - apply proof_compare_eq_reflex. 198 | - rewrite IHr1. rewrite IHr2. reflexivity. 199 | - rewrite IHr1. rewrite IHr2. reflexivity. 200 | - rewrite IHr1. rewrite IHr2. reflexivity. 201 | - rewrite IHr. reflexivity. 202 | - rewrite IHr. reflexivity. 203 | Qed. 204 | 205 | Lemma regex_proof_compare_eq_trans 206 | : forall {A: Type} 207 | {cmp: comparable A} 208 | (x y z: regex A) 209 | (p: compare_regex x y = Eq) 210 | (q: compare_regex y z = Eq) 211 | , compare_regex x z = Eq. 212 | Proof. 213 | (* TODO: Good First Issue *) 214 | Admitted. 215 | 216 | Lemma regex_proof_compare_lt_trans 217 | : forall {A: Type} 218 | {cmp: comparable A} 219 | (x y z: regex A) 220 | (p: compare_regex x y = Lt) 221 | (q: compare_regex y z = Lt) 222 | , compare_regex x z = Lt. 223 | Proof. 224 | (* TODO: Good First Issue *) 225 | Admitted. 226 | 227 | Lemma regex_proof_compare_gt_trans 228 | : forall {A: Type} 229 | {cmp: comparable A} 230 | (x y z: regex A) 231 | (p: compare_regex x y = Gt) 232 | (q: compare_regex y z = Gt) 233 | , compare_regex x z = Gt. 234 | Proof. 235 | (* TODO: Good First Issue *) 236 | Admitted. 237 | 238 | Instance comparable_regex {A: Type} {cmp: comparable A} : comparable (regex A) := 239 | { compare := compare_regex 240 | ; proof_compare_eq_is_equal := regex_proof_compare_eq_is_equal 241 | ; proof_compare_eq_reflex := regex_proof_compare_eq_reflex 242 | ; proof_compare_eq_trans := regex_proof_compare_eq_trans 243 | ; proof_compare_lt_trans := regex_proof_compare_lt_trans 244 | ; proof_compare_gt_trans := regex_proof_compare_gt_trans 245 | }. 246 | 247 | Theorem compare_regex_is_compare: forall 248 | {A: Type} 249 | {cmp: comparable A} 250 | (r s: regex A), 251 | compare_regex r s = compare r s. 252 | Proof. 253 | simpl. 254 | reflexivity. 255 | Qed. 256 | 257 | (* induction_on_compare_regex starts induction on a `compare_regex` expression in the goal. 258 | It makes sense to remember this comparison, so that it be rewritten to an 259 | equality in the Eq induction goal. 260 | *) 261 | Ltac induction_on_compare_regex := 262 | rewrite compare_regex_is_compare; 263 | induction_on_compare. 264 | 265 | (* test_compare_list simply tests whether nat can be used 266 | with a function that expects a comparable instance. 267 | compare_list is defined in comparable, 268 | specifically for this use case. 269 | *) 270 | Require Import compare_nat. 271 | Definition list_a : list (@regex nat _) := (empty :: fail :: nil). 272 | Definition list_b : list (@regex nat _) := (empty:: (char 1) :: nil). 273 | Definition test_compare_list : Prop := 274 | comparable_list list_a list_b = Lt. 275 | -------------------------------------------------------------------------------- /src/Reexamined/derive.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Bool.Bool. 2 | 3 | Require Import CoqStock.comparable. 4 | Require Import CoqStock.List. 5 | Require Import CoqStock.reduce_orb. 6 | Require Import CoqStock.Truthy. 7 | 8 | Require Import Reexamined.compare_regex. 9 | Require Export Reexamined.derive_def. 10 | Require Import Reexamined.nullable. 11 | Require Import Reexamined.regex. 12 | Require Import Reexamined.setoid. 13 | 14 | Theorem fail_is_terminating : forall {A: Type} {cmp: comparable A} (xs: list A), 15 | matchesb fail xs = false. 16 | Proof. 17 | induction xs; intros; simpl_matchesb; trivial. 18 | Qed. 19 | 20 | (* or_simple simplifies or expressions *) 21 | Ltac or_simple := repeat 22 | ( truthy 23 | || rewrite or_is_logical_or 24 | || rewrite fail_is_terminating 25 | ). 26 | 27 | Section Derive. 28 | 29 | Context {A: Type}. 30 | Context {cmp: comparable A}. 31 | 32 | (* r&r = r *) 33 | Theorem and_idemp : forall (xs: list A) (r1 r2: regex A) (p: compare_regex r1 r2 = Eq), 34 | matchesb (and r1 r2) xs = matchesb r1 xs. 35 | Proof. 36 | unfold matchesb. 37 | induction xs. 38 | - simpl. 39 | intros. 40 | rewrite (regex_proof_compare_eq_is_equal r1 r2 p). 41 | apply Bool.andb_diag. 42 | - simpl. 43 | intros. 44 | rewrite (regex_proof_compare_eq_is_equal r1 r2 p). 45 | apply IHxs. 46 | apply regex_proof_compare_eq_reflex. 47 | Qed. 48 | 49 | (* r&s = s&r *) 50 | Theorem and_comm : forall (xs: list A) (r1 r2: regex A), 51 | matchesb (and r1 r2) xs = matchesb (and r2 r1) xs. 52 | Proof. 53 | unfold matchesb. 54 | induction xs. 55 | - simpl. 56 | SearchPattern (?X && ?Y = ?Y && ?X). 57 | intros. 58 | apply andb_comm. 59 | - simpl. 60 | intros. 61 | apply IHxs. 62 | Qed. 63 | 64 | (* (r&s)&t = r&(s&t) *) 65 | Theorem and_assoc : forall (xs: list A) (r s t: regex A), 66 | matchesb (and (and r s) t) xs = matchesb (and r (and s t)) xs. 67 | Proof. 68 | unfold matchesb. 69 | induction xs. 70 | - simpl. 71 | intros. 72 | truthy. 73 | - simpl. 74 | intros. 75 | apply IHxs. 76 | Qed. 77 | 78 | (* fail&r = fail *) 79 | Theorem and_fail : forall (xs: list A) (r: regex A), 80 | matchesb (and fail r) xs = matchesb fail xs. 81 | Proof. 82 | unfold matchesb. 83 | induction xs. 84 | - simpl. 85 | trivial. 86 | - simpl. 87 | intros. 88 | apply IHxs. 89 | Qed. 90 | 91 | (* not(fail)&r = r *) 92 | Theorem and_not_fail : forall (xs: list A) (r: regex A), 93 | matchesb (and (not fail) r) xs = matchesb r xs. 94 | Proof. 95 | unfold matchesb. 96 | induction xs. 97 | - simpl. 98 | trivial. 99 | - simpl. 100 | intros. 101 | apply IHxs. 102 | Qed. 103 | 104 | 105 | (* concat (or r s) t => or (concat r t) (concat s t) *) 106 | Theorem concat_or_distrib_r': forall 107 | (xs: list A) 108 | (r s t: regex A), 109 | matchesb (concat (or r s) t) xs 110 | = matchesb (or (concat r t) (concat s t)) xs. 111 | Proof. 112 | induction xs. 113 | - intros. simpl_matchesb. 114 | truthy. 115 | - intros. simpl_matchesb. 116 | case (nullable r), (nullable s). 117 | + cbn. 118 | repeat rewrite or_is_logical_or. 119 | rewrite IHxs. 120 | or_simple. 121 | + cbn. 122 | repeat rewrite or_is_logical_or. 123 | rewrite IHxs. 124 | or_simple. 125 | + cbn. 126 | repeat rewrite or_is_logical_or. 127 | rewrite IHxs. 128 | or_simple. 129 | + cbn. 130 | repeat rewrite or_is_logical_or. 131 | rewrite IHxs. 132 | or_simple. 133 | Qed. 134 | 135 | (* (r.s).t = r.(s.t) *) 136 | Theorem concat_assoc': forall 137 | (xs: list A) 138 | (r s t: regex A), 139 | matchesb (concat (concat r s) t) xs 140 | = matchesb (concat r (concat s t)) xs. 141 | Proof. 142 | induction xs. 143 | - intros. 144 | cbn. 145 | truthy. 146 | - intros. 147 | simpl_matchesb. 148 | case (nullable r), (nullable s); 149 | try ( cbn; 150 | repeat rewrite or_is_logical_or; 151 | try rewrite concat_or_distrib_r'; 152 | repeat rewrite or_is_logical_or; 153 | rewrite IHxs; 154 | truthy). 155 | Qed. 156 | 157 | (* fail.r = fail *) 158 | Theorem concat_fail_l : forall (xs: list A) (r: regex A), 159 | matchesb (concat fail r) xs = matchesb fail xs. 160 | Proof. 161 | unfold matchesb. 162 | induction xs. 163 | - simpl. 164 | reflexivity. 165 | - simpl. 166 | exact IHxs. 167 | Qed. 168 | 169 | Theorem concat_fail_r : 170 | forall (xs : list A) 171 | (r : regex A), 172 | matchesb (concat r fail) xs = matchesb fail xs. 173 | Proof. 174 | induction xs; intros; simpl_matchesb. 175 | - rewrite andb_false_r. 176 | reflexivity. 177 | - destruct (nullable r). 178 | + rewrite or_is_logical_or. 179 | rewrite IHxs. 180 | rewrite orb_diag. 181 | reflexivity. 182 | + rewrite IHxs. 183 | reflexivity. 184 | Qed. 185 | 186 | (* concat (or r s) t => or (concat r t) (concat s t) *) 187 | Lemma concat_or_distrib_r: 188 | forall (xs: list A) 189 | (r s t: regex A), 190 | matchesb (concat (or r s) t) xs = matchesb (or (concat r t) (concat s t)) xs. 191 | Proof. 192 | induction xs; intros; simpl_matchesb. 193 | - rewrite andb_orb_distrib_l. 194 | reflexivity. 195 | - destruct (nullable r), (nullable s); 196 | simpl_matchesb; 197 | repeat rewrite or_is_logical_or; 198 | try apply IHxs; 199 | try rewrite IHxs; 200 | repeat rewrite or_is_logical_or; 201 | truthy. 202 | Qed. 203 | 204 | (* (r.s).t = r.(s.t) *) 205 | Theorem concat_assoc: forall (xs: list A) (r s t: regex A), 206 | matchesb (concat (concat r s) t) xs = matchesb (concat r (concat s t)) xs. 207 | Proof. 208 | induction xs; intros; simpl_matchesb. 209 | - intros. 210 | truthy. 211 | - destruct (nullable r), (nullable s); 212 | simpl_matchesb; 213 | repeat rewrite or_is_logical_or; 214 | try apply IHxs; 215 | try rewrite IHxs; 216 | rewrite concat_or_distrib_r; 217 | repeat rewrite or_is_logical_or; 218 | rewrite IHxs; 219 | truthy. 220 | Qed. 221 | 222 | Lemma fold_at_fail : forall (xs : list A), (fold_left derive xs fail = fail). 223 | Proof. 224 | simpl. 225 | intros. 226 | induction xs. 227 | - simpl. 228 | trivial. 229 | - simpl. 230 | apply IHxs. 231 | Qed. 232 | 233 | Lemma nullable_fold : forall (xs : list A) (r s: regex A), (nullable (fold_left derive xs (or r s))) = (orb (nullable (fold_left derive xs r)) (nullable (fold_left derive xs s))). 234 | Proof. 235 | induction xs. 236 | - intros. 237 | simpl. 238 | reflexivity. 239 | - intros. 240 | simpl. 241 | apply IHxs. 242 | Qed. 243 | 244 | (* r.fail = fail *) 245 | Theorem concat_fail_r' : forall (xs: list A) (r: regex A), 246 | matchesb (concat r fail) xs = matchesb fail xs. 247 | Proof. 248 | unfold matchesb. 249 | induction xs. 250 | - intros. 251 | simpl. 252 | apply Bool.andb_false_r. 253 | - simpl. 254 | intros. 255 | remember (nullable r). 256 | destruct b. 257 | + rewrite nullable_fold. 258 | case (nullable(fold_left derive xs fail)). 259 | * intros. 260 | truthy. 261 | * rewrite IHxs. 262 | rewrite fold_at_fail. 263 | simpl. 264 | trivial. 265 | + apply IHxs. 266 | Qed. 267 | 268 | (* empty.r = r *) 269 | Theorem concat_empty : forall (xs: list A) (r: regex A), 270 | matchesb (concat empty r) xs = matchesb r xs. 271 | Proof. 272 | induction xs; intros; simpl_matchesb. 273 | - reflexivity. 274 | - rewrite or_is_logical_or. 275 | rewrite concat_fail_l. 276 | rewrite fail_is_terminating. 277 | rewrite orb_false_l. 278 | reflexivity. 279 | Qed. 280 | 281 | (* r.empty = r *) 282 | Theorem concat_empty2: forall (xs: list A) (r: regex A), 283 | matchesb (concat r empty) xs = matchesb r xs. 284 | Proof. 285 | induction xs; intros; simpl_matchesb. 286 | - rewrite andb_true_r. 287 | reflexivity. 288 | - case (nullable r). 289 | + rewrite or_is_logical_or. 290 | rewrite IHxs. 291 | rewrite fail_is_terminating. 292 | rewrite orb_false_r. 293 | reflexivity. 294 | + apply IHxs. 295 | Qed. 296 | 297 | (* r|r = r *) 298 | Theorem or_idemp : forall (xs: list A) (r1 r2: regex A) (p: compare_regex r1 r2 = Eq), 299 | matchesb (or r1 r2) xs = matchesb r1 xs. 300 | Proof. 301 | unfold matchesb. 302 | induction xs. 303 | - simpl. 304 | intros. 305 | rewrite (regex_proof_compare_eq_is_equal r1 r2 p). 306 | induction (nullable r2); compute; reflexivity. 307 | - simpl. 308 | intros. 309 | rewrite (regex_proof_compare_eq_is_equal r1 r2 p). 310 | apply IHxs. 311 | apply regex_proof_compare_eq_reflex. 312 | Qed. 313 | 314 | (* r|s = s|r *) 315 | Theorem or_comm : forall (xs: list A) (r s: regex A), 316 | matchesb (or r s) xs = matchesb (or s r) xs. 317 | Proof. 318 | unfold matchesb. 319 | induction xs. 320 | - simpl. 321 | intros. 322 | truthy. 323 | - simpl. 324 | intros. 325 | apply IHxs. 326 | Qed. 327 | 328 | (* (r|s)|t = r|(s|t) *) 329 | Theorem or_assoc : forall (xs: list A) (r s t: regex A), 330 | matchesb (or r (or s t)) xs = matchesb (or (or r s) t) xs. 331 | Proof. 332 | unfold matchesb. 333 | induction xs. 334 | - simpl. 335 | intros. 336 | truthy. 337 | - intros. 338 | apply IHxs. 339 | Qed. 340 | 341 | (* not(fail)|r = not(fail) *) 342 | Theorem or_not_fail : forall (xs: list A) (r: regex A), 343 | matchesb (or (not fail) r) xs = matchesb (not fail) xs. 344 | Proof. 345 | induction xs; intros; simpl_matchesb; trivial. 346 | Qed. 347 | 348 | (* fail|r = r *) 349 | Theorem or_id : forall (xs: list A) (r: regex A), 350 | matchesb (or r fail) xs = matchesb r xs. 351 | Proof. 352 | unfold matchesb. 353 | induction xs. 354 | - simpl. 355 | intros. 356 | truthy. 357 | - intros. 358 | simpl. 359 | apply IHxs. 360 | Qed. 361 | 362 | (* star(star(r)) = star(r) *) 363 | Theorem star_star : forall (xs: list A) (r: regex A), 364 | matchesb (star (star r)) xs = matchesb (star r) xs. 365 | (* TODO: Help Wanted *) 366 | Admitted. 367 | 368 | (* (empty)* = empty *) 369 | Theorem star_empty : forall (xs: list A), 370 | matchesb (star empty) xs = matchesb empty xs. 371 | Proof. 372 | induction xs; intros; simpl_matchesb. 373 | - trivial. 374 | - rewrite concat_fail_l. 375 | reflexivity. 376 | Qed. 377 | 378 | (* (fail)* = empty *) 379 | Theorem fail_star : forall (xs: list A), 380 | matchesb (star fail) xs = matchesb empty xs. 381 | Proof. 382 | unfold matchesb. 383 | induction xs. 384 | - simpl. 385 | reflexivity. 386 | - simpl. 387 | apply concat_fail_l. 388 | Qed. 389 | 390 | (* not(not(r)) = r *) 391 | Theorem not_not : forall (xs: list A) (r: regex A), 392 | matchesb (not (not r)) xs = matchesb r xs. 393 | Proof. 394 | induction xs; intros; simpl_matchesb. 395 | - rewrite negb_involutive. 396 | reflexivity. 397 | - apply IHxs. 398 | Qed. 399 | 400 | Theorem not_fail_is_terminating : forall (xs: list A), 401 | matchesb (not fail) xs = true. 402 | Proof. 403 | induction xs; intros; simpl_matchesb. 404 | - trivial. 405 | - apply IHxs. 406 | Qed. 407 | 408 | End Derive. -------------------------------------------------------------------------------- /src/Reexamined/derive_def.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Bool.Bool. 2 | 3 | Require Import CoqStock.comparable. 4 | Require Import CoqStock.List. 5 | 6 | Require Import Reexamined.nullable. 7 | Require Import Reexamined.regex. 8 | 9 | Definition is_eq {A: Type} {cmp: comparable A} (x y: A) : bool := 10 | match compare x y with 11 | | Eq => true 12 | | _ => false 13 | end. 14 | 15 | (* derive returns the regular expression that is left to match 16 | after matching the input character x, for example: 17 | derive (ba)* b = a(ba)* 18 | derive a a = empty 19 | derive b a = fail 20 | derive ab|a a = b|empty 21 | derive bc b = c 22 | derive (a|empty)b a = b 23 | derive (a|empty)b b = empty 24 | derive empty b b = empty 25 | *) 26 | Fixpoint derive {A: Type} {cmp: comparable A} (r: regex A) (x: A) : regex A := 27 | match r with 28 | | fail => fail 29 | | empty => fail 30 | | char y => if is_eq x y 31 | then empty 32 | else fail 33 | | or s t => or (derive s x) (derive t x) 34 | | and s t => and (derive s x) (derive t x) 35 | | concat s t => 36 | if nullable s 37 | then or (concat (derive s x) t) (derive t x) 38 | else concat (derive s x) t 39 | | not s => not (derive s x) 40 | | star s => concat (derive s x) (star s) 41 | end. 42 | 43 | Definition matchesb {A: Type} {cmp: comparable A} (r: regex A) (xs: list A) : bool := 44 | nullable (fold_left derive xs r). 45 | 46 | (* fold_matchesb tries to find a expression 47 | `nullable (fold_left derive XS R)` 48 | in the goal, where XS and R are variables. 49 | It then applies the fold tactic to 50 | refold: 51 | `nullable (fold_left derive XS R)` 52 | into: 53 | `matchesb XS R` 54 | since that is the definition of matchesb. 55 | *) 56 | Ltac fold_matchesb := 57 | match goal with 58 | | [ |- context [nullable (fold_left derive ?XS ?R)] ] => 59 | fold (matchesb R XS) 60 | end. 61 | 62 | (* 63 | simpl_matchesb simplifies the current expression 64 | with the cbn tactic and tries to fold back up any 65 | matchesb expressions it can spot. 66 | *) 67 | Ltac simpl_matchesb := 68 | cbn; repeat fold_matchesb. 69 | 70 | Theorem or_is_logical_or: forall {A: Type} {cmp: comparable A} (xs: list A) (r s: regex A), 71 | matchesb (or r s) xs = (orb (matchesb r xs) (matchesb s xs)). 72 | Proof. 73 | induction xs; intros; simpl_matchesb. 74 | - trivial. 75 | - apply IHxs. 76 | Qed. 77 | 78 | Theorem and_is_logical_and: forall {A: Type} {cmp: comparable A} (xs: list A) (r s: regex A), 79 | matchesb (and r s) xs = (andb (matchesb r xs) (matchesb s xs)). 80 | Proof. 81 | (* TODO: Good First Issue *) 82 | Admitted. 83 | 84 | (* not(not(r)) = r *) 85 | Theorem not_is_logical_not : forall {A: Type} {cmp: comparable A} (xs: list A) (r: regex A), 86 | matchesb (not r) xs = negb (matchesb r xs). 87 | Proof. 88 | induction xs; intros; simpl_matchesb. 89 | - reflexivity. 90 | - apply IHxs. 91 | Qed. 92 | -------------------------------------------------------------------------------- /src/Reexamined/main.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | Require Import CoqStock.List. 6 | 7 | Require Import Reexamined.compare_regex. 8 | Require Import Reexamined.derive. 9 | Require Import Reexamined.nullable. 10 | Require Import Reexamined.regex. 11 | Require Import Reexamined.smart. 12 | 13 | (*Using only or_comm, or_assoc and or_idemp 14 | Brzozowski proved that a notion of RE similarity including only 15 | r + r = r 16 | r + s = s + r 17 | (r + s) + t = r + (s + t) 18 | is enough to ensure that every RE has only a finite number of dissimilar derivatives. 19 | Hence, DFA construction is guaranteed to terminate if we use similarity as an approximation for equivalence 20 | see https://www.ccs.neu.edu/home/turon/re-deriv.pdf 21 | Regular-expression derivatives reexamined - Scott Owens, John Reppy, Aaron Turon 22 | *) 23 | 24 | (* Definition 4.2 25 | Two input characters are equivalent if for the same regex r 26 | they produce the same derivative. 27 | *) 28 | Definition eqv_char {A: Type} {cmp: comparable A} (a b: A) (r: regex A) : Prop := 29 | derive r a = derive r b. 30 | 31 | (* Lemma 4.1 proves that given the equivalent_character property 32 | it also holds for the combinators. 33 | If characters a and b are equivalent for regular expressions r and s. 34 | Then they are also equivalent for the: 35 | - concat 36 | - or 37 | - and 38 | - star 39 | - not 40 | or those regular expressions. 41 | *) 42 | Lemma eqv_concat : forall {A: Type} {cmp: comparable A} (a b: A) (r s: regex A) 43 | (eqvr: eqv_char a b r) (eqvs: eqv_char a b s), 44 | eqv_char a b (concat r s). 45 | Proof. 46 | (* TODO: Good First Issue *) 47 | Abort. 48 | 49 | Lemma eqv_or : forall {A: Type} {cmp: comparable A} (a b: A) (r s: regex A) 50 | (eqvr: eqv_char a b r) (eqvs: eqv_char a b s), 51 | eqv_char a b (or r s). 52 | Proof. 53 | unfold eqv_char. 54 | intros. 55 | simpl. 56 | rewrite eqvr. 57 | rewrite eqvs. 58 | reflexivity. 59 | Qed. 60 | 61 | Lemma eqv_and : forall {A: Type} {cmp: comparable A} (a b: A) (r s: regex A) 62 | (eqvr: eqv_char a b r) (eqvs: eqv_char a b s), 63 | eqv_char a b (and r s). 64 | Proof. 65 | (* TODO: Good First Issue *) 66 | Abort. 67 | 68 | Lemma eqv_star : forall {A: Type} {cmp: comparable A} (a b: A) (r: regex A) 69 | (eqvr: eqv_char a b r), 70 | eqv_char a b (star r). 71 | Proof. 72 | (* TODO: Good First Issue *) 73 | Abort. 74 | 75 | Lemma eqv_not : forall {A: Type} {cmp: comparable A} (a b: A) (r: regex A) 76 | (eqvr: eqv_char a b r), 77 | eqv_char a b (not r). 78 | Proof. 79 | (* TODO: Good First Issue *) 80 | Abort. 81 | 82 | 83 | -------------------------------------------------------------------------------- /src/Reexamined/matches_pred.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.comparable. 2 | Require Import CoqStock.List. 3 | 4 | Require Import Reexamined.derive_def. 5 | Require Import Reexamined.regex. 6 | 7 | Reserved Notation "xs =~ r" (at level 80). 8 | Reserved Notation "xs !=~ r" (at level 80). 9 | 10 | Inductive matches_prop {A: Type} {cmp: comparable A} : regex A -> (list A) -> Prop := 11 | | empty_matches : 12 | [] =~ empty 13 | 14 | | char_matches (a : A): 15 | [a] =~ char a 16 | 17 | | or_matches_l (r s : regex A) (xs : list A): 18 | xs =~ r -> 19 | (* --------- *) 20 | xs =~ or r s 21 | 22 | | or_matches_r (r s : regex A) (xs : list A): 23 | xs =~ s -> 24 | (* --------- *) 25 | xs =~ or r s 26 | 27 | | and_matches (r s : regex A) (xs: list A) : 28 | xs =~ r -> 29 | xs =~ s -> 30 | (* --------- *) 31 | xs =~ and r s 32 | 33 | | concat_matches (r s : regex A) (xs ys: list A) : 34 | xs =~ r -> 35 | ys =~ s -> 36 | (* --------- *) 37 | (xs ++ ys) =~ concat r s 38 | 39 | | not_matches (r : regex A) (xs : list A): 40 | xs !=~ r -> 41 | (* --------- *) 42 | xs =~ not r 43 | 44 | | star_matches_nil (r : regex A): 45 | [] =~ star r 46 | 47 | | star_matches_concat (r : regex A) (xs ys : list A): 48 | xs =~ r -> 49 | ys =~ star r -> 50 | (* --------- *) 51 | (xs ++ ys) =~ star r 52 | 53 | with not_matches_prop {A: Type} {cmp: comparable A}: regex A -> list A -> Prop := 54 | | fail_not_matches (xs: list A): 55 | (* --------- *) 56 | xs !=~ fail 57 | 58 | | empty_not_matches (xs: list A): 59 | (xs <> []) -> 60 | (* --------- *) 61 | xs !=~ empty 62 | 63 | | char_not_matches (a: A) (xs: list A): 64 | (xs <> [a]) -> 65 | (* --------- *) 66 | xs !=~ (char a) 67 | 68 | | or_not_matches (r s: regex A) (xs: list A): 69 | xs !=~ r -> 70 | xs !=~ s -> 71 | (* --------- *) 72 | xs !=~ or r s 73 | 74 | | and_not_matches_l (r s: regex A) (xs: list A): 75 | xs !=~ r -> 76 | (* --------- *) 77 | xs !=~ and r s 78 | 79 | | and_not_matches_r (r s: regex A) (xs: list A): 80 | xs !=~ s -> 81 | xs !=~ and r s 82 | 83 | | concat_not_matches (r s: regex A) (xs ys: list A): 84 | xs !=~ r \/ ys !=~ s -> 85 | (* --------- *) 86 | (xs ++ ys) !=~ concat r s 87 | 88 | | not_not_matches (r: regex A) (xs: list A): 89 | xs =~ r -> 90 | (* --------- *) 91 | xs !=~ not r 92 | 93 | | star_not_matches (r: regex A) (xs: list A): 94 | xs <> [] -> 95 | xs !=~ concat r (star r) -> 96 | (* --------- *) 97 | xs !=~ star r 98 | 99 | where "xs =~ r" := (matches_prop r xs) and "xs !=~ r" := (not_matches_prop r xs). 100 | 101 | Theorem matches_prop_describes_matches_impl: 102 | forall 103 | {A: Type} 104 | {cmp: comparable A} 105 | (r: regex A) 106 | (xs: list A), 107 | matchesb r xs = true <-> matches_prop r xs 108 | . 109 | (* TODO: Help Wanted 110 | If this theorem is proved, 111 | then matches_prop can be used in proofs, 112 | rather than induction on xs and matchesb. 113 | *) 114 | Abort. 115 | -------------------------------------------------------------------------------- /src/Reexamined/matches_pred_proofs.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.comparable. 2 | Require Import CoqStock.List. 3 | Require Import CoqStock.WreckIt. 4 | 5 | Require Import Reexamined.regex. 6 | Require Import Reexamined.matches_pred. 7 | 8 | 9 | Theorem concat_empty_l: 10 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 11 | xs =~ r -> 12 | xs =~ concat r empty. 13 | Proof. 14 | intros. 15 | rewrite <- app_nil_r. 16 | apply concat_matches. 17 | - assumption. 18 | - apply empty_matches. 19 | Qed. 20 | 21 | Theorem concat_empty_r: 22 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 23 | xs =~ r -> 24 | xs =~ concat r empty. 25 | Proof. 26 | intros. 27 | rewrite <- app_nil_r. 28 | apply concat_matches. 29 | - assumption. 30 | - apply empty_matches. 31 | Qed. 32 | 33 | Theorem concat_nil: 34 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 35 | xs =~ r -> 36 | (xs ++ nil) =~ r. 37 | Proof. 38 | intros. 39 | rewrite <- app_nil_r in H. 40 | assumption. 41 | Qed. 42 | 43 | Theorem concatP: 44 | forall {A : Type} {cmp : comparable A} (xs : list A) (r s : regex A), 45 | xs =~ concat r s -> 46 | (exists (prefix suffix : list A), 47 | xs = prefix ++ suffix /\ prefix =~ r /\ suffix =~ s). 48 | Proof. 49 | intros. 50 | remember (concat r s) as r'. 51 | induction H; (try inversion Heqr'). 52 | - subst. 53 | clear Heqr' IHmatches_prop1 IHmatches_prop2. 54 | exists xs. 55 | exists ys. 56 | split. 57 | + reflexivity. 58 | + split; assumption. 59 | Qed. 60 | 61 | Theorem concat_assoc: 62 | forall {A : Type} {cmp : comparable A} (l : list A) (r s t: regex A), 63 | l =~ (concat (concat r s) t) -> 64 | l =~ (concat r (concat s t)). 65 | Proof. 66 | intros. 67 | apply concatP in H. 68 | elim H; clear H. 69 | intros xs_ys H0. 70 | elim H0; clear H0. 71 | intros zs H1. 72 | elim H1; clear H1. 73 | intros. 74 | elim H0; clear H0. 75 | intros. 76 | rewrite H. 77 | apply concatP in H0. 78 | elim H0; clear H0. 79 | intros xs H0. 80 | elim H0; clear H0. 81 | intros ys H0. 82 | elim H0; clear H0. 83 | intros. 84 | elim H2; clear H2. 85 | intros. 86 | (* TODO: Help Wanted 87 | clean up above *) 88 | 89 | 90 | subst. 91 | rewrite <- app_assoc. 92 | 93 | apply concat_matches. 94 | - assumption. 95 | - apply concat_matches; assumption. 96 | Qed. 97 | 98 | Theorem concat_assoc': 99 | forall {A : Type} {cmp : comparable A} (l : list A) (r s t: regex A), 100 | l =~ (concat (concat r s) t) -> 101 | l =~ (concat r (concat s t)). 102 | Proof. 103 | intros. 104 | apply concatP in H. 105 | wreckit. 106 | apply concatP in H1. 107 | wreckit. 108 | rewrite <- app_assoc. 109 | apply concat_matches. 110 | - assumption. 111 | - apply concat_matches; assumption. 112 | Qed. 113 | 114 | Theorem orP: 115 | forall {A : Type} {cmp : comparable A} (xs : list A) (r s : regex A), 116 | xs =~ or r s -> 117 | xs =~ r \/ xs =~ s. 118 | Proof. 119 | intros. 120 | remember (or r s) as r'. 121 | induction H; (try inversion Heqr'). 122 | - subst. 123 | left; assumption. 124 | - subst. 125 | right; assumption. 126 | Qed. 127 | 128 | Theorem concat_or_distrib_r: 129 | forall {A : Type} {cmp : comparable A} (xs: list A) (r s t: regex A), 130 | xs =~ (concat (or r s) t) -> 131 | xs =~ or (concat r t) (concat s t). 132 | Proof. 133 | intros. 134 | remember (concat (or r s) t) as r'. 135 | induction H; (try inversion Heqr'). 136 | - subst. 137 | clear IHmatches_prop2. 138 | clear IHmatches_prop1. 139 | 140 | apply orP in H. 141 | elim H. 142 | + intros. 143 | apply or_matches_l. 144 | apply concat_matches; assumption. 145 | + intros. 146 | apply or_matches_r. 147 | apply concat_matches; assumption. 148 | Qed. 149 | 150 | Theorem concat_fail_l: 151 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 152 | xs =~ concat fail r -> 153 | xs =~ fail. 154 | Proof. 155 | intros. 156 | inversion H. 157 | inversion H2. 158 | Qed. 159 | 160 | Theorem concat_fail_r: 161 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 162 | xs =~ concat r fail -> 163 | xs =~ fail. 164 | Proof. 165 | intros. 166 | inversion H. 167 | inversion H4. 168 | Qed. 169 | 170 | Theorem or_comm: 171 | forall {A : Type} {cmp : comparable A} (xs : list A) (r s : regex A), 172 | xs =~ (or r s) -> 173 | xs =~ (or s r). 174 | Proof. 175 | intros. 176 | apply orP in H; elim H; intros. 177 | - apply or_matches_r; assumption. 178 | - apply or_matches_l; assumption. 179 | Qed. 180 | 181 | Theorem starP: 182 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 183 | xs =~ star r -> 184 | xs <> nil -> 185 | exists prefix suffix : list A, 186 | xs = prefix ++ suffix /\ prefix =~ r /\ suffix =~ star r. 187 | Proof. 188 | intros. 189 | remember (star r) as r'. 190 | induction H; (try inversion Heqr'). 191 | - elim (H0 (eq_refl nil)). 192 | - subst. 193 | exists xs. 194 | exists ys. 195 | split. 196 | + reflexivity. 197 | + split; assumption. 198 | Qed. 199 | 200 | Lemma star_app: 201 | forall {A : Type} {cmp : comparable A} (xs ys : list A) (r : regex A), 202 | xs =~ (star r) -> 203 | ys =~ (star r) -> 204 | xs ++ ys =~ (star r). 205 | Proof. 206 | intros. 207 | remember (star r) as r'. 208 | induction H; (try inversion Heqr'). 209 | - rewrite H1 in *. 210 | cbn. 211 | assumption. 212 | - subst. 213 | clear IHmatches_prop1. 214 | rewrite <- app_assoc. 215 | apply star_matches_concat. 216 | + assumption. 217 | + apply IHmatches_prop2. 218 | * reflexivity. 219 | * assumption. 220 | Qed. 221 | 222 | Theorem star_idem: 223 | forall {A : Type} {cmp : comparable A} (xs : list A) (r : regex A), 224 | xs =~ star (star r) -> 225 | xs =~ (star r). 226 | Proof. 227 | intros. 228 | remember (star (star r)) as r'. 229 | induction H; (try inversion Heqr'). 230 | - apply star_matches_nil. 231 | - subst. 232 | apply star_app. 233 | + assumption. 234 | + apply IHmatches_prop2. 235 | assumption. 236 | Qed. 237 | -------------------------------------------------------------------------------- /src/Reexamined/nullable.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.comparable. 2 | Require Import CoqStock.List. 3 | 4 | Require Import Reexamined.regex. 5 | 6 | (* nullable returns whether the regular expression matchesb the 7 | empty string, for example: 8 | nullable (ab)* = true 9 | nullable a(ab)* = false 10 | nullable a = false 11 | nullable (abc)*|ab = true 12 | nullable a(abc)*|ab = false 13 | nullable !(a) = true 14 | *) 15 | Fixpoint nullable {A: Type} {cmp: comparable A} (r: regex A) : bool := 16 | match r with 17 | | fail => false 18 | | empty => true 19 | | char _ => false 20 | | or s t => nullable s || nullable t 21 | | and s t => nullable s && nullable t 22 | | concat s t => nullable s && nullable t 23 | | not s => negb (nullable s) 24 | | star _ => true 25 | end. -------------------------------------------------------------------------------- /src/Reexamined/regex.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.comparable. 2 | Require Import CoqStock.List. 3 | 4 | (* A character for a regular expression is generic, 5 | but it needs to implement an interface. 6 | It needs to be comparable. 7 | *) 8 | 9 | Inductive regex (A: Type) {cmp: comparable A} : Type := 10 | fail : regex A (* matchesb no strings *) 11 | | empty : regex A (* matchesb the empty string *) 12 | | char : A -> regex A (* matchesb a single character *) 13 | | or : regex A -> regex A -> regex A 14 | | and : regex A -> regex A -> regex A 15 | | concat : regex A -> regex A -> regex A 16 | | not : regex A -> regex A 17 | | star : regex A -> regex A 18 | . 19 | 20 | (* 21 | We set arguments for fail and empty so that A is implicit when constructing a regex. 22 | For fail: Arguments A, cmp are implicit and maximally inserted 23 | For empty: Arguments A, cmp are implicit and maximally inserted 24 | *) 25 | 26 | Arguments fail {A} {cmp}. 27 | Arguments empty {A} {cmp}. 28 | Arguments char {A} {cmp} _. 29 | Arguments or {A} {cmp} _ _. 30 | Arguments and {A} {cmp} _ _. 31 | Arguments concat {A} {cmp} _ _. 32 | Arguments not {A} {cmp} _. 33 | Arguments star {A} {cmp} _. 34 | -------------------------------------------------------------------------------- /src/Reexamined/set_of_sequences.v: -------------------------------------------------------------------------------- 1 | Require Import CoqStock.comparable. 2 | Require Import CoqStock.compare_nat. 3 | Require Import CoqStock.List. 4 | 5 | Require Import Reexamined.regex. 6 | Require Import Reexamined.derive_def. 7 | 8 | (* 9 | A set of sequences is interpreted as a value of `list A -> Prop` 10 | where the sequence `list A` is in the set if the value on the sequence is `True`. 11 | *) 12 | Definition set_of_sequences {A: Type} {cmp: comparable A} := list A -> Prop. 13 | 14 | Notation "xs \in R" := (R xs) (at level 80). 15 | Notation "{ xs | P }" := (fun xs => P) (at level 0, xs at level 99). 16 | 17 | Reserved Notation "| r |" (at level 60). 18 | Reserved Notation "xs \in * R" (at level 80). 19 | 20 | Inductive matching_sequences_for_star {A: Type} {cmd: comparable A} (R: set_of_sequences): set_of_sequences := 21 | | star_matches_nil : [] \in *R 22 | | star_matches_concat : forall zs, 23 | (exists xs ys, xs ++ ys = zs -> xs \in R /\ ys \in *R) -> zs \in *R 24 | where "xs \in * R" := ((matching_sequences_for_star R) xs). 25 | 26 | Fixpoint matching_sequences_for_regex {A: Type} {cmp: comparable A} (r: regex A): set_of_sequences := 27 | match r with 28 | | fail => { _ | False } 29 | | empty => { xs | xs = [] } 30 | | char a => { xs | xs = [a] } 31 | | or r1 r2 => { xs | xs \in |r1| \/ xs \in |r2| } 32 | | and r1 r2 => { xs | xs \in |r1| /\ xs \in |r2| } 33 | | concat r1 r2 => { xs | exists ys zs, xs = ys ++ zs /\ ys \in |r1| /\ zs \in |r2| } 34 | | not r1 => { xs | ~ (xs \in |r1|) } 35 | | star r1 => { xs | xs \in *|r1| } 36 | end 37 | where "| r |" := (matching_sequences_for_regex r). 38 | 39 | Definition derive_sequence {A: Type} {cmd: comparable A} (a: A) (R: set_of_sequences) : set_of_sequences := 40 | { xs | (a :: xs) \in R }. 41 | 42 | Theorem derive_is_derivative {A: Type} {cmd: comparable A} (a: A) (r: regex A): 43 | forall (xs: list A), xs \in |derive r a| <-> xs \in derive_sequence a (|r|). 44 | Abort. 45 | 46 | Example test_not_not_char : [1] \in |not (not (char 1))|. 47 | Proof. 48 | unfold matching_sequences_for_regex. 49 | unfold Logic.not. 50 | intros. 51 | remember (H eq_refl). 52 | assumption. 53 | Qed. 54 | 55 | Example test_two_not_not_in_char_one : ~ ([2] \in |not (not (char 1))|). 56 | Proof. 57 | unfold matching_sequences_for_regex. 58 | unfold Logic.not. 59 | intros. 60 | apply H. 61 | intros. 62 | discriminate. 63 | Qed. 64 | 65 | Example test_list_in_concat_one : [1;2] \in |concat (char 1) (char 2)|. 66 | Proof. 67 | unfold matching_sequences_for_regex. 68 | exists [1]. 69 | exists [2]. 70 | repeat split; reflexivity. 71 | Qed. 72 | 73 | Example test_list_not_in_concat_one_two : ~([1;2;3] \in |concat (char 1) (char 2)|). 74 | Proof. 75 | unfold matching_sequences_for_regex. 76 | unfold Logic.not. 77 | intros. 78 | destruct H as [x [y [l1 [l2 l3]]]]. 79 | subst. 80 | discriminate. 81 | Qed. 82 | 83 | Example test_one_in_star_char_one : [1] \in |star (char 1)|. 84 | Proof. 85 | unfold matching_sequences_for_regex. 86 | constructor. 87 | exists [1]. 88 | exists []. 89 | intros. 90 | constructor. 91 | - reflexivity. 92 | - constructor. 93 | Qed. 94 | -------------------------------------------------------------------------------- /src/Reexamined/setoid.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | 3 | Require Export Coq.Relations.Relation_Definitions. 4 | Require Export Coq.Setoids.Setoid. 5 | 6 | Require Import CoqStock.comparable. 7 | 8 | Require Import Reexamined.derive_def. 9 | Require Import Reexamined.nullable. 10 | Require Import Reexamined.regex. 11 | 12 | Section RegexEq. 13 | 14 | Context {A: Type}. 15 | Context {cmp: comparable A}. 16 | 17 | Definition bool_eq (b1 b2: bool) : Prop := b1 = b2. 18 | 19 | Definition char_eq (a b: A) : Prop := compare a b = Eq. 20 | 21 | Definition regex_eq (r s: regex A): Prop := 22 | forall (xs: list A), matchesb r xs = matchesb s xs. 23 | 24 | Lemma regex_eq_refl : reflexive (regex A) regex_eq. 25 | Proof. 26 | unfold reflexive. 27 | unfold regex_eq. 28 | reflexivity. 29 | Qed. 30 | 31 | Lemma regex_eq_sym: symmetric (regex A) regex_eq. 32 | Proof. 33 | unfold symmetric. 34 | unfold regex_eq. 35 | symmetry. 36 | apply H. 37 | Qed. 38 | 39 | Lemma regex_eq_trans: transitive (regex A) regex_eq. 40 | Proof. 41 | unfold transitive. 42 | unfold regex_eq. 43 | intros. 44 | specialize H with xs. 45 | specialize H0 with xs. 46 | eapply eq_trans. 47 | - exact H. 48 | - exact H0. 49 | Qed. 50 | 51 | Add Parametric Relation: (regex A) regex_eq 52 | reflexivity proved by regex_eq_refl 53 | symmetry proved by regex_eq_sym 54 | transitivity proved by regex_eq_trans as regex_setoid. 55 | 56 | Add Parametric Morphism: nullable 57 | with signature regex_eq ==> bool_eq as nullable_morph. 58 | Proof. 59 | intros. 60 | unfold bool_eq. 61 | unfold regex_eq in H. 62 | specialize H with nil. 63 | cbn in H. 64 | assumption. 65 | Qed. 66 | 67 | Add Parametric Morphism: (@derive A cmp) 68 | with signature regex_eq ==> char_eq ==> regex_eq as derive_morph. 69 | Proof. 70 | intros. 71 | unfold char_eq in H0. 72 | symmetry in H0. 73 | compare_to_eq. 74 | unfold regex_eq in *. 75 | unfold matchesb in H. 76 | intro. 77 | specialize H with (cons y0 xs). 78 | cbn in H. 79 | fold (matchesb (derive x y0) xs) in H. 80 | fold (matchesb (derive y y0) xs) in H. 81 | assumption. 82 | Qed. 83 | 84 | Add Parametric Morphism: or 85 | with signature regex_eq ==> regex_eq ==> regex_eq as or_morph. 86 | Proof. 87 | intros. 88 | unfold regex_eq in *. 89 | intros. 90 | repeat rewrite or_is_logical_or. 91 | rewrite H. 92 | rewrite H0. 93 | reflexivity. 94 | Qed. 95 | 96 | Add Parametric Morphism: and 97 | with signature regex_eq ==> regex_eq ==> regex_eq as and_morph. 98 | Proof. 99 | intros. 100 | unfold regex_eq in *. 101 | intros. 102 | repeat rewrite and_is_logical_and. 103 | rewrite H. 104 | rewrite H0. 105 | reflexivity. 106 | Qed. 107 | 108 | Add Parametric Morphism: not 109 | with signature regex_eq ==> regex_eq as not_morph. 110 | Proof. 111 | intros. 112 | unfold regex_eq in *. 113 | intro. 114 | repeat rewrite not_is_logical_not. 115 | rewrite H. 116 | reflexivity. 117 | Qed. 118 | 119 | Lemma concat_morph_specialized : forall 120 | (xs: list A) 121 | (x y x0 y0: regex A) 122 | (H0: (regex_eq x x0)) 123 | (H1: (regex_eq y y0)), 124 | (matchesb (concat x y) xs) = (matchesb (concat x0 y0) xs). 125 | Proof. 126 | intro. 127 | induction xs. 128 | - intros. 129 | cbn. 130 | rewrite (nullable_morph H0). 131 | rewrite (nullable_morph H1). 132 | reflexivity. 133 | - intros. 134 | unfold matchesb. 135 | cbn. 136 | simpl_matchesb. 137 | rewrite (nullable_morph H0). 138 | destruct (nullable x0). 139 | + repeat rewrite or_is_logical_or. 140 | rewrite (derive_morph H1 (proof_compare_eq_reflex a)). 141 | replace (matchesb (concat (derive x0 a) y0) xs) with (matchesb (concat (derive x a) y) xs). 142 | * reflexivity. 143 | * eapply IHxs. 144 | ** rewrite (derive_morph H0 (proof_compare_eq_reflex a)). 145 | reflexivity. 146 | ** assumption. 147 | + eapply IHxs. 148 | * rewrite (derive_morph H0 (proof_compare_eq_reflex a)). 149 | reflexivity. 150 | * assumption. 151 | Qed. 152 | 153 | Add Parametric Morphism: concat 154 | with signature regex_eq ==> regex_eq ==> regex_eq as concat_morph. 155 | Proof. 156 | intros. 157 | unfold regex_eq. 158 | intro. 159 | eapply concat_morph_specialized. 160 | - assumption. 161 | - assumption. 162 | Qed. 163 | 164 | Add Parametric Morphism: star 165 | with signature regex_eq ==> regex_eq as star_morph. 166 | Proof. 167 | (* TODO: Help Wanted *) 168 | Abort. 169 | 170 | End RegexEq. 171 | 172 | Existing Instance regex_setoid. 173 | Existing Instance and_morph_Proper. 174 | Existing Instance or_morph_Proper. 175 | Existing Instance not_morph_Proper. 176 | Existing Instance concat_morph_Proper. 177 | Existing Instance nullable_morph_Proper. 178 | Existing Instance derive_morph_Proper. 179 | 180 | -------------------------------------------------------------------------------- /src/Reexamined/simple.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | Require Import CoqStock.List. 6 | 7 | Require Import Reexamined.compare_regex. 8 | Require Import Reexamined.derive. 9 | Require Import Reexamined.nullable. 10 | Require Import Reexamined.regex. 11 | Require Import Reexamined.smart. 12 | Require Import Reexamined.smart_or. 13 | 14 | (* simple is a simpler version of simplified to learn how to prove simplified in future *) 15 | Fixpoint simple {A: Type} {cmp: comparable A} (r: regex A) : Prop := 16 | match r with 17 | | fail => True 18 | | empty => True 19 | | char _ => True 20 | | or s t => simple s /\ simple t 21 | /\ ~(compare_regex s t = Eq) 22 | | and s t => simple s /\ simple t 23 | | concat s t => simple s /\ simple t 24 | | not s => simple s 25 | | star s => simple s 26 | end. 27 | 28 | Lemma smart_or_is_simple: forall {A: Type} {cmp: comparable A} (r s: regex A) (simple_r: simple r) (simple_s: simple s), 29 | simple (smart_or r s). 30 | intros. 31 | induction r, s; simpl; try easy. 32 | - unfold smart_or. 33 | remember (compare_regex (char a) (char a0)) as c. 34 | induction c. 35 | + assumption. 36 | + simpl. 37 | simpl in Heqc. 38 | rewrite <- Heqc. 39 | firstorder. 40 | discriminate. 41 | + simpl. 42 | firstorder. 43 | unfold Logic.not. 44 | simpl in Heqc. 45 | intros. 46 | apply (proof_compare_eq_symm a0 a) in H. 47 | rewrite H in Heqc. 48 | discriminate. 49 | - unfold smart_or. 50 | remember (compare_regex (or r1 r2) (or s1 s2)) as c. 51 | induction c. 52 | + assumption. 53 | + unfold simple. 54 | fold simple. 55 | simpl in simple_r. 56 | simpl in simple_s. 57 | split. 58 | * assumption. 59 | * split. 60 | -- assumption. 61 | -- unfold Logic.not. 62 | intros. 63 | rewrite H in Heqc. 64 | discriminate. 65 | + unfold simple; fold simple. 66 | split. 67 | * assumption. 68 | * split. 69 | -- assumption. 70 | -- unfold Logic.not. 71 | intros. 72 | assert (h := H). 73 | apply regex_proof_compare_eq_is_equal in H. 74 | rewrite H in Heqc. 75 | rewrite regex_proof_compare_eq_reflex in Heqc. 76 | discriminate. 77 | - unfold smart_or. 78 | remember (compare_regex (and r1 r2) (and s1 s2)) as c. 79 | induction c. 80 | + assumption. 81 | + unfold simple; fold simple. 82 | simpl in simple_r. 83 | simpl in simple_s. 84 | split. 85 | * assumption. 86 | * split. 87 | -- assumption. 88 | -- unfold Logic.not. 89 | intros. 90 | rewrite H in Heqc. 91 | discriminate. 92 | + unfold simple; fold simple. 93 | split. 94 | * assumption. 95 | * split. 96 | -- assumption. 97 | -- unfold Logic.not. 98 | intros. 99 | assert (h := H). 100 | apply regex_proof_compare_eq_is_equal in H. 101 | rewrite H in Heqc. 102 | rewrite regex_proof_compare_eq_reflex in Heqc. 103 | discriminate. 104 | - unfold smart_or. 105 | remember (compare_regex (concat r1 r2) (concat s1 s2)) as c. 106 | induction c. 107 | + assumption. 108 | + unfold simple; fold simple. 109 | simpl in simple_r. 110 | simpl in simple_s. 111 | split. 112 | * assumption. 113 | * split. 114 | -- assumption. 115 | -- unfold Logic.not. 116 | intros. 117 | rewrite H in Heqc. 118 | discriminate. 119 | + unfold simple; fold simple. 120 | split. 121 | * assumption. 122 | * split. 123 | -- assumption. 124 | -- unfold Logic.not. 125 | intros. 126 | assert (h := H). 127 | apply regex_proof_compare_eq_is_equal in H. 128 | rewrite H in Heqc. 129 | rewrite regex_proof_compare_eq_reflex in Heqc. 130 | discriminate. 131 | - unfold smart_or. 132 | remember (compare_regex (not r) (not s)) as c. 133 | induction c. 134 | + assumption. 135 | + unfold simple; fold simple. 136 | simpl in simple_r. 137 | simpl in simple_s. 138 | split. 139 | * assumption. 140 | * split. 141 | -- assumption. 142 | -- unfold Logic.not. 143 | intros. 144 | rewrite H in Heqc. 145 | discriminate. 146 | + unfold simple; fold simple. 147 | split. 148 | * assumption. 149 | * split. 150 | -- assumption. 151 | -- unfold Logic.not. 152 | intros. 153 | assert (h := H). 154 | apply regex_proof_compare_eq_is_equal in H. 155 | rewrite H in Heqc. 156 | rewrite regex_proof_compare_eq_reflex in Heqc. 157 | discriminate. 158 | - unfold smart_or. 159 | remember (compare_regex (star r) (star s)) as c. 160 | induction c. 161 | + assumption. 162 | + unfold simple; fold simple. 163 | simpl in simple_r. 164 | simpl in simple_s. 165 | split. 166 | * assumption. 167 | * split. 168 | -- assumption. 169 | -- unfold Logic.not. 170 | intros. 171 | rewrite H in Heqc. 172 | discriminate. 173 | + unfold simple; fold simple. 174 | split. 175 | * assumption. 176 | * split. 177 | -- assumption. 178 | -- unfold Logic.not. 179 | intros. 180 | assert (h := H). 181 | apply regex_proof_compare_eq_is_equal in H. 182 | rewrite H in Heqc. 183 | rewrite regex_proof_compare_eq_reflex in Heqc. 184 | discriminate. 185 | Qed. -------------------------------------------------------------------------------- /src/Reexamined/simplified.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | 6 | Require Import Reexamined.compare_regex. 7 | Require Import Reexamined.nullable. 8 | Require Import Reexamined.regex. 9 | 10 | (* simplified is a property that a regex's ors are somewhat simplified *) 11 | Fixpoint simplified {A: Type} {cmp: comparable A} (r: regex A) : Prop := 12 | match r with 13 | | fail => True 14 | | empty => True 15 | | char _ => True 16 | | or s t => 17 | simplified s 18 | /\ simplified t 19 | /\ compare_regex s t = Lt 20 | /\ match s with 21 | | or _ _ => False 22 | | _ => True 23 | end 24 | /\ match t with 25 | | or tl _ => compare_regex s tl = Lt 26 | | _ => True 27 | end 28 | | and s t => simplified s /\ simplified t 29 | | concat s t => simplified s /\ simplified t 30 | | not s => simplified s 31 | | star s => simplified s 32 | end. 33 | 34 | (* 35 | (or (char x1) (or (char x2) (or (char x3) (char x4)))) 36 | or 37 | - x1 38 | - or 39 | - x2 40 | - or 41 | - x3 42 | - x4 43 | *) 44 | Lemma test_simplified_or_all_left_in_order : forall {A: Type} {cmp: comparable A} (x1 x2 x3 x4: A) 45 | (p12: compare x1 x2 = Lt) 46 | (p23: compare x2 x3 = Lt) 47 | (p34: compare x3 x4 = Lt), 48 | simplified (or (char x1) (or (char x2) (or (char x3) (char x4)))) -> True. 49 | Proof. 50 | intros. 51 | firstorder. 52 | Qed. 53 | 54 | (* 55 | (or (char x1) (or (char x2) (or (char x2) (char x1)))) 56 | or 57 | - x1 58 | - or 59 | - x2 60 | - or 61 | - x2 62 | - x1 63 | *) 64 | Lemma test_simplified_or_all_left_out_of_order : forall 65 | {A: Type} 66 | {cmp: comparable A} 67 | (x1 x2 x3 x4: A) 68 | (p12: compare x1 x2 = Lt) 69 | (p23: compare x2 x3 = Lt) 70 | (p34: compare x3 x4 = Lt), 71 | simplified (or (char x1) (or (char x3) (or (char x2) (char x4)))) -> False. 72 | Proof. 73 | intros x cmp. 74 | intros x1 x2 x3 x4. 75 | intros p12 p23 p34. 76 | simpl. 77 | firstorder. 78 | assert (p := proof_compare_lt_trans x2 x3 x2 p23 H7). 79 | rewrite proof_compare_eq_reflex in p. 80 | discriminate. 81 | Qed. 82 | 83 | (* 84 | (or (or (char x1) (char x2)) (or (char x3) (char x4))) 85 | or 86 | - or 87 | - x1 88 | - x2 89 | - or 90 | - x3 91 | - x4 92 | *) 93 | Lemma test_simplified_or_symmetric: forall {A: Type} {cmp: comparable A} (x1 x2 x3 x4: A) 94 | (p12: compare x1 x2 = Lt) 95 | (p23: compare x2 x3 = Lt) 96 | (p34: compare x3 x4 = Lt), 97 | simplified (or (or (char x1) (char x2)) (or (char x3) (char x4))) -> False. 98 | Proof. 99 | intros x cmp. 100 | intros x1 x2 x3 x4 p12 p23 p34. 101 | simpl. 102 | firstorder. 103 | Qed. 104 | -------------------------------------------------------------------------------- /src/Reexamined/size.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | Require Import CoqStock.List. 6 | 7 | Require Import Reexamined.regex. 8 | 9 | Fixpoint size {A: Type} {cmp: comparable A} (r: regex A) := 10 | match r with 11 | | fail => 1 12 | | empty => 1 13 | | char _ => 1 14 | | (or s t) => 1 + size s + size t 15 | | (and s t) => 1 + size s + size t 16 | | (concat s t) => 1 + size s + size t 17 | | (not s) => 1 + size s 18 | | (star s) => 1 + size s 19 | end. 20 | -------------------------------------------------------------------------------- /src/Reexamined/smart.v: -------------------------------------------------------------------------------- 1 | Set Implicit Arguments. 2 | Set Asymmetric Patterns. 3 | 4 | Require Import CoqStock.comparable. 5 | Require Import CoqStock.List. 6 | 7 | Require Import Reexamined.compare_regex. 8 | Require Import Reexamined.derive. 9 | Require Import Reexamined.nullable. 10 | Require Import Reexamined.regex. 11 | Require Import Reexamined.smart_or. 12 | 13 | (* sderive is the same as derive, except that it applies 14 | simplification rules by construction. 15 | This way we don't have to apply simplification after derivation. 16 | We hope this will also make it easier to prove things. 17 | *) 18 | Definition sderive {A: Type} {cmp: comparable A} (r: regex A) (x: A) : regex A := 19 | match r with 20 | | fail => fail 21 | | empty => fail 22 | | char y => if is_eq x y 23 | then empty 24 | else fail 25 | | or s t => smart_or (derive s x) (derive t x) 26 | | and s t => and (derive s x) (derive t x) 27 | | concat s t => 28 | if nullable s 29 | then or (concat (derive s x) t) (derive t x) 30 | else concat (derive s x) t 31 | | not s => not (derive s x) 32 | | star s => concat (derive s x) (star s) 33 | end. 34 | 35 | Definition smatchesb {A: Type} {cmp: comparable A} (r: regex A) (xs: list A) : bool := 36 | nullable (fold_left sderive xs r) 37 | . 38 | 39 | (* mathing without simplification is the same as with simplification *) 40 | Theorem simplify_is_correct : forall {A: Type} {cmp: comparable A} (xs: list A) (r: regex A), 41 | matchesb r xs = smatchesb r xs. 42 | Proof. 43 | unfold matchesb. 44 | unfold smatchesb. 45 | induction xs. 46 | - simpl. 47 | reflexivity. 48 | - simpl. 49 | induction r; simpl; try (apply IHxs). 50 | * unfold smart_or. 51 | remember (compare_regex (derive r1 a) (derive r2 a)). 52 | induction c. 53 | + symmetry in Heqc. 54 | remember or_idemp as H_or_idemp. 55 | remember (H_or_idemp xs (derive r1 a) (derive r2 a)) as Hmatch_or_if. 56 | remember (Hmatch_or_if Heqc) as Hmatch_or. 57 | unfold matchesb in Hmatch_or. 58 | rewrite Hmatch_or. 59 | remember regex_proof_compare_eq_is_equal as H_compare_equal. 60 | remember (H_compare_equal (derive r1 a) (derive r2 a) Heqc) as Heq_r1_r2. 61 | rewrite Heq_r1_r2. 62 | apply IHxs. 63 | + apply IHxs. 64 | + remember or_comm as H_or_comm. 65 | unfold matchesb in H_or_comm. 66 | rewrite H_or_comm. 67 | apply IHxs. 68 | Qed. --------------------------------------------------------------------------------