├── LICENSE ├── README.md ├── examples ├── a-and-b.pf ├── associativity-of-and.pf ├── associativity-of-or.pf ├── bad-parse.pf ├── bad-ref.pf ├── check_info.txt ├── commutativity-of-and.pf ├── commutativity-of-or.pf ├── contrapositive.pf ├── cycle.pf ├── cycle2.pf ├── de-morgan1.pf ├── ill-formed.pf ├── impl-or.pf ├── not-implies-implies.pf ├── not-not-a.pf ├── peirce.pf ├── pqr.pf ├── problem1_1.pf ├── problem1_2.pf ├── problem1_3.pf ├── problem1_4a.pf ├── problem1_4b.pf ├── problem1_5.pf └── sample.pf ├── propcheck.cabal ├── src ├── Logic │ ├── Predicate.hs │ ├── Predicate │ │ └── Parse.hs │ ├── Propositional.hs │ └── Propositional │ │ ├── Natural.hs │ │ ├── Natural │ │ ├── ProofLine.hs │ │ └── Prover.hs │ │ ├── Parse.hs │ │ ├── Sequent.hs │ │ └── TruthTable.hs ├── Main.hs ├── Setup.hs └── rule_summaries.txt └── stack.yaml /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Benjamin Selfridge (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # propcheck 2 | 3 | This package provides several Haskell modules for interfacing with 4 | propositional logic. It also provides an executable called check, 5 | which automatically parses and checks a proof file in a format we 6 | specify. 7 | 8 | ## Introduction 9 | 10 | propcheck is intended as an educational tool provided as an aide to 11 | those wanting to learn about proofs in propositional logic 12 | (constructive and classical). It is both a code library and a 13 | command-line tool. propcheck is a proof *checker* for propositional 14 | logic proofs written in the Gentzen-style natural deduction. We 15 | adapted our proof rules from the book "Type Theory and Functional 16 | Programming" by Simon Thompson. The primitive connectives are &, |, 17 | =>, and \_|\_. There are two abbreviated connectives, ~a (a => \_|\_) and 18 | a <=> b (a => b & b => a). 19 | 20 | ## Installation 21 | 22 | This is a Haskell project. I use the Haskell Stack tool to build and 23 | maintain it, but you don't need that to build it. However, you do need 24 | the basic Haskell command line tools, including ghc and 25 | cabal. Assuming you have those tools, you can install it by standing 26 | in the top-level directory and typing 27 | 28 | ``` 29 | $ cabal install 30 | ``` 31 | 32 | This should install all dependencies, as well as the project, in your 33 | default installation directory (usually ~/.local/bin). If you add that 34 | directory to your path, you should be able to run the "check" 35 | executable. 36 | 37 | ## Running 38 | 39 | Try running the check command: 40 | 41 | ``` 42 | $ check 43 | Please specify a path. 44 | For help on using check, run "check --help". 45 | ``` 46 | 47 | Okay, sure: 48 | 49 | ``` 50 | $ check --help 51 | check [OPTIONS] [FILE] 52 | PropCheck propositional logic checker (check) 0.0.1, June 2017. 53 | Copyright 2017 Ben Selfridge. All rights reserved. 54 | 55 | -p --proof Show the parsed proof along with the theorem. 56 | --rules Print the complete list of derivation rules that can be used 57 | in a proof. Use this flag in conjunction with --sample to 58 | figure out the correct format for writing proof files. 59 | -s --sample Print a sample proof to stdout. To test this, redirect the 60 | file to a file with > sample.pf and run `check sample.pf`. 61 | -? --help Display help message 62 | -V --version Print version information 63 | ``` 64 | 65 | Generate a simple proof with the -s command: 66 | 67 | ``` 68 | $ check -s > simple.pf 69 | ``` 70 | 71 | Take a look at this file to see an example of a proof, or just run check on it: 72 | 73 | ``` 74 | $ check simple.pf 75 | Thm: [a => b, b => c] |- a => c 76 | ``` 77 | 78 | This output says that the proof supplied demonstrates the formula a => 79 | c is valid, given the top-level assumptions a => b and b => c. 80 | 81 | To see the entire proof as parsed by check, use the -p option: 82 | 83 | ``` 84 | $ check -p simple.pf 85 | Thm: [a => b, b => c] |- a => c 86 | Proof: 87 | a => c [ImpliesIntro] 88 | c [ImpliesElim] 89 | b [ImpliesElim] 90 | a [Assumption]* 91 | a => b [Assumption] 92 | b => c [Assumption] 93 | ``` 94 | 95 | To find out more about the proof format, take a look at the examples 96 | in the examples/ folder. You can also get a complete listing of the 97 | inference rules by running "check --rules". 98 | -------------------------------------------------------------------------------- /examples/a-and-b.pf: -------------------------------------------------------------------------------- 1 | -- proof of (a & b) => a 2 | 3 | Proof. 4 | 1. a & b [Assumption] 5 | 2. a [AndElimL 1] 6 | 3. (a & b) => a [ImpliesIntro 2] 7 | QED -------------------------------------------------------------------------------- /examples/associativity-of-and.pf: -------------------------------------------------------------------------------- 1 | -- (a & (b & c)) <=> ((a & b) & c) 2 | Proof. 3 | 4 | -- => 5 | 1. a & (b & c) [Assumption] 6 | 2. a [AndElimL 1] 7 | 3. b & c [AndElimR 1] 8 | 4. b [AndElimL 3] 9 | 5. c [AndElimR 3] 10 | 6. a & b [AndIntro 2 4] 11 | 7. (a & b) & c [AndIntro 6 5] 12 | 8. (a & (b & c)) => ((a & b) & c) [ImpliesIntro 7] 13 | 14 | -- <= 15 | 9. (a & b) & c [Assumption] 16 | 10. a & b [AndElimL 9] 17 | 11. c [AndElimR 9] 18 | 12. a [AndElimL 10] 19 | 13. b [AndElimR 10] 20 | 14. b & c [AndIntro 13 11] 21 | 15. a & (b & c) [AndIntro 12 14] 22 | 16. ((a & b) & c) => (a & (b & c)) [ImpliesIntro 15] 23 | 24 | -- <=> 25 | 17. (a & (b & c)) <=> ((a & b) & c) [AndIntro 8 16] 26 | QED 27 | -------------------------------------------------------------------------------- /examples/associativity-of-or.pf: -------------------------------------------------------------------------------- 1 | -- proof of (a | (b | c)) <=> ((a | b) | c) 2 | 3 | Proof. 4 | -- => 5 | 1. a | (b | c) [Assumption] 6 | 7 | -- Case split on 1 8 | -- Case 1: a 9 | 2. a [Assumption] 10 | 3. a | b [OrIntroL 2] 11 | 4. (a | b) | c [OrIntroL 3] 12 | 13 | -- Case 2: b | c 14 | 5. b | c [Assumption] 15 | 16 | -- Case split on 5 17 | -- Case 2.1: b 18 | 6. b [Assumption] 19 | 7. a | b [OrIntroR 6] 20 | 8. (a | b) | c [OrIntroL 7] 21 | 22 | -- Case 2.2: c 23 | 9. c [Assumption] 24 | 10. (a | b) | c [OrIntroR 9] 25 | 26 | 11. (a | b) | c [OrElim 5 8 10] 27 | 28 | 12. (a | b) | c [OrElim 1 4 11] 29 | 13. (a | (b | c)) => ((a | b) | c) [ImpliesIntro 12] 30 | 31 | 14. (a | b) | c [Assumption] 32 | 33 | -- Case split on 14 34 | -- Case 1: a | b 35 | 15. a | b [Assumption] 36 | 37 | -- Case split on 15 38 | -- Case 1.1: a 39 | 16. a [Assumption] 40 | 17. a | (b | c) [OrIntroL 16] 41 | 42 | -- Case 1.2: b 43 | 18. b [Assumption] 44 | 19. b | c [OrIntroL 18] 45 | 20. a | (b | c) [OrIntroR 19] 46 | 47 | 21. a | (b | c) [OrElim 15 17 20] 48 | 49 | -- Case 2: c 50 | 22. c [Assumption] 51 | 23. b | c [OrIntroR 22] 52 | 24. a | (b | c) [OrIntroR 23] 53 | 54 | 25. a | (b | c) [OrElim 14 21 24] 55 | 26. ((a | b) | c) => (a | (b | c)) [ImpliesIntro 25] 56 | 57 | 27. (a | (b | c)) <=> ((a | b) | c) [AndIntro 13 26] 58 | 59 | QED -------------------------------------------------------------------------------- /examples/bad-parse.pf: -------------------------------------------------------------------------------- 1 | Proof. 2 | 1. a => b (Assumption) 3 | 2. b => c (Assumption) 4 | 3. a (Assumption) 5 | 4. b (ImpliesElim 3 1 6 | 5. c (ImpliesElim 4 2) 7 | 6. a => c (ImpliesIntro 5) 8 | QED -------------------------------------------------------------------------------- /examples/bad-ref.pf: -------------------------------------------------------------------------------- 1 | Proof. 2 | 1. a => b [Assumption] 3 | 2. b => c [Assumption] 4 | 3. a [Assumption] 5 | 4. b [ImpliesElim 3 1] 6 | 5. c [ImpliesElim 4 2] 7 | 6. a => c [ImpliesIntro 7] 8 | QED -------------------------------------------------------------------------------- /examples/check_info.txt: -------------------------------------------------------------------------------- 1 | Propcheck (version 0.0.1) 2 | -- copyright 2017 by Ben Selfridge 3 | 4 | PropCheck is a program that automatically checks a proof you write in 5 | intuituionistic propositional logic. The program consists of a single 6 | executable called "check". To use it, write a proof in a file called 7 | myProof.pf (or whatever extension you like", and run the following 8 | command: 9 | 10 | > check myProof.pf 11 | 12 | The output will be a single line of the form 13 | 14 | [] |- 15 | 16 | or some kind of error message. is (by default) the 17 | conclusion of the final step in your proof, and are the 18 | list of assumptions your proof did not discharge. 19 | 20 | Run "check --help" for a list of other options. 21 | -------------------------------------------------------------------------------- /examples/commutativity-of-and.pf: -------------------------------------------------------------------------------- 1 | -- prove (a & b) => (b & a) 2 | 3 | Proof. 4 | 5 | -- => 6 | 1. a & b [Assumption] 7 | 2. a [AndElimL 1] 8 | 3. b [AndElimR 1] 9 | 4. b & a [AndIntro 3 2] 10 | 5. (a & b) => (b & a) [ImpliesIntro 4] 11 | 12 | QED -------------------------------------------------------------------------------- /examples/commutativity-of-or.pf: -------------------------------------------------------------------------------- 1 | -- prove (a | b) => (b | a) 2 | 3 | Proof. 4 | 5 | -- => 6 | 1. a | b [Assumption] 7 | 8 | -- Case split on a | b. 9 | -- Case 1: a 10 | 2. a [Assumption] 11 | 3. b | a [OrIntroR 2] 12 | 13 | -- Case 2: b 14 | 4. b [Assumption] 15 | 5. b | a [OrIntroL 4] 16 | 17 | 6. b | a [OrElim 1 3 5] 18 | 7. (a | b) => (b | a) [ImpliesIntro 6] 19 | 20 | QED -------------------------------------------------------------------------------- /examples/contrapositive.pf: -------------------------------------------------------------------------------- 1 | -- a proof of (a => b) <=> (~b => ~a) 2 | 3 | Proof. 4 | 5 | -- => 6 | 1. a => b [Assumption] --* 7 | 2. ~b [Assumption] --* 8 | 3. a [Assumption] --* 9 | 4. b [ImpliesElim 3 1] 10 | 5. _|_ [ImpliesElim 4 2] 11 | 6. ~a [ImpliesIntro 5] 12 | 7. ~b => ~a [ImpliesIntro 6] 13 | 8. (a => b) => (~b => ~a) [ImpliesIntro 7] 14 | 15 | -- <= 16 | 9. ~b => ~a [Assumption] --* 17 | 10. a [Assumption] --* 18 | 19 | -- case split on b | ~b to prove b 20 | -- Case 1: Assume b 21 | 11. b [Assumption] --* 22 | 23 | -- Case 2: Assume ~b 24 | 12. ~b [Assumption] --* 25 | 13. ~a [ImpliesElim 12 9] 26 | 14. _|_ [ImpliesElim 10 13] 27 | 15. b [BottomElim 14] 28 | 29 | 16. b | ~b [ExcludedMiddle] 30 | 17. b [OrElim 16 11 15] 31 | 18. a => b [ImpliesIntro 17] 32 | 19. (~b => ~a) => (a => b) [ImpliesIntro 18] 33 | 34 | -- Put them together 35 | --20. (a => b) <=> (~b => ~a) [AndIntro 8 19] 36 | 37 | QED -------------------------------------------------------------------------------- /examples/cycle.pf: -------------------------------------------------------------------------------- 1 | -- proof with a cycle in it. Need to include a check for this. 2 | 3 | Proof. 4 | 5 | 1. a => a [Assumption] 6 | 2. a [Assumption] 7 | 3. a [ImpliesElim 3 1] 8 | 9 | QED -------------------------------------------------------------------------------- /examples/cycle2.pf: -------------------------------------------------------------------------------- 1 | -- proof of ~(a & b) <=> (~a | ~b) 2 | 3 | Proof. 4 | 5 | -- => 6 | 1. ~(a & b) [Assumption] 7 | 8 | -- case split on a 9 | 2. a | ~a [ExcludedMiddle] 10 | -- Case 1: a, show ~b and thus ~a | ~b 11 | 3. a [Assumption] 12 | -- case split on b 13 | 4. b | ~b [ExcludedMiddle] 14 | -- Case 1: b 15 | 5. b [Assumption] 16 | 6. a & b [AndIntro 3 15] 17 | 7. _|_ [ImpliesElim 6 1] 18 | 8. ~b [ImpliesIntro 7] 19 | 9. ~a | ~b [OrIntroR 8] 20 | -- Case 2: ~b 21 | 10. ~b [Assumption] 22 | 11. ~a | ~b [OrIntroR 10] 23 | 12. ~a | ~b [OrElim 4 9 11] 24 | 25 | -- Case 2: ~a 26 | 13. ~a [Assumption] 27 | 14. ~a | ~b [OrIntroL 13] 28 | 15. ~a | ~b [OrElim 2 12 14] 29 | 16. ~(a & b) => (~a | ~b) [ImpliesIntro 15] 30 | 31 | -- <= 32 | 17. ~a | ~b [Assumption] 33 | 18. a & b [Assumption] 34 | 19. a [AndElimL 18] 35 | 20. b [AndElimR 18] 36 | 37 | -- case split on 17 38 | -- Case 1: ~a 39 | 21. ~a [Assumption] 40 | 22. _|_ [ImpliesElim 19 21] 41 | 23. ~(a & b) [ImpliesIntro 22] 42 | 43 | -- Case 2: ~b 44 | 24. ~b [Assumption] 45 | 25. _|_ [ImpliesElim 20 24] 46 | 26. ~(a & b) [ImpliesIntro 25] 47 | 27. ~(a & b) [OrElim 17 23 26] 48 | 28. (~a | ~b) => ~(a & b) [ImpliesIntro 27] 49 | 50 | -- Putting it all together. 51 | 29. ~(a & b) <=> (~a | ~b) [AndIntro 16 28] 52 | QED -------------------------------------------------------------------------------- /examples/de-morgan1.pf: -------------------------------------------------------------------------------- 1 | -- proof of ~(a & b) <=> (~a | ~b) 2 | 3 | Proof. 4 | 5 | -- => 6 | 1. ~(a & b) [Assumption] 7 | 8 | -- case split on a 9 | 2. a | ~a [ExcludedMiddle] 10 | -- Case 1: a, show ~b and thus ~a | ~b 11 | 3. a [Assumption] 12 | -- case split on b 13 | 4. b | ~b [ExcludedMiddle] 14 | -- Case 1: b 15 | 5. b [Assumption] 16 | 6. a & b [AndIntro 3 5] 17 | 7. _|_ [ImpliesElim 6 1] 18 | 8. ~b [ImpliesIntro 7] 19 | 9. ~a | ~b [OrIntroR 8] 20 | -- Case 2: ~b 21 | 10. ~b [Assumption] 22 | 11. ~a | ~b [OrIntroR 10] 23 | 12. ~a | ~b [OrElim 4 9 11] 24 | 25 | -- Case 2: ~a 26 | 13. ~a [Assumption] 27 | 14. ~a | ~b [OrIntroL 13] 28 | 15. ~a | ~b [OrElim 2 12 14] 29 | 16. ~(a & b) => (~a | ~b) [ImpliesIntro 15] 30 | 31 | -- <= 32 | 17. ~a | ~b [Assumption] 33 | 18. a & b [Assumption] 34 | 19. a [AndElimL 18] 35 | 20. b [AndElimR 18] 36 | 37 | -- case split on 17 38 | -- Case 1: ~a 39 | 21. ~a [Assumption] 40 | 22. _|_ [ImpliesElim 19 21] 41 | 23. ~(a & b) [ImpliesIntro 22] 42 | 43 | -- Case 2: ~b 44 | 24. ~b [Assumption] 45 | 25. _|_ [ImpliesElim 20 24] 46 | 26. ~(a & b) [ImpliesIntro 25] 47 | 27. ~(a & b) [OrElim 17 23 26] 48 | 28. (~a | ~b) => ~(a & b) [ImpliesIntro 27] 49 | 50 | -- Putting it all together. 51 | 29. ~(a & b) <=> (~a | ~b) [AndIntro 16 28] 52 | QED -------------------------------------------------------------------------------- /examples/ill-formed.pf: -------------------------------------------------------------------------------- 1 | Proof. 2 | 1. a => b [Assumption] 3 | 2. b => c [Assumption] 4 | 3. a [Assumption] 5 | 4. b [ImpliesElim 3 1] 6 | 5. c [ImpliesElim 4 1 ] 7 | 6. a => c [ImpliesIntro 5] 8 | QED -------------------------------------------------------------------------------- /examples/impl-or.pf: -------------------------------------------------------------------------------- 1 | -- a proof of (p => q) | (q => p) 2 | 3 | Proof. 4 | 5 | -- Case split on p => q 6 | 1. (p => q) | ~(p => q) [ExcludedMiddle] 7 | 8 | -- Case 1. p => q 9 | 2. p => q [Assumption] --* 10 | 3. (p => q) | (q => p) [OrIntroL 2] 11 | 12 | -- Case 2. ~(p => q), show q => p. 13 | 4. ~(p => q) [Assumption] --* 14 | 5. q [Assumption] --* 15 | 6. p => q [ImpliesIntro 5] 16 | 7. _|_ [ImpliesElim 6 4] 17 | 8. p [BottomElim 7] 18 | 9. q => p [ImpliesIntro 8] 19 | 10. (p => q) | (q => p) [OrIntroR 9] 20 | 21 | -- Now use OrElim to get rid of the remaining assumptions. 22 | 11. (p => q) | (q => p) [OrElim 1 3 10] 23 | 24 | QED -------------------------------------------------------------------------------- /examples/not-implies-implies.pf: -------------------------------------------------------------------------------- 1 | -- proof of ~p => (p => q) 2 | -- this one is actually constructive. 3 | 4 | Proof. 5 | 6 | 1. ~p [Assumption] --* 7 | 2. p [Assumption] --* 8 | 3. _|_ [ImpliesElim 2 1] 9 | 4. q [BottomElim 3] 10 | 5. p => q [ImpliesIntro 4] 11 | 6. ~p => (p => q) [ImpliesIntro 5] 12 | 13 | QED -------------------------------------------------------------------------------- /examples/not-not-a.pf: -------------------------------------------------------------------------------- 1 | -- A proof of ~~a => a, using classical logic. 2 | 3 | Proof. 4 | 1. a | ~a [ExcludedMiddle] 5 | 2. ~~a [Assumption] --* 6 | 7 | -- We are going to user OrElim on 1. First we need to assume the 8 | -- left-hand side and prove a. 9 | 3. a [Assumption] --* 10 | 11 | -- Okay, that was pretty easy. Now let's assume the right-hand side 12 | -- and prove a. 13 | 4. ~a [Assumption] --* 14 | 5. _|_ [ImpliesElim 4 2] 15 | 6. a [BottomElim 5] -- By absurdity, we conclude a 16 | 17 | 7. a [OrElim 1 3 6] -- discharges 3 and 4 18 | 8. ~~a => a [ImpliesIntro 7] -- discharges 2 19 | 20 | QED -------------------------------------------------------------------------------- /examples/peirce.pf: -------------------------------------------------------------------------------- 1 | -- Peirce's law: ((p => q) => p) => p 2 | 3 | Proof. 4 | 5 | 1. ((p => q) => p) [Assumption] --* 6 | 7 | -- Proof by contradiction. Suppose ~p. 8 | 2. ~p [Assumption] --* 9 | 10 | -- Then we can show p => q. First, suppose p. 11 | 3. p [Assumption] --* 12 | 4. _|_ [ImpliesElim 3 2] 13 | 5. q [BottomElim 4] 14 | 6. p => q [ImpliesIntro 5] 15 | 16 | -- This lets us conclude p. 17 | 7. p [ImpliesElim 6 1] 18 | 19 | -- But we assumed ~p, which gives us a contradiction~ 20 | 8. _|_ [ImpliesElim 7 2] 21 | 9. p [BottomElim 8] 22 | 23 | -- Now certainly we can conclude p if we assume it: 24 | 10. p [Assumption] --* 25 | 26 | -- Put it all together with excluded middle and or elimination: 27 | 11. p | ~p [ExcludedMiddle] 28 | 12. p [OrElim 11 10 9] 29 | 13. ((p => q) => p) => p [ImpliesIntro 12] 30 | 31 | QED -------------------------------------------------------------------------------- /examples/pqr.pf: -------------------------------------------------------------------------------- 1 | -- proof of ((p => r) | (q => r)) => ((p & q) => r) 2 | 3 | Proof. 4 | 5 | 1. (p => r) | (q => r) [Assumption] --* 6 | 2. p & q [Assumption] --* 7 | 3. p [AndElimL 2] 8 | 4. q [AndElimR 2] 9 | 10 | -- Case split on 1. 11 | -- Case 1: p => r 12 | 5. p => r [Assumption] --* 13 | 6. r [ImpliesElim 3 5] 14 | 15 | -- Case 2: q => r 16 | 7. q => r [Assumption] --* 17 | 8. r [ImpliesElim 4 7] 18 | 19 | 9. r [OrElim 1 6 8] 20 | 10. ((p & q) => r) [ImpliesIntro 9] 21 | 11. ((p => r) | (q => r)) => ((p & q) => r) [ImpliesIntro 10] 22 | 23 | QED -------------------------------------------------------------------------------- /examples/problem1_1.pf: -------------------------------------------------------------------------------- 1 | Proof. 2 | 1. a => b [Assumption] 3 | 2. b => c [Assumption] 4 | 3. a [Assumption] 5 | 4. b [ImpliesElim 3 1] 6 | 5. c [ImpliesElim 4 2] 7 | 6. a => c [ImpliesIntro 5] 8 | QED -------------------------------------------------------------------------------- /examples/problem1_2.pf: -------------------------------------------------------------------------------- 1 | Proof. 2 | 1. (a | b) => c [Assumption] 3 | 2. a [Assumption] 4 | 3. a | b [OrIntroL 2] 5 | 4. c [ImpliesElim 3 1] 6 | 5. a => c [ImpliesIntro 4] 7 | 6. b [Assumption] 8 | 7. a | b [OrIntroR 6] 9 | 8. c [ImpliesElim 7 1] 10 | 9. b => c [ImpliesIntro 8] 11 | 10. (a => c) & (b => c) [AndIntro 5 9] 12 | 11. ((a | b) => c) => ((a => c) & (b => c)) [ImpliesIntro 10] 13 | QED -------------------------------------------------------------------------------- /examples/problem1_3.pf: -------------------------------------------------------------------------------- 1 | -- 1.3 Give a proof of (a => (b => c)) => ((a & b) => c). 2 | 3 | Proof. 4 | 1. a => (b => c) [Assumption] 5 | 2. a & b [Assumption] 6 | 3. a [AndElimL 2] 7 | 4. b [AndElimR 2] 8 | 5. b => c [ImpliesElim 3 1] 9 | 6. c [ImpliesElim 4 5] 10 | 7. (a & b) => c [ImpliesIntro 6] 11 | 8. (a => (b => c)) => ((a & b) => c) [ImpliesIntro 7] 12 | QED -------------------------------------------------------------------------------- /examples/problem1_4a.pf: -------------------------------------------------------------------------------- 1 | -- 1.4a Give a proof of (a => b) => (~b => ~a). 2 | 3 | Proof. 4 | 1. a => b [Assumption] 5 | 2. ~b [Assumption] 6 | 3. a [Assumption] 7 | 4. b [ImpliesElim 3 1] 8 | 5. _|_ [ImpliesElim 4 2] 9 | 6. ~a [ImpliesIntro 5] -- discharges 3 10 | 7. ~b => ~a [ImpliesIntro 6] -- discharges 2 11 | 8. (a => b) => (~b => ~a) [ImpliesIntro 7] -- discharges 1 12 | QED -------------------------------------------------------------------------------- /examples/problem1_4b.pf: -------------------------------------------------------------------------------- 1 | -- 1.4b Give a proof of a => ~~a. 2 | 3 | Proof. 4 | 1. a [Assumption] 5 | 2. ~a [Assumption] 6 | 3. _|_ [ImpliesElim 1 2] 7 | 4. ~~a [ImpliesIntro 3] 8 | 5. a => ~~a [ImpliesIntro 4] 9 | QED -------------------------------------------------------------------------------- /examples/problem1_5.pf: -------------------------------------------------------------------------------- 1 | -- 1.5 From the assumption (a | b) prove ~(~a & ~b). 2 | 3 | Proof. 4 | 1. (a | b) [Assumption] 5 | 2. (~a & ~b) [Assumption] 6 | 3. ~a [AndElimL 2] 7 | 4. ~b [AndElimR 2] 8 | -- Case split: Assume a, derive bottom. Then assume b, derive bottom. 9 | -- Case 1: 10 | 5. a [Assumption] 11 | 6. _|_ [ImpliesElim 5 3] 12 | -- Case 2: 13 | 7. b [Assumption] 14 | 8. _|_ [ImpliesElim 7 4] 15 | 9. _|_ [OrElim 1 6 8] -- discharges assumptions a and b. 16 | 10. ~(~a & ~b) [ImpliesIntro 9] 17 | QED -------------------------------------------------------------------------------- /examples/sample.pf: -------------------------------------------------------------------------------- 1 | -- Here is a simple proof of transitivity. Also, this is a comment~ 2 | 3 | -- Every proof starts with the keyword "Proof." 4 | Proof. 5 | 6 | -- Next, we list the steps of our proof. You can use any order of 7 | -- numbers that you want, but make sure there are no duplicates. 8 | 9 | 1. a => b [Assumption] 10 | 2. b => c [Assumption] 11 | 3. a [Assumption] 12 | 4. b [ImpliesElim 3 1] 13 | 5. c [ImpliesElim 4 2] 14 | 15 | -- The last statement in a proof is taken as the conclusion by default. 16 | 6. a => c [ImpliesIntro 5] 17 | 18 | -- Our proof is complete~ 19 | QED 20 | -------------------------------------------------------------------------------- /propcheck.cabal: -------------------------------------------------------------------------------- 1 | name: propcheck 2 | version: 0.0.1 3 | -- synopsis: 4 | -- description: 5 | -- homepage: https://github.com/githubuser/propcheck#readme 6 | -- license: BSD3 7 | -- license-file: LICENSE 8 | author: Ben Selfridge 9 | maintainer: benselfridge, gmail 10 | -- copyright: 2017 Author name here 11 | category: Logic 12 | build-type: Simple 13 | cabal-version: >=1.10 14 | extra-source-files: README.md 15 | 16 | library 17 | build-depends: 18 | base >= 4.7 && < 5, 19 | containers, 20 | parsec 21 | hs-source-dirs: src 22 | exposed-modules: 23 | Logic.Propositional 24 | Logic.Propositional.Natural 25 | Logic.Propositional.Sequent 26 | Logic.Propositional.Parse 27 | Logic.Propositional.TruthTable 28 | other-modules: 29 | Logic.Propositional.Natural.ProofLine 30 | default-language: Haskell2010 31 | 32 | -- test-suite propcheck 33 | -- type: exitcode-stdio-1.0 34 | -- default-language: Haskell2010 35 | -- ghc-options: -Wall 36 | -- main-is: Main.hs 37 | -- other-modules: ElfX64Linux 38 | -- hs-source-dirs: tests 39 | -- build-depends: 40 | -- base, 41 | -- bytestring, 42 | -- containers, 43 | -- elf-edit, 44 | -- exceptions, 45 | -- filemanip, 46 | -- filepath, 47 | -- lens, 48 | -- macaw, 49 | -- parameterized-utils, 50 | -- reopt, 51 | -- temporary, 52 | -- tasty, 53 | -- tasty-hunit 54 | 55 | executable check 56 | hs-source-dirs: src 57 | main-is: Main.hs 58 | other-modules: 59 | Logic.Propositional 60 | Logic.Propositional.Natural 61 | Logic.Propositional.Natural.ProofLine 62 | Logic.Propositional.Sequent 63 | Logic.Propositional.Parse 64 | Logic.Propositional.TruthTable 65 | default-language: Haskell2010 66 | build-depends: base >= 4.7 && < 5, 67 | cmdargs, 68 | containers, 69 | lens, 70 | parsec 71 | -------------------------------------------------------------------------------- /src/Logic/Predicate.hs: -------------------------------------------------------------------------------- 1 | module Logic.Predicate 2 | ( Term(..) 3 | , Formula(..) 4 | , a, b, c 5 | , x, y, z 6 | , f, g, h 7 | , p, q, r 8 | , (~&), (~|), (~>), (<~>), (~=) 9 | , bot, forall, exists, neg 10 | , occurs 11 | , subTerm 12 | , right 13 | ) where 14 | 15 | -- This module defines the syntax of propositional calculus. We 16 | -- introduce the Formula datatype. 17 | 18 | import Data.List 19 | import qualified Data.Set as S 20 | 21 | -- | Utility functions. 22 | 23 | right :: (a -> Either b c) -> a -> c 24 | right f x | Right x' <- f x = x' 25 | | otherwise = error "right: bad input" 26 | 27 | -- | Term datatype. 28 | data Term = Const String 29 | | Var String 30 | | App String [Term] 31 | deriving (Eq, Ord) 32 | 33 | instance Show Term where 34 | show (Const s) = "_" ++ s 35 | show (Var s) = s 36 | show (App f ts) = f ++ "(" ++ intercalate "," (map show ts) ++ ")" 37 | 38 | -- | Formula datatype. 39 | data Formula = Bottom 40 | | Pred String [Term] 41 | | Equals Term Term 42 | | Implies Formula Formula 43 | | And Formula Formula 44 | | Or Formula Formula 45 | | Forall String Formula 46 | | Exists String Formula 47 | deriving (Eq, Ord) 48 | 49 | showFormula :: Formula -> String 50 | showFormula (Pred pred []) = pred 51 | showFormula (Pred pred terms) = 52 | pred ++ "(" ++ intercalate "," (map show terms) ++ ")" 53 | showFormula (Equals s t) = "(" ++ show s ++ " = " ++ show t ++ ")" 54 | showFormula Bottom = "_|_" 55 | showFormula (Implies f Bottom) = "~" ++ showFormula f 56 | showFormula (Implies f g) = "(" ++ showFormula f ++ " => " ++ showFormula g ++ ")" 57 | showFormula (And (Implies f g) (Implies g' f')) 58 | | f == f' && g == g' = "(" ++ showFormula f ++ " <=> " ++ showFormula g ++ ")" 59 | showFormula (And f g) = "(" ++ showFormula f ++ " & " ++ showFormula g ++ ")" 60 | showFormula (Or f g) = "(" ++ showFormula f ++ " | " ++ showFormula g ++ ")" 61 | showFormula (Forall x f) = "forall " ++ x ++ " . " ++ showFormula f 62 | showFormula (Exists x f) = "exists " ++ x ++ " . " ++ showFormula f 63 | 64 | showFormulaTop :: Formula -> String 65 | showFormulaTop (Equals s t) = show s ++ " = " ++ show t 66 | showFormulaTop f@(Implies _ Bottom) = showFormula f 67 | showFormulaTop (Implies f g) = showFormula f ++ " => " ++ showFormula g 68 | showFormulaTop (And (Implies f g) (Implies g' f')) 69 | | f == f' && g == g' = showFormula f ++ " <=> " ++ showFormula g 70 | showFormulaTop (And f g) = showFormula f ++ " & " ++ showFormula g 71 | showFormulaTop (Or f g) = showFormula f ++ " | " ++ showFormula g 72 | showFormulaTop f = showFormula f 73 | 74 | instance Show Formula where 75 | show = showFormulaTop 76 | 77 | -- | Easy to use constructors. 78 | 79 | a = Const "a" 80 | b = Const "b" 81 | c = Const "c" 82 | 83 | x = Var "x" 84 | y = Var "y" 85 | z = Var "z" 86 | 87 | f = App "f" 88 | g = App "g" 89 | h = App "h" 90 | 91 | p = Pred "P" 92 | q = Pred "Q" 93 | r = Pred "R" 94 | 95 | -- Infix operators for formula construction 96 | (~&) = And 97 | (~|) = Or 98 | (~>) = Implies 99 | (~=) = Equals 100 | 101 | -- quick bottom, forall, exists 102 | bot = Bottom 103 | forall = \(Var x) -> Forall x 104 | exists = \(Var x) -> Exists x 105 | 106 | -- Derived operators for formula construction 107 | neg f = Implies f bot 108 | (<~>) f g = And (Implies f g) (Implies g f) 109 | 110 | -- | Substitution 111 | 112 | -- variable occurs in a term 113 | occursTerm :: String -> Term -> Bool 114 | occursTerm v (Var q) | v == q = True 115 | occursTerm v (App f ts) = any (occursTerm v) ts 116 | occursTerm _ _ = False 117 | 118 | -- variable occurs free in a formula 119 | occurs :: String -> Formula -> Bool 120 | occurs x Bottom = False 121 | occurs x (Pred _ ts) = any (occursTerm x) ts 122 | occurs x (Equals s t) = occursTerm x s || occursTerm x t 123 | occurs x (Implies f g) = occurs x f || occurs x g 124 | occurs x (And f g) = occurs x f || occurs x g 125 | occurs x (Or f g) = occurs x f || occurs x g 126 | occurs x (Forall y f) | x == y = False 127 | | otherwise = occurs x f 128 | occurs x (Exists y f) | x == y = False 129 | | otherwise = occurs x f 130 | 131 | -- substitute a term for a variable in another term 132 | substTerm :: String -> Term -> Term -> Term 133 | substTerm x t (Const c) = Const c 134 | substTerm x t (Var y) | x == y = t 135 | | otherwise = Var y 136 | substTerm x t (App f ts) = App f $ map (substTerm x t) ts 137 | 138 | 139 | -------------------------------------------------------------------------------- /src/Logic/Predicate/Parse.hs: -------------------------------------------------------------------------------- 1 | module Logic.Predicate.Parse 2 | ( parseTerm 3 | ) where 4 | 5 | import Logic.Predicate 6 | 7 | import Data.Maybe 8 | import Text.ParserCombinators.Parsec 9 | import qualified Data.Map.Strict as Map 10 | 11 | -- | Utilities. 12 | 13 | spacebars = skipMany (char ' ') 14 | 15 | p_lparen = do char '(' 16 | return () 17 | 18 | p_rparen = do char ')' 19 | return () 20 | 21 | -- p_lbracket = do char '[' 22 | -- return () 23 | 24 | -- p_rbracket = do char ']' 25 | -- return () 26 | 27 | -------------------------------------------------------------------------------- 28 | -- | Parse a term. 29 | 30 | parseTerm :: String -> Either ParseError Term 31 | parseTerm input = parse p_term "Bad term" input 32 | 33 | p_term = try p_const 34 | <|> try p_app 35 | <|> try p_var 36 | 37 | p_const = 38 | do char '_' 39 | c <- many1 alphaNum 40 | return $ Const c 41 | "constant" 42 | 43 | p_var = 44 | do first <- lower 45 | v' <- many alphaNum 46 | return $ Var (first:v') 47 | "variable" 48 | 49 | p_varS = 50 | do first <- lower 51 | v' <- many alphaNum 52 | return (first:v') 53 | 54 | p_app = 55 | do first <- lower 56 | f' <- many alphaNum 57 | spacebars 58 | ts <- p_argList 59 | return $ App (first:f') ts 60 | "function application" 61 | 62 | p_argList = 63 | do p_lparen 64 | ts <- sepBy1 (spacebars >> p_term <* spacebars) (char ',') 65 | p_rparen 66 | return ts 67 | 68 | -------------------------------------------------------------------------------- 69 | -- | Parse a formula. 70 | 71 | parseFormula :: String -> Either ParseError Formula 72 | parseFormula input = parse p_formula "Bad formula" input 73 | 74 | p_formula = try (p_binaryFormula "&" And) 75 | <|> try (p_binaryFormula "|" Or) 76 | <|> try (p_binaryFormula "=>" Implies) 77 | <|> try (p_binaryFormula "<=>" (<~>)) 78 | <|> try (p_quantifier "forall" Forall) 79 | <|> try (p_quantifier "exists" Exists) 80 | <|> try p_bottom 81 | <|> try p_equals 82 | <|> try p_pred 83 | <|> try p_neg 84 | 85 | p_pred = 86 | do first <- upper 87 | rest <- many alphaNum 88 | let p = first:rest 89 | ts <- optionMaybe p_argList 90 | case ts of 91 | Nothing -> return $ Pred p [] 92 | Just ts -> return $ Pred p ts 93 | "predicate" 94 | 95 | p_equals = 96 | do p_lparen 97 | spacebars 98 | t1 <- p_term 99 | spacebars 100 | char '=' 101 | spacebars 102 | t2 <- p_term 103 | spacebars 104 | p_rparen 105 | return $ Equals t1 t2 106 | 107 | p_bottom = 108 | do string "_|_" 109 | return Bottom 110 | "_|_" 111 | 112 | p_neg = 113 | do string "~" 114 | spacebars 115 | x <- p_formula 116 | return $ Implies x Bottom 117 | 118 | p_binaryFormula opString opFn = 119 | do p_lparen 120 | spacebars 121 | f <- p_formula 122 | spacebars 123 | string opString 124 | spacebars 125 | g <- p_formula 126 | spacebars 127 | p_rparen 128 | return $ opFn f g 129 | "binary formula" 130 | 131 | p_quantifier qString qFn = 132 | do string qString 133 | spacebars 134 | x <- p_varS 135 | spacebars 136 | char '.' 137 | spacebars 138 | f <- p_formula 139 | return $ qFn x f 140 | -------------------------------------------------------------------------------- /src/Logic/Propositional.hs: -------------------------------------------------------------------------------- 1 | module Logic.Propositional 2 | ( Formula(..) 3 | , a, b, c 4 | , (~&), (~|), (~>), bot, neg, iff 5 | , Assignment 6 | , showAssignment 7 | ) where 8 | 9 | -- This module defines the syntax of propositional calculus. We 10 | -- introduce the Formula datatype. 11 | 12 | import Data.List 13 | import qualified Data.Set as S 14 | 15 | data Formula = Var String 16 | | And Formula Formula 17 | | Or Formula Formula 18 | | Implies Formula Formula 19 | | Bottom 20 | deriving (Eq, Ord) 21 | 22 | showFormula :: Formula -> String 23 | showFormula (Var s) = s 24 | showFormula (And (Implies a b) (Implies c d)) 25 | | a == d && b == c = "(" ++ showFormula a ++ " <=> " ++ showFormula b ++ ")" 26 | showFormula (And a b) = "(" ++ showFormula a ++ " & " ++ showFormula b ++ ")" 27 | showFormula (Or a b) = "(" ++ showFormula a ++ " | " ++ showFormula b ++ ")" 28 | showFormula (Implies a Bottom) = "~" ++ showFormula a 29 | showFormula (Implies a b) = "(" ++ showFormula a ++ " => " ++ showFormula b ++ ")" 30 | showFormula Bottom = "_|_" 31 | 32 | showFormulaTop :: Formula -> String 33 | showFormulaTop (Var s) = s 34 | showFormulaTop (And (Implies a b) (Implies c d)) 35 | | a == d && b == c = showFormula a ++ " <=> " ++ showFormula b 36 | showFormulaTop (And a b) = showFormula a ++ " & " ++ showFormula b 37 | showFormulaTop (Or a b) = showFormula a ++ " | " ++ showFormula b 38 | showFormulaTop (Implies a Bottom) = "~" ++ showFormula a 39 | showFormulaTop (Implies a b) = showFormula a ++ " => " ++ showFormula b 40 | showFormulaTop Bottom = "_|_" 41 | 42 | instance Show Formula where 43 | show = showFormulaTop 44 | 45 | -- | Convenience definitions for variables 46 | a = Var "a" 47 | b = Var "b" 48 | c = Var "c" 49 | 50 | -- Infix operators for formula construction 51 | (~&) = And 52 | (~|) = Or 53 | (~>) = Implies 54 | bot = Bottom 55 | 56 | -- Derived operators for formula construction 57 | neg f = Implies f bot 58 | iff f g = And (Implies f g) (Implies g f) 59 | 60 | -- | Assignments 61 | 62 | type Assignment = [(String, Bool)] 63 | 64 | showAssignment :: Assignment -> String 65 | showAssignment = intercalate "\n" . map showPair 66 | where showPair (var, val) = var ++ " = " ++ show val 67 | -------------------------------------------------------------------------------- /src/Logic/Propositional/Natural.hs: -------------------------------------------------------------------------------- 1 | -- | Logic.Propositional.Natural 2 | 3 | module Logic.Propositional.Natural 4 | ( Proof(..) 5 | , conclusion 6 | , Assumptions 7 | , checkProof 8 | , ppTheorem 9 | , ppTheoremAndProof 10 | ) where 11 | 12 | import Logic.Propositional 13 | 14 | import Data.List 15 | import qualified Data.Set as S 16 | 17 | data Proof = Assumption Formula 18 | | AndIntro Formula Proof Proof 19 | | AndElimL Formula Proof 20 | | AndElimR Formula Proof 21 | | ImpliesIntro Formula Proof 22 | | ImpliesElim Formula Proof Proof 23 | | OrIntroL Formula Proof 24 | | OrIntroR Formula Proof 25 | | OrElim Formula Proof Proof Proof 26 | | BottomElim Formula Proof 27 | | ExcludedMiddle Formula 28 | deriving (Eq, Ord) 29 | 30 | type Assumptions = S.Set Formula 31 | 32 | conclusion :: Proof -> Formula 33 | conclusion (Assumption f) = f 34 | conclusion (AndIntro f _ _) = f 35 | conclusion (AndElimL f _) = f 36 | conclusion (AndElimR f _) = f 37 | conclusion (ImpliesIntro f _) = f 38 | conclusion (ImpliesElim f _ _) = f 39 | conclusion (OrIntroL f _) = f 40 | conclusion (OrIntroR f _) = f 41 | conclusion (OrElim f _ _ _) = f 42 | conclusion (BottomElim f _) = f 43 | conclusion (ExcludedMiddle f) = f 44 | 45 | showProof_ :: S.Set Formula -> String -> Proof -> String 46 | showProof_ pool pad (Assumption formula) = 47 | pad ++ show formula ++ " [Assumption]" ++ 48 | if (formula `S.member` pool) then "*" else "" 49 | showProof_ pool pad (AndIntro formula p1 p2) = 50 | pad ++ show formula ++ " [AndIntro]\n" ++ 51 | showProof_ pool (pad++" ") p1 ++ "\n" ++ 52 | showProof_ pool (pad++" ") p2 53 | showProof_ pool pad (AndElimL formula p) = 54 | pad ++ show formula ++ " [AndElimL]\n" ++ 55 | showProof_ pool (pad++" ") p 56 | showProof_ pool pad (AndElimR formula p) = 57 | pad ++ show formula ++ " [AndElimR]\n" ++ 58 | showProof_ pool (pad++" ") p 59 | showProof_ pool pad (ImpliesIntro formula@(Implies f _) p) = 60 | pad ++ show formula ++ " [ImpliesIntro]\n" ++ 61 | showProof_ (S.insert f pool) (pad++" ") p 62 | showProof_ pool pad (ImpliesElim formula p1 p2) = 63 | pad ++ show formula ++ " [ImpliesElim]\n" ++ 64 | showProof_ pool (pad++" ") p1 ++ "\n" ++ 65 | showProof_ pool (pad++" ") p2 66 | showProof_ pool pad (OrIntroL formula p) = 67 | pad ++ show formula ++ " [OrIntroL]\n" ++ 68 | showProof_ pool (pad++" ") p 69 | showProof_ pool pad (OrIntroR formula p) = 70 | pad ++ show formula ++ " [OrIntroR]\n" ++ 71 | showProof_ pool (pad++" ") p 72 | showProof_ pool pad (OrElim formula p1 p2 p3) 73 | | Or f g <- conclusion p1 = 74 | pad ++ show formula ++ " [OrElim]\n" ++ 75 | showProof_ pool (pad++" ") p1 ++ "\n" ++ 76 | showProof_ (S.insert f pool) (pad++" ") p2 ++ "\n" ++ 77 | showProof_ (S.insert g pool) (pad++" ") p3 78 | showProof_ pool pad (BottomElim formula p) = 79 | pad ++ show formula ++ " [BottomElim]\n" ++ 80 | showProof_ pool (pad++" ") p 81 | showProof_ pool pad (ExcludedMiddle formula) = 82 | pad ++ show formula ++ " [ExcludedMiddle]" 83 | 84 | showProof :: Proof -> String 85 | showProof = showProof_ S.empty "" 86 | 87 | instance Show Proof where 88 | show = showProof 89 | 90 | checkProof :: Proof -> Either String Assumptions 91 | checkProof proof 92 | | Assumption f <- proof = return $ S.singleton f 93 | | AndIntro (And f g) p1 p2 <- proof, 94 | conclusion p1 == f, 95 | conclusion p2 == g = 96 | do a1 <- checkProof p1 97 | a2 <- checkProof p2 98 | return $ S.union a1 a2 99 | | AndElimL f p <- proof, 100 | And g _ <- conclusion p, 101 | g == f = 102 | checkProof p 103 | | AndElimR f p <- proof, 104 | And _ g <- conclusion p, 105 | g == f = 106 | checkProof p 107 | | ImpliesIntro (Implies f g) p <- proof, 108 | conclusion p == g = 109 | do a <- checkProof p 110 | return $ S.delete f a 111 | | ImpliesElim f p1 p2 <- proof, 112 | Implies g h <- conclusion p2, 113 | conclusion p1 == g, 114 | h == f = 115 | do a1 <- checkProof p1 116 | a2 <- checkProof p2 117 | return $ S.union a1 a2 118 | | OrIntroL (Or f g) p <- proof, 119 | conclusion p == f = 120 | checkProof p 121 | | OrIntroR (Or f g) p <- proof, 122 | conclusion p == g = 123 | checkProof p 124 | | OrElim f p1 p2 p3 <- proof, 125 | conclusion p2 == f, 126 | conclusion p3 == f, 127 | Or g h <- conclusion p1 = 128 | do a1 <- checkProof p1 129 | a2 <- checkProof p2 130 | a3 <- checkProof p3 131 | let a2' = S.delete g a2 132 | let a3' = S.delete h a3 133 | return $ S.union a1 (S.union a2' a3') 134 | | BottomElim f p <- proof, 135 | Bottom <- conclusion p = 136 | do checkProof p 137 | | ExcludedMiddle (Or f (Implies g Bottom)) <- proof, 138 | f == g = 139 | return S.empty 140 | | otherwise = Left $ "Ill-formed proof:\n" ++ show proof 141 | 142 | ppTheorem :: Proof -> String 143 | ppTheorem p = case checkProof p of 144 | Right as -> "Thm: [" ++ showAssumptions as ++ "]" ++ 145 | " |- " ++ show (conclusion p) 146 | Left s -> s 147 | where showAssumptions = intercalate ", " . map show . S.toList 148 | 149 | ppTheoremAndProof :: Proof -> String 150 | ppTheoremAndProof p = case checkProof p of 151 | Right as -> "Thm: [" ++ showAssumptions as ++ "]" ++ 152 | " |- " ++ show (conclusion p) ++ "\n" ++ 153 | "Proof:\n" ++ show p 154 | Left s -> s 155 | where showAssumptions = intercalate ", " . map show . S.toList 156 | -------------------------------------------------------------------------------- /src/Logic/Propositional/Natural/ProofLine.hs: -------------------------------------------------------------------------------- 1 | -- | ProofLine.hs 2 | 3 | module Logic.Propositional.Natural.ProofLine 4 | (ProofRef(..), 5 | ProofLine, 6 | genProof) 7 | where 8 | 9 | import Logic.Propositional 10 | import Logic.Propositional.Natural 11 | 12 | import Data.Maybe 13 | import qualified Data.Set as S 14 | 15 | data ProofRef = AssumptionRef 16 | | AndIntroRef Int Int 17 | | AndElimLRef Int 18 | | AndElimRRef Int 19 | | ImpliesIntroRef Int 20 | | ImpliesElimRef Int Int 21 | | OrIntroLRef Int 22 | | OrIntroRRef Int 23 | | OrElimRef Int Int Int 24 | | BottomElimRef Int 25 | | ExcludedMiddleRef 26 | deriving (Show) 27 | 28 | type ProofLine = (Int, (Formula, ProofRef)) 29 | 30 | duplicates :: Eq a => [a] -> Maybe a 31 | duplicates [] = Nothing 32 | duplicates (x:xs) | x `elem` xs = Just x 33 | | otherwise = duplicates xs 34 | 35 | duplicateKeys :: Eq a => [(a, b)] -> Maybe a 36 | duplicateKeys = duplicates . map fst 37 | 38 | type SimpleGraph = [(Int, [Int])] 39 | 40 | findCycle :: [Int] -> Int -> SimpleGraph -> Maybe [Int] 41 | findCycle _ _ [] = Nothing 42 | findCycle visitedNodes start graph 43 | | Just children <- children, 44 | any (`elem` children) visitedNodes = 45 | Just visitedNodes 46 | | Just children <- children, 47 | (cyc:_) <- (catMaybes . map findCycleChild) children = Just cyc 48 | | otherwise = Nothing 49 | where children = lookup start graph 50 | findCycleChild child = findCycle (child:visitedNodes) child graph 51 | 52 | lineToNode :: ProofLine -> (Int, [Int]) 53 | lineToNode (l,(_,AssumptionRef)) = (l,[]) 54 | lineToNode (l,(_,AndIntroRef x y)) = (l,[x,y]) 55 | lineToNode (l,(_,AndElimLRef x)) = (l,[x]) 56 | lineToNode (l,(_,AndElimRRef x)) = (l,[x]) 57 | lineToNode (l,(_,ImpliesIntroRef x)) = (l,[x]) 58 | lineToNode (l,(_,ImpliesElimRef x y)) = (l,[x,y]) 59 | lineToNode (l,(_,OrIntroLRef x)) = (l,[x]) 60 | lineToNode (l,(_,OrIntroRRef x)) = (l,[x]) 61 | lineToNode (l,(_,OrElimRef x y z)) = (l,[x,y,z]) 62 | lineToNode (l,(_,BottomElimRef x)) = (l,[x]) 63 | lineToNode (l,(_,ExcludedMiddleRef)) = (l,[]) 64 | 65 | linesToGraph :: [ProofLine] -> SimpleGraph 66 | linesToGraph = map lineToNode 67 | 68 | -- We assume there are no cycles. 69 | genProofFromLine :: Int -> Formula -> ProofRef -> [ProofLine] -> Either String Proof 70 | genProofFromLine lineNum f ref proofLines 71 | | AssumptionRef <- ref = return $ Assumption f 72 | | AndIntroRef j k <- ref, 73 | Just (g, g_ref) <- lookup j proofLines, 74 | Just (h, h_ref) <- lookup k proofLines = 75 | do g_proof <- genProofFromLine j g g_ref proofLines 76 | h_proof <- genProofFromLine k h h_ref proofLines 77 | return $ AndIntro f g_proof h_proof 78 | | AndElimLRef j <- ref, 79 | Just (g, g_ref) <- lookup j proofLines = 80 | do g_proof <- genProofFromLine j g g_ref proofLines 81 | return $ AndElimL f g_proof 82 | | AndElimRRef j <- ref, 83 | Just (g, g_ref) <- lookup j proofLines = 84 | do g_proof <- genProofFromLine j g g_ref proofLines 85 | return $ AndElimR f g_proof 86 | | ImpliesIntroRef j <- ref, 87 | Just (g, g_ref) <- lookup j proofLines = 88 | do g_proof <- genProofFromLine j g g_ref proofLines 89 | return $ ImpliesIntro f g_proof 90 | | ImpliesElimRef j k <- ref, 91 | Just (g, g_ref) <- lookup j proofLines, 92 | Just (h, h_ref) <- lookup k proofLines = 93 | do g_proof <- genProofFromLine j g g_ref proofLines 94 | h_proof <- genProofFromLine k h h_ref proofLines 95 | return $ ImpliesElim f g_proof h_proof 96 | | OrIntroLRef j <- ref, 97 | Just (g, g_ref) <- lookup j proofLines = 98 | do g_proof <- genProofFromLine j g g_ref proofLines 99 | return $ OrIntroL f g_proof 100 | | OrIntroRRef j <- ref, 101 | Just (g, g_ref) <- lookup j proofLines = 102 | do g_proof <- genProofFromLine j g g_ref proofLines 103 | return $ OrIntroR f g_proof 104 | | OrElimRef j k l <- ref, 105 | Just (g, g_ref) <- lookup j proofLines, 106 | Just (h, h_ref) <- lookup k proofLines, 107 | Just (i, i_ref) <- lookup l proofLines = 108 | do g_proof <- genProofFromLine j g g_ref proofLines 109 | h_proof <- genProofFromLine k h h_ref proofLines 110 | i_proof <- genProofFromLine l i i_ref proofLines 111 | return $ OrElim f g_proof h_proof i_proof 112 | | BottomElimRef j <- ref, 113 | Just (g, g_ref) <- lookup j proofLines = 114 | do g_proof <- genProofFromLine j g g_ref proofLines 115 | return $ BottomElim f g_proof 116 | | ExcludedMiddleRef <- ref = return $ ExcludedMiddle f 117 | | otherwise = Left ("Line " ++ show lineNum ++ 118 | ": reference to non-existent line ") 119 | 120 | genProof :: [ProofLine] -> Either String Proof 121 | genProof [] = Left "empty proof" 122 | genProof proofLines = do 123 | case duplicateKeys proofLines of 124 | Just dup -> Left $ "duplicate keys: " ++ show dup 125 | Nothing -> 126 | case findCycle [] i (linesToGraph proofLines) of 127 | Just cycle -> Left $ "cyclic dependencies: " ++ show cycle 128 | Nothing -> genProofFromLine i f f_ref proofLines 129 | where (i, (f, f_ref)) = last proofLines 130 | -------------------------------------------------------------------------------- /src/Logic/Propositional/Natural/Prover.hs: -------------------------------------------------------------------------------- 1 | -- This module is purely experimental; I wouldn't suggest using it. 2 | 3 | module Logic.Propositional.Prover 4 | ( 5 | ) where 6 | 7 | import Logic.Propositional 8 | import Logic.Propositional.Natural 9 | 10 | import Control.Applicative 11 | import Data.List 12 | import Data.Maybe 13 | import qualified Data.Set as S 14 | 15 | ------------------------------------------------------- 16 | -- prover1 -- 17 | ------------------------------------------------------- 18 | 19 | -- Our first attempt at a prover just assumes the formula it is trying to 20 | -- prove. Not the most intelligent way to do it. 21 | prover1 :: Assumptions -> Formula -> Proof 22 | prover1 assumptions f = Assumption f 23 | 24 | 25 | ------------------------------------------------------- 26 | -- prover2 -- 27 | ------------------------------------------------------- 28 | 29 | -- Our second attempt at a prover will, after first checking the list of 30 | -- assumptions for the formula, see if it can build up an And formula from 31 | -- provable subformulas. 32 | prover2 :: Assumptions -> Formula -> Proof 33 | prover2 assumptions f 34 | | f `S.member` assumptions = Assumption f 35 | | (And g h) <- f, 36 | g_proof <- prover2 assumptions g, 37 | h_proof <- prover2 assumptions h = 38 | AndIntro f g_proof h_proof 39 | | otherwise = Assumption f 40 | 41 | 42 | ------------------------------------------------------- 43 | -- prover3 -- 44 | ------------------------------------------------------- 45 | 46 | -- prover3 will incorporate prover2, and it will also attempt to conclude 47 | -- formulas from the various conjuncts of the assumptions. 48 | 49 | findAsLConjunct :: Formula -> Formula -> Maybe Formula 50 | findAsLConjunct f (And g h) 51 | | g == f = Just $ And g h 52 | | Just conjunct <- findAsLConjunct f g = Just conjunct 53 | | Just conjunct <- findAsLConjunct f h = Just conjunct 54 | findAsLConjunct _ _ = Nothing 55 | 56 | findAsRConjunct :: Formula -> Formula -> Maybe Formula 57 | findAsRConjunct f (And g h) 58 | | h == f = Just $ And g h 59 | | Just conjunct <- findAsRConjunct f g = Just conjunct 60 | | Just conjunct <- findAsRConjunct f h = Just conjunct 61 | findAsRConjunct _ _ = Nothing 62 | 63 | prover3 :: Assumptions -> Formula -> Proof 64 | prover3 assumptions f 65 | | f `S.member` assumptions = Assumption f 66 | | (conjunct:_) <- catMaybes $ (findAsLConjunct f) <$> (S.toList assumptions) = 67 | AndElimL f (prover3 assumptions conjunct) 68 | | (conjunct:_) <- catMaybes $ (findAsRConjunct f) <$> (S.toList assumptions) = 69 | AndElimR f (prover3 assumptions conjunct) 70 | | (And g h) <- f, 71 | g_proof <- prover3 assumptions g, 72 | h_proof <- prover3 assumptions h = 73 | AndIntro f g_proof h_proof 74 | | otherwise = Assumption f 75 | 76 | -- Note that there is a smarter way to do this, by finding ALL instances of the 77 | -- formula on the left and the right, finding the shallowest occurrence, and 78 | -- using that one. However, we don't want to get that fancy just yet. See below 79 | -- for the definitions. 80 | 81 | -- findAsLConjunct' :: Int -> Formula -> Formula -> [(Int, Formula)] 82 | -- findAsLConjunct' i f (And g h) 83 | -- | g == f = (i, And g h) : findAsLConjunct' (i+1) f g ++ findAsLConjunct' (i+1) f h 84 | -- | otherwise = findAsLConjunct' (i+1) f g ++ findAsLConjunct' (i+1) f h 85 | -- findAsLConjunct' _ _ _ = [] 86 | 87 | -- findAsLConjunct :: Formula -> Formula -> [(Int, Formula)] 88 | -- findAsLConjunct = findAsLConjunct' 1 89 | 90 | -- findAsRConjunct' :: Int -> Formula -> Formula -> [(Int, Formula)] 91 | -- findAsRConjunct' i f (And g h) 92 | -- | h == f = (i, And g h) : findAsRConjunct' (i+1) f g ++ findAsRConjunct' (i+1) f h 93 | -- | otherwise = findAsRConjunct' (i+1) f g ++ findAsRConjunct' (i+1) f h 94 | -- findAsRConjunct' _ _ _ = [] 95 | 96 | -- findAsRConjunct :: Formula -> Formula -> [(Int, Formula)] 97 | -- findAsRConjunct = findAsRConjunct' 1 98 | 99 | 100 | 101 | 102 | ------------------------------------------------------- 103 | -- prover4 -- 104 | ------------------------------------------------------- 105 | 106 | -- prover4 will incorporate prover3 , with the additional ability to use the 107 | -- implies introduction rule whenever it encounters an implication in the 108 | -- conclusion (and the other techniques have failed). 109 | 110 | prover4 :: Assumptions -> Formula -> Proof 111 | prover4 assumptions f 112 | | f `S.member` assumptions = Assumption f 113 | | (conjunct:_) <- catMaybes $ (findAsLConjunct f) <$> (S.toList assumptions) = 114 | AndElimL f (prover4 assumptions conjunct) 115 | | (conjunct:_) <- catMaybes $ (findAsRConjunct f) <$> (S.toList assumptions) = 116 | AndElimR f (prover4 assumptions conjunct) 117 | | And g h <- f, 118 | g_proof <- prover4 assumptions g, 119 | h_proof <- prover4 assumptions h = 120 | AndIntro f g_proof h_proof 121 | | Implies g h <- f, 122 | h_proof <- prover4 (S.insert g assumptions) h = 123 | ImpliesIntro f h_proof 124 | | otherwise = Assumption f 125 | 126 | 127 | 128 | 129 | ------------------------------------------------------- 130 | -- prover5 -- 131 | ------------------------------------------------------- 132 | 133 | -- prover5 will incorporate prover4, with the additional ability to use the 134 | -- implies elimination rule. This is the first time the prover will be 135 | -- considering several potential proofs and deciding between each of them. 136 | 137 | -- This is a work in progress. I'm not happy with it yet. 138 | 139 | -- -- Takes a formula f and a formula g, and returns a set of subformulas of g 140 | -- -- where f appears on the right hand side of an implication. 141 | -- findAsRHS :: Formula -> Formula -> S.Set Formula 142 | -- findAsRHS f (Implies g h) 143 | -- | h == f = S.singleton $ Implies g h 144 | -- | otherwise = findAsRHS f h 145 | -- findAsRHS f (And g h) = findAsRHS f g `S.union` findAsRHS f h 146 | -- findAsRHS f (Or g h) = findAsRHS f g `S.union` findAsRHS f h 147 | -- findAsRHS f _ = S.empty 148 | 149 | -- fewerAssumptions :: Proof -> Proof -> Bool 150 | -- fewerAssumptions p1 p2 151 | -- | Right a1 <- checkProof p1, 152 | -- Right a2 <- checkProof p2 = 153 | -- length a1 < length a2 154 | 155 | -- prover5' :: Assumptions -> Formula -> [Proof] 156 | -- prover5' assumptions f 157 | -- | f `S.member` assumptions = [Assumption f] 158 | -- | (conjunct:_) <- catMaybes $ (findAsLConjunct f) <$> (S.toList assumptions) = 159 | -- map (AndElimL f) (prover5' assumptions conjunct) 160 | -- | (conjunct:_) <- catMaybes $ (findAsRConjunct f) <$> (S.toList assumptions) = 161 | -- map (AndElimR f) (prover5' assumptions conjunct) 162 | -- | impliers@(_:_) <- (S.toList . S.unions) $ findAsRHS f <$> (S.toList assumptions) = 163 | -- let candidateProofs@(p1:_) = concat (map makeImpliesProof impliers) 164 | -- -- smallestProof = pickProof candidateProofs 165 | -- in candidateProofs 166 | -- | And g h <- f, 167 | -- g_proofs <- prover5' assumptions g, 168 | -- h_proofs <- prover5' assumptions h = 169 | -- liftA2 (AndIntro f) g_proofs h_proofs 170 | -- | Implies g h <- f, 171 | -- h_proofs <- prover5' (S.insert g assumptions) h = 172 | -- map (ImpliesIntro f) h_proofs 173 | -- | otherwise = [Assumption f] 174 | 175 | -- where makeImpliesProof g@(Implies h _) = 176 | -- liftA2 (ImpliesElim f) (prover5' assumptions h) (prover5' assumptions g) 177 | 178 | -- prover5 assumptions f = pickProof $ prover5' assumptions f 179 | -- where pickProof (c:cs) = foldl withFewerAssumptions c (c:cs) 180 | -- withFewerAssumptions p1 p2 = if p1 `fewerAssumptions` p2 then p1 else p2 181 | -- -- pickProof (c:cs) = foldl fewerAssumptions c (c:cs) 182 | -- -- It's not the candidate proof with the fewest assumptions. It's the one where 183 | -- -- the proof of h has the fewest assumptions! ... or is it? 184 | 185 | 186 | ------------------------------------------------------- 187 | -- sequentProver -- 188 | ------------------------------------------------------- 189 | 190 | andProofs f xs ys = S.fromList (liftA2 (\x y -> AndIntro f x y) (S.toList xs) (S.toList ys)) 191 | orProofs f xs ys = (S.map (OrIntroL f) xs) `S.union` (S.map (OrIntroR f) ys) 192 | impliesProofs f = S.map (ImpliesIntro f) 193 | 194 | -- findFormula f g 195 | -- returns the set of subformulas in g that correspond to a potential way to derive f from g. 196 | findVariable :: String -> Formula -> S.Set Formula 197 | findVariable x (And f g) 198 | | Var y <- f, x == y = S.insert (And f g) (findVariable x g) 199 | | Var z <- g, x == z = S.insert (And f g) (findVariable x f) 200 | | Var _ <- f, Var _ <- g = S.empty 201 | | otherwise = findVariable x f `S.union` findVariable x g 202 | findVariable x (Implies f g) 203 | | Var y <- g, x == y = S.singleton $ Implies f g 204 | | Var _ <- g = S.empty 205 | | otherwise = findVariable x g 206 | findVariable _ _ = S.empty 207 | 208 | sf' :: Formula -> S.Set Formula 209 | sf' f@(And g h) = S.insert f (sf' g `S.union` sf h) 210 | sf' f@(Implies g h) = S.insert f (sf' h) 211 | sf' f = S.singleton f 212 | 213 | sf :: Formula -> S.Set Formula 214 | sf f = S.delete f (sf' f) 215 | 216 | sfSets :: S.Set Formula -> S.Set Formula 217 | sfSets = foldl S.union S.empty . S.map sf 218 | 219 | -- sequentProver :: Assumptions -> Formula -> S.Set Proof 220 | -- sequentProver assumptions f 221 | -- | f `S.member` assumptions = S.singleton $ Assumption f 222 | -- | And g h <- f, 223 | -- g_proofs <- sequentProver assumptions g, 224 | -- h_proofs <- sequentProver assumptions h = 225 | -- andProofs f g_proofs h_proofs 226 | -- | Or g h <- f, 227 | -- g_proofs <- sequentProver assumptions g, 228 | -- h_proofs <- sequentProver assumptions h = 229 | -- orProofs f g_proofs h_proofs 230 | -- | Implies g h <- f, 231 | -- promoteProofs <- sequentProver (S.insert g assumptions) h = 232 | -- impliesProofs f promoteProofs 233 | 234 | -- So, we are in a variable case or bottom. 235 | -- | (conjunct:_) <- catMaybes $ (findAsLConjunct f) <$> (S.toList assumptions) = 236 | -- AndElimL f (prover3 assumptions conjunct) 237 | -- | (conjunct:_) <- catMaybes $ (findAsRConjunct f) <$> (S.toList assumptions) = 238 | -- AndElimR f (prover3 assumptions conjunct) 239 | 240 | -- We're to find all instances of f as: 241 | -- 1) conjuncts in the assumptions 242 | -- 2) consequences in the assumptions (right-hand sides) 243 | 244 | -------------------------------------------------------------------------------- /src/Logic/Propositional/Parse.hs: -------------------------------------------------------------------------------- 1 | module Logic.Propositional.Parse 2 | ( parseFormula 3 | , parseProof 4 | ) where 5 | 6 | import Logic.Propositional 7 | import Logic.Propositional.Natural 8 | import Logic.Propositional.Natural.ProofLine 9 | 10 | import Data.Maybe 11 | import Text.ParserCombinators.Parsec 12 | import qualified Data.Map.Strict as Map 13 | 14 | spacebars = skipMany (char ' ') 15 | 16 | -- | Parse a formula. 17 | 18 | parseFormula :: String -> Either ParseError Formula 19 | parseFormula input = parse (spacebars >> 20 | p_outerFormula 21 | <* skipMany (char ' ') 22 | <* eof) 23 | "Bad formula" input 24 | 25 | p_outerFormula = try (p_outerBinaryFormula "&" And) 26 | <|> try (p_outerBinaryFormula "|" Or) 27 | <|> try (p_outerBinaryFormula "=>" Implies) 28 | <|> try (p_outerBinaryFormula "<=>" iff) 29 | <|> p_formula 30 | 31 | p_formula = try (p_binaryFormula "&" And) 32 | <|> try (p_binaryFormula "|" Or) 33 | <|> try (p_binaryFormula "=>" Implies) 34 | <|> try (p_binaryFormula "<=>" iff) 35 | <|> p_neg 36 | <|> p_bottom 37 | <|> p_var 38 | "formula" 39 | 40 | p_var = 41 | do x <- many1 alphaNum 42 | return $ Var x 43 | "variable" 44 | 45 | p_outerBinaryFormula opString opFn = 46 | do f <- p_formula 47 | spacebars 48 | string opString 49 | spacebars 50 | g <- p_formula 51 | return $ opFn f g 52 | "formula" 53 | 54 | p_binaryFormula opString opFn = 55 | do p_lparen 56 | spacebars 57 | f <- p_formula 58 | spacebars 59 | string opString 60 | spacebars 61 | g <- p_formula 62 | spacebars 63 | p_rparen 64 | return $ opFn f g 65 | "binary formula" 66 | 67 | p_bottom = 68 | do string "_|_" 69 | return Bottom 70 | "_|_" 71 | 72 | p_neg = 73 | do string "~" 74 | spacebars 75 | x <- p_formula 76 | return $ Implies x Bottom 77 | 78 | p_lparen = do char '(' 79 | return () 80 | 81 | p_rparen = do char ')' 82 | return () 83 | 84 | p_lbracket = do char '[' 85 | return () 86 | 87 | p_rbracket = do char ']' 88 | return () 89 | 90 | -- | Parse a proof reference. 91 | 92 | parseProofRef :: String -> Either ParseError ProofRef 93 | parseProofRef input = parse (spacebars >> 94 | p_ref 95 | <* spacebars 96 | <* eof) 97 | "Bad proof reference" input 98 | 99 | p_ref = try (p_ref0 "Assumption" AssumptionRef) 100 | <|> try (p_ref0 "ExcludedMiddle" ExcludedMiddleRef) 101 | <|> try (p_ref1 "AndElimL" AndElimLRef) 102 | <|> try (p_ref1 "AndElimR" AndElimRRef) 103 | <|> try (p_ref1 "ImpliesIntro" ImpliesIntroRef) 104 | <|> try (p_ref1 "OrIntroL" OrIntroLRef) 105 | <|> try (p_ref1 "OrIntroR" OrIntroRRef) 106 | <|> try (p_ref1 "BottomElim" BottomElimRef) 107 | <|> try (p_ref2 "AndIntro" AndIntroRef) 108 | <|> try (p_ref2 "ImpliesElim" ImpliesElimRef) 109 | <|> try (p_ref3 "OrElim" OrElimRef) 110 | 111 | p_ref0 refString refFn = 112 | do p_lbracket 113 | spacebars 114 | string refString 115 | spacebars 116 | p_rbracket 117 | return refFn 118 | 119 | p_ref1 refString refFn = 120 | do p_lbracket 121 | spacebars 122 | string refString 123 | spacebars 124 | i <- many1 digit 125 | spacebars 126 | p_rbracket 127 | return $ refFn (read i) 128 | 129 | p_ref2 refString refFn = 130 | do p_lbracket 131 | spacebars 132 | string refString 133 | spacebars 134 | i <- many1 digit 135 | spacebars 136 | j <- many1 digit 137 | spacebars 138 | p_rbracket 139 | return $ refFn (read i) (read j) 140 | 141 | p_ref3 refString refFn = 142 | do p_lbracket 143 | spacebars 144 | string refString 145 | spacebars 146 | i <- many1 digit 147 | spacebars 148 | j <- many1 digit 149 | spacebars 150 | k <- many1 digit 151 | spacebars 152 | p_rbracket 153 | return $ refFn (read i) (read j) (read k) 154 | 155 | -- | Parsing a proof body. 156 | parseProofBody :: String -> Either ParseError [Maybe ProofLine] 157 | parseProofBody input = parse (spaces >> 158 | p_lines 159 | <* spacebars 160 | <* eof) 161 | "Bad proof body" input 162 | 163 | p_line = 164 | do spacebars 165 | i <- many1 digit 166 | spacebars 167 | char '.' 168 | spacebars 169 | f <- p_outerFormula 170 | spacebars 171 | r <- p_ref 172 | spacebars 173 | optional p_comment 174 | return $ Just (read i, (f, r)) 175 | 176 | p_comment = 177 | do string "--" 178 | many (noneOf ['\n']) 179 | return () 180 | 181 | p_blankLine = 182 | do spacebars 183 | optional p_comment 184 | return Nothing 185 | 186 | p_blankLines = many (p_blankLine <* newline) 187 | 188 | p_lines = endBy (try p_line <|> p_blankLine) (newline) 189 | 190 | -- | Parsing a proof. 191 | parseProofLines :: String -> Either ParseError [Maybe ProofLine] 192 | parseProofLines input = parse (spaces >> 193 | p_proof) 194 | "Error parsing proof" input 195 | 196 | p_proof = 197 | do p_blankLines 198 | string "Proof." 199 | spacebars 200 | newline 201 | p_blankLines 202 | body <- p_lines 203 | p_blankLines 204 | string "QED" 205 | return body 206 | 207 | parseProof :: String -> Either String Proof 208 | parseProof input = 209 | case parseProofLines input of 210 | Left parseError -> Left $ show parseError 211 | Right proofLines -> 212 | case genProof (catMaybes proofLines) of 213 | Left e -> Left e 214 | Right proof -> Right proof 215 | -------------------------------------------------------------------------------- /src/Logic/Propositional/Sequent.hs: -------------------------------------------------------------------------------- 1 | -- | Logic.Propositional.Sequent 2 | 3 | module Logic.Propositional.Sequent 4 | ( Sequent(..) 5 | , printTheorem 6 | , printTheoremAndProof 7 | , ppTheoremAndProof 8 | , ppTheoremAndProofReverse 9 | ) where 10 | 11 | import Logic.Propositional 12 | 13 | import Data.List 14 | import qualified Data.Map.Strict as M 15 | import qualified Data.Set as S 16 | 17 | data Sequent = S.Set Formula :- S.Set Formula 18 | 19 | lefts (ls: _) = ls 20 | rights ( _:rs) = rs 21 | 22 | showFormulas :: S.Set Formula -> String 23 | showFormulas = intercalate ", " . map show . S.toList 24 | 25 | instance Show Sequent where 26 | show (ls :- rs) 27 | | S.null ls && S.null rs = ":-" 28 | | S.null ls = ":- " ++ showFormulas rs 29 | | S.null rs = showFormulas ls ++ " :-" 30 | | otherwise = showFormulas ls ++ " :- " ++ showFormulas rs 31 | 32 | infix 0 :- 33 | 34 | data Proof = Axiom Sequent 35 | | RAnd Sequent Proof Proof 36 | | ROr Sequent Proof 37 | | RImplies Sequent Proof 38 | | RBottom Sequent Proof 39 | | LAnd Sequent Proof 40 | | LOr Sequent Proof Proof 41 | | LImplies Sequent Proof Proof 42 | | LBottom Sequent Proof 43 | 44 | conclusion :: Proof -> Sequent 45 | conclusion (Axiom s ) = s 46 | conclusion (RAnd s _ _) = s 47 | conclusion (ROr s _) = s 48 | conclusion (RImplies s _) = s 49 | conclusion (LAnd s _) = s 50 | conclusion (LOr s _ _) = s 51 | conclusion (LImplies s _ _) = s 52 | conclusion (LBottom s _) = s 53 | 54 | prove :: Sequent -> Either Assignment Proof 55 | prove (ls :- rs) 56 | | (f@(And g h):_) <- filter isAnd (S.toList rs) = 57 | do g_proof <- prove (ls :- S.insert g (S.delete f rs)) 58 | h_proof <- prove (ls :- S.insert h (S.delete f rs)) 59 | return $ RAnd (ls :- rs) g_proof h_proof 60 | | (f@(Or g h):_) <- filter isOr (S.toList rs) = 61 | do gh_proof <- prove (ls :- S.union (S.fromList [g,h]) (S.delete f rs)) 62 | return $ ROr (ls :- rs) gh_proof 63 | | (f@(Implies g h):_) <- filter isImplies (S.toList rs) = 64 | do gh_proof <- prove (S.insert g ls :- S.insert h (S.delete f rs)) 65 | return $ RImplies (ls :- rs) gh_proof 66 | | (f@Bottom:_) <- filter isBottom (S.toList rs) = 67 | do nof_proof <- prove (ls :- S.delete f rs) 68 | return $ RBottom (ls :- rs) nof_proof 69 | | (f@(And g h):_) <- filter isAnd (S.toList ls) = 70 | do gh_proof <- prove (S.union (S.fromList [g,h]) (S.delete f ls) :- rs) 71 | return $ LAnd (ls :- rs) gh_proof 72 | | (f@(Or g h):_) <- filter isOr (S.toList ls) = 73 | do g_proof <- prove (S.insert g (S.delete f ls) :- rs) 74 | h_proof <- prove (S.insert h (S.delete f ls) :- rs) 75 | return $ LOr (ls :- rs) g_proof h_proof 76 | | (f@(Implies g h):_) <- filter isImplies (S.toList ls) = 77 | do g_proof <- prove (S.delete f ls :- S.insert g rs) 78 | h_proof <- prove (S.insert h (S.delete f ls) :- rs) 79 | return $ LImplies (ls :- rs) g_proof h_proof 80 | | (Bottom:_) <- filter isBottom (S.toList ls) = return $ Axiom (ls :- rs) 81 | | otherwise = if S.null (S.intersection ls rs) 82 | then Left $ counterExample (S.toList ls) (S.toList rs) 83 | else return $ Axiom (ls :- rs) 84 | where isAnd f = case f of (And _ _) -> True; _ -> False 85 | isOr f = case f of (Or _ _) -> True; _ -> False 86 | isImplies f = case f of (Implies _ _) -> True; _ -> False 87 | isBottom f = case f of Bottom -> True; _ -> False 88 | 89 | counterExample :: [Formula] -> [Formula] -> Assignment 90 | counterExample (Var x:fs) gs = (x, True) : counterExample fs gs 91 | counterExample [] (Var y:gs) = (y, False) : counterExample [] gs 92 | counterExample [] [] = [] 93 | counterExample _ _ = error "called counterExample on sequent with non-variable" 94 | 95 | showProof :: String -> Proof -> String 96 | showProof pad (Axiom s) = pad ++ show s ++ " [Axiom]" 97 | showProof pad (RAnd s p1 p2) = 98 | pad ++ show s ++ " [RAnd]\n" ++ 99 | showProof (pad++" ") p1 ++ "\n" ++ 100 | showProof (pad++" ") p2 101 | showProof pad (ROr s p) = 102 | pad ++ show s ++ " [ROr]\n" ++ 103 | showProof (pad++" ") p 104 | showProof pad (RImplies s p) = 105 | pad ++ show s ++ " [RImplies]\n" ++ 106 | showProof (pad++" ") p 107 | showProof pad (RBottom s p) = 108 | pad ++ show s ++ " [RBottom]\n" ++ 109 | showProof (pad++" ") p 110 | showProof pad (LAnd s p) = 111 | pad ++ show s ++ " [LAnd]\n" ++ 112 | showProof (pad++" ") p 113 | showProof pad (LOr s p1 p2) = 114 | pad ++ show s ++ " [LOr]\n" ++ 115 | showProof (pad++" ") p1 ++ "\n" ++ 116 | showProof (pad++" ") p2 117 | showProof pad (LImplies s p1 p2) = 118 | pad ++ show s ++ " [LImplies]\n" ++ 119 | showProof (pad++" ") p1 ++ "\n" ++ 120 | showProof (pad++" ") p2 121 | showProof pad (LBottom s p) = 122 | pad ++ show s ++ " [LBottom]\n" ++ 123 | showProof (pad++" ") p 124 | 125 | instance Show Proof where 126 | show = showProof "" 127 | 128 | printTheorem :: Formula -> String 129 | printTheorem f = case prove (S.fromList [] :- S.fromList [f]) of 130 | Left _ -> show f ++ " is not a theorem." 131 | Right _ -> show f ++ " is a theorem." 132 | 133 | printTheoremAndProof :: Formula -> String 134 | printTheoremAndProof f = case prove (S.fromList [] :- S.fromList [f]) of 135 | Left a -> show f ++ " is not a theorem.\n" ++ 136 | "Counterexample:\n" ++ pad 2 0 (showAssignment a) 137 | Right p -> show f ++ " is a theorem.\n" ++ 138 | "Proof:\n" ++ (show p) 139 | 140 | -- | Pretty printing 141 | 142 | stringWidth :: String -> Int 143 | stringWidth = maximum . map length . lines 144 | 145 | coLines :: [String] -> [String] -> ([String], [String]) 146 | coLines (x1:x2:xs) (y1:y2:ys) = 147 | let (xs',ys') = coLines (x2:xs) (y2:ys) in (x1:xs',y1:ys') 148 | coLines (x1:[]) (y1:y2:ys) = 149 | let (xs',ys') = coLines [replicate (length x1) ' '] (y2:ys) 150 | in (x1:xs',y1:ys') 151 | coLines (x1:x2:xs) (y1:[]) = 152 | let (xs',ys') = coLines (x2:xs) [replicate (length y1) ' '] 153 | in (x1:xs',y1:ys') 154 | coLines (x:[]) (y:[]) = ([x],[y]) 155 | coLines _ _ = error "coLines called with two empty arguments" 156 | 157 | spliceLines :: String -> String -> String 158 | spliceLines s1 s2 = unlines $ zipWith spliceLine lines1 lines2 159 | where spliceLine s1 s2 = s1 ++ " | " ++ s2 160 | (lines1, lines2) = coLines (lines s1) (lines s2) 161 | 162 | padLine :: Int -> Int -> String -> String 163 | padLine i j s = replicate i ' ' ++ s ++ replicate j ' ' 164 | 165 | pad :: Int -> Int -> String -> String 166 | pad i j = unlines . map (padLine i j) . lines 167 | 168 | ppProofStep :: String -> String -> String 169 | ppProofStep ppSeq ppPf = 170 | let seqWidth = stringWidth ppSeq 171 | ppPfWidth = stringWidth ppPf 172 | totalWidth = max seqWidth ppPfWidth 173 | seqPadL = (totalWidth - seqWidth) `div` 2 174 | seqPadR = totalWidth - (seqPadL + seqWidth) 175 | pfPadL = (totalWidth - ppPfWidth) `div` 2 176 | pfPadR = totalWidth - (pfPadL + ppPfWidth) 177 | in pad seqPadL seqPadR ppSeq ++ 178 | -- replicate totalWidth '-' ++ "\n" ++ 179 | pad seqPadL seqPadR (replicate seqWidth '-') ++ 180 | pad pfPadL pfPadR ppPf 181 | 182 | ppProof :: Proof -> String 183 | ppProof (Axiom seq) = 184 | let ppSeq = show seq 185 | seqWidth = stringWidth ppSeq 186 | in ppSeq ++ "\n" ++ replicate seqWidth '-' ++ "\n" 187 | ppProof (RAnd seq pf1 pf2) = 188 | ppProofStep (show seq) (spliceLines (ppProof pf1) (ppProof pf2)) 189 | ppProof (ROr seq pf) = ppProofStep (show seq) (ppProof pf) 190 | ppProof (RImplies seq pf) = ppProofStep (show seq) (ppProof pf) 191 | ppProof (RBottom seq pf) = ppProofStep (show seq) (ppProof pf) 192 | ppProof (LAnd seq pf) = ppProofStep (show seq) (ppProof pf) 193 | ppProof (LOr seq pf1 pf2) = 194 | ppProofStep (show seq) (spliceLines (ppProof pf1) (ppProof pf2)) 195 | ppProof (LImplies seq pf1 pf2) = 196 | ppProofStep (show seq) (spliceLines (ppProof pf1) (ppProof pf2)) 197 | ppProof (LBottom seq pf) = ppProofStep (show seq) (ppProof pf) 198 | 199 | reverseLines :: String -> String 200 | reverseLines = unlines . reverse . lines 201 | 202 | ppProofReverse :: Proof -> String 203 | ppProofReverse = reverseLines . ppProof 204 | 205 | ppTheoremAndProof :: Formula -> String 206 | ppTheoremAndProof f = case prove (S.fromList [] :- S.fromList [f]) of 207 | Left a -> show f ++ " is not a theorem.\n" ++ 208 | "Counterexample:\n" ++ pad 2 0 (showAssignment a) 209 | Right p -> "Theorem: " ++ show f ++ "\n" ++ 210 | "Proof:\n" ++ ppProof p 211 | 212 | ppTheoremAndProofReverse :: Formula -> String 213 | ppTheoremAndProofReverse f = case prove (S.fromList [] :- S.fromList [f]) of 214 | Left a -> show f ++ " is not a theorem.\n" ++ 215 | "Counterexample:\n" ++ pad 2 0 (showAssignment a) 216 | Right p -> "Theorem: " ++ show f ++ "\n" ++ 217 | "Proof:\n" ++ ppProofReverse p 218 | -------------------------------------------------------------------------------- /src/Logic/Propositional/TruthTable.hs: -------------------------------------------------------------------------------- 1 | -- | Logic.Propositional.TruthTable 2 | 3 | module Logic.Propositional.TruthTable 4 | ( truthTable 5 | , truthTableAndMessage 6 | ) where 7 | 8 | import Logic.Propositional 9 | 10 | import qualified Data.Set as S 11 | import Data.Maybe 12 | 13 | variables :: Formula -> S.Set String 14 | variables (Var x) = S.singleton x 15 | variables (And f g) = variables f `S.union` variables g 16 | variables (Or f g) = variables f `S.union` variables g 17 | variables (Implies f g) = variables f `S.union` variables g 18 | variables (Bottom) = S.empty 19 | 20 | varList :: Formula -> [String] 21 | varList = S.toList . variables 22 | 23 | assignments :: [String] -> [Assignment] 24 | assignments [] = [[]] 25 | assignments (x:xs) = [(x,a):as | a <- [True, False] , as <- assignments xs] 26 | 27 | evalFormula :: Formula -> Assignment -> Either String Bool 28 | evalFormula (Var x) as = case lookup x as of 29 | Nothing -> Left x 30 | Just v -> return v 31 | evalFormula (And f g) as = do 32 | f' <- evalFormula f as 33 | g' <- evalFormula g as 34 | return $ f' && g' 35 | evalFormula (Or f g) as = do 36 | f' <- evalFormula f as 37 | g' <- evalFormula g as 38 | return $ f' || g' 39 | evalFormula (Implies f g) as = do 40 | f' <- evalFormula f as 41 | g' <- evalFormula g as 42 | return $ if f' then g' else True 43 | evalFormula (Bottom) as = return False 44 | 45 | ttHeader :: Formula -> String 46 | ttHeader f = concat (map columnHeader (varList f)) ++ 47 | "| " ++ show f ++ " \n" 48 | where columnHeader x = " " ++ x ++ " |" 49 | 50 | ttSeparator :: Formula -> String 51 | ttSeparator f = replicate (length columnHeaders - 1) '-' ++ 52 | "||" ++ (replicate (length (show f) + 2) '-') ++ "\n" 53 | where columnHeader x = " " ++ x ++ " |" 54 | columnHeaders = concat (map columnHeader (varList f)) 55 | 56 | stringWidth :: String -> Int 57 | stringWidth = maximum . map length . lines 58 | 59 | padLine :: Int -> Int -> String -> String 60 | padLine i j s = replicate i ' ' ++ s ++ replicate j ' ' 61 | 62 | pad :: Int -> Int -> String -> String 63 | pad i j = unlines . map (padLine i j) . lines 64 | 65 | ttRow :: Formula -> Assignment -> String 66 | ttRow f as = concat (map rowEntry (varList f)) ++ 67 | "| " ++ pad lpad rpad (boolTF f') 68 | where rowEntry x = padLine (varLpad x) (varRpad x) ((boolTF . fromJust .lookup x) as) ++ "|" 69 | varLpad x = (stringWidth (show x)) `div` 2 70 | varRpad x = (stringWidth (show x)) - (varLpad x) - 1 71 | boolTF True = "T" 72 | boolTF False = "F" 73 | (Right f') = evalFormula f as 74 | formulaWidth = stringWidth (show f) 75 | lpad = formulaWidth `div` 2 76 | rpad = formulaWidth - lpad 77 | 78 | truthTable :: Formula -> String 79 | truthTable f = header ++ separator ++ 80 | concat [ttRow f as | as <- assignments (varList f)] 81 | where header = ttHeader f 82 | separator = ttSeparator f 83 | 84 | truthTableAndMessage :: Formula -> String 85 | truthTableAndMessage f = (if all testFormula (assignments (varList f)) then 86 | show f ++ " is a theorem.\n\nTruth table:\n" 87 | else 88 | show f ++ " is not a theorem.\n\nTruth Table:\n") ++ 89 | pad 2 0 (truthTable f) 90 | where testFormula a | Right v <- evalFormula f a = v 91 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Logic.Propositional 4 | import qualified Logic.Propositional.Natural as N 5 | import qualified Logic.Propositional.Sequent as S 6 | import Logic.Propositional.Parse 7 | import Logic.Propositional.TruthTable 8 | 9 | import Control.Lens 10 | import Control.Monad 11 | import System.Console.CmdArgs.Explicit 12 | import System.Environment (getArgs) 13 | import System.Exit (exitFailure) 14 | import System.IO 15 | 16 | -- | Action to perform when running 17 | data Action 18 | = Check 19 | | CheckWithProof 20 | | PrintRule 21 | | Prove 22 | | SampleProof 23 | | ShowHelp 24 | | ShowVersion 25 | 26 | -- | Command line arguments. 27 | data Args = Args { _checkAction :: !Action 28 | , _rule :: !String 29 | , _proofPath :: !FilePath 30 | } 31 | 32 | -- | Action to perform when running 33 | checkAction :: Simple Lens Args Action 34 | checkAction = lens _checkAction (\s v -> s { _checkAction = v }) 35 | 36 | rule :: Simple Lens Args String 37 | rule = lens _rule (\s v -> s { _rule = v }) 38 | 39 | proofPath :: Simple Lens Args FilePath 40 | proofPath = lens _proofPath (\s v -> s { _proofPath = v }) 41 | 42 | -- | Initial arguments if nothing is specified. 43 | defaultArgs :: Args 44 | defaultArgs = Args { _checkAction = Check 45 | , _rule = ruleList 46 | , _proofPath = "" 47 | } 48 | 49 | -- | Flags. 50 | 51 | checkWithProofFlag :: Flag Args 52 | checkWithProofFlag = flagNone [ "show-proof", "p" ] upd help 53 | where upd = checkAction .~ CheckWithProof 54 | help = "Show the parsed proof along with the theorem." 55 | 56 | sampleProofFlag :: Flag Args 57 | sampleProofFlag = flagNone [ "sample", "s" ] upd help 58 | where upd = checkAction .~ SampleProof 59 | help = "Print a sample proof to stdout. To test this, \ 60 | \redirect the file to a file with > sample.pf \ 61 | \and run `check sample.pf`." 62 | 63 | parseRuleFlag :: String -> Either String String 64 | parseRuleFlag rl = 65 | case rl of 66 | "Assumption" -> return assumptionSummary 67 | "AndIntro" -> return andIntroSummary 68 | "AndElim" -> return andElimSummary 69 | "AndElimR" -> return andElimSummary 70 | "AndElimL" -> return andElimSummary 71 | "ImpliesIntro" -> return impliesIntroSummary 72 | "ImpliesElim" -> return impliesElimSummary 73 | "OrIntro" -> return orIntroSummary 74 | "OrIntroL" -> return orIntroSummary 75 | "OrIntroR" -> return orIntroSummary 76 | "OrElim" -> return orElimSummary 77 | "BottomElim" -> return bottomElimSummary 78 | "ExcludedMiddle" -> return excludedMiddleSummary 79 | "all" -> return ruleList 80 | "" -> return ruleList 81 | otherwise -> Left $ "Unknown rule: " ++ rl 82 | 83 | ruleFlag :: Flag Args 84 | ruleFlag = flagOpt "all" [ "show-rule", "r" ] upd "RULE" help 85 | where upd s old = 86 | do newRule <- parseRuleFlag s 87 | Right $ (rule .~ newRule) ((checkAction .~ PrintRule) old) 88 | help = "Print info about a particular rule. To see a list of all \ 89 | \rules, along with a list of all the connectives, use \ 90 | \--show-rule=all (or provide no explicit argument)." 91 | 92 | proveFlag :: Flag Args 93 | proveFlag = flagNone ["prove"] upd help 94 | where upd = checkAction .~ Prove 95 | help = "Prove a propositional formula using the sequent calculus \ 96 | \using a REPL interface." 97 | 98 | arguments :: Mode Args 99 | arguments = mode "check" defaultArgs help filenameArg flags 100 | where help = checkVersion ++ "\n" ++ copyrightNotice 101 | flags = [ checkWithProofFlag 102 | , sampleProofFlag 103 | , ruleFlag 104 | , proveFlag 105 | , flagHelpSimple (checkAction .~ ShowHelp) 106 | , flagVersion (checkAction .~ ShowVersion) 107 | ] 108 | 109 | -- printProofFlag :: Flag Args 110 | -- printProofFlag = flagNone [ "proof", "p" ] upd help 111 | -- where upd = checkAction 112 | 113 | checkVersion :: String 114 | checkVersion = "PropCheck propositional logic checker (check) " ++ 115 | versionString ++ ", June 2017." 116 | where versionString = "0.0.1" 117 | 118 | copyrightNotice :: String 119 | copyrightNotice = "Copyright 2017 Ben Selfridge. All rights reserved." 120 | 121 | filenameArg :: Arg Args 122 | filenameArg = Arg { argValue = setFilename 123 | , argType = "[FILE]" 124 | , argRequire = False 125 | } 126 | where setFilename :: String -> Args -> Either String Args 127 | setFilename nm a = Right (a & proofPath .~ nm) 128 | 129 | 130 | getCommandLineArgs :: IO Args 131 | getCommandLineArgs = do 132 | argStrings <- getArgs 133 | case process arguments argStrings of 134 | Left msg -> do 135 | hPutStrLn stderr msg 136 | exitFailure 137 | Right v -> return v 138 | 139 | -- | Execution. 140 | 141 | check :: FilePath -> IO () 142 | check path = do 143 | when (null path) $ do 144 | hPutStrLn stderr "Please specify a path." 145 | hPutStrLn stderr "For help on using check, run \"check --help\"." 146 | exitFailure 147 | proofString <- readFile path 148 | case parseProof proofString of 149 | Left e -> putStrLn e 150 | Right proof -> putStrLn $ N.ppTheorem proof 151 | 152 | 153 | checkWithProof :: FilePath -> IO () 154 | checkWithProof path = do 155 | when (null path) $ do 156 | hPutStrLn stderr "Please specify a path." 157 | hPutStrLn stderr "For help on using check, run \"check --help\"." 158 | exitFailure 159 | proofString <- readFile path 160 | case parseProof proofString of 161 | Left e -> putStrLn e 162 | Right proof -> putStrLn $ N.ppTheoremAndProof proof 163 | 164 | sampleProof :: String 165 | sampleProof = 166 | "-- Here is a simple proof of transitivity. Also, this is a comment!\n\ 167 | \\n\ 168 | \-- Every proof starts with the keyword \"Proof.\"\n\ 169 | \Proof.\n\ 170 | \\n\ 171 | \-- Next, we list the steps of our proof. You can use any order of\n\ 172 | \-- numbers that you want, but make sure there are no duplicates.\n\ 173 | \\n\ 174 | \1. a => b [Assumption]\n\ 175 | \2. b => c [Assumption]\n\ 176 | \3. a [Assumption]\n\ 177 | \4. b [ImpliesElim 3 1]\n\ 178 | \5. c [ImpliesElim 4 2]\n\ 179 | \\n\ 180 | \-- The last statement in a proof is taken as the conclusion by default.\n\ 181 | \6. a => c [ImpliesIntro 5]\n\ 182 | \\n\ 183 | \-- Our proof is complete!\n\ 184 | \QED\n" 185 | 186 | putSampleProof :: IO () 187 | putSampleProof = putStr sampleProof 188 | 189 | assumptionSummary :: String 190 | assumptionSummary = 191 | "-- Rule of assumption --\n\ 192 | \\n\ 193 | \Format: [Assumption]\n\ 194 | \\n\ 195 | \The rule of assumption allows the introduction of any hypothesis, with\n\ 196 | \the implicit cost that unless it is discharged at a later point in the\n\ 197 | \proof, it will appear as a top-level hypothesis. This rule requires no\n\ 198 | \references to any other lines in a proof." 199 | 200 | andIntroSummary :: String 201 | andIntroSummary = 202 | "-- Rule of and introduction --\n\ 203 | \\n\ 204 | \Format: f & g [AndIntro i j]\n\ 205 | \\n\ 206 | \ (where line i has conclusion f,\n\ 207 | \line j has conclusion g)\n\ 208 | \\n\ 209 | \The rule of and introduction allows the introduction of a new formula,\n\ 210 | \f & g, given two references, i and j, to lines in the proof concluding\n\ 211 | \f and g respectively." 212 | 213 | andElimSummary :: String 214 | andElimSummary = 215 | "-- Rule of and elimination --\n\ 216 | \\n\ 217 | \Formats: f [AndElimL i]\n\ 218 | \ g [AndElimR i]\n\ 219 | \\n\ 220 | \ (where line i has conclusion f & g for some formula g)\n\ 221 | \\n\ 222 | \The rules of and elimination allow us to conclude formulas f and g,\n\ 223 | \given a reference i to a line in the proof concluding f & g." 224 | 225 | impliesIntroSummary :: String 226 | impliesIntroSummary = 227 | "-- Rule of implies introduction --\n\ 228 | \\n\ 229 | \Format: f => g [ImpliesIntro i]\n\ 230 | \\n\ 231 | \ (where line i has conclusion g)\n\ 232 | \\n\ 233 | \The rule of implies introduction allows us conclude f => g, given a\n\ 234 | \reference i to a line in the proof concluding g. This rule has the\n\ 235 | \benefit of discharging the assumption f, wherever it may occur in the\n\ 236 | \proof tree of the formula f => g. Note that if thep assumption f is\n\ 237 | \used elsewhere in the proof, outside the scope of this formula, then\n\ 238 | \it may still appear as a top-level assumption." 239 | 240 | impliesElimSummary :: String 241 | impliesElimSummary = 242 | "-- Rule of implies elimination --\n\ 243 | \\n\ 244 | \Format: f [ImpliesElim i j]\n\ 245 | \\n\ 246 | \ (where line i has conclusion g for some formula g,\n\ 247 | \ line j has conclusion g => f)\n\ 248 | \\n\ 249 | \The rule of implies elimination (or modus ponens) allows us to\n\ 250 | \conclude a formula f, given two references, i and j, to lines in the\n\ 251 | \proof concluding g and g => f, respectively, where g can be any\n\ 252 | \formula." 253 | 254 | orIntroSummary :: String 255 | orIntroSummary = 256 | "-- Rule of or introduction --\n\ 257 | \\n\ 258 | \Formats: f | g [OrIntroL i]\n\ 259 | \ f | g [OrIntroR j]\n\ 260 | \\n\ 261 | \ (where line i has conclusion f,\n\ 262 | \ or line j has conclusion g)\n\ 263 | \\n\ 264 | \The rule of or introduction allows the introduction of a new formula,\n\ 265 | \f | g, given a reference i (j) to a line in the proof concluding f\n\ 266 | \(g)." 267 | 268 | orElimSummary :: String 269 | orElimSummary = 270 | "-- Rule of or elimination --\n\ 271 | \\n\ 272 | \Format: f [OrElim i j k]\n\ 273 | \\n\ 274 | \ (where line i has conclusion g | h for some formulas g and h,\n\ 275 | \ line j has conclusion f,\n\ 276 | \ line k has conclusion f)\n\ 277 | \\n\ 278 | \The rule of or elimination allows us to conclude a formula f, given\n\ 279 | \three references, i, j, and k, to lines in the proof concluding g | h,\n\ 280 | \f, and f, respectively. This rule has the benefit of discharging the\n\ 281 | \assumption g in the proof of line j, along with the assumption h in\n\ 282 | \the proof of line k. Note that if these assumptions are used elsewhere\n\ 283 | \in the proof, outside the scope of those respective formulas, then\n\ 284 | \they may still appear as top-level assumptions." 285 | 286 | bottomElimSummary :: String 287 | bottomElimSummary = 288 | "-- Rule of bottom elimination --\n\ 289 | \\n\ 290 | \Formats: f [BottomElim i]\n\ 291 | \\n\ 292 | \ (where line i has conclusion _|_)\n\ 293 | \\n\ 294 | \THe rule of bottom elimination (or absurdity) allows us to conclude\n\ 295 | \any formula f, given a reference to a proof i concluding _|_\n\ 296 | \(bottom)." 297 | 298 | excludedMiddleSummary :: String 299 | excludedMiddleSummary = 300 | "-- Rule of excluded middle --\ 301 | \\n\ 302 | \Formats: f | ~f [ExcludedMiddle]\n\ 303 | \\n\ 304 | \The rule of excluded middle takes constructive logic and turns it into\n\ 305 | \classical logic, where every statement is either true or false. It\n\ 306 | \says that for any formula f, it is either true or it is false. This is\n\ 307 | \a very powerful law, because it always permits us to case split on the\n\ 308 | \truth or falsehood of any particular statement. This enables us to do\n\ 309 | \proofs by contradiction; without this law, we couldn't prove\n\ 310 | \DeMorgan's laws, Peirce's laws, and a number of other intuitively\n\ 311 | \clear formulas.\n" 312 | 313 | allRuleSummaries :: String 314 | allRuleSummaries = 315 | assumptionSummary ++ "\n\n" ++ 316 | andIntroSummary ++ "\n\n" ++ 317 | andElimSummary ++ "\n\n" ++ 318 | impliesIntroSummary ++ "\n\n" ++ 319 | impliesElimSummary ++ "\n\n" ++ 320 | orIntroSummary ++ "\n\n" ++ 321 | orElimSummary ++ "\n\n" ++ 322 | bottomElimSummary ++ "\n\n" ++ 323 | excludedMiddleSummary 324 | 325 | ruleList :: String 326 | ruleList = 327 | "Complete list of rules:\n\ 328 | \\n\ 329 | \ Assumption\n\ 330 | \ AndIntro\n\ 331 | \ AndElim(L,R)\n\ 332 | \ ImpliesIntro\n\ 333 | \ ImpliesElim\n\ 334 | \ OrIntro(L,R)\n\ 335 | \ OrElim\n\ 336 | \ BottomElim\n\ 337 | \\n\ 338 | \Complete list of connectives:\n\ 339 | \ 0-ary:\n\ 340 | \ _|_\n\ 341 | \ 1-ary:\n\ 342 | \ ~ (~a, abbreviates a => _|_)\n\ 343 | \ 2-ary:\n\ 344 | \ & (a & b)\n\ 345 | \ | (a | b)\n\ 346 | \ => (a => b)\n\ 347 | \ <=> (a <=> b, abbreviates (a => b) & (b => a))\n\ 348 | \\n\ 349 | \(if you want to see more info on a particular rule, try -r=, where \n\ 350 | \ is one of the above)" 351 | 352 | proveREPL :: Bool -> Bool -> Bool -> IO () 353 | proveREPL pp seqMode ud = do 354 | putStr "> " 355 | hFlush stdout 356 | fStr <- getLine 357 | case words fStr of 358 | (":q":[]) -> return () 359 | (":h":[]) -> do putStrLn "Type any formula to prove or find a counterexample." 360 | putStrLn "Special commands:" 361 | putStrLn " :q -> quit" 362 | putStrLn " :h -> display this help message" 363 | putStrLn " :p -> toggle pretty printing (enabled by default)" 364 | putStrLn " :u -> toggle upside-down printing (disabled by default" 365 | putStrLn " :m [sequent,truth] -> change between sequent and truth table modes" 366 | proveREPL pp seqMode ud 367 | (":p":[]) -> case pp of 368 | True -> do { putStrLn "Pretty printing disabled.";proveREPL False seqMode ud } 369 | False -> do { putStrLn "Pretty printing enabled.";proveREPL True seqMode ud } 370 | (":u":[]) -> case ud of 371 | True -> do { putStrLn "Upside-down printing disabled.";proveREPL pp seqMode False} 372 | False -> do { putStrLn "Upside-down printing enabled.";proveREPL pp seqMode True} 373 | (":m":"sequent":_) -> do { putStrLn "Sequent proof mode."; proveREPL pp True ud } 374 | (":m":"truth":_) -> do { putStrLn "Truth table proof mode."; proveREPL pp False ud } 375 | (":m":m:_) -> do { putStrLn $ "Invalid proof mode " ++ m ++ ". [sequent, truth]"; 376 | proveREPL pp seqMode ud } 377 | ((':':c):_) -> do { putStrLn $ "Invalid command :" ++ c ++ "."; proveREPL pp seqMode ud } 378 | _ -> case parseFormula fStr of 379 | Left e -> do { print e; proveREPL pp seqMode ud } 380 | Right f -> do 381 | if seqMode -- sequent proof mode 382 | then case (pp, ud) of 383 | (True, True) -> putStr (S.ppTheoremAndProofReverse f) 384 | (True, False) -> putStr (S.ppTheoremAndProof f) 385 | (False, _) -> putStrLn (S.printTheoremAndProof f) 386 | else putStr (truthTableAndMessage f) 387 | proveREPL pp seqMode ud 388 | 389 | 390 | main :: IO () 391 | main = do 392 | args <- getCommandLineArgs 393 | case args^.checkAction of 394 | Check -> do 395 | check (args^.proofPath) 396 | CheckWithProof -> do 397 | checkWithProof (args^.proofPath) 398 | SampleProof -> putSampleProof 399 | PrintRule -> putStrLn (args ^. rule) 400 | Prove -> do 401 | putStrLn "Enter a formula. Type \":h\" for help.\n" 402 | proveREPL True True False 403 | putStrLn "Bye!" 404 | ShowHelp -> 405 | print $ helpText [] HelpFormatDefault arguments 406 | ShowVersion -> 407 | putStrLn (modeHelp arguments) 408 | -------------------------------------------------------------------------------- /src/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/rule_summaries.txt: -------------------------------------------------------------------------------- 1 | -- Rule of assumption -- 2 | 3 | Format: [Assumption] 4 | 5 | The rule of assumption allows the introduction of any hypothesis, with 6 | the implicit cost that unless it is discharged at a later point in the 7 | proof, it will appear as a top-level hypothesis. This rule requires no 8 | references to any other lines in a proof. 9 | 10 | -- Rule of and introduction -- 11 | 12 | Format: f & g [AndIntro i j] 13 | 14 | (where line i has conclusion f, 15 | line j has conclusion g) 16 | 17 | The rule of and introduction allows the introduction of a new formula, 18 | f & g, given two references, i and j, to lines in the proof concluding 19 | f and g respectively. 20 | 21 | -- Rule of and elimination -- 22 | 23 | Formats: f [AndElimL i] 24 | g [AndElimR i] 25 | 26 | (where line i has conclusion f & g for some formula g) 27 | 28 | The rules of and elimination allow us to conclude formulas f and g, 29 | given a reference i to a line in the proof concluding f & g. 30 | 31 | -- Rule of implies introduction -- 32 | 33 | Format: f => g [ImpliesIntro i] 34 | 35 | (where line i has conclusion g) 36 | 37 | The rule of implies introduction allows us conclude f => g, given a 38 | reference i to a line in the proof concluding g. This rule has the 39 | benefit of discharging the assumption f, wherever it may occur in the 40 | proof tree of the formula f => g. Note that if the assumption f is 41 | used elsewhere in the proof, outside the scope of this formula, then 42 | it may still appear as a top-level assumption. 43 | 44 | -- Rule of implies elimination -- 45 | 46 | Format: f [ImpliesElim i j] 47 | 48 | (where line i has conclusion g for some formula g, 49 | line j has conclusion g => f) 50 | 51 | The rule of implies elimination (or modus ponens) allows us to 52 | conclude a formula f, given two references, i and j, to lines in the 53 | proof concluding g and g => f, respectively, where g can be any 54 | formula. 55 | 56 | -- Rule of or introduction -- 57 | 58 | Formats: f | g [OrIntroL i] 59 | f | g [OrIntroR j] 60 | 61 | (where line i has conclusion f, 62 | line j has conclusion g) 63 | 64 | The rule of or introduction allows the introduction of a new formula, 65 | f | g, given a reference i (j) to a line in the proof concluding f 66 | (g). 67 | 68 | -- Rule of or elimination -- 69 | 70 | Format: f [OrElim i j k] 71 | 72 | (where line i has conclusion g | h for some formulas g and h, 73 | line j has conclusion f, 74 | line k has conclusion f) 75 | 76 | The rule of or elimination allows us to conclude a formula f, given 77 | three references, i, j, and k, to lines in the proof concluding g | h, 78 | f, and f, respectively. This rule has the benefit of discharging the 79 | assumption g in the proof of line j, along with the assumption h in 80 | the proof of line k. Note that if these assumptions are used elsewhere 81 | in the proof, outside the scope of those respective formulas, then 82 | they may still appear as top-level assumptions. 83 | 84 | -- Rule of bottom elimination -- 85 | 86 | Formats: f [BottomElim i] 87 | 88 | (where line i has conclusion _|_) 89 | 90 | THe rule of bottom elimination (or absurdity) allows us to conclude 91 | any formula f, given a reference to a proof i concluding _|_ 92 | (bottom). 93 | 94 | -- Rule of excluded middle -- 95 | 96 | Formats: f | !f [ExcludedMiddle] 97 | 98 | The rule of excluded middle takes constructive logic and turns it into 99 | classical logic, where every statement is either true or false. It 100 | says that for any formula f, it is either true or it is false. This is 101 | a very powerful law, because it always permits us to case split on the 102 | truth or falsehood of any particular statement. This enables us to do 103 | proofs by contradiction; without this law, we couldn't prove 104 | DeMorgan's laws, Peirce's laws, and a number of other intuitively 105 | clear formulas. 106 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-8.20 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.3" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor --------------------------------------------------------------------------------