├── Makefile ├── README.md ├── dune-project ├── easier_proof.opam ├── examples ├── bool │ ├── .ocamlformat │ ├── bin │ │ ├── .ocamlformat │ │ ├── dune │ │ └── main.ml │ ├── bool.ml │ └── readme.md ├── cleanup.rb ├── configure.sh ├── coq_lib │ └── CpdtTactics.v ├── equality │ ├── .ocamlformat │ └── readme.md ├── generate.rb ├── list │ ├── .ocamlformat │ ├── bin │ │ ├── .ocamlformat │ │ ├── dune │ │ └── main.ml │ ├── list.ml │ └── readme.md ├── nat │ ├── .ocamlformat │ ├── bin │ │ ├── .ocamlformat │ │ ├── dune │ │ └── main.ml │ ├── nat.ml │ └── readme.md └── readme.md └── src ├── .ocamlformat ├── ast.ml ├── ast.mli ├── dslProp.ml ├── dune ├── generateProofs.ml ├── generateProofs.mli └── tests ├── .ocamlformat ├── dune └── easier_proof_test.ml /Makefile: -------------------------------------------------------------------------------- 1 | .DEFAULT_GOAL := all 2 | 3 | .PHONY: all 4 | all: 5 | dune build @all 6 | 7 | .PHONY: check 8 | check: 9 | dune build @check 10 | 11 | .PHONY: test 12 | test: # Run the unit tests 13 | dune build @src/tests/runtest 14 | 15 | .PHONY: clean 16 | clean: # Clean build artifacts and other generated files 17 | dune clean 18 | 19 | .PHONY: fmt 20 | fmt: # Format the codebase with ocamlformat 21 | dune build @fmt --auto-promote 22 | 23 | .PHONY: watch 24 | watch: # Watch for the filesyste, and rebuild on every change 25 | dune build --watch 26 | 27 | .PHONY: doc 28 | doc: # Generate odoc 29 | dune build @doc-private -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # easier-proofs 2 | This project aims to help making proofs easier by providing a DSL which can express assertions and proof. This tool is using the `Coq` Proof Assistance. 3 | 4 | ## Use easier-proof as a library in your project. 5 | 6 | You have to clone easier-proof and install it locally with `opam install .` at the root of the project. 7 | After that you can add "easier_proof" in your dune "librairies" stanza. 8 | 9 | 10 | ## How to use it 11 | 12 | The [`crush`](https://github.com/jwiegley/coq-haskell/blob/master/src/Crush.v) custom tactic of [Adam Chlipala](http://adam.chlipala.net/) from certified programming with dependent types is widely use in this project. 13 | 14 | Let us consider this simple example with the commutative property of addition on natural numbers. 15 | 16 | First of all, we have this OCaml code in a "proof" directory, into your entire project. 17 | 18 | ```ocaml 19 | type nat = 20 | | Zero 21 | | S of nat 22 | 23 | let pred (n : nat) : nat = match n with 24 | | Zero -> Zero 25 | | S p -> p 26 | 27 | let rec add (n : nat) (m : nat) : nat = match n with 28 | | Zero -> m 29 | | S p -> S (add p m) 30 | ``` 31 | 32 | We generate the Coq code for this Ocaml code by using the tool [**coq-of-ocaml**](https://github.com/foobar-land/coq-of-ocaml). 33 | 34 | ```coq 35 | Inductive nat : Set := 36 | | Zero : nat 37 | | S : nat -> nat. 38 | 39 | Definition pred (n : nat) : nat := 40 | match n with 41 | | Zero => Zero 42 | | S p => p 43 | end. 44 | 45 | Fixpoint add (n : nat) (m : nat) : nat := 46 | match n with 47 | | Zero => m 48 | | S p => S (add p m) 49 | end. 50 | ``` 51 | 52 | In order to prove the commutative property of the addition, we have to prove these two lemmas first: 53 | - n + 0 = n 54 | - S (x + y) = x + (S y) 55 | 56 | We are using the [DSL](https://en.wikipedia.org/wiki/Domain-specific_language) (Domain-specific language) to express properties that we want to prove. 57 | 58 | This OCaml code 59 | 60 | ```ocaml 61 | open Easier_proof.DslProp 62 | 63 | 64 | let t = to_proofs [ 65 | block "commutative property of Nat addition" [ 66 | prop "add_right_zero" ~context:(forall [("n","nat")]) ((atom "add n Zero" =.= atom "n") >> induction "n"); 67 | 68 | prop "add_s" ~context:(forall [("x","nat");("y","nat")]) ((atom "S (add x y)" =.= atom "add x (S y)") >> induction "x"); 69 | 70 | prop "add_commut" 71 | ~context:(forall [("x","nat");("y","nat")]) 72 | ((atom "add x y" =.= atom "add y x") >> induction "x") 73 | ~hints:["add_right_zero";"add_s"] 74 | ] 75 | ] 76 | 77 | let _ = run t 78 | ``` 79 | express the two needed lemmas above and the commutative, and run the translation. 80 | 81 | The code below is the Coq proof automatically generated from the OCaml DSL code above. 82 | 83 | ```coq 84 | From Test Require Import CpdtTactics. 85 | (* ----PROOFS---- *) 86 | (* Proofs for commutativity of nat addition *) 87 | 88 | Fact add_right_zero : forall (n:nat) , add n Zero = n. 89 | 90 | induction n;crush. 91 | Qed. 92 | 93 | Fact add_s : forall (x:nat) (y:nat) , S (add x y) = add x (S y). 94 | 95 | induction x;crush. 96 | Qed. 97 | 98 | Fact add_commut : forall (x:nat) (y:nat) , add x y = add y x. 99 | 100 | #[local] Hint Rewrite add_right_zero. 101 | #[local] Hint Rewrite add_s. 102 | induction x;crush. 103 | Qed. 104 | (**END OF PROOFS**) 105 | 106 | ``` 107 | 108 | ## Documentation 109 | 110 | We need to install odoc (> 2.0.0), to build the document do `make; make doc`. 111 | 112 | This is a document for private library and it can be found at `_build/default/_doc/_html/`. -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (using menhir 2.1) 3 | (name easier_proof) 4 | (generate_opam_files false) 5 | 6 | (source 7 | (github marigold-dev/easier-proofs)) 8 | 9 | (authors "Hakim Baaloudj = 2.9.1)) 18 | (coq (>= 8.14.0)) 19 | (coq-of-ocaml (>= 2.5.1)) 20 | (odoc (>= 2.0.0)) 21 | (ocamlformat (>= 0.20.1)))) -------------------------------------------------------------------------------- /easier_proof.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Easier proof generate Coq proof from a DSL embedded in OCaml" 4 | maintainer: ["Marigold Team"] 5 | authors: ["Hakim Baaloudj = "2.9" & >= "2.9.1"} 11 | "coq" {>= "8.14.0"} 12 | "coq-of-ocaml" {>= "2.5.1"} 13 | "odoc" {>= "2.0.0"} 14 | "ocamlformat" {>= "0.20.1"} 15 | ] 16 | build: [ 17 | ["sh" "-c" "cd examples && ./configure.sh"] {coq:installed} 18 | [make] {coq:installed} 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "--promote-install-files=false" 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ["dune" "install" "-p" name "--create-install-files" name] 33 | ] 34 | dev-repo: "git+https://github.com/marigold-dev/easier-proofs.git" 35 | -------------------------------------------------------------------------------- /examples/bool/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/bool/bin/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/bool/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries easier_proof stdio)) 4 | -------------------------------------------------------------------------------- /examples/bool/bin/main.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Easier_proof.DslProp 27 | open Easier_proof.GenerateProofs 28 | open Format 29 | open Stdio 30 | 31 | let bool_properties = 32 | to_proofs 33 | [ block "Conjuction property of Bool" 34 | [ prop "andb_true" 35 | ~context:(forall [("b", "boolean")]) 36 | ( atom "andb b True" =.= atom "b" >> case "b" 37 | &^ (atom "andb True b" =.= atom "b" >> straight) ) ] ] 38 | 39 | let () = 40 | if Array.length Sys.argv = 2 then 41 | let filename = Sys.argv.(1) in 42 | Out_channel.with_file ~append:true ~fail_if_exists:false filename 43 | ~f:(fun out -> 44 | let fmt = formatter_of_out_channel out in 45 | generate_proof fmt bool_properties ; 46 | close_out out ) 47 | else fprintf err_formatter "target file name missing" 48 | -------------------------------------------------------------------------------- /examples/bool/bool.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | type boolean = True | False 27 | 28 | let negb (b : boolean) : boolean = match b with True -> False | False -> True 29 | 30 | let andb (b1 : boolean) (b2 : boolean) : boolean = 31 | match b1 with True -> b2 | _ -> False 32 | 33 | let orb (b1 : boolean) (b2 : boolean) : boolean = 34 | match b1 with True -> True | _ -> b2 -------------------------------------------------------------------------------- /examples/bool/readme.md: -------------------------------------------------------------------------------- 1 | # Properties for boolean operators 2 | 3 | ## Negation (NEG/NOT) 4 | 5 | The boolean operator `negb` is defined in `Bool.v`: 6 | 7 | ``` 8 | Definition negb (b : boolean) : boolean := 9 | match b with 10 | | True => False 11 | | False => True 12 | end. 13 | ``` 14 | 15 | TODO 16 | 17 | ## Conjunction (AND) 18 | 19 | The boolean operator `andb` is defined in `Bool.v`: 20 | 21 | ``` 22 | Definition andb (b1 : boolean) (b2 : boolean) : boolean := 23 | match b1 with 24 | | True => b2 25 | | _ => False 26 | end. 27 | ``` 28 | 29 | These are some basic properties: 30 | 31 | ``` 32 | Lemma andb_prop (a b: boolean) : andb a b = True -> a = True /\ b = True. 33 | Lemma andb_true_intro (a b: boolean) : a = true /\ b = True -> andb a b = True. 34 | Lemma andb_left (b: boolean) : andb True b = b. 35 | Lemma andb_right (b: boolean) : andb b True = b. 36 | ``` 37 | 38 | ## Disjunction (OR) 39 | The boolean operator `orb` is defined in `Bool.v`: 40 | 41 | ``` 42 | Definition orb (b1 : boolean) (b2 : boolean) : boolean := 43 | match b1 with 44 | | True => True 45 | | _ => b2 46 | end. 47 | ``` 48 | 49 | The basic properties or `orb` is similar as `andb`: 50 | 51 | ``` 52 | Lemma orb_prop (a b: boolean) : orb a b = True -> a = True \/ b = True. 53 | Lemma orb_true_intro (a b: boolean) : a = true \/ b = True -> orb a b = True. 54 | Lemma orb_left (b: boolean): orb True b = True. 55 | Lemma orb_right (b: boolean): orb b True = True. 56 | ``` 57 | 58 | ## Exclusive OR (XOR) 59 | 60 | TODO 61 | 62 | ## Material implication (if ... then) 63 | 64 | TODO 65 | 66 | ## Bio-conditional (if and only if) 67 | 68 | 69 | -------------------------------------------------------------------------------- /examples/cleanup.rb: -------------------------------------------------------------------------------- 1 | # Remove the generated Coq files 2 | 3 | if ARGV.size < 3 then 4 | puts "Usage:" 5 | puts " ruby cleanup.rb easier_proofs_path examples_path target_path" 6 | exit(1) 7 | end 8 | 9 | easier_proofs_path, examples_path, target_path = ARGV 10 | full_path = File.join(easier_proofs_path, examples_path, target_path) 11 | 12 | # Remove 13 | 14 | remove_files = 15 | Dir.glob(File.join(full_path, "*.v")) 16 | for coq_file_name in remove_files.sort do 17 | command = "make clean && cd #{full_path} && rm -rf #{File.basename(coq_file_name)}" 18 | system(command) 19 | end 20 | 21 | remove_files_aux = 22 | Dir.glob(File.join(full_path, ".*.aux")) 23 | for aux_file_name in remove_files_aux.sort do 24 | command = "cd #{full_path} && rm -rf #{File.basename(aux_file_name)}" 25 | system(command) 26 | end 27 | 28 | # Remove 29 | system("rm Makefile Makefile.conf _CoqProject .lia.cache") 30 | 31 | 32 | -------------------------------------------------------------------------------- /examples/configure.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | # Generate the `_CoqProject` file 4 | echo "# !!!" > _CoqProject 5 | echo "# Generated by configure.sh" >> _CoqProject 6 | echo "# !!!" >> _CoqProject 7 | echo "-Q coq_lib/ Test" >> _CoqProject 8 | 9 | echo "-arg -impredicative-set" >> _CoqProject 10 | echo "-arg -w" >> _CoqProject 11 | echo "-arg -notation-overridden,-unexpected-implicit-declaration" >> _CoqProject 12 | echo >> _CoqProject 13 | find bool nat list coq_lib -name "*.v" | sort >> _CoqProject 14 | 15 | # Generate the Makefile 16 | coq_makefile -f _CoqProject -o Makefile -------------------------------------------------------------------------------- /examples/coq_lib/CpdtTactics.v: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2008-2012, Adam Chlipala 2 | * 3 | * This work is licensed under a 4 | * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 5 | * Unported License. 6 | * The license text is available at: 7 | * http://creativecommons.org/licenses/by-nc-nd/3.0/ 8 | *) 9 | 10 | Require Import Eqdep List Lia. 11 | 12 | Set Implicit Arguments. 13 | 14 | 15 | (** A version of [injection] that does some standard simplifications afterward: clear the hypothesis in question, bring the new facts above the double line, and attempt substitution for known variables. *) 16 | Ltac inject H := injection H; clear H; intros; try subst. 17 | 18 | (** Try calling tactic function [f] on all hypotheses, keeping the first application that doesn't fail. *) 19 | Ltac appHyps f := 20 | match goal with 21 | | [ H : _ |- _ ] => f H 22 | end. 23 | 24 | (** Succeed iff [x] is in the list [ls], represented with left-associated nested tuples. *) 25 | Ltac inList x ls := 26 | match ls with 27 | | x => idtac 28 | | (_, x) => idtac 29 | | (?LS, _) => inList x LS 30 | end. 31 | 32 | (** Try calling tactic function [f] on every element of tupled list [ls], keeping the first call not to fail. *) 33 | Ltac app f ls := 34 | match ls with 35 | | (?LS, ?X) => f X || app f LS || fail 1 36 | | _ => f ls 37 | end. 38 | 39 | (** Run [f] on every element of [ls], not just the first that doesn't fail. *) 40 | Ltac all f ls := 41 | match ls with 42 | | (?LS, ?X) => f X; all f LS 43 | | (_, _) => fail 1 44 | | _ => f ls 45 | end. 46 | 47 | (** Workhorse tactic to simplify hypotheses for a variety of proofs. 48 | * Argument [invOne] is a tuple-list of predicates for which we always do inversion automatically. *) 49 | Ltac simplHyp invOne := 50 | (** Helper function to do inversion on certain hypotheses, where [H] is the hypothesis and [F] its head symbol *) 51 | let invert H F := 52 | (** We only proceed for those predicates in [invOne]. *) 53 | inList F invOne; 54 | (** This case covers an inversion that succeeds immediately, meaning no constructors of [F] applied. *) 55 | (inversion H; fail) 56 | (** Otherwise, we only proceed if inversion eliminates all but one constructor case. *) 57 | || (inversion H; [idtac]; clear H; try subst) in 58 | 59 | match goal with 60 | (** Eliminate all existential hypotheses. *) 61 | | [ H : ex _ |- _ ] => destruct H 62 | 63 | (** Find opportunities to take advantage of injectivity of data constructors, for several different arities. *) 64 | | [ H : ?F ?X = ?F ?Y |- ?G ] => 65 | (** This first branch of the [||] fails the whole attempt iff the arguments of the constructor applications are already easy to prove equal. *) 66 | (assert (X = Y); [ assumption | fail 1 ]) 67 | (** If we pass that filter, then we use injection on [H] and do some simplification as in [inject]. 68 | * The odd-looking check of the goal form is to avoid cases where [injection] gives a more complex result because of dependent typing, which we aren't equipped to handle here. *) 69 | || (injection H; 70 | match goal with 71 | | [ |- X = Y -> G ] => 72 | try clear H; intros; try subst 73 | end) 74 | | [ H : ?F ?X ?U = ?F ?Y ?V |- ?G ] => 75 | (assert (X = Y); [ assumption 76 | | assert (U = V); [ assumption | fail 1 ] ]) 77 | || (injection H; 78 | match goal with 79 | | [ |- U = V -> X = Y -> G ] => 80 | try clear H; intros; try subst 81 | end) 82 | 83 | (** Consider some different arities of a predicate [F] in a hypothesis that we might want to invert. *) 84 | | [ H : ?F _ |- _ ] => invert H F 85 | | [ H : ?F _ _ |- _ ] => invert H F 86 | | [ H : ?F _ _ _ |- _ ] => invert H F 87 | | [ H : ?F _ _ _ _ |- _ ] => invert H F 88 | | [ H : ?F _ _ _ _ _ |- _ ] => invert H F 89 | 90 | (** Use an (axiom-dependent!) inversion principle for dependent pairs, from the standard library. *) 91 | | [ H : existT _ ?T _ = existT _ ?T _ |- _ ] => generalize (inj_pair2 _ _ _ _ _ H); clear H 92 | 93 | (** If we're not ready to use that principle yet, try the standard inversion, which often enables the previous rule. *) 94 | | [ H : existT _ _ _ = existT _ _ _ |- _ ] => inversion H; clear H 95 | 96 | (** Similar logic to the cases for constructor injectivity above, but specialized to [Some], since the above cases won't deal with polymorphic constructors. *) 97 | | [ H : Some _ = Some _ |- _ ] => injection H; clear H 98 | end. 99 | 100 | (** Find some hypothesis to rewrite with, ensuring that [auto] proves all of the extra subgoals added by [rewrite]. *) 101 | Ltac rewriteHyp := 102 | match goal with 103 | | [ H : _ |- _ ] => rewrite H by solve [ auto ] 104 | end. 105 | 106 | (** Combine [autorewrite] with automatic hypothesis rewrites. *) 107 | Ltac rewriterP := repeat (rewriteHyp; autorewrite with core in *). 108 | Ltac rewriter := autorewrite with core in *; rewriterP. 109 | 110 | (** This one is just so darned useful, let's add it as a hint here. *) 111 | #[global] Hint Rewrite app_ass. 112 | 113 | (** Devious marker predicate to use for encoding state within proof goals *) 114 | Definition done (T : Type) (x : T) := True. 115 | 116 | (** Try a new instantiation of a universally quantified fact, proved by [e]. 117 | * [trace] is an accumulator recording which instantiations we choose. *) 118 | Ltac inster e trace := 119 | (** Does [e] have any quantifiers left? *) 120 | match type of e with 121 | | forall x : _, _ => 122 | (** Yes, so let's pick the first context variable of the right type. *) 123 | match goal with 124 | | [ H : _ |- _ ] => 125 | inster (e H) (trace, H) 126 | | _ => fail 2 127 | end 128 | | _ => 129 | (** No more quantifiers, so now we check if the trace we computed was already used. *) 130 | match trace with 131 | | (_, _) => 132 | (** We only reach this case if the trace is nonempty, ensuring that [inster] fails if no progress can be made. *) 133 | match goal with 134 | | [ H : done (trace, _) |- _ ] => 135 | (** Uh oh, found a record of this trace in the context! Abort to backtrack to try another trace. *) 136 | fail 1 137 | | _ => 138 | (** What is the type of the proof [e] now? *) 139 | let T := type of e in 140 | match type of T with 141 | | Prop => 142 | (** [e] should be thought of as a proof, so let's add it to the context, and also add a new marker hypothesis recording our choice of trace. *) 143 | generalize e; intro; 144 | assert (done (trace, tt)) by constructor 145 | | _ => 146 | (** [e] is something beside a proof. Better make sure no element of our current trace was generated by a previous call to [inster], or we might get stuck in an infinite loop! (We store previous [inster] terms in second positions of tuples used as arguments to [done] in hypotheses. Proofs instantiated by [inster] merely use [tt] in such positions.) *) 147 | all ltac:(fun X => 148 | match goal with 149 | | [ H : done (_, X) |- _ ] => fail 1 150 | | _ => idtac 151 | end) trace; 152 | (** Pick a new name for our new instantiation. *) 153 | let i := fresh "i" in (pose (i := e); 154 | assert (done (trace, i)) by constructor) 155 | end 156 | end 157 | end 158 | end. 159 | 160 | (** After a round of application with the above, we will have a lot of junk [done] markers to clean up; hence this tactic. *) 161 | Ltac un_done := 162 | repeat match goal with 163 | | [ H : done _ |- _ ] => clear H 164 | end. 165 | 166 | Require Import JMeq. 167 | 168 | (** A more parameterized version of the famous [crush]. Extra arguments are: 169 | * - A tuple-list of lemmas we try [inster]-ing 170 | * - A tuple-list of predicates we try inversion for *) 171 | Ltac crush' lemmas invOne := 172 | (** A useful combination of standard automation *) 173 | let sintuition := simpl in *; intuition; try subst; 174 | repeat (simplHyp invOne; intuition; try subst); try congruence in 175 | 176 | (** A fancier version of [rewriter] from above, which uses [crush'] to discharge side conditions *) 177 | let rewriter := autorewrite with core in *; 178 | repeat (match goal with 179 | | [ H : ?P |- _ ] => 180 | match P with 181 | | context[JMeq] => fail 1 (** JMeq is too fancy to deal with here. *) 182 | | _ => rewrite H by crush' lemmas invOne 183 | end 184 | end; autorewrite with core in *) in 185 | 186 | (** Now the main sequence of heuristics: *) 187 | (sintuition; rewriter; 188 | match lemmas with 189 | | false => idtac (** No lemmas? Nothing to do here *) 190 | | _ => 191 | (** Try a loop of instantiating lemmas... *) 192 | repeat ((app ltac:(fun L => inster L L) lemmas 193 | (** ...or instantiating hypotheses... *) 194 | || appHyps ltac:(fun L => inster L L)); 195 | (** ...and then simplifying hypotheses. *) 196 | repeat (simplHyp invOne; intuition)); un_done 197 | end; 198 | sintuition; rewriter; sintuition; 199 | (** End with a last attempt to prove an arithmetic fact with [omega], or prove any sort of fact in a context that is contradictory by reasoning that [omega] can do. *) 200 | try lia; try (elimtype False; lia)). 201 | 202 | (** [crush] instantiates [crush'] with the simplest possible parameters. *) 203 | Ltac crush := crush' false fail. 204 | 205 | (** * Wrap Program's [dependent destruction] in a slightly more pleasant form *) 206 | 207 | Require Import Program.Equality. 208 | 209 | (** Run [dependent destruction] on [E] and look for opportunities to simplify the result. 210 | The weird introduction of [x] helps get around limitations of [dependent destruction], in terms of which sorts of arguments it will accept (e.g., variables bound to hypotheses within Ltac [match]es). *) 211 | Ltac dep_destruct E := 212 | let x := fresh "x" in 213 | remember E as x; simpl in x; dependent destruction x; 214 | try match goal with 215 | | [ H : _ = E |- _ ] => try rewrite <- H in *; clear H 216 | end. 217 | 218 | (** Nuke all hypotheses that we can get away with, without invalidating the goal statement. *) 219 | Ltac clear_all := 220 | repeat match goal with 221 | | [ H : _ |- _ ] => clear H 222 | end. 223 | 224 | (** Instantiate a quantifier in a hypothesis [H] with value [v], or, if [v] doesn't have the right type, with a new unification variable. 225 | * Also prove the lefthand sides of any implications that this exposes, simplifying [H] to leave out those implications. *) 226 | Ltac guess v H := 227 | repeat match type of H with 228 | | forall x : ?T, _ => 229 | match type of T with 230 | | Prop => 231 | (let H' := fresh "H'" in 232 | assert (H' : T); [ 233 | solve [ eauto 6 ] 234 | | specialize (H H'); clear H' ]) 235 | || fail 1 236 | | _ => 237 | specialize (H v) 238 | || let x := fresh "x" in 239 | evar (x : T); 240 | let x' := eval unfold x in x in 241 | clear x; specialize (H x') 242 | end 243 | end. 244 | 245 | (** Version of [guess] that leaves the original [H] intact *) 246 | Ltac guessKeep v H := 247 | let H' := fresh "H'" in 248 | generalize H; intro H'; guess v H'. 249 | -------------------------------------------------------------------------------- /examples/equality/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/equality/readme.md: -------------------------------------------------------------------------------- 1 | # Leibniz equality 2 | 3 | TODO 4 | 5 | ## Equality 6 | 7 | property of diff1 { diff1 : "42" <> "41" - straight } -------------------------------------------------------------------------------- /examples/generate.rb: -------------------------------------------------------------------------------- 1 | # Generate the OCaml files to Coq using `coq-of-ocaml` and use easier-proofs to 2 | # generate the proof for it 3 | 4 | if ARGV.size < 3 then 5 | puts "Usage:" 6 | puts " ruby generate.rb easier_proofs_path examples_path target_path" 7 | exit(1) 8 | end 9 | 10 | easier_proofs_path, examples_path, target_path = ARGV 11 | full_path = File.join(easier_proofs_path, examples_path, target_path) 12 | 13 | # Generate 14 | 15 | generate_files = 16 | Dir.glob(File.join(full_path, "*.ml")) 17 | for ocaml_file_name in generate_files.sort do 18 | command = "cd #{full_path} && coq-of-ocaml #{File.basename(ocaml_file_name)}" 19 | system(command) 20 | end 21 | 22 | # Generate proof by easier-proofs 23 | 24 | coq_files = 25 | Dir.glob(File.join(full_path, "*.v")) 26 | for coq_file_name in coq_files.sort do 27 | command = "cd #{full_path} && #{easier_proofs_path}/_build/default/#{examples_path}/#{target_path}/bin/main.exe #{File.basename(coq_file_name)}" 28 | system(command) 29 | end 30 | 31 | # Generate _CoqProject 32 | system("./configure.sh") -------------------------------------------------------------------------------- /examples/list/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/list/bin/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/list/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries easier_proof stdio)) 4 | -------------------------------------------------------------------------------- /examples/list/bin/main.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Easier_proof.DslProp 27 | open Easier_proof.GenerateProofs 28 | open Format 29 | open Stdio 30 | 31 | let list_prop = 32 | to_proofs 33 | [ block "Concat list with nil" 34 | [ prop "append_nil_left" 35 | ~context:(forall [("a", "Set"); ("xs", "myList a")]) 36 | (atom "append Nil xs" =.= atom "xs" >> straight) 37 | ; prop "append_nil_right" 38 | ~context:(forall [("a", "Set"); ("xs", "myList a")]) 39 | (atom "append xs Nil" =.= atom "xs" >> induction "xs") ] ] 40 | 41 | let () = 42 | if Array.length Sys.argv = 2 then 43 | let filename = Sys.argv.(1) in 44 | Out_channel.with_file ~append:true ~fail_if_exists:false filename 45 | ~f:(fun out -> 46 | let fmt = formatter_of_out_channel out in 47 | generate_proof fmt list_prop ; 48 | close_out out ) 49 | else fprintf err_formatter "target file name missing" 50 | -------------------------------------------------------------------------------- /examples/list/list.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | type 'a myList = Nil | Cons of 'a * 'a myList 27 | 28 | let length (l : 'a myList) : int = 29 | let rec aux (acc : int) (l' : 'a myList) : int = 30 | match l' with Nil -> 0 | Cons (el, tl) -> aux (acc + 1) tl 31 | in 32 | aux 0 l 33 | 34 | let rec append (l : 'a myList) (d : 'a myList) : 'a myList = 35 | match l with Nil -> d | Cons (el, tl) -> Cons (el, append tl d) 36 | -------------------------------------------------------------------------------- /examples/list/readme.md: -------------------------------------------------------------------------------- 1 | # Properties for polymorphic list operations 2 | 3 | ## Length 4 | 5 | A length of list is defined in `List.v` as: 6 | 7 | ``` 8 | Definition length {a : Set} (l : myList a) : int := 9 | let fix aux (acc : int) (l' : myList a) : int := 10 | match l' with 11 | | Nil => 0 12 | | Cons el tl => aux (Z.add acc 1) tl 13 | end in 14 | aux 0 l. 15 | ``` 16 | 17 | These are some properties: 18 | 19 | `Lemma length_zero : forall (A: Set) (l: myList A) <-> length l = 0 -> l = Nil.` 20 | 21 | ## Append 22 | 23 | Appending a list is defined in `List.v` as: 24 | 25 | ``` 26 | Fixpoint append {a : Set} (l : myList a) (d : myList a) : myList a := 27 | match l with 28 | | Nil => d 29 | | Cons el tl => Cons el (append tl d) 30 | end. 31 | ``` 32 | 33 | These are the basic properties: 34 | 35 | - Concat with nil 36 | 37 | ``` 38 | Lemma app_nil_left: forall (A: Set) (xs: myList A) -> app nil xs = xs. 39 | Lemma app_nil_right: forall (A:Set) (xs:myList A) -> app xs nil = xs. 40 | ``` 41 | 42 | - Length of the append list 43 | 44 | ``` 45 | Lemma length_app: forall (A:Set) (xs ys:myList A) -> length (app xs ys) = length xs + length ys. 46 | ``` 47 | 48 | - Association 49 | 50 | ``` 51 | Lemma app_assoc: forall (A: Set) (l m n: myList A) -> app (app l n) m = app l (app n m). 52 | ``` 53 | 54 | ## In 55 | TODO 56 | 57 | ## Head and tail 58 | 59 | TODO 60 | ## Nth element in a list 61 | 62 | TODO 63 | ## Remove 64 | TODO 65 | -------------------------------------------------------------------------------- /examples/nat/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/nat/bin/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /examples/nat/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries easier_proof stdio)) 4 | -------------------------------------------------------------------------------- /examples/nat/bin/main.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Easier_proof.DslProp 27 | open Easier_proof.GenerateProofs 28 | open Format 29 | open Stdio 30 | 31 | let nat_add_commut = 32 | to_proofs 33 | [ 34 | block "commutative property of Nat addition" 35 | [ 36 | prop "add_right_zero" 37 | ~context:(forall [ ("n", "nat") ]) 38 | (atom "add n Zero" =.= atom "n" >> induction "n"); 39 | prop "add_s" 40 | ~context:(forall [ ("x", "nat"); ("y", "nat") ]) 41 | (atom "S (add x y)" =.= atom "add x (S y)" >> induction "x"); 42 | prop "add_commut" 43 | ~context:(forall [ ("x", "nat"); ("y", "nat") ]) 44 | (atom "add x y" =.= atom "add y x" >> induction "x") 45 | ~hints:[ "add_right_zero"; "add_s" ]; 46 | ]; 47 | ] 48 | 49 | let () = 50 | if Array.length Sys.argv = 2 then 51 | let filename = Sys.argv.(1) in 52 | Out_channel.with_file ~append:true ~fail_if_exists:false filename 53 | ~f:(fun out -> 54 | let fmt = formatter_of_out_channel out in 55 | generate_proof fmt nat_add_commut; 56 | close_out out) 57 | else fprintf err_formatter "target file name missing" 58 | -------------------------------------------------------------------------------- /examples/nat/nat.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | type nat = Zero | S of nat 27 | 28 | let pred (n : nat) : nat = match n with Zero -> Zero | S p -> p 29 | 30 | let rec add (n : nat) (m : nat) : nat = 31 | match n with Zero -> m | S p -> S (add p m) 32 | -------------------------------------------------------------------------------- /examples/nat/readme.md: -------------------------------------------------------------------------------- 1 | # Peano natural number operators 2 | 3 | Peano natural number is defined as 4 | 5 | ``` 6 | Inductive nat : Set := 7 | | Zero : nat 8 | | S : nat -> nat. 9 | ``` 10 | It has some properties: 11 | 12 | ``` 13 | Lemma one_succ: 1 = S 0. 14 | Lemma two_succ: 2 = S 1. 15 | ``` 16 | 17 | ## Predecessor 18 | 19 | The `pred` is defined as: 20 | ``` 21 | Definition pred (n : nat) : nat := 22 | match n with 23 | | Zero => Zero 24 | | S p => p 25 | end. 26 | ``` 27 | 28 | It has some basic properties: 29 | 30 | ``` 31 | Lemma pred_succ (n: nat): pred (S n) = n. 32 | Lemma pred_zero : pred 0 = 0. 33 | ``` 34 | 35 | ## Addition 36 | 37 | The addition `add` is defined in `Nat.v` as: 38 | 39 | ``` 40 | Fixpoint add (n : nat) (m : nat) : nat := 41 | match n with 42 | | Zero => m 43 | | S p => S (add p m) 44 | end. 45 | ``` 46 | 47 | It has some basic properties: 48 | 49 | ``` 50 | Lemma add_zero_left: forall (a:Set (m:nat) -> add Zero m = m. 51 | Lemma add_zero_right: forall (a:Set) (n:nat) -> add n Zero = n. 52 | Lemma add_succ_right: forall (a:Set) (m n:nat) -> add m (S n) = S (add m n). 53 | ``` 54 | 55 | ## Subtraction 56 | TODO 57 | 58 | ## Multiplication 59 | TODO 60 | -------------------------------------------------------------------------------- /examples/readme.md: -------------------------------------------------------------------------------- 1 | # Build examples 2 | 3 | ## Generate 4 | 5 | To generate the proofs by using easier-proofs do: 6 | 7 | `ruby generate.rb path_1 path_2 path_3` 8 | 9 | where: 10 | 11 | - `path_1` is the path of easier-proofs 12 | - `path_2` is the path of the examples 13 | - `path_3` is the path of the specific examples that you want to proof. 14 | 15 | This command does 3 things: 16 | - Use `coq-of-ocaml` to generate the file(s) `*.ml` to `*.v` 17 | - Then use the easier-proofs to generate the proofs for `*.v` (the proofs is defined in the file for example: `examples/nat/bin/main.ml`). The lemmas will be added after the definitions of `*.v` (generated by `coq-of-ocaml` step). 18 | - Create the `_CoqProject` and `Makefile` 19 | 20 | For example: 21 | 22 | To generate the proofs by using easier-proofs for natural numbers (`easier-proofs/examples/nat`) do: 23 | 24 | `ruby generate.rb ~/easier-proofs examples nat` 25 | 26 | Finally, to compile the `Coq` files do: `make` 27 | 28 | ## Clean up 29 | 30 | For cleanup the generated files do: 31 | `ruby cleanup.rb path_1 path_2 path_3` 32 | 33 | where `path_1, path_2, path_3` are the same as before. 34 | 35 | For example, clean up the generated files for natural numbers above: 36 | 37 | `ruby cleanup.rb ~/easier-proofs examples nat` 38 | 39 | it will do `make clean`, to clean up the `Coq` compiled files, remove the generated `Coq` file (in this case is `Nat.v`), remove the `_CoqProject`, and `Makefile`. 40 | -------------------------------------------------------------------------------- /src/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /src/ast.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | type quant = Forall 27 | 28 | type bop = Equality | Inequality | Conjunction | Disjunction | Implication 29 | 30 | type helper = Straight | Case of string | Induction of string | Left | Right 31 | 32 | type prop_body = 33 | | ASTAtom of string 34 | | ASTAssert of bop * prop_body * prop_body * helper 35 | 36 | type arg = ASTArg of string * string 37 | 38 | type prop_context = 39 | { assert_name: string 40 | ; qtf: quant option 41 | ; args: arg list option 42 | ; assertt: prop_body 43 | ; hints: string list } 44 | 45 | type prop = ASTProp of prop_context 46 | 47 | type block = ASTBlock of string * prop list 48 | 49 | type blocks = ASTBlocks of block list 50 | -------------------------------------------------------------------------------- /src/ast.mli: -------------------------------------------------------------------------------- 1 | (** 2 | The AST of the DSL we use for express assertion to prove. 3 | The most important thing to understand are the helpers. A helper in, as its name suggests, 4 | a way to help easier proof to generate the right proof for a given assertion. 5 | 6 | In our DSL, a program is in a list of blocks, each block is a piece of context where we want to prove things, a block contains one or several assertion we want to prove 7 | and for each assertion we must give one helper to .. help easier-proof. 8 | 9 | *) 10 | type quant = Forall 11 | 12 | type bop = Equality | Inequality | Conjunction | Disjunction | Implication 13 | 14 | (** 15 | - Straight -> the easiest way to generate a proof in easier proof, we use this when we know that our assertion can be proved with 16 | chlipala's "crush" tactic. 17 | - Case -> this helper is the case reasoning, the string is the name on the var we want to use the case reasoning. After that, easier proof will 18 | use "crush" on all cases. 19 | - Induction -> this helper is the induction reasoning, the string is the name on the var we want to use the case reasoning. After that, easier proof will 20 | use "crush" on the two cases. 21 | - Left -> when we have a disjunction we have to choose which part we will prove, in this case it is the left one. 22 | - Right -> it is the same as "Left", but for the right one. 23 | 24 | *) 25 | type helper = Straight | Case of string | Induction of string | Left | Right 26 | 27 | type prop_body = 28 | | ASTAtom of string 29 | | ASTAssert of bop * prop_body * prop_body * helper 30 | 31 | type arg = ASTArg of string * string 32 | 33 | type prop_context = 34 | { assert_name: string 35 | ; qtf: quant option 36 | ; args: arg list option 37 | ; assertt: prop_body 38 | ; hints: string list } 39 | 40 | type prop = ASTProp of prop_context 41 | 42 | type block = ASTBlock of string * prop list 43 | 44 | type blocks = ASTBlocks of block list 45 | -------------------------------------------------------------------------------- /src/dslProp.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Ast 27 | open GenerateProofs 28 | open Format 29 | 30 | let args_ l = Some (List.map (fun arg -> ASTArg (fst arg, snd arg)) l) 31 | 32 | let forall args = (Some Forall, args_ args) 33 | 34 | let case target = Case target 35 | 36 | let induction target = Induction target 37 | 38 | let straight = Straight 39 | 40 | let atom str = ASTAtom str 41 | 42 | let prop name ?(context = (None, None)) ?(hints = []) assertt = 43 | ASTProp 44 | { assert_name= name 45 | ; qtf= fst context 46 | ; args= snd context 47 | ; assertt 48 | ; hints= hints } 49 | 50 | let run program = 51 | let fmt = formatter_of_out_channel stdout in 52 | generate_proof fmt program 53 | 54 | let to_proofs blocks = ASTBlocks blocks 55 | 56 | let block name asserts = ASTBlock (name, asserts) 57 | 58 | let ( =.= ) l r h = ASTAssert (Equality, l, r, h) 59 | 60 | let ( =!= ) l r h = ASTAssert (Inequality, l, r, h) 61 | 62 | let ( &^ ) l r = ASTAssert (Conjunction, l, r, Straight) 63 | 64 | let ( |^ ) l r h = ASTAssert (Disjunction, l, r, h) 65 | 66 | let (|->) l r h = ASTAssert (Implication, l,r,h) 67 | 68 | let ( >> ) l h = l h 69 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name easier_proof)) -------------------------------------------------------------------------------- /src/generateProofs.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Ast 27 | open Format 28 | 29 | exception Not_Supported_Yet 30 | 31 | exception Incoherent_Helper of string 32 | 33 | let string_of_bop (b : bop) : string = 34 | match b with 35 | | Equality -> 36 | "=" 37 | | Inequality -> 38 | "<>" 39 | | Conjunction -> 40 | "/\\" 41 | | Disjunction -> 42 | "\\/" 43 | | Implication -> 44 | "->" 45 | 46 | let straight_tactic (fmt : formatter) : unit = fprintf fmt "crush" 47 | 48 | let split_tactic (fmt : formatter) : unit = fprintf fmt "split" 49 | 50 | let destruct_tactic (fmt : formatter) (var : string) : unit = 51 | fprintf fmt "destruct %s" var 52 | 53 | let induction_tactic (fmt : formatter) (var : string) : unit = 54 | fprintf fmt "induction %s" var 55 | 56 | let qed (fmt : formatter) : unit = fprintf fmt "@[Qed.@]@." 57 | 58 | let arg fmt = function ASTArg (id, typ) -> fprintf fmt " (%s: %s) " id typ 59 | 60 | let semicolon fmt = fprintf fmt "; " 61 | 62 | let dot fmt = fprintf fmt "@[.@]@." 63 | 64 | (** only rewrite hints for now **) 65 | let hint_rewrite fmt target = 66 | fprintf fmt "#[local] Hint Rewrite %s" target 67 | 68 | let standalone_proof fmt b h = 69 | match (b, h) with 70 | | Conjunction, Straight -> 71 | split_tactic fmt ; dot fmt 72 | | Disjunction, Left -> 73 | fprintf fmt "left" ; dot fmt 74 | | Disjunction, Right -> 75 | fprintf fmt "right" ; dot fmt 76 | | (Conjunction | Disjunction), _ -> 77 | raise (Incoherent_Helper "Unusable helper for conjunction/disjunction") 78 | | _, Straight -> 79 | straight_tactic fmt ; dot fmt 80 | | _, Case target -> 81 | destruct_tactic fmt target ; semicolon fmt ; straight_tactic fmt ; dot fmt 82 | | _, Induction target -> 83 | induction_tactic fmt target ; 84 | semicolon fmt ; 85 | straight_tactic fmt ; 86 | dot fmt 87 | | _ -> 88 | raise (Incoherent_Helper "left and right are helpers for disjunction only") 89 | 90 | let fact_description fmt = 91 | let rec aux fmt = function 92 | | ASTAtom cnt -> 93 | fprintf fmt "%s" cnt 94 | | ASTAssert (bop, left, right, _) -> 95 | fprintf fmt "@[%a %s %a@]" aux left (string_of_bop bop) aux right 96 | in 97 | aux fmt 98 | 99 | let in_assertion fmt a hints = 100 | pp_print_list hint_rewrite fmt hints ; 101 | let rec aux = function 102 | | ASTAtom _ -> 103 | straight_tactic fmt 104 | | ASTAssert (Disjunction, left, _, Left) -> 105 | standalone_proof fmt Disjunction Left ; 106 | aux left 107 | | ASTAssert (Disjunction, _, right, Right) -> 108 | standalone_proof fmt Disjunction Right ; 109 | aux right 110 | | ASTAssert (bop, ASTAtom _, ASTAtom _, helper) -> 111 | standalone_proof fmt bop helper 112 | | ASTAssert (bop, left, right, helper) -> 113 | standalone_proof fmt bop helper ; 114 | aux left ; 115 | aux right 116 | in 117 | aux a 118 | 119 | let in_property fmt = function 120 | | ASTProp 121 | { assert_name= assert_name' 122 | ; qtf= Some Forall 123 | ; args= Some args' 124 | ; assertt= assertt' 125 | ; hints } -> 126 | fprintf fmt "Fact %s : forall" assert_name' ; 127 | pp_print_list arg fmt args' ; 128 | fprintf fmt "@[, %a.@]@." fact_description assertt' ; 129 | in_assertion fmt assertt' hints ; 130 | qed fmt 131 | | ASTProp 132 | {assert_name= assert_name'; qtf= _; args= None; assertt= assertt'; hints} 133 | -> 134 | fprintf fmt "Fact %s : " assert_name' ; 135 | fprintf fmt "@[%a.@]@." fact_description assertt' ; 136 | in_assertion fmt assertt' hints ; 137 | qed fmt 138 | | _ -> 139 | raise Not_Supported_Yet 140 | 141 | let in_block fmt = function 142 | | ASTBlock (blockName, props) -> 143 | fprintf fmt "@[(* Proofs for %s *)@,@]" blockName ; 144 | pp_print_list in_property fmt props 145 | 146 | let in_blocks fmt = function 147 | | ASTBlocks properties_blocks -> 148 | fprintf fmt "@.@[(* ---- Proofs generated by easier-proofs ---- *)@]" ; 149 | fprintf fmt "@.@[From Test Require Import CpdtTactics.@,@]" ; 150 | pp_print_list in_block fmt properties_blocks 151 | 152 | let generate_proof fmt program = 153 | fprintf fmt "%a" in_blocks program ; 154 | fprintf fmt "@[ (**END OF PROOFS**)@]" 155 | -------------------------------------------------------------------------------- /src/generateProofs.mli: -------------------------------------------------------------------------------- 1 | 2 | (** 3 | The core of easier-proof, the file contains all the functions for generating proof from a program written in our DSL. 4 | 5 | In easier-proof, we represent assertion with a DSL, a program in this DSL is a list of blocks, each block concern a precise subject, and in 6 | each block we have one of several properties that we want to prove. We can express an assertion, and we have to give "helpers" with a property 7 | for helping easier-proof to determine how to generate the proof of the assertion. 8 | 9 | Read in {!module:Ast} and {!module:DslProp} for more information about the DSL, the helpers, etc.... 10 | *) 11 | 12 | exception Not_Supported_Yet 13 | exception Incoherent_Helper of string 14 | 15 | val string_of_bop : Ast.bop -> string 16 | 17 | (**[straight_tactic fmt] is the most basic helper in easier-proof, we use straight when we are sure that the assertion we 18 | want to prove is solvable with the tactic crush of Chlipala.*) 19 | val straight_tactic : Format.formatter -> unit 20 | 21 | (**[split_tactic fmt] print the induction split, needed if we encounter a conjunction operator in our assertion.*) 22 | val split_tactic : Format.formatter -> unit 23 | 24 | (**[destruct_tactic fmt var] print the destruct tactic on var, needed for a case reasoning on our proof.*) 25 | val destruct_tactic : Format.formatter -> string -> unit 26 | 27 | (**[induction_tactic fmt var] print the induction tactic on var*) 28 | val induction_tactic : Format.formatter -> string -> unit 29 | 30 | (**[qed fmt] print the end of a proof, named "Qed".*) 31 | val qed : Format.formatter -> unit 32 | 33 | (**[arg a] print an argument.*) 34 | val arg : Format.formatter -> Ast.arg -> unit 35 | 36 | (**[semicolon] print the ltac command ";"*) 37 | val semicolon : Format.formatter -> unit 38 | 39 | (**[dot fmt] print a '.', we don't necesseraly use the dot after a Coq tactic since we can use the ltac command ";" 40 | in order to automate a part of the proof.*) 41 | val dot : Format.formatter -> unit 42 | 43 | (**[hint_rewrite fmt name] generate a hint for a rewrite needed in the generated proof*) 44 | val hint_rewrite : Format.formatter -> string -> unit 45 | 46 | (** [standalone_proof fmt binOp helper] handle the "standalone" proofs 47 | which don't need auxiliary lemmas to be written. 48 | It takes a binary operator and a proof helper to determine 49 | how to print the correct Coq code.*) 50 | val standalone_proof : Format.formatter -> Ast.bop -> Ast.helper -> unit 51 | 52 | (** [fact_description fmt prop_body] generate the body of a "Fact" Coq construction.*) 53 | val fact_description : Format.formatter -> Ast.prop_body -> unit 54 | 55 | (** [in_assertion fmt prop_body hints] determine what kind of proof we have to generate, 56 | and use the hints if there is any.*) 57 | val in_assertion : 58 | Format.formatter -> Ast.prop_body -> string list -> unit 59 | 60 | (** [in_property fmt prop] is a function that show the pipeline of an entire proof generation for a given assertion.*) 61 | val in_property : Format.formatter -> Ast.prop -> unit 62 | 63 | val in_block : Format.formatter -> Ast.block -> unit 64 | 65 | val in_blocks : Format.formatter -> Ast.blocks -> unit 66 | 67 | (**[generate_proof fmt program] generate a proof of a program in the DSL which can express assertion.*) 68 | val generate_proof : Format.formatter -> Ast.blocks -> unit 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/tests/.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.20.1 2 | wrap-fun-args=false 3 | let-binding-spacing=compact 4 | field-space=loose 5 | break-separators=after 6 | space-around-arrays=false 7 | space-around-lists=false 8 | space-around-records=false 9 | space-around-variants=false 10 | dock-collection-brackets=true 11 | space-around-records=false 12 | sequence-style=separator 13 | doc-comments=before 14 | margin=80 15 | module-item-spacing=sparse 16 | parens-tuple=always -------------------------------------------------------------------------------- /src/tests/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names easier_proof_test) 3 | (libraries alcotest stdio easier_proof)) 4 | -------------------------------------------------------------------------------- /src/tests/easier_proof_test.ml: -------------------------------------------------------------------------------- 1 | (*****************************************************************************) 2 | (* *) 3 | (* Open Source License *) 4 | (* Copyright (c) 2021 Marigold *) 5 | (* *) 6 | (* Permission is hereby granted, free of charge, to any person obtaining a *) 7 | (* copy of this software and associated documentation files (the "Software"),*) 8 | (* to deal in the Software without restriction, including without limitation *) 9 | (* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) 10 | (* and/or sell copies of the Software, and to permit persons to whom the *) 11 | (* Software is furnished to do so, subject to the following conditions: *) 12 | (* *) 13 | (* The above copyright notice and this permission notice shall be included *) 14 | (* in all copies or substantial portions of the Software. *) 15 | (* *) 16 | (* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) 17 | (* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) 18 | (* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) 19 | (* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) 20 | (* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) 21 | (* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) 22 | (* DEALINGS IN THE SOFTWARE. *) 23 | (* *) 24 | (*****************************************************************************) 25 | 26 | open Easier_proof.DslProp 27 | open Easier_proof.GenerateProofs 28 | open Format 29 | 30 | (** Boolean *) 31 | let bool_and_expected = 32 | fprintf std_formatter 33 | "From Test Require Import CpdtTactics.\n\ 34 | \ (* ----PROOFS---- *)\n\ 35 | \ (* Proofs for my_and *)\n\ 36 | \ Fact andb_true1 : forall (b:boolean) , andb True b = b.\n\ 37 | \ crush.\n\ 38 | \ Qed.\n\ 39 | \ Fact andb_true2 : forall (b:boolean) , andb b True = b.\n\ 40 | \ destruct b\n\ 41 | \ crush.\n\ 42 | \ crush.\n\ 43 | \ Qed." 44 | 45 | let bool_and_properties = 46 | to_proofs 47 | [ block "andb" 48 | [ prop "andb_true1" 49 | ~context:(forall [("b", "boolean")]) 50 | ( atom "andb b True" =.= atom "b" >> case "b" 51 | &^ (atom "andb True b" =.= atom "b" >> straight) ) ] ] 52 | 53 | let test_bool_and () = 54 | Alcotest.(check unit) 55 | "have to match" bool_and_expected 56 | (generate_proof std_formatter bool_and_properties) 57 | 58 | (** Natural numbers *) 59 | 60 | let nat_trivial = 61 | to_proofs 62 | [block "nat" [prop "diff42_41" (atom "42" =!= atom "41" >> straight)]] 63 | 64 | let nat_trivial_expected = 65 | fprintf std_formatter 66 | "From Test Require Import CpdtTactics.\n\ 67 | \ (* ----PROOFS---- *)\n\ 68 | \ (* Proofs for nat *)\n\ 69 | \ Fact diff42_41 : 42 <> 41.\n\ 70 | \ crush.\n\ 71 | \ Qed." 72 | 73 | let test_nat_inequal () = 74 | Alcotest.(check unit) 75 | "have to match" nat_trivial_expected 76 | (generate_proof std_formatter nat_trivial) 77 | 78 | let nat_add_properties = 79 | to_proofs 80 | [ block "add" 81 | [ prop "add_0" 82 | ~context:(forall [("m", "nat")]) 83 | (atom "add Zero m" =.= atom "m" >> straight) 84 | ; prop "add_1" 85 | ~context:(forall [("n", "nat")]) 86 | (atom "add n Zero" =.= atom "n" >> induction "n") ] ] 87 | 88 | let nat_add_expected = 89 | fprintf std_formatter 90 | "From Test Require Import CpdtTactics.\n\ 91 | \ (* ----PROOFS---- *)\n\ 92 | \ (* Proofs for add *)\n\ 93 | \ Fact add_0 : forall (m:nat) , add Zero m = m.\n\ 94 | \ crush.\n\ 95 | \ Qed.\n\ 96 | \ Fact add_1 : forall (n:nat) , add n Zero = n.\n\ 97 | \ induction n.\n\ 98 | \ crush.\n\ 99 | \ crush.\n\ 100 | \ Qed." 101 | 102 | let test_nat_add () = 103 | Alcotest.(check unit) 104 | "have to match" nat_add_expected 105 | (generate_proof std_formatter nat_add_properties) 106 | 107 | let () = 108 | let open Alcotest in 109 | run "DSL for express assertions and generate proofs on them" 110 | [ ( "Testing suite for bool/nat properties proofs " 111 | , [ test_case "Simple straight and case proof on andb" `Quick test_bool_and 112 | ; test_case "Simple auto proof of an nat inequality" `Quick 113 | test_nat_inequal 114 | ; test_case 115 | "Simple straight and inductive proofs for add function on nat" 116 | `Quick test_nat_add ] ) ] 117 | --------------------------------------------------------------------------------