pax_global_header00006660000000000000000000000064145376064410014524gustar00rootroot0000000000000052 comment=1aa8bb578a71481bd473283a642e7e5518bcfd9a LibHyps-libhyps-2.0.8/000077500000000000000000000000001453760644100145555ustar00rootroot00000000000000LibHyps-libhyps-2.0.8/.github/000077500000000000000000000000001453760644100161155ustar00rootroot00000000000000LibHyps-libhyps-2.0.8/.github/workflows/000077500000000000000000000000001453760644100201525ustar00rootroot00000000000000LibHyps-libhyps-2.0.8/.github/workflows/ci-libhyps.yml000066400000000000000000000036331453760644100227450ustar00rootroot00000000000000# This is a basic workflow to help you get started with Actions name: CI # Controls when the workflow will run on: # Triggers the workflow on push or pull request events but only for the "master" branch push: branches: [ "master" ] pull_request: branches: [ "master" ] # Allows you to run this workflow manually from the Actions tab workflow_dispatch: # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: # This workflow contains a single job called "build" build: # The type of runner that the job will run on runs-on: ubuntu-latest strategy: matrix: image: - 'coqorg/coq:dev' - 'coqorg/coq:8.18' - 'coqorg/coq:8.17' - 'coqorg/coq:8.16' # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - uses: actions/checkout@v3 - uses: coq-community/docker-coq-action@v1 with: opam_file: 'coq-libhyps.opam' custom_image: ${{ matrix.image }} env: OPAMWITHTEST: 'true' # This workflow contains a single job called "build" test: # The type of runner that the job will run on runs-on: ubuntu-latest strategy: matrix: image: - 'coqorg/coq:dev' - 'coqorg/coq:8.18' - 'coqorg/coq:8.17' - 'coqorg/coq:8.16' # Steps represent a sequence of tasks that will be executed as part of the job steps: # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it - uses: actions/checkout@v3 - uses: coq-community/docker-coq-action@v1 with: opam_file: 'coq-libhyps.opam' custom_image: ${{ matrix.image }} export: 'OPAMWITHTEST' # space-separated list of variables env: OPAMWITHTEST: 'true' LibHyps-libhyps-2.0.8/.gitignore000066400000000000000000000000421453760644100165410ustar00rootroot00000000000000Makefile Makefile.conf .coqdeps.d LibHyps-libhyps-2.0.8/CHANGES.md000066400000000000000000000032401453760644100161460ustar00rootroot00000000000000 # Changes from 1.x to 2.x ## New Syntax + "tac1 ;; tac2" remains, but you can also use "tac1; { tac2 }". + "tac1 ;!; tac2" remains, but you can also use "tac1; {< tac2 }". + "!tac", "!!tac" etc are now only loaded if you do: `Import LibHyps.LegacyNotations.`, the new following composable tacticals are preferred: + `tac /s` is an alias for `tac ;{ substHyp }` + `tac /r` is an alias for `tac ;{ revertHyp }` + `tac /n` is an alias for `tac ;{ autorename }` + `tac /g` is an alias for `tac ;{ group_up_list}` which is itself preferred to `tac ; { move_up_types }` or `tac ;; move_up_types.` + Combinations like `tac /s/n/g` are accepted. + Some combination have shortcuts, e.g. `tac /sng` stands for `tac /s/n/g`. Other shortcuts include `\sn`,`\ng`,`\sg`... ## New Tactical for tactical dealing with all hyps at once + "tac1; {! tac2 }" applies tac2 once to *the list of* all new hypothesis. + "tac1; {!< tac2 }" applies tac2 once to *the list of* all new hypothesis (reverse order). Use case: new tactic `group_up_list` is a faster version of `move_up_types` and deals directly with the list of hypothesis. Note for developping other such tactics: the list of hypothesis uses the type `LibHyps.TacNewHyps.DList`. ## `move_up_types` now groups variables with similar types. Feature wish https://github.com/Matafou/LibHyps/issues/5 by @Yazko: non-Prop hypothesis with same type are now grouped, which takes benefit of Coq's goal printing mechanism's own factorization heuristic. ## `group_up_list` is a (faster) variant of move_up_types It applies on a list of hyptohesis, so you should use it like this: ``` intros ; {! group_up_list }. ``` LibHyps-libhyps-2.0.8/CoqMakefile.conf000066400000000000000000000056361453760644100176160ustar00rootroot00000000000000# This configuration file was generated by running: # coq_makefile -f _CoqProject ############################################################################### # # # Project files. # # # ############################################################################### COQMF_VFILES = LibHyps/LibDecomp.v LibHyps/TacNewHyps.v LibHyps/LibTac.v LibHyps/LibHypsNaming.v COQMF_MLIFILES = COQMF_MLFILES = COQMF_ML4FILES = COQMF_MLPACKFILES = COQMF_MLLIBFILES = COQMF_CMDLINE_VFILES = ############################################################################### # # # Path directives (-I, -R, -Q). # # # ############################################################################### COQMF_OCAMLLIBS = COQMF_SRC_SUBDIRS = COQMF_COQLIBS = COQMF_COQLIBS_NOML = COQMF_CMDLINE_COQLIBS = ############################################################################### # # # Coq configuration. # # # ############################################################################### COQMF_LOCAL=1 COQMF_COQLIB=/home/courtieu/coq/v8.9// COQMF_DOCDIR=/home/courtieu/coq/v8.9/doc/ COQMF_OCAMLFIND=/home/courtieu/.opam/4.07.0/bin/ocamlfind COQMF_CAMLP5O=/home/courtieu/.opam/4.07.0/bin/camlp5o COQMF_CAMLP5BIN=/home/courtieu/.opam/4.07.0/bin/ COQMF_CAMLP5LIB=/home/courtieu/.opam/4.07.0/lib/camlp5 COQMF_CAMLP5OPTIONS=-loc loc COQMF_CAMLFLAGS=-thread -rectypes -w +a-4-9-27-41-42-44-45-48-50-58-59 -safe-string -strict-sequence COQMF_HASNATDYNLINK=true COQMF_COQ_SRC_SUBDIRS=config dev lib clib kernel library engine pretyping interp parsing proofs tactics toplevel printing grammar ide stm vernac plugins/btauto plugins/cc plugins/derive plugins/extraction plugins/firstorder plugins/funind plugins/ltac plugins/micromega plugins/nsatz plugins/omega plugins/quote plugins/romega plugins/rtauto plugins/setoid_ring plugins/ssr plugins/ssrmatching plugins/syntax plugins/xml COQMF_WINDRIVE= ############################################################################### # # # Extra variables. # # # ############################################################################### COQMF_OTHERFLAGS = COQMF_INSTALLCOQDOCROOT = orphan_ LibHyps-libhyps-2.0.8/Demo/000077500000000000000000000000001453760644100154415ustar00rootroot00000000000000LibHyps-libhyps-2.0.8/Demo/_CoqProject000066400000000000000000000003431453760644100175740ustar00rootroot00000000000000-R ../LibHyps LibHyps -arg -w -arg -undo-batch-mode demo.v incremental1.v incremental1_fix.v #incremental2.v incremental2_fix.v #incremental3.v incremental3_fix.v incremental5.v incremental5_libhyp.v incremental5_nolibhyps.v LibHyps-libhyps-2.0.8/Demo/demo.org000066400000000000000000000124721453760644100171040ustar00rootroot00000000000000 LibHyps: Small proof maintenance enhancements with Coq * Dealing with hyps ** ssreflect spirit *** Operate on hypothesis *before* introducing them. - Goal's conclusion seen as a stack. - tactics operate on the top of the stack. - Post-treatment (administrative) *while* introducing. - still needs to name hypothesis to revert them. **** example #+begin_src coq x: nat H: x > 0 =========== forall y:nat, x <= y -> x <> 1 -> x = 2 case. (* = destruct y. *) by move: H; case: (x) => [| [| s1]]. #+end_src ** Ltac spirit *** Deal with hypothesis *after* introducing them. - destruct H, induction H, rewrite ... in H - rename H into htruc... => idea: provide post-treatment tyding tacticals => apply them to "recent" hyps after an arbitrary tactic. * Tacticals iterating on (new) hyps *** New tactical ";{ }" #+begin_src coq tac1 ;{ tac2 }. #+end_src + applies tac1, then applies tac2 on each new hypothesis from tac1. example: #+begin_src coq intros ; { fun h => idtac h } #+end_src + *Important*: "new hyp" means "new hyp *name*". *** Reverse order ";{< }" #+begin_src coq tac1 ;{< tac2 }. #+end_src *** Iterating on all hyps instead #+begin_src coq onAllHyps tac. #+end_src *** iterate on the *list* of new hyps (for efficiency) #+begin_src coq tac1 ;{! tac2 }. tac1 ;{!< tac2 }. #+end_src tac2 takes a term of type LibHyps.Depl **** details #+begin_src coq Inductive Depl := | DNil: Depl | DCons: forall (A:Type) (x:A), Depl -> Depl. x : nat b1 : bool y, b : nat ============================ x < y + b Check (DCons nat x (DCons bool b1 DNil)). (* : Depl *) #+end_src ** DEMO: different use cases + revert (short: tac /r) + subst (=tac /s=) + move non-Prop away to the top (=tac /g=) + autorename =(tac /n)= + combinations =tac /s/n/g= * Dealing with big goals (demo) ** A bit help from IDE *** hide big hyps *** help read the goal *** copy hyps names easily ** use case for ";;" move variables away to focus on intersting (i.e. Prop-sorted) stuff. * Hypothesis names ** Problem not really interesting ** Been there for decades now ** Known solutions *** "smack" à la Chlipala Maintain adhoc automatic tactics, never perform the proof directly. Few adopters? *** ssrefelct partial solution Less use of introduced hyps. New hyps never introduced automatically. Still need to provide names. *** others **** coq-label aka Cortouche https://github.com/pedagand/coq-label Great idea: never use the name of a hypothesis, use a non ambiguous pattern instead: #+begin_src coq Lemma example_patt: forall t e1 e2 , is_foo e1 t -> is_foo e2 t -> is_foo e1 t. Proof. intros. exact (\< is_foo e1 _ \>). Qed. #+end_src Needs: - automatic pattern generation for IDE - still a bit hard to read. - but promising - Maintained? **** haystac https://ptival.github.io/2017/04/10/nameless-tactic-programming-with-haystac/ - Designate a hyp by an ident appearing in its type - Needs more - Maintained? **** LibHyps (present work) Automatic naming from the type of the hyp ***** tactic autorename - rename a hypothesis, works with ";;" #+begin_src coq autorename H. #+end_src Simple recursive procedure on the type. PROP SORTED ONLY. Pseudo-code (th = type of the hypothesis, n = "depth"): #+begin_src coq Ltac name n th := match n with | 0 => fresh "" (*max depth reached, empty name *) | S n => rename_hyps n th (* User customized naming *) + match th with (* default naming *) | f t1 t2 t3 => fresh "_f" ^ name n t1 ^ name n t2 ^ name n t3 | => ... end end. #+end_src ***** Details + prefix "h_", suffix "_" (optional, avoids bad interaction with Coq hacking names) + omit implicits (Ltac painful) + special cases for equality, negation, option, quantifiers. + USER DEFINED NAMING LTAC + keep using "rename" and "as" and "intros" for non-Prop hyps ** Demo * Conclusion ** A distributed Ltac plugin opam install coq-libhyps ** Need of an ocaml plugin *** Efficiency problem on big goals + Lots of terms building (and typing) to do all this in Ltac. + Speed up with a tactical applying to the *list* of new hyps. other syntax: #+begin_src coq tac ; { fun h => ... }. (* equivalent to tac1 ;; tac2. *) tac ; {< fun h => ... }. (* tac1 ;!; tac2 *) tac ; {! fun lh => ... }. tac ; {!< fun lh => ... }. #+end_src + But still slow on big goals. *** implicit detection slow *** program a new "as" for new hyps - difficult in ltac *** Nicer customization syntax. There is already this: #+begin_src coq Arguments my_relation {A} {R} x y z : rename. #+end_src Maybe we can add: #+begin_src coq Naming my_relation _ _ x _ z: "_mr" x z. Naming my_relation2 _ _ x _ z: "_mr2" x#(n-1) z#n. #+end_src or maybe merge both declarations? *** BUT plugins tend to be less adopted (fear of long term maintenance) - proofgeneral: coq-libhyps-intros allows to remove dependency: names are put in the file. Inconvenient: need to re-insert the names during maintenance. - is this the good philosophy? ** Give it a try. *** tests, comments and bug reports welcome https://github.com/Matafou/LibHyps opam install coq-libhyps LibHyps-libhyps-2.0.8/Demo/demo.v000066400000000000000000000224361453760644100165630ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* DEMO FILE FOR THE LIBHYPS LIBRARY FEATURES. *) (* This acts as a documentation for LibHyps. *) (* WARNING: You can play this file in any IDE but beware that it contains "Undo" at many places and that your IDE may not support it. In this case you can edit the script by commenting things instead of playing the Undos. *) (* You can install LibHyps with opam with: opam install coq_libhyps *) (*** Proof maintenance ***) Unset Printing Compact Contexts. Require Import Arith ZArith List. Require Import LibHyps.LibHyps. Lemma foo: forall (x:nat) (b1:bool) (y:nat) (b2:bool), x = y -> orb b2 b1 = false -> forall a b:nat, forall b3:bool, forall t : nat, a+1 = t+2 -> b + 5 = t - 7 -> forall z, forall b4:bool, forall z', orb b3 b4 = b2 -> (forall u v, v+1 = 1 -> u+1 = 1 -> a = z+2) -> z = b + 5-> z' + 1 = b + x-> x < y + b. Proof. (* tactical "; { }" to apply a tactic to each "new" hyp. *) intros ; { fun h => idtac h }. Undo. (* tactical "; {< }": same but newer hyps first. *) intros ; {< fun h => idtac h }. Undo. intros x b1. (* Only the *new* hyps are iterated *) intros ; { fun h => idtac h }. Undo 2. (* Simply based on new *names* *) intros x b1. (* this tactic renames x into aaa, which is a new name. *) rename x into aaa ; { fun h => idtac h }. Undo 2. (* Here x is reused by induction and thus not new. *) intros x. induction x ; {< (fun h => idtac h) }. Undo 2. (* tactical "onAllhyps": same thing but on all hyps. *) intros. onAllHyps (fun h => idtac h). (*** Use Cases ***) (* Revert any new hyp. Must be older fist. *) intros. revert x H H6. induction x ; {< (fun h => revert dependent h) }. Undo. (* Shortcut *) induction x /r. Restart. (* Try subst on each new hyp. *) intros ; { fun h => try match type of h with (?x = ?y) => (subst x+subst y) end }. Undo. (* predefined tactic. *) intros ;{ subst_or_idtac }. Undo. (* and a shortcut. *) intros /s. Undo. (* combination: try subst and revert remaining hyps. *) intros x b1. intros ; { subst_or_idtac } ; {< (fun h => revert dependent h) }. Undo. intros /s/r. Undo 2. (* It really applies only on new hyps: *) intros until 1. intros /s/r. Abort. (*** Large Goals - Foraward reasoning and reordering and autorenaming of hypothesis. ***) Lemma foo: forall (x:nat) (b1:bool) (y:nat) (b2:bool), x = y -> orb b2 b1 = false -> forall a b:nat, forall b3:bool, forall t : nat, a+1 = t+2 -> b + 5 = t - 7 -> (forall n m p : nat, 0 <= p -> Nat.divide n p -> Nat.divide m p -> (forall q : nat, Nat.divide n q -> Nat.divide m q -> Nat.divide p q) -> Nat.lcm n m = p) -> (exists w:nat , ~(true=(andb false true)) /\ le w w /\ w = x) -> forall z, forall b4:bool, forall z', orb b3 b4 = b2 -> (forall u v, v+1 = 1 -> u+1 = 1 -> a = z+2) -> z = b + 5-> z' + 1 = b + x-> x < y + b. Proof. intros. Set Printing Compact Contexts. (* BIG HYPS may clutter the goal. IDE solution. *) (* 1. ProofGeneral: just hide it by clicking on its button, or hit "f" while cursor on its name. Persistent and simply based on hyp name. *) (* 2. Big hyps ask for "non verbose forward reasoning". *) (* Since a few years coq allows "specialize" to re-quantifies non-unified premisses. *) specialize H3 with (1:= le_S _ _ (le_n 0)). (* Our tactic "especialize" starts a goal to instantiate a dependent premiss of a hyp, and then re-quantifies everything non instantiated. *) Undo. (* THIS IS BROKEN IN COQ 8.18 *) (* especialize H3 at 1. { apply le_S. apply le_n. } Undo 5. *) (* IDEs don't like Undo, replay the next ocommand twice will resync proofgeneral. *) (* It accepts several (up to 7) premisses numers. *) (* BROKEN IN 8.18 *) (* especialize H3 at 2,3. Undo. *) (* you can ask a goal for all premisses, in the spirit of the "exploit" tactic from CompCert. *) (* BROKEN IN 8.18 *) (* especialize H3 at *. Undo. *) (* You can also specify that you want to instantiate the n first premisses. *) (* BROKEN IN 8.18 *) (* especialize H3 until 3. Show 4. Undo. *) (* VARIABLES MIXED WITH HYPOTHESIS. *) (* move_up_types X. moves X at top near something of the same type, but only if X is Type-sorted (not Prop). *) move_up_types b4. (* group z on top *) move_up_types H. (* does nothing because H:..:Prop *) Undo 2. Unset Printing Compact Contexts. (* Do that on all hyps: *) onAllHyps move_up_types. Set Printing Compact Contexts. Restart. (* Better do that on new hyps only. *) intros ; { move_up_types }. Undo. (* Faster version dealing with the whole list of new hyps at once: *) intros; {! group_up_list }. Undo. (* Shortcut for this faster version: *) intros /g. Undo. (* combined with subst: *) intros /s/g. (* And have this coq option on fo saving a bit more room: *) Set Printing Compact Contexts. (*** HYPOTHESIS NAMES. ***) Restart. intros. Undo. (* After a lot of non interesting thinking. *) intros x b1 y b2 h_x_eq_y h_or_b2_b1 a b b3 t h_a_t h_b_t hh hex z b4 z' h_b3_b4 h_all_uvaz heq_z heq_z'_b. (* But at each change in definitions or statements ==> Adapt the intros and "as". *) Restart. intros. (* tactic "autorename H" applies the naming heursitc to H. *) autorename H. (* Notice the trailing "_": avoids coq replacing digits. *) Undo. (* Again, one can apply it to all hyps: *) onAllHyps autorename. (* experimental: (setq coq-libhyps-intros t) *) Undo 2. Show. Restart. Show. (* Again, better combine it with "; { }". *) intros ; { autorename }. (* You can still shorten big hyps. but hiding most of the time is better. *) rename h_all_eq_lcm_p_ into hall. Undo 2. (* shortcut: *) intros /n. Restart. Show. Set Printing Compact Contexts. (* Combining with other cleaning operators: *) intros /s/n/g. (* /sng is also accepted *) (* Long names, this is configurable (next demo), but IDE provides easy ways to see them (highlight) and to input them: - middle-click on hyp's name. - completion (company-coq). *) (* tactic that generate names can be easily tamed. *) decompose [ex and or] h_ex_and_neq_and_/sng. (* No more obscure "as" to maintain *) inversion h_le_y_y_ /sng. Show 2. (* You can still use destructive pattern, but without inventing names: *) Undo. assert (y < a /\ b < t /\ z' < t) /n. {admit. } destruct h_and_lt_y_a_and_lt_lt_ as [ ? [? ?]] /n. Abort. (* customization of autorename *) Local Open Scope autonaming_scope. Import ListNotations. (* Define the naming scheme as new tactic pattern matching on a type th, and the depth n of the recursive naming analysis. Here we state that a type starting with Nat.eqb should start with _Neqb, followed by the name of both arguments. #n here means normal decrement of depth. (S n) would increase depth by 1 (n-1) would decrease depth. *) Ltac rename_hyp_2 n th := match th with | Nat.eqb ?x ?y => name(`_Neqb` ++ x#n ++ y#n) end. (* Then overwrite the customization hook of the naming tactic *) Ltac rename_hyp ::= rename_hyp_2. Goal forall x y:nat, True. intros. (* computing a few names *) (* Customize the starting depth *) let res := fallback_rename_hyp_name (Nat.eqb 1 2) in idtac res. let res := fallback_rename_hyp_name (Nat.eqb x 4) in idtac res. let res := fallback_rename_hyp_name (Nat.eqb 1 2 = false) in idtac res. Ltac rename_depth ::= constr:(2). let res := fallback_rename_hyp_name (Nat.eqb 1 2 = false) in idtac res. Ltac rename_depth ::= constr:(3). Abort. (** Suppose I want to add another naming rule: I need to cumulate the previous scheme with the new one. First define a new tactic that will replace the old one. it should call previous naming schemes in case of failure of the new scheme. It is thus important that rename_hyp_2 was defined by itself and directly as rename_hyp. *) Ltac rename_hyp_3 n th := match th with | ?x = false => name(x#n ++ `_isf`) | ?x = true => name( x#n ++ `_ist`) | _ => rename_hyp_2 n th (* previous naming scheme *) end. (* Then update the customization hook *) Ltac rename_hyp ::= rename_hyp_3. (* Close the naming scope *) Local Close Scope autonaming_scope. Goal forall x y:nat, True. intros. let res := fallback_rename_hyp_name (Nat.eqb 1 2 = false) in idtac res. Abort. Lemma foo: forall (x:nat) (b1:bool) (y:nat) (b2:bool), x = y -> orb b2 b1 = false -> forall a b:nat, forall b3:bool, forall t : nat, true = Nat.eqb (a+1) (t+2) -> b + 5 = t - 7 -> forall z, forall b4:bool, forall z', orb b3 b4 = b2 -> (forall u v, v+1 = 1 -> u+1 = 1 -> a = z+2) -> z = b + 5-> z' + 1 = b + x-> x < y + b. Proof. (* Customize the starting depth *) Ltac rename_depth ::= constr:(3). intros/n/g. Undo. (* Have shorter names: *) Ltac rename_depth ::= constr:(2). intros/n/g. Abort. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental1.v000066400000000000000000000036151453760644100202170ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp: exp -> Z -> Prop:= EE_val: forall v, Eval_exp (Val v) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp e1 v1 -> Eval_exp e2 v2 -> eval_op op = f -> Eval_exp (BinOp op e1 e2) (f v1 v2). (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. Lemma determ_nolibhyp: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros * h_EE_e_v. induction h_EE_e_v as [v | e1 e2 v1 v2 op f h_e_v1 IHh_v1 h_e_v2 IHh_v2 hop]; intros h_EE_e_v'. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'. subst. (* H2 H4... need to fix the proof! *) Admitted. (* Same proof as above, no naming effort. *) Lemma determ: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros until 1 /ng. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_op_e1_e2_v'_ /sng. (* need to fix the proof! *) Admitted. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental1_fix.v000066400000000000000000000040001453760644100210520ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp: exp -> Z -> Prop:= EE_val: forall v, Eval_exp (Val v) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp e1 v1 -> Eval_exp e2 v2 -> eval_op op = f -> Eval_exp (BinOp op e1 e2) (f v1 v2). (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. Lemma determ_nolibhyp: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop]; intros v' h_EE_e_v'. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'. (* "as" very hard to guess + useless here. *) subst. erewrite IH_v1;eauto. erewrite IH_v2;eauto. Qed. (* Same proof as above, no naming effort. *) Lemma determ: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_op_e1_e2_v'_ /sng. erewrite h_all_eq_v1_v'_;eauto. erewrite h_all_eq_v2_v'_;eauto. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental2.v000066400000000000000000000045231453760644100202170ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Adding variables, thus an environment. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. (* Env is a map from nat to values (Z) *) Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. (* We add variabes *) Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. (* We add an environment Γ in the rules. *) Inductive Eval_exp Γ : exp -> Z -> Prop:= EE_val: forall v, Eval_exp Γ (Val v) v | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) (f v1 v2). (* optional customization. NEEDS UPDATE (Γ + Var). *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* NEEDS UPDATE: add gamma *) Lemma determ_nolibhyp: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop]; intros v' h_EE_e_v'. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'. subst. erewrite IH_v1;eauto. erewrite IH_v2;eauto. Qed. (* Same proof as above, no naming effort. *) Lemma determ: forall e v v', Eval_exp e v -> Eval_exp e v' -> v = v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_op_e1_e2_v'_ /sng. erewrite h_all_eq_v1_v'_;eauto. erewrite h_all_eq_v2_v'_;eauto. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental2_fix.v000066400000000000000000000051671453760644100210720ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Adding variables, thus an environment. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. (* Env is a map from nat to values (Z) *) Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. (* We add variabes *) Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. (* We add an environment Γ in the rules. *) Inductive Eval_exp Γ : exp -> Z -> Prop:= EE_val: forall v, Eval_exp Γ (Val v) v | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) (f v1 v2). (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) (* no gamma in name *) | Val ?v => name(v#(S n)) (* v instead of Val v *) | Var ?x => name(x#(S n)) (* x instead of Var x *) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) (* hide BinOp *) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) (* hide eval_op *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. Lemma determ_nolibhyp: forall Γ e v v', Eval_exp Γ e v -> Eval_exp Γ e v' -> v = v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | x v h_MapsTo | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop]; intros v' h_EE_e_v'. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'; auto; subst. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_e_v'. subst. erewrite IH_v1;eauto. erewrite IH_v2;eauto. Qed. (* No intros to update. Some hyps have a new type hence a new name. *) Lemma determ: forall Γ e v v', Eval_exp Γ e v -> Eval_exp Γ e v' -> v = v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_x_v'_ ; auto/sng. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_op_e1_e2_v'_ /sng. erewrite h_all_eq_v1_v'_;eauto. erewrite h_all_eq_v2_v'_;eauto. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental3.v000066400000000000000000000050351453760644100202170ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Lemma on determinism needs generalization. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp Γ: exp -> Z -> Prop:= EE_val: forall v, Eval_exp Γ (Val v) v | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) (f v1 v2). (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | Var ?x => name(x#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) | Env.Equal ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* We actually need to prove modulo equivalence of environments *) Lemma determ_nolibhyp: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> v = v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | x v h_MapsTo | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop]; intros v' h_EE_e_v'. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'; auto; subst. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_e_v'. subst. erewrite IH_v1;eauto. erewrite IH_v2;eauto. Qed. Lemma determ: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> v = v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_x_v'_ ; auto/sng. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_op_e1_e2_v'_ /sng. erewrite h_all_eq_v1_v'_;eauto. erewrite h_all_eq_v2_v'_;eauto. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental3_fix.v000066400000000000000000000051631453760644100210670ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Lemma on determinism needs generalization. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp. Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp Γ: exp -> Z -> Prop:= EE_val: forall v, Eval_exp Γ (Val v) v | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) v | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) (f v1 v2). (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | Var ?x => name(x#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) | Env.Equal ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* We actually need to prove modulo equivalence of environments *) Lemma determ_nolibhyp: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> v = v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | x v h_MapsTo | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop]; intros v' h_EE_e_v' heq_Γ. - inversion h_EE_e_v'. auto. - inversion h_EE_e_v'; auto; subst. rewrite heq_Γ in h_MapsTo. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_e_v'. subst. erewrite IH_v1;eauto. erewrite IH_v2;eauto. Qed. Lemma determ: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> v = v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. auto. - inversion h_EE_x_v'_; auto /sng. rewrite h_EQ_Γ_Γ'_ in h_MapsTo_x_v_Γ_. eapply EnvFact.MapsTo_fun;eauto. - inversion h_EE_op_e1_e2_v'_ /sng. erewrite h_all_eq_v1_v'_;eauto. erewrite h_all_eq_v2_v'_;eauto. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental5.v000066400000000000000000000115071453760644100202220ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* We add commands, and Assign is an expr. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp | Assign: nat -> exp -> exp. Inductive Com : Type := | Skip: Com | Seq: Com -> Com -> Com. Record Ret := { val: Z; env: Env.t Z }. Definition EqRet ret1 ret2 := ret1.(val) = ret2.(val) /\ Env.Equal ret1.(env) ret2.(env). Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp Γ: exp -> Ret -> Prop := EE_val: forall v, Eval_exp Γ (Val v) {| val := v; env := Γ |} | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) {| val := v; env := Γ |} | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) {| val :=(f v1.(val) v2.(val)); env := Γ |} | EX_Assign: forall (x:nat) (e:exp) v, Eval_exp Γ e v -> Eval_exp Γ (Assign x e) {| val := v.(val); env := (Env.add x v.(val) v.(env)) |} . Inductive Exec Γ: Com -> Env.t Z -> Prop := | EX_Skip: Exec Γ Skip Γ | EX_Seq: forall Γ1 Γ2 (c1 c2:Com), Exec Γ c1 Γ1 -> Exec Γ1 c2 Γ2 -> Exec Γ (Seq c1 c2) Γ2. (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | Var ?x => name(x#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) | Exec ?G ?c ?G' => name(`_EX` ++ G#n ++ c#n ++ G'#n) | Env.Equal ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) | EqRet ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* We actually need to prove modulo equivalence of environments *) (* Here I give up giving names for all these inversions. *) Lemma determ_nolibhyp: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> EqRet v v'. Proof. intros * h_EE_e_v. revert v'. induction h_EE_e_v as [v | x v h_MapsTo | e1 e2 v1 v2 op f h_e_v1 IH_v1 h_e_v2 IH_v2 hop | x e v h_EE_e_v_ h_all_EQ_v_v'_] ; intros v' h_EE_e_v' heq_Γ. - inversion h_EE_e_v'. red;auto. - inversion h_EE_e_v'; auto; subst. rewrite heq_Γ in h_MapsTo. red. assert (v=v0);subst. { eapply EnvFact.MapsTo_fun;eauto. } auto. - inversion h_EE_e_v' as [| |e0 e3 v0 v3 op0 f0 h_EE_e1_v0_ h_EE_e2_v3_ | ];subst. specialize IH_v1 with (1:=h_EE_e1_v0_) (2:=heq_Γ). specialize IH_v2 with (1:=h_EE_e2_v3_) (2:=heq_Γ). unfold EqRet in IH_v1,IH_v2. destruct IH_v1 as [h_eq_val_v1_val_v0_ ?], IH_v2 as [h_eq_val_v2_val_v3_ ?]. rewrite h_eq_val_v1_val_v0_, h_eq_val_v2_val_v3_. red;auto. - inversion h_EE_e_v' as [ | | | x0 e0 v0 h_EE_e_v0_ ]; subst. specialize h_all_EQ_v_v'_ with (1:=h_EE_e_v0_) (2:=heq_Γ). unfold EqRet in h_all_EQ_v_v'_. destruct h_all_EQ_v_v'_ as [h_eq_val_v_val_v0_ h_eq_env_v_env_v0_]. repeat rewrite h_eq_val_v_val_v0_. red;split;auto. cbn. rewrite h_eq_env_v_env_v0_. reflexivity. Qed. (* We actually need to prove modulo equivalence of environments *) Lemma determ: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> EqRet v v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. red;auto. - inversion h_EE_x_v'_; auto /sng. rewrite h_EQ_Γ_Γ'_ in h_MapsTo_x_v_Γ_. red. assert (v=v0);subst/sng. { eapply EnvFact.MapsTo_fun;eauto. } auto. - inversion h_EE_op_e1_e2_v'_ /sng. specialize h_all_EQ_v1_v'_ with (1:=h_EE_e1_v0_) (2:=h_EQ_Γ_Γ'_). specialize h_all_EQ_v2_v'_ with (1:=h_EE_e2_v3_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v1_v'_, h_all_EQ_v2_v'_. destruct h_all_EQ_v1_v'_, h_all_EQ_v2_v'_/sng. rewrite h_eq_val_v1_val_v0_,h_eq_val_v2_val_v3_. red;auto. - inversion h_EE_Assign_x_e_v'_ /sng. subst. specialize h_all_EQ_v_v'_ with (1:=h_EE_e_v0_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v_v'_. destruct h_all_EQ_v_v'_ /sng. repeat rewrite h_eq_val_v_val_v0_. red;split;auto. cbn. rewrite h_EQ_env_v_env_v0_. reflexivity. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental5_libhyp.v000066400000000000000000000066761453760644100216040ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Lemma on determinism needs generalization. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp | Assign: nat -> exp -> exp. Inductive Com : Type := | Skip: Com | Seq: Com -> Com -> Com. Record Ret := { val: Z; env: Env.t Z }. Definition EqRet ret1 ret2 := ret1.(val) = ret2.(val) /\ Env.Equal ret1.(env) ret2.(env). Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp Γ: exp -> Ret -> Prop := EE_val: forall v, Eval_exp Γ (Val v) {| val := v; env := Γ |} | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) {| val := v; env := Γ |} | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) {| val :=(f v1.(val) v2.(val)); env := Γ |} | EX_Assign: forall (x:nat) (e:exp) v, Eval_exp Γ e v -> Eval_exp Γ (Assign x e) {| val := v.(val); env := (Env.add x v.(val) v.(env)) |} . Inductive Exec Γ: Com -> Env.t Z -> Prop := | EX_Skip: Exec Γ Skip Γ | EX_Seq: forall Γ1 Γ2 (c1 c2:Com), Exec Γ c1 Γ1 -> Exec Γ1 c2 Γ2 -> Exec Γ (Seq c1 c2) Γ2. (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | Var ?x => name(x#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) | Exec ?G ?c ?G' => name(`_EX` ++ G#n ++ c#n ++ G'#n) | Env.Equal ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) | EqRet ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* We actually need to prove modulo equivalence of environments *) Lemma determ: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> EqRet v v'. Proof. intros until 1 /ng. revert v'. induction h_EE_e_v_; intros /sng. - inversion h_EE_v_v'_. red;auto. - inversion h_EE_x_v'_ /sng. rewrite h_EQ_Γ_Γ'_ in h_MapsTo_x_v_Γ_. red. assert (v=v0)/sng. { eapply EnvFact.MapsTo_fun;eauto. } auto. - inversion h_EE_op_e1_e2_v'_ /sng. specialize h_all_EQ_v1_v'_ with (1:=h_EE_e1_v0_) (2:=h_EQ_Γ_Γ'_). specialize h_all_EQ_v2_v'_ with (1:=h_EE_e2_v3_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v1_v'_, h_all_EQ_v2_v'_. destruct h_all_EQ_v1_v'_, h_all_EQ_v2_v'_/sng. rewrite h_eq_val_v1_val_v0_, h_eq_val_v2_val_v3_. red;auto. - inversion h_EE_Assign_x_e_v'_ /sng. subst. specialize h_all_EQ_v_v'_ with (1:=h_EE_e_v0_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v_v'_. destruct h_all_EQ_v_v'_ /sng. repeat rewrite h_eq_val_v_val_v0_. red;split;auto. cbn. rewrite h_EQ_env_v_env_v0_. reflexivity. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/Demo/incremental5_nolibhyps.v000066400000000000000000000076471453760644100223230ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* Lemma on determinism needs generalization. *) Require Import FSets.FMapList FSets.FMapFacts Arith ZArith LibHyps.LibHyps List. Require Import Structures.OrderedTypeEx FSets.FSetList. Module Env := FMapList.Make(Nat_as_OT). Module EnvFact := FMapFacts.Facts(Env). Inductive binop := Plus | Minus | Mult. Inductive exp : Type := | Val : Z -> exp | Var : nat -> exp | BinOp: binop -> exp -> exp -> exp | Assign: nat -> exp -> exp. Inductive Com : Type := | Skip: Com | Seq: Com -> Com -> Com. Record Ret := { val: Z; env: Env.t Z }. Definition EqRet ret1 ret2 := ret1.(val) = ret2.(val) /\ Env.Equal ret1.(env) ret2.(env). Definition eval_op op := match op with Plus => Z.add| Minus => Z.sub| Mult => Z.mul end. Inductive Eval_exp Γ: exp -> Ret -> Prop := EE_val: forall v, Eval_exp Γ (Val v) {| val := v; env := Γ |} | EE_var: forall x v, Env.MapsTo x v Γ -> Eval_exp Γ (Var x) {| val := v; env := Γ |} | EE_binop: forall e1 e2 v1 v2 op f, Eval_exp Γ e1 v1 -> Eval_exp Γ e2 v2 -> eval_op op = f -> Eval_exp Γ (BinOp op e1 e2) {| val :=(f v1.(val) v2.(val)); env := Γ |} | EX_Assign: forall (x:nat) (e:exp) v, Eval_exp Γ e v -> Eval_exp Γ (Assign x e) {| val := v.(val); env := (Env.add x v.(val) v.(env)) |} . Inductive Exec Γ: Com -> Env.t Z -> Prop := | EX_Skip: Exec Γ Skip Γ | EX_Seq: forall Γ1 Γ2 (c1 c2:Com), Exec Γ c1 Γ1 -> Exec Γ1 c2 Γ2 -> Exec Γ (Seq c1 c2) Γ2. (* optional customization *) Ltac rename_depth ::= constr:(3). Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_eval n th := match th with Eval_exp _ ?e ?v => name(`_EE` ++ e#n ++ v#n) | Val ?v => name(v#(S n)) | Var ?x => name(x#(S n)) | BinOp ?o ?e1 ?e2 => name(o#(S 0) ++ e1#n ++ e2#n) | eval_op ?o ?v1 ?v2 => name(o#(S 0) ++ v1#n ++ v2#n) | Exec ?G ?c ?G' => name(`_EX` ++ G#n ++ c#n ++ G'#n) | Env.Equal ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) | EqRet ?X ?Y => name(`_EQ` ++ X#n ++ Y#n) (* shorten Equal *) end. Close Scope autonaming_scope. Ltac rename_hyp ::= rename_hyp_eval. (* We actually need to prove modulo equivalence of environments *) Lemma determ_nolibhyp: forall Γ Γ' e v v', Eval_exp Γ e v -> Eval_exp Γ' e v' -> Env.Equal Γ Γ' -> EqRet v v'. Proof. intros * h_EE_e_v_. revert v'. induction h_EE_e_v_ as [v | x v h_MapsTo_x_v_Γ_ | e1 e2 v1 v2 op f h_e_v1 h_all_EQ_v1_v'_ h_e_v2 h_all_EQ_v2_v'_ hop | x e v h_EE_e_v_ h_all_EQ_v_v'_ ] ; [intros v' h_EE_v_v'_ h_EQ_Γ_Γ'_ | intros v' h_EE_x_v'_ h_EQ_Γ_Γ'_ | intros v' h_EE_op_e1_e2_v'_ h_EQ_Γ_Γ'_| intros v' h_EE_Assign_x_e_v'_ h_EQ_Γ_Γ'_ ]. - inversion h_EE_v_v'_ . red;auto. - inversion h_EE_x_v'_; auto; subst. rewrite h_EQ_Γ_Γ'_ in h_MapsTo_x_v_Γ_. red. assert (v=v0);subst. { eapply EnvFact.MapsTo_fun;eauto. } auto. - inversion h_EE_op_e1_e2_v'_ as [| |e0 e3 v0 v3 op0 f0 h_EE_e1_v0_ h_EE_e2_v3_ | ];subst. specialize h_all_EQ_v1_v'_ with (1:=h_EE_e1_v0_) (2:=h_EQ_Γ_Γ'_). specialize h_all_EQ_v2_v'_ with (1:=h_EE_e2_v3_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v1_v'_,h_all_EQ_v2_v'_. destruct h_all_EQ_v1_v'_ as [h_eq_val_v1_val_v0_ ?], h_all_EQ_v2_v'_ as [h_eq_val_v2_val_v3_ ?]. rewrite h_eq_val_v1_val_v0_, h_eq_val_v2_val_v3_. red;auto. - inversion h_EE_Assign_x_e_v'_ as [ | | | x0 e0 v0 h_EE_e_v0_ ]; subst. specialize h_all_EQ_v_v'_ with (1:=h_EE_e_v0_) (2:=h_EQ_Γ_Γ'_). unfold EqRet in h_all_EQ_v_v'_. destruct h_all_EQ_v_v'_ as [h_eq_val_v_val_v0_ h_EQ_env_v_env_v0_]. repeat rewrite h_eq_val_v_val_v0_. red;split;auto. cbn. rewrite h_EQ_env_v_env_v0_. reflexivity. Qed. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) LibHyps-libhyps-2.0.8/LICENSE000066400000000000000000000020441453760644100155620ustar00rootroot00000000000000Copyright (c) 2021 Pierre Courtieu Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. LibHyps-libhyps-2.0.8/LibHyps/000077500000000000000000000000001453760644100161275ustar00rootroot00000000000000LibHyps-libhyps-2.0.8/LibHyps/.gitignore000066400000000000000000000000221453760644100201110ustar00rootroot00000000000000*.glob *.vo *.v.d LibHyps-libhyps-2.0.8/LibHyps/LibDecomp.v000066400000000000000000000036471453760644100201660ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (** ** A specific variant of decompose. Which decomposes all logical connectives. *) Ltac decomp_logicals h := idtac;match type of h with | @ex _ (fun x => _) => let x' := fresh x in let h1 := fresh in destruct h as [x' h1]; decomp_logicals h1 | @sig _ (fun x => _) => let x' := fresh x in let h1 := fresh in destruct h as [x' h1]; decomp_logicals h1 | @sig2 _ (fun x => _) (fun _ => _) => let x' := fresh x in let h1 := fresh in let h2 := fresh in destruct h as [x' h1 h2]; decomp_logicals h1; decomp_logicals h2 | @sigT _ (fun x => _) => let x' := fresh x in let h1 := fresh in destruct h as [x' h1]; decomp_logicals h1 | @sigT2 _ (fun x => _) (fun _ => _) => let x' := fresh x in let h1 := fresh in let h2 := fresh in destruct h as [x' h1 h2]; decomp_logicals h1; decomp_logicals h2 | and _ _ => let h1 := fresh in let h2 := fresh in destruct h as [h1 h2]; decomp_logicals h1; decomp_logicals h2 | iff _ _ => let h1 := fresh in let h2 := fresh in destruct h as [h1 h2]; decomp_logicals h1; decomp_logicals h2 | or _ _ => let h' := fresh in destruct h as [h' | h']; [decomp_logicals h' | decomp_logicals h' ] | _ => idtac end. (* Lemma foo: (IF_then_else False True False) -> False. Proof. intros H. decomp_logicals H. Admitted. Lemma foo2 : { aa:False & True } -> False. Proof. intros H. decomp_logicals H. Admitted. Lemma foo3 : { aa:False & True & False } -> False. Proof. intros H. decomp_logicals H. Abort. *) LibHyps-libhyps-2.0.8/LibHyps/LibHyps.v000066400000000000000000000122411453760644100176700ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Export LibHyps.TacNewHyps. Require Export LibHyps.LibHypsNaming. (* Require Export LibHyps.LibSpecialize. *) Require Export LibHyps.LibHypsTactics. (* We export ; { } etc. ";;" also. *) Export TacNewHyps.Notations. (* There are three variants of the autorename tatic, depending on what to do with hypothesis on which no name was found. *) (* hypothesis for which autonaming failed ar left with there default name. *) Tactic Notation (at level 4) tactic4(Tac) "/" "n":= Tac ; { autorename }. Tactic Notation (at level 4) "/" "n" := (onAllHyps autorename). (* Fail if autonaming fails on some hyp *) Tactic Notation(at level 4) tactic4(Tac) "/" "n!":= Tac ; { autorename_strict }. Tactic Notation (at level 4) "/" "n!" := (onAllHyps autorename_strict). (* Revert hyps for which autorenaming fails, but don't fail *) Tactic Notation (at level 4) tactic4(Tac) "/" "n?" := Tac ; { rename_or_revert }. Tactic Notation (at level 4) "/" "n?" := (onAllHyps rename_or_revert). (* Revert new hypothesis *) Tactic Notation (at level 4) tactic4(Tac) "/" "r" := Tac ; {< revertHyp }. Tactic Notation (at level 4) "/" "r" := (onAllHypsRev revertHyp). (* WARNING group_up_list applies to the whole list of hyps directly. *) (* Tactic Notation (at level 4) tactic4(Tac) "/" "g" := (then_allnh Tac group_up_list). *) Tactic Notation (at level 4) tactic4(Tac) "/" "g" := Tac ; {! group_up_list }. Tactic Notation (at level 4) "/" "g" := (group_up_list all_hyps). (* Tactic Notation (at level 4) tactic4(Tac) "/" "s" := (then_eachnh Tac subst_or_idtac). *) Tactic Notation (at level 4) tactic4(Tac) "/" "s" := Tac ; { subst_or_idtac }. Tactic Notation (at level 4) "/" "s" := (onAllHyps subst_or_idtac). (* usual combinations *) Tactic Notation (at level 4) tactic4(Tac) "//" := (Tac /s/n/g). Tactic Notation (at level 4) tactic4(Tac) "/" "sng" := (Tac /s/n/g). Tactic Notation (at level 4) tactic4(Tac) "/" "sgn" := (Tac /s/g/n). Tactic Notation (at level 4) tactic4(Tac) "/" "sn" := (Tac /s/n). Tactic Notation (at level 4) tactic4(Tac) "/" "sr" := (Tac /s/r). Tactic Notation (at level 4) tactic4(Tac) "/" "sg" := (Tac /s/g). Tactic Notation (at level 4) tactic4(Tac) "/" "ng" := (Tac /n/g). Tactic Notation (at level 4) tactic4(Tac) "/" "gn" := (Tac /g/n). Tactic Notation (at level 4) "/" "sng" := (onAllHyps subst_or_idtac); (onAllHyps autorename); group_up_list all_hyps. Tactic Notation (at level 4) "/" "sn" := (onAllHyps subst_or_idtac); (onAllHyps autorename). Tactic Notation (at level 4) "/" "sr" := (onAllHyps subst_or_idtac); (onAllHyps revertHyp). Tactic Notation (at level 4) "/" "ng" := ((onAllHyps autorename) ; group_up_list all_hyps). Module LegacyNotations. Import Notations. (* COMPATIBILITY WITH PREVIOUS VERSION OF LIBHYPS. *) Tactic Notation (at level 0) "!" tactic(Tac) := (Tac /n?). (* binds stronger than ";" *) Tactic Notation (at level 3) "!!" tactic3(Tac) := (Tac /n). (* like !!tac + tries to subst with each new hypothesis. *) Tactic Notation "!!!" tactic3(Tac) := Tac/s/n?. (* Like !!! + regroup new Type-sorted hyps at top. *) Tactic Notation (at level 4) "!!!!" tactic4(Tac) := Tac /s/n?/g. (* Other Experimental combinations *) (* subst or revert, revert is done from older to newer for consistency. *) Tactic Notation (at level 4) "??" tactic4(tac1) := tac1 /s/r. (* subst or rename or revert, revert is done from older to newer *) Tactic Notation (at level 4) "?!" tactic4(tac1) := tac1 /s/n!. End LegacyNotations. (* Goal forall x1 x3:bool, forall a z e : nat, z+e = a -> forall SEP:(True -> True), a = z+z -> ((fun f => z = e) true) -> forall b1 b2 b3 b4: bool, True -> True. Proof. (* Set Ltac Debug. *) (* then_nh_rev ltac:(intros) ltac:(subst_or_idtac). *) intros ; {! group_up_list }. (* intros ? ? ? ? ? ? ? ? ? ?. *) (* group_up_list (DCons bool b1 DNil). *) Undo. intros ; { move_up_types }. intros /n!. intros /s/n!. Undo. intros /n. match goal with | h: bool => assert end Undo. intros/n. Undo. intros ; { autorename }; {! group_up_list }. Undo. intros/ng. Undo. intros ; {subst_or_idtac} ; { autorename } ; {! group_up_list }. Undo. intros/sng. Fail progress intros ; { revertHyp }. subst_or_idtac (DCons (z0 + r = a) H DNil). let hyps := all_hyps in idtac hyps. subst_or_idtac hyps. intros ;!; ltac:(subst_or_idtac_l). then_nh_one_by_one ltac:(intros) ltac:(subst_or_idtac). ; {< subst_or_idtac }. ; { group_up_list } ; { autorename_l }. subst_or_idtac h_eq_a_add_z0_t. intros ; { fun h => autorename_strict h }. intros ; { fun h => idtac h }. intros ; { ltac:(fun h => idtac h) }. intros ; [H: sng H]. *) (* Goal forall x1 x3:bool, True -> forall a z e r t z e r t z e r t z e r t y: nat, False -> forall u i o p q s d f g:nat, forall x2:bool, True -> True. Proof. time then_nh ltac:(intros) ltac:(group_up_list). intros. Set Ltac Profiling. let lh := all_hyps in let cache := build_initial_cache lh in group_up_list_ H (DCons bool x3 DNil) lh. idtac cache. *) LibHyps-libhyps-2.0.8/LibHyps/LibHypsNaming.v000066400000000000000000000506771453760644100210410ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Import Arith ZArith List LibHyps.TacNewHyps. Import ListNotations. Local Open Scope list. (** This file defines a tactic "autorename h" (and "autorename_strict h") that automatically rename hypothesis h followinh a systematic, but customizable heuristic. Comments welcome. *) (* Comment this and the Z-dependent lines below if you don't want ZArith to be loaded *) Require Import ZArith. (** ** The custom renaming tactic The tactic "rename_hyp" should be redefined along a coq development, it should return a fresh name build from a type th and a depth. It should fail if no name is found, so that the fallback scheme is called. Typical use, in increasing order of complexity, approximatively equivalent to the decreasing order of interest. << Ltac rename_hyp1 n th := match th with | List.In ?e ?l => name ( `_lst_in` ++ e#n ++ l#O) | InA _ ?e ?l => name( `_inA` ++ e#n ++ l#0) | @StronglySorted _ ?ord ?l => name ( `_strgSorted` ++ l#(S (S n))) | @Forall _ ?P ?x => name (`_lst_forall` ++ P#n ++ x#n) | @Forall2 _ _ ?P ?x ?y => name (`_lst_forall2` ++ P#n ++ x#n ++ y#n) | NoDupA _ ?l => name (`_NoDupA` ++ l#n) | NoDup _ ?l => name (`_NoDup` ++ l#n) end. >> (* Overwrite the definition of rename_hyp using the ::= operator. :*) << Ltac rename_hyp ::= my_rename_hyp. >> *) (** * Implementation principle: The name of the hypothesis will be a sequence of chunks. A chunk is a word generally starting with "_". Internally (not seen by the user) this sequence is represented by a list of small terms. One term of the form (∀ :Prop, DUMMY ) per chunk. For instance the sequence "h_eq_foo" is represented by the following coq term: [(∀ h,DUMMY h) ; (∀ _eq,DUMMY _eq) ; (∀ _foo, DUMMY _foo)] where DUMMY is an opaque (identity) function but we don't care. *) (** We define DUMMY as an opaque symbol. *) Definition DUMMY: Prop -> Prop. exact (fun x:Prop => x). Qed. (* ********** CUSTOMIZATION ********** *) (** If this is true, then all hyps names will have a trailing "_". In case of names ending with a digit (like in "le_1_2" or "le_x1_x2") this additional suffix avoids Coq's fresh name generation to *replace* the digit. Although this is esthetically bad, it makes things more predictable. You may set this to true for backward compatility. *) Ltac add_suffix := constr:(true). (* This sets the way numerical constants are displayed, default value is set below to numerical_names_nosufx, which will give the same name to (O<1)%nat and (O<1)%Z and (O<1)%N, i.e. h_lt_0_1_. but you can use this in your development to change it h_lt_0n_1n_/h_lt_0z_1z_/h_lt_0N_1N_: Ltac numerical_names ::= numerical_names_sufx *) Ltac numerical_names := fail. (** This determines the depth of the recursive analysis of a type to compute the corresponding hypothesis name. generally 2 or 3 is enough. More gives too log names, less may give identical names too often. *) Ltac rename_depth := constr:(3). (** Default prefix for hypothesis names. *) Ltac default_prefix :=constr:(forall h, DUMMY h). (** A few special default chunks, for special cases in the naming heuristic. *) Ltac impl_prefix := constr:(forall _impl, DUMMY _impl). Ltac forall_prefix := constr:(forall _all, DUMMY _all). Ltac exists_prefix := constr:(forall _ex, DUMMY _ex). (** This is the customizable naming tactic that the user should REDEFINE along his development. See above for an example of such redefinition. It should always fail when no name suggestion is found, to give a chance to the default naming scheme to apply. *) Ltac rename_hyp stop th := fail. (* ************************************** *) (** Builds an id from a sequence of chunks. fresh is not supposed to add suffixes anywhere because all the ids we use start with "_". As long as no constant or hyp name start with "_" it is ok. *) Ltac build_name_gen suffx l := let l := eval lazy beta delta [List.app] iota in l in match l with | nil => fail | (forall id1:Prop, DUMMY id1)::nil => match suffx with | true => fresh id1 "_" | false => fresh id1 end | (forall id1:Prop, DUMMY id1)::?l' => let recres := build_name_gen suffx l' in (* id1 starts with "_", so fresh do not add any suffix *) let res := fresh id1 recres in res end. Ltac build_name l := build_name_gen add_suffix l. Ltac build_name_no_suffix l := build_name_gen constr:(false) l. (** Check if t is an eligible argument for fresh function. For instance if t is (forall foo, ...), it is not eligible. *) Ltac freshable t := let x := fresh t "_dummy_sufx" in idtac. (** Generate fresh name for numerical constants. Warning: problem here: hyps names may end with a digit: Coq may *replace* the digit in case of name clash. If you are bitten by this, you should switch to "Ltac add_suffix ::= constr:(true)." so that every hyp name ends with "_", so that coq never mangle with the digits *) Ltac numerical_names_nosufx t := match t with | 0%Z => fresh "_0" | 1%Z => fresh "_1" | 2%Z => fresh "_2" | 3%Z => fresh "_3" | 4%Z => fresh "_4" | 5%Z => fresh "_5" | 6%Z => fresh "_6" | 7%Z => fresh "_7" | 8%Z => fresh "_8" | 9%Z => fresh "_9" | 10%Z => fresh "_10" (* | Z0 => fresh "_0" *) | O%nat => fresh "_0" | 1%nat => fresh "_1" | 2%nat => fresh "_2" | 3%nat => fresh "_3" | 4%nat => fresh "_4" | 5%nat => fresh "_5" | 6%nat => fresh "_6" | 7%nat => fresh "_7" | 8%nat => fresh "_8" | 9%nat => fresh "_9" | 10%nat => fresh "_10" | O%N => fresh "_0" | 1%N => fresh "_1" | 2%N => fresh "_2" | 3%N => fresh "_3" | 4%N => fresh "_4" | 5%N => fresh "_5" | 6%N => fresh "_6" | 7%N => fresh "_7" | 8%N => fresh "_8" | 9%N => fresh "_9" | 10%N => fresh "_10" end. Ltac numerical_names_sufx t := match t with | 0%Z => fresh "_0z" | 1%Z => fresh "_1z" | 2%Z => fresh "_2z" | 3%Z => fresh "_3z" | 4%Z => fresh "_4z" | 5%Z => fresh "_5z" | 6%Z => fresh "_6z" | 7%Z => fresh "_7z" | 8%Z => fresh "_8z" | 9%Z => fresh "_9z" | 10%Z => fresh "_10z" (* | Z0 => fresh "_0" *) | O%nat => fresh "_0n" | 1%nat => fresh "_1n" | 2%nat => fresh "_2n" | 3%nat => fresh "_3n" | 4%nat => fresh "_4n" | 5%nat => fresh "_5n" | 6%nat => fresh "_6n" | 7%nat => fresh "_7n" | 8%nat => fresh "_8n" | 9%nat => fresh "_9n" | 10%nat => fresh "_10n" | O%N => fresh "_0N" | 1%N => fresh "_1N" | 2%N => fresh "_2N" | 3%N => fresh "_3N" | 4%N => fresh "_4N" | 5%N => fresh "_5N" | 6%N => fresh "_6N" | 7%N => fresh "_7N" | 8%N => fresh "_8N" | 9%N => fresh "_9N" | 10%N => fresh "_10N" end. (* Default value, see above for another possible one. Ltac numerical_names ::= numerical_names_sufx *) Ltac numerical_names ::= numerical_names_nosufx. Ltac raw_name X := (constr:((forall X, DUMMY X) :: [])). (** Build a chunk from a simple term: either a number or a freshable term. *) Ltac box_name t := let id_ := match t with | _ => numerical_names t | _ => let _ := freshable t in fresh "_" t end in constr:(forall id_:Prop, DUMMY id_). (** This will later contain a few default fallback naming strategy. *) Ltac rename_hyp_default stop th := fail. Ltac decr n := match n with | S ?n' => n' | 0 => 0 end. (* This computes the way we decrement our depth counter when we go inside of t. For now we forget the idea of traversing Prop sorted terms indefinitely. It gives too long names. *) Ltac nextlevel n t := let tt := type of t in match tt with (* | Prop => n *) | _ => decr n end. (* Determines the number of "head" implicit arguments, i.e. implicit arguments that are before any explicit one. This shall be ignored when naming an application. This is done in very ugly way. Any better solution welcome. *) Ltac count_impl th := lazymatch th with | (?z ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ _ _ _ _ _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z _ _ _ _ _ f g h i j k) in constr:(6%nat) | _ => let foo := constr:(z _ _ _ _ e f g h i j k) in constr:(7%nat) | _ => let foo := constr:(z _ _ _ d e f g h i j k) in constr:(8%nat) | _ => let foo := constr:(z _ _ c d e f g h i j k) in constr:(9%nat) | _ => let foo := constr:(z _ b c d e f g h i j k) in constr:(10%nat) | _ => let foo := constr:(z a b c d e f g h i j k) in constr:(10%nat) end | (?z ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ _ _ _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ _ _ _ _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z _ _ _ _ f g h i j k) in constr:(6%nat) | _ => let foo := constr:(z _ _ _ e f g h i j k) in constr:(7%nat) | _ => let foo := constr:(z _ _ d e f g h i j k) in constr:(8%nat) | _ => let foo := constr:(z _ c d e f g h i j k) in constr:(9%nat) | _ => let foo := constr:(z b c d e f g h i j k) in constr:(10%nat) end | (?z ?c ?d ?e ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ _ _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ _ _ _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z _ _ _ f g h i j k) in constr:(6%nat) | _ => let foo := constr:(z _ _ e f g h i j k) in constr:(7%nat) | _ => let foo := constr:(z _ d e f g h i j k) in constr:(8%nat) | _ => let foo := constr:(z c d e f g h i j k) in constr:(9%nat) end | (?z ?d ?e ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ _ _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z _ _ f g h i j k) in constr:(6%nat) | _ => let foo := constr:(z _ e f g h i j k) in constr:(7%nat) | _ => let foo := constr:(z d e f g h i j k) in constr:(8%nat) end | (?z ?e ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z _ f g h i j k) in constr:(6%nat) | _ => let foo := constr:(z e f g h i j k) in constr:(7%nat) end | (?z ?f ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z _ g h i j k) in constr:(5%nat) | _ => let foo := constr:(z f g h i j k) in constr:(6%nat) end | (?z ?g ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ _ i j k) in constr:(3%nat) | _ => let foo := constr:(z _ h i j k) in constr:(4%nat) | _ => let foo := constr:(z g h i j k) in constr:(5%nat) end | (?z ?h ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ _ j k) in constr:(2%nat) | _ => let foo := constr:(z _ i j k) in constr:(3%nat) | _ => let foo := constr:(z h i j k) in constr:(4%nat) end | (?z ?i ?j ?k) => match th with | _ => let foo := constr:(z _ _ k) in constr:(1%nat) | _ => let foo := constr:(z _ j k) in constr:(2%nat) | _ => let foo := constr:(z i j k) in constr:(3%nat) end | (?z ?j ?k) => match th with | _ => let foo := constr:(z _ k) in constr:(1%nat) | _ => let foo := constr:(z j k) in constr:(2%nat) end | (?z ?j) => constr:(1%nat) | _ => constr:(0%nat) end. (** Default naming of an application: we name the function if possible or fail, then we name all parameters that can be named either recursively or simply. Parameters at positions below nonimpl are considered implicit and not considered. *) Ltac rename_app nonimpl stop acc th := match th with | ?f => let f'' := box_name f in constr:(f''::acc) | (?f ?x) => match nonimpl with | (S ?nonimpl') => let newstop := nextlevel stop x in let namex := match true with | _ => fallback_rename_hyp newstop x | _ => constr:(@nil Prop) end in let newacc := constr:(namex ++ acc) in rename_app nonimpl' stop newacc f | 0%nat => (* don't consider this (implicit) argument *) rename_app nonimpl stop acc f end | _ => constr:(@nil Prop) end (* Go under binder and rebuild a term with a good name inside, catchable by a match context. *) with build_dummy_quantified stop th := lazymatch th with | forall __z:?A , ?B => constr:( fun __z:A => ltac:( let th' := constr:((fun __z => B) __z) in let th' := eval lazy beta in th' in let res := build_dummy_quantified stop th' in exact res)) | ex ?f => match f with | (fun __z:?A => ?B) => constr:( fun __z:A => ltac:( let th' := constr:((fun __z => B) __z) in let th' := eval lazy beta in th' in let res := build_dummy_quantified stop th' in exact res)) end | _ => fallback_rename_hyp stop th end (** ** Calls the (user-defined) rename_hyp + and fallbacks to some default namings if needed. [h] is the hypothesis (ident) to rename, [th] is its type. *) with fallback_rename_hyp_quantif stop th := let prefx := match th with | ?A -> ?B => impl_prefix | forall _ , _ => forall_prefix | ex (fun _ => _) => exists_prefix | _ => fail end in let newstop := decr stop in (* sufx_buried contains a list of dummies *) let sufx_buried := build_dummy_quantified newstop th in (* FIXME: a bit fragile *) let sufx_buried' := eval lazy beta delta [List.app] iota in sufx_buried in let sufx := match sufx_buried' with | context [ (@cons Prop ?x ?y)] => constr:(x::y) end in constr:(prefx::sufx) with fallback_rename_hyp_specials stop th := let newstop := decr stop in match th with (* First see if user has something that applies *) | _ => rename_hyp newstop th (* if it fails try default specials *) | _ => rename_hyp_default newstop th end with fallback_rename_hyp stop th := match stop with (*| 0 => constr:(cons ltac:(box_name th) nil)*) | 0 => constr:(@nil Prop) | S ?n => match th with | _ => fallback_rename_hyp_specials stop th | _ => fallback_rename_hyp_quantif stop th | _ => (*let newstop := nextlevel stop th in*) let numnonimpl := count_impl th in rename_app numnonimpl stop (@nil Prop) th end end. (** * Notation to define specific naming strategy *) Declare Scope autonaming_scope. (** Notation to build a singleton chunk list *) (* from coq-8.13 we should use name instead of ident. But let us wait a few versions before this change. *) Notation "'`' idx '`'" := (@cons Prop (forall idx:Prop, DUMMY idx) (@nil Prop)) (at level 1,idx ident,only parsing): autonaming_scope. (** Notation to call naming on a term X, with a given depth n. *) Notation " X '#' n " := ltac:( let c := fallback_rename_hyp n X in exact c) (at level 1,X constr, only parsing): autonaming_scope. Notation " X '##' " := ltac:(let c := raw_name X in exact c) (at level 1,X constr, only parsing): autonaming_scope. (** It is nicer to write name t than constr:t, see below. *) Ltac name c := (constr:(c)). (** * Default fallback renaming strategy (Re)defining it now that we have everything we need. *) Local Open Scope autonaming_scope. Ltac rename_hyp_default n th ::= let res := match th with (* | (@eq _ ?x ?y) => name (`_eq` ++ x#n ++ y#n) *) (* | Z.le ?A ?B => name (`_Zle` ++ A#n ++ B#n) *) | ?x <> ?y => name ( `_neq` ++ x#(decr n) ++ y#(decr n)) | @cons _ ?x (cons ?y ?l) => match n with | S ?n' => name (`_cons` ++ x#n ++ y#n ++ l#n') | 0 => name (`_cons` ++ x#n) end | @cons _ ?x ?l => match n with | S ?n' => name (`_cons` ++ x#n ++ l#n') | 0 => name (`_cons` ++ x#n) end | (@Some _ ?x) => name (x#(S n)) | (@None _) => name (`_None`) | _ => fail end in res. (* Call this in your own renaming scheme if you want the "hneg" prefix on negated properties *) Ltac rename_hyp_neg n th := match th with | ~ (_ = _) => fail 1(* h_neq already dealt by fallback *) | ~ ?th' => name (`not` ++ th'#(S n)) | _ => fail end. Local Close Scope autonaming_scope. (* Entry point of the renaming code. *) Ltac fallback_rename_hyp_name th := let depth := rename_depth in let h := constr:(ltac:(let x := default_prefix in exact x)) in let l := fallback_rename_hyp depth th in match l with nil => fail 1 | _ => let nme := build_name (h::l) in fresh nme end. (* Formating Error message *) Inductive LHMsg t (h:t) := LHMsgC: LHMsg t h. Notation "h : t" := (LHMsgC t h) (at level 1,only printing, format "'[ ' h ':' '/' '[' t ']' ']'"). Ltac rename_hyp_with_name h th := fail. (* Tactic renaming hypothesis H. Ignore Type-sorted hyps, fails if no renaming can be computed. Example of failing type: H:((fun x => True) true). *) Ltac autorename_strict H := match type of H with | ?th => match type of th with | _ => let l := rename_hyp_with_name H th in let dummy_name := fresh "dummy" in rename H into dummy_name; (* frees current name of H, in case of idempotency *) let newname := build_name_no_suffix l in rename dummy_name into newname | Prop => let dummy_name := fresh "dummy" in rename H into dummy_name; (* frees current name of H, in case of idempotency *) let newname := fallback_rename_hyp_name th in rename dummy_name into newname | Prop => let c := constr:(LHMsgC th H) in fail 1 "no renaming pattern for " c (* "no renaming pattern for " H *) | _ => idtac (* not in Prop or "no renaming pattern for " H *) end end. (* Tactic renaming hypothesis H. *) Ltac autorename H := try autorename_strict H. (* (* Tests *) Print Visibility. Local Open Scope autonaming_scope. Ltac rename_hyp1 n th := match th with (* | (?min <= ?x) /\ (?x < ?max) => name (x#n ++ `_bounded_` ++ min#n ++ `_` ++ max#n) *) | ((?min <= ?x) /\ (?x <= ?max))%nat => name (x#n ++ `_bounded` ++ min#n ++ max#n) end. (* example of adhoc naming from hyp name: *) Ltac rename_hyp_with_name h th ::= match reverse goal with | H: ?A = h |- _ => name ( A## ++ `_same`) (* let _ := freshable A in *) (* name (`same_as` ++ A#1) *) end. Local Close Scope autonaming_scope. Ltac rename_hyp n th ::= match th with | _ => rename_hyp1 n th end. Goal forall x1 x3:bool, forall a z e : nat, z+e = a -> z = a -> forall SEP:(True -> True), a = z+z -> z+z <= a <= e + e -> ((fun f => z = e) true) -> forall b1 b2 b3 b4: bool, True -> True. Proof. intros. autorename a. autorename H2. autorename H1. Fail autorename_strict H2. *) LibHyps-libhyps-2.0.8/LibHyps/LibHypsRegression.v000066400000000000000000000467441453760644100217500ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Import Arith ZArith LibHyps.LibHyps (*LibHyps.LibSpecialize*) List. Import TacNewHyps.Notations. Import LibHyps.LegacyNotations. (* This settings should reproduce the naming scheme of libhypps-1.0.0 and libhypps-1.0.1. *) Ltac add_suffix ::= constr:(false). Ltac numerical_names ::= numerical_names_sufx. Local Open Scope autonaming_scope. Import ListNotations. (* From there this is LibHypTest from 1f7a1ed2289e439c291fcbd06c51705547feef1e *) Ltac rename_hyp_2 n th := match th with | true <> false => name(`_tNEQf`) | true = false => name(`_tEQf`) end. Ltac rename_hyp ::= rename_hyp_2. (* Suppose I want to add later another naming rule: *) Ltac rename_hyp_3 n th := match th with | Nat.eqb ?x ?y = true => name(`_Neqb` ++ x#n ++ y#n) | true = Nat.eqb ?x ?y => name(`_Neqb` ++ x#n ++ y#n) | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. Ltac rename_hyp ::= rename_hyp_3. Ltac rename_depth ::= constr:(3). Close Scope Z_scope. Open Scope nat_scope. Lemma dummy: forall x y, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> 0 = 1 -> (0 = 1)%Z -> ~x = y -> true = Nat.eqb 3 4 -> Nat.eqb 3 4 = true -> true = Nat.leb 3 4 -> 1 = 0 -> ~x = y -> ~1 < 0 -> (forall w w':nat , w = w' -> ~true=false) -> (forall w w':nat , w = w' -> true=false /\ True) -> (forall w w':nat , w = w' -> False /\ True) -> (exists w:nat , w = w -> ~(true=(andb false true)) /\ False) -> (exists w:nat , w = w -> True /\ False) -> (forall w w':nat , w = w' -> true=false) -> (forall w w':nat , w = w' -> Nat.eqb 3 4=Nat.eqb 4 3) -> List.length (cons 3 nil) = (fun x => 0)1 -> List.length (cons 3 nil) = 0 -> plus 0 y = y -> (true=false) -> (False -> (true=false)) -> forall (x : nat) (env : list nat), ~ List.In x nil -> cons x (cons 3 env) = cons 2 env -> forall z t:nat, IDProp -> (0 < 1 -> 0 < 0 -> true = false -> ~(true=false)) -> (~(true=false)) -> (forall w w',w < w' -> ~(true=false)) -> (0 < 1 -> ~(1<0)) -> (0 < 1 -> 1<0) -> 0 < z -> True. (* auto naming at intro: *) !intros. match type of x with nat => idtac | _ => fail "test failed!" end. match type of y with nat => idtac | _ => fail "test failed!" end. match type of h_le_0n_1n with 0 <= 1 => idtac | _ => fail "test failed!" end. match type of h_le_0z_1z with (0 <= 1)%Z => idtac | _ => fail "test failed!" end. match type of h_le_x_y with x <= y => idtac | _ => fail "test failed!" end. match type of h_eq_x_y with x = y => idtac | _ => fail "test failed!" end. match type of h_eq_0n_1n with 0 = 1 => idtac | _ => fail "test failed!" end. match type of h_eq_0z_1z with 0%Z = 1%Z => idtac | _ => fail "test failed!" end. match type of h_neq_x_y with x <> y => idtac | _ => fail "test failed!" end. match type of h_Neqb_3n_4n with true = (3 =? 4) => idtac | _ => fail "test failed!" end. match type of h_Neqb_3n_4n0 with (3 =? 4) = true => idtac | _ => fail "test failed!" end. match type of h_eq_true_leb_3n_4n with true = (3 <=? 4) => idtac | _ => fail "test failed!" end. match type of h_eq_1n_0n with 1 = 0 => idtac | _ => fail "test failed!" end. match type of h_neq_x_y0 with x <> y => idtac | _ => fail "test failed!" end. match type of h_not_lt_1n_0n with ~ 1 < 0 => idtac | _ => fail "test failed!" end. match type of h_all_tNEQf with forall w w' : nat, w = w' -> true <> false => idtac | _ => fail "test failed!" end. match type of h_all_and_tEQf_True with forall w w' : nat, w = w' -> true = false /\ True => idtac | _ => fail "test failed!" end. match type of h_all_and_False_True with forall w w' : nat, w = w' -> False /\ True => idtac | _ => fail "test failed!" end. match type of h_ex_and_neq_False with exists w : nat, w = w -> true <> (false && true)%bool /\ False => idtac | _ => fail "test failed!" end. match type of h_ex_and_True_False with exists w : nat, w = w -> True /\ False => idtac | _ => fail "test failed!" end. match type of h_all_tEQf with forall w w' : nat, w = w' -> true = false => idtac | _ => fail "test failed!" end. match type of h_all_eq_eqb_eqb with forall w w' : nat, w = w' -> (3 =? 4) = (4 =? 3) => idtac | _ => fail "test failed!" end. match type of h_eq_length_cons with length [3] = (fun _ : nat => 0) 1 => idtac | _ => fail "test failed!" end. match type of h_eq_length_cons_0n with length [3] = 0 => idtac | _ => fail "test failed!" end. match type of h_eq_add_0n_y_y with 0 + y = y => idtac | _ => fail "test failed!" end. match type of h_tEQf with true = false => idtac | _ => fail "test failed!" end. match type of h_impl_tEQf with False -> true = false => idtac | _ => fail "test failed!" end. match type of x0 with nat => idtac | _ => fail "test failed!" end. match type of env with list nat => idtac | _ => fail "test failed!" end. match type of h_not_In_x0_nil with ~ In x0 [] => idtac | _ => fail "test failed!" end. match type of h_eq_cons_x0_3n_cons_2n with x0 :: 3 :: env = 2 :: env => idtac | _ => fail "test failed!" end. match type of h_IDProp with IDProp => idtac | _ => fail "test failed!" end. match type of h_impl_tNEQf with 0 < 1 -> 0 < 0 -> true = false -> true <> false => idtac | _ => fail "test failed!" end. match type of h_tNEQf with true <> false => idtac | _ => fail "test failed!" end. match type of h_all_tNEQf0 with forall w w' : nat, w < w' -> true <> false => idtac | _ => fail "test failed!" end. match type of h_impl_not_lt with 0 < 1 -> ~ 1 < 0 => idtac | _ => fail "test failed!" end. match type of h_impl_lt_1n_0n with 0 < 1 -> 1 < 0 => idtac | _ => fail "test failed!" end. match type of h_lt_0n_z with 0 < z => idtac | _ => fail "test failed!" end. exact I. Qed. (* BROKEN IN 8.18 *) (* Definition eq_one (i:nat) := i = 1. (* eq_one is delta_reducible but I don't want it to be reduced. *) Lemma test_espec: (eq_one 2 -> eq_one 3 -> eq_one 1 -> False) -> True. Proof. intros h_eqone. (* let nme := fresh_robust H "hh" "def" in idtac nme.Definition *) especialize h_eqone as newH at 2; [ admit | match type of newH with eq_one 2 -> eq_one 1 -> False => idtac end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac end]. Undo. especialize h_eqone at 2 as newH; [ admit | match type of newH with eq_one 2 -> eq_one 1 -> False => idtac end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 as hhh; [ admit | match type of hhh with _ <= _ -> _ = _ => idtac | _ => fail "Test failed!" end ]. Undo. especialize (let x:=Nat.le_antisymm in x)as hhh at 2; [ admit | match type of hhh with _ <= _ -> _ = _ => idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone at 2; [ admit | match type of h_eqone with eq_one 2 -> eq_one 1 -> False => idtac end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2; [ admit | match goal with |- (_ <= _ -> _ = _) -> True => idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone as ? at 2; [ admit | match type of h_eqone_spec with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 as ? ; [ admit | match type of h_eqone_spec with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) as ? at 2; [ admit | match type of H_spec with _ <= _ -> _ = _ => idtac | _ => fail "Test failed!" end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 as ? ; [ admit | match type of H_spec with _ <= _ -> _ = _ => idtac | _ => fail "Test failed!" end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 : h; [ admit | match type of h_eqone with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 : h; [ admit | match goal with |- (_ <= _ -> _ = _) -> True => idtac | _ => fail "Test failed!" end; match type of h with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 : ? ; [ admit | match type of h_eqone with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h_eqone_prem with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 : ? ; [ admit | match goal with |- (_ <= _ -> _ = _) -> True => idtac | _ => fail "Test failed!" end; match type of H_prem with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 as newH : h; [ admit | match type of newH with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 as newH : h; [ admit | match type of newH with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of h with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as newH at 2 : h; [ admit | match type of newH with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) as newH at 2 : h; [ admit | match type of newH with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of h with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 as ? : h; [ admit | match type of h_eqone_spec with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 as ? : h; [ admit | match type of H_spec with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of h with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as ? at 2 : h; [ admit | match type of h_eqone_spec with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) as ? at 2 : h; [ admit | match type of H_spec with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of h with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2 as ? : ? ; [ admit | match type of h_eqone_spec with eq_one 2 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end; match type of h_eqone_prem with 3=1 => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2 as ? : ? ; [ admit | match type of H_spec with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of H_prem with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as ? at 2 : ? ; [ admit | match goal with h_eqone_spec:eq_one 2 -> eq_one 1 -> False, h_eqone_prem : 3 = 1 |- _ => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) as ? at 2 : ? ; [ admit | match type of H_spec with (_ <= _ -> _ = _) => idtac | _ => fail "Test failed!" end; match type of H_prem with _ <= _ => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2,3; [ admit | admit| match type of h_eqone with eq_one 2 -> False=> idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 1,2; [ admit | admit | match goal with |- (_ = _) -> True => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 3,2; [ admit | admit| match type of h_eqone with eq_one 2 -> False=> idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2,1; [ admit | admit | match goal with |- (_ = _) -> True => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as h at 2,3; [ admit | admit| match type of h with eq_one 2 -> False=> idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) at 2,1 as h; [ admit | admit | match type of h with (_ = _) => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 2,3 as h; [ admit | admit| match type of h with eq_one 2 -> False=> idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=Nat.le_antisymm in x) as h at 2,1; [ admit | admit | match type of h with (_ = _) => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 3,2,1; [ admit | admit | admit | match type of h_eqone with False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone as h at 3,2,1; [ admit | admit | admit | match type of h with False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone at 3,2,1 as h; [ admit | admit | admit | match type of h with False=> idtac | _ => fail "Test failed!" end ]. Undo. exact I. Qed. Lemma foo2: (eq_one 2 -> eq_one 3 ->eq_one 4 ->eq_one 5 ->eq_one 6 -> eq_one 1 -> False) -> True. Proof. intros h_eqone. especialize h_eqone at 3,1,4,5 as h; [ admit | admit | admit | admit | match type of h with eq_one 3 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone as h at 3,1,4,5; [ admit | admit | admit | admit | match type of h with eq_one 3 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone at 3,1,4,5; [ admit | admit | admit | admit | match type of h_eqone with eq_one 3 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone at 3,1,4,5,2; [ admit | admit | admit | admit | admit | match type of h_eqone with eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone at 3,1,4,5,2 as h; [ admit | admit | admit | admit | admit | match type of h with eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. especialize h_eqone as h at 3,1,4,5,2; [ admit | admit | admit | admit | admit | match type of h with eq_one 1 ->False=> idtac | _ => fail "Test failed!" end ]. Undo. exact I. Qed. Lemma test_espec_namings: forall n:nat, (eq_one n -> eq_one 1 -> False) -> True. Proof. intros n h_eqone. especialize Nat.quadmul_le_squareadd at 1 as hh : h. { apply le_n. } especialize min_l at 1 as ? : ?. { apply (le_n O). } especialize h_eqone at 2 as h1 : h2. { reflexivity. } match type of h2 with 1 = 1 => idtac | _ => fail end. match type of h1 with eq_one n -> False => idtac | _ => fail end. exact I. Qed. Lemma test_esepec_6_7: (eq_one 2 -> eq_one 3 ->eq_one 4 ->eq_one 5 ->eq_one 6 ->eq_one 7 ->eq_one 8 -> eq_one 9 -> eq_one 1 -> False) -> True. Proof. intros h_eqone. especialize h_eqone at 3,1,4,5,2,7 as h; [ admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as h at 3,1,4,5,2,7; [ admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 3,1,4,5,2,7; [ admit | admit | admit | admit | admit | admit | match type of h_eqone with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 3,1,4,5,2,7,9 as h; [ admit | admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone as h at 3,1,4,5,2,7,9; [ admit | admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at 3,1,4,5,2,7,9; [ admit | admit | admit | admit | admit | admit | admit | match type of h_eqone with eq_one 7 -> eq_one 9 -> False => idtac | _ => fail "Test failed!" end]. Undo. exact I. Qed. (* "until i" and "at *" *) Lemma test_esepec_until_star: (eq_one 2 -> eq_one 3 ->eq_one 4 ->eq_one 5 ->eq_one 6 ->eq_one 7 ->eq_one 8 -> eq_one 9 -> eq_one 1 -> False) -> True. Proof. intros h_eqone. (* specialize on term ==> create a new hyp *) especialize (let x:=not_eq_S in x) at *; [ intro ; admit | match type of H_spec with (S _)<>(S _) => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=not_eq_S in x) at * as h; [ intro ; admit | match type of h with (S _)<>(S _) => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=h_eqone in x) at *; [ admit |admit |admit |admit |admit |admit |admit |admit |admit | match type of H_spec with False => idtac | _ => fail "Test failed!" end]. Undo. (* proveprem_until h_eqone 4. *) especialize (let x:= h_eqone in x) until 4; [ admit |admit |admit |admit | match type of H_spec with eq_one 6 -> eq_one 7 -> eq_one 8 -> eq_one 9 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end ]. Undo. (* behavior when acting on a hypothesis: replace the hyp by its specialize version *) especialize h_eqone until 4 ; [ admit |admit |admit |admit | match type of h_eqone with eq_one 6 -> eq_one 7 -> eq_one 8 -> eq_one 9 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone at * ; [ admit |admit |admit |admit |admit |admit |admit |admit |admit | match type of h_eqone with False => idtac | _ => fail "Test failed!" end]. Undo. (* unless we give the "as" option *) especialize h_eqone at * as h ; [ admit |admit |admit |admit |admit |admit |admit |admit |admit | match type of h with False => idtac | _ => fail "Test failed!" end; match type of h_eqone with eq_one 2 -> eq_one 3 -> eq_one 4 -> eq_one 5 -> eq_one 6 -> eq_one 7 -> eq_one 8 -> eq_one 9 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. especialize h_eqone until 4 as h; [ admit |admit |admit |admit | match type of h with eq_one 6 -> eq_one 7 -> eq_one 8 -> eq_one 9 -> eq_one 1 -> False => idtac | _ => fail "Test failed!" end]. Undo. exact I. Qed. *) Require Import LibHyps.LibDecomp. Goal forall l1 l2 l3:list nat, List.length l1 = List.length l2 /\ List.length l1 = List.length l3 -> True. Proof. intros l1 l2 l3 h. (* then_allnh_gen ltac:(fun x => all_hyps) ltac:(fun _ => decomp_logicals h) ltac:(fun lh => idtac lh) . *) (* Set Ltac Debug. *) decomp_logicals h /sng. match goal with |- _ => match type of h_eq_length_l1_length_l2 with length l1 = length l2 => idtac | _ => fail "Test failed (wrong type)!" end | _ => fail "Test failed (wrong name)!" end. exact I. Qed. LibHyps-libhyps-2.0.8/LibHyps/LibHypsTactics.v000066400000000000000000000265571453760644100212220ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Export LibHyps.TacNewHyps. Require Export LibHyps.LibHypsNaming. (* Require Export LibHyps.LibSpecialize. *) (* debug *) Ltac pr_goal := match goal with |- ?g => let allh := all_hyps in idtac allh " ⊢ " g end. (* Default behaviour: generalize hypothesis that we failed to rename, so that no automatic names are introduced by mistake. Of course one can do "intros" to reintroduce them. Revert needs to be done in the other direction (so better do ";; autorename ;!; revertHyp"), and may fail if something depends on the reverted hyp. So we should revert everything depending on the unrenamed hyp. *) Ltac revert_if_norename H := let t := type of H in match type of t with | Prop => match goal with | _ => let x := fallback_rename_hyp_name t in idtac (* since we are only in prop it is almost never the case that something depends on H but if this happens we revert everything that does. This needs testing. *) | _ => try revert dependent H end | _ => idtac end. Ltac rename_or_revert H := autorename_strict H + revert H. (* Some usual tactics one may want to use with onNewHypsOf: *) (* apply subst using H if possible. *) (*Ltac substHyp H := match type of H with | ?x = ?y => move H at top; (* to ensure subst will take this hyp *) once (subst x + subst y) end. *) (* This is similar to subst x, but ensures that H and only H is used. Even if there is another hyp with the same variable *) Ltac substHyp H := match type of H with | Depl => fail 1 (* fail immediately, we are applying on a list of hyps. *) | ?x = ?y => (* subst would maybe subst using another hyp, so use replace to be sure *) once ((is_var(x); replace x with y in *; [try clear x ; try clear H] ) + (is_var(y); replace y with x in * ; [try clear y; try clear H])) | _ => idtac end. (* revert, fails if impossible, should not fail if hyps are ordered in the right order *) Ltac revertHyp H := revert H. (* revert is a tactic notation, so we need to define this *) (* revert if subst fails. Never fail, be careful not to use this tactic in the left member of a "+" tactical: *) Ltac subst_or_revert H := try first [progress substHyp H | revert H]. (* try subst. Never fail, be careful to not use this tactic in the left member of a "+" tactical: *) Ltac subst_or_idtac H := substHyp H. Ltac map_tac tac lH := lazymatch lH with (DCons _ ?Hyp ?lH') => (try tac Hyp); map_tac tac lH' | DNil => idtac end. (* Naive variants for lists of hyps. We might want to optimize if possible like group_up_list. *) Ltac subst_or_revert_l := map_tac subst_or_revert. Ltac subst_or_idtac_l := map_tac subst_or_idtac. Ltac revertHyp_l := map_tac revertHyp. Ltac substHyp_l := map_tac ltac:(fun x => try substHyp x) substHyp. Ltac revert_if_norename_l := map_tac revert_if_norename. Ltac autorename_l := map_tac autorename. (* Auto rename all hypothesis *) Ltac rename_all_hyps := autorename_l all_hyps. (* return the lowest hyp with type T in segment lH. We suppose lH is given lower-first. I.e. we return the first hyp of type T. *) Ltac find_lowest_T T candidate lH := lazymatch lH with | (DCons T ?Hyp _) => Hyp | (DCons _ ?Hyp ?lH') => find_lowest_T T candidate lH' | _ => candidate end. (* Look into the cache for a hyp of type T. If found, returns the hyp + the cache where hyp is deleted. *) Ltac find_in_cache_T cache T := lazymatch cache with | DCons ?th ?h ?cache' => match th with | T => constr:((cache' , h)) | _ => let recres := find_in_cache_T cache' T in match recres with | (_,@None T) => constr:((cache,@None T)) | (?newcache1,?res1) => constr:((DCons th h newcache1 , res1)) end end | _ => constr:((cache,@None T)) end. (* if T is not already present in cache, return the (cache + (h:T)), otherwise return cache unchanged. *) Ltac find_in_cache_update cache T h := match find_in_cache_T cache T with (?c , None) => constr:((DCons T h c , None)) | (?c , ?res) => constr:((DCons T h c , res)) end. (* Precondition: x must be "below" y at start *) (* equivalent to move x before belowme but fails if x=bleowme. This forces the pre-8.14 behaviour of move below. *) Ltac move_above x y := match constr:((x , y)) with | (?c,?c) => idtac | _ => move x after y end. (* Precondition: x must be "below" y at start *) (* equivalent to move x after belowme but fails if x=bleowme *) Ltac move_below x y := match constr:((x , y)) with | (?c,?c) => idtac | _ => move x before y end. (* move each hyp in lhyps either after the pivot hyp for its type found in cache, or just above fstProp if there is no pivot. In this second case we return a new cache with h as a new pivot. *) (* Example There is a number of "segments". A segment for type T is the first set of consecutive variables of type T, located before the first Prop-sorted hyp. For sintance there are 2 segments in the goal below, one is x1-x3 and the other is b1-b2. x1 : nat x2 : nat x3 : nat <-- pivot for nat b1 : bool b2 : bool <-- pivot for bool H : ... : Prop <-- fstProp H2: ... : Prop not in lhyps x : nat <-- in lhyps b : bool <-- in lhyps c : Z <-- in lhyps ======= ... This is described by the three arguments: - cache is (DCons bool b2 (DCons nat x3 DNil)) i.e. last variable of each segment - lhyps is (DCons nat x (DCons bool b (DCons Z c DNil))) list of variable to move (may not contain all the badly place variables) - fstProp is H. The goal of group_up_list_ is to move all vars of lhyps to there segment or above fstProp if there segment does not exist yet. invariant: the things in lhyps always need to be moved upward, otherwise move before and move after work the wrong way. *) Ltac group_up_list_ fstProp cache lhyps := lazymatch lhyps with | DCons ?th ?h ?lhyps' => match type of th with | Prop => (* lhyps is supposed to be filtered out of Prop already. *) idtac "LibHyps: This shoud not happen. Please report."; group_up_list_ fstProp cache lhyps' | _ => let upd := find_in_cache_update cache th h in lazymatch upd with | (?newcache , None) => (* there was no pivot for th *) match fstProp with | @None => idtac (* No Prop Hyp, don't move *) | ?hfstprop => move_above h hfstprop end; group_up_list_ fstProp constr:(DCons th h cache) lhyps' | (?newcache , ?theplace) => (* we append h to its segment, and it becomes the new pivot. *) (try move_below h theplace); group_up_list_ fstProp newcache lhyps' end end | DNil => idtac (* no more hyps to move *) end . Ltac find_in t lh := match lh with | DNil => None | (DCons t ?h ?lh') => h | (DCons _ ?h ?lh') => find_in t lh' end. (* return a triple for hyps groupinf initiation: - H: topmost Prop-sorted hyp (where a hyp goes if there is no segment for it). - list of pivots for each type seen above H (pivot = lowest of the first segment of a type) - the hypothesis that may need to be moved (not belonging to there first segment). See group_up_list_ above. *) Ltac build_initial_cache_ acc lh := match acc with (?fstProp, ?pivots, ?tomove) => lazymatch lh with | DNil => constr:((fstProp, pivots , tomove)) | (DCons ?th ?h ?lh') => lazymatch type of th with | Prop => lazymatch fstProp with (* is this the first Prop? *) | @None => build_initial_cache_ (h, pivots, tomove) lh' | _ => build_initial_cache_ (fstProp, pivots, tomove) lh' end | _ => (* Type-sorted hyp *) lazymatch fstProp with (* we haven't reached the fstprop *) | @None => (* does this type already have a pivot? if yes don't replace *) let found := find_in th pivots in lazymatch found with | @None => (* no pivot yet, see the next hyp *) lazymatch lh' with | (DCons th _ _) => (* h is correctly placed, not the pivot *) build_initial_cache_ (fstProp, pivots, tomove) lh' | (DCons _ _ _) => (* h is the pivot for th *) build_initial_cache_ (fstProp, DCons th h pivots , tomove) lh' | DNil => (* h is the pivot for th *) constr:((fstProp, DCons th h pivots , tomove)) end | _ => (* there already is a pivot for th, and it needs to move *) build_initial_cache_ (fstProp, pivots , DCons th h tomove) lh' end | _ => (*fstprop already reached, this is not a pivot and needs to move*) build_initial_cache_ (fstProp, pivots , DCons th h tomove) lh' end end end end. Ltac build_initial_cache lh := build_initial_cache_ constr:((@None, DNil, DNil)) lh. Ltac mem x l := lazymatch l with | DNil => false | DCons _ x ?l' => true | DCons _ _ ?l' => mem x l' end. (* return the intersection of l1 l2 in reverse order of l1 *) Ltac intersec_ acc l1 l2 := match l1 with DNil => acc | DCons ?th ?h ?l1' => match (mem h l2) with | true => intersec_ (DCons th h acc) l1' l2 | false => intersec_ acc l1' l2 end end. Ltac intersec l1 l2 := intersec_ DNil l1 l2. (* Move up non-Prop hypothesis of lhyps up in the goal, to make Prop hyptohesis closer to the conclusion. Also group non-Prop hyps by same type to win some place in goal printing. Note: This tactic takes a list of hyps, you should use the tactical then_allnh (syntax: ";{! group_up_list }") or then_allnh_rev (syntax: ";{!< group_up_list}"). *) Ltac group_up_list lhyps := match build_initial_cache all_hyps with | (?fstProp, ?cache, ?tomove) => (* tomove is reversed, but intersec re-reverse *) let tomove2 := intersec tomove lhyps in group_up_list_ fstProp cache tomove2 end. (* Stays for compatibility, but for efficiency reason prefer rename_all_hyps, which applies on the list of hyptohesis to move. Use the corresponding tactical. *) Ltac move_up_types H := let t := type of H in match t with Depl => fail "Try to use { } instead of {! }" | _ => group_up_list constr:(DCons t H DNil) end. (* (* Tests *) Export TacNewHyps.Notations. Goal forall x1 x3:bool, forall a z e : nat, z+e = a -> forall SEP:(True -> True), a = z+z -> ((fun f => z = e) true) -> forall b1 b2 b3 b4: bool, True -> True. Proof. (* Set Ltac Debug. *) (* then_nh_rev ltac:(intros) ltac:(subst_or_idtac). *) intros ; {! group_up_list }. (* intros ? ? ? ? ? ? ? ? ? ?. *) (* group_up_list (DCons bool b1 DNil). *) Undo. intros ; { move_up_types }. Undo. intros ; { autorename }; {! group_up_list }. Undo. intros ; {subst_or_idtac} ; { autorename } ; {! group_up_list }. Undo. Fail progress intros ; { revertHyp }. intros. let hyps := all_hyps in idtac hyps. Undo 2. then_eachnh ltac:(intros) ltac:(subst_or_idtac). Undo. Fail intros ; { fun h => autorename_strict h }. intros ; { fun h => idtac h }. intros ; { ltac:(fun h => idtac h) }. *) LibHyps-libhyps-2.0.8/LibHyps/LibHypsTest.v000066400000000000000000000505741453760644100205430ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) Require Import Arith ZArith LibHyps.LibHyps (*LibHyps.LibSpecialize*) List. Local Open Scope autonaming_scope. Import ListNotations. Ltac rename_hyp_2 n th := match th with | true <> false => name(`_tNEQf`) | true = false => name(`_tEQf`) end. Ltac rename_hyp ::= rename_hyp_2. (* Suppose I want to add later another naming rule: *) Ltac rename_hyp_3 n th := match th with | Nat.eqb ?x ?y = true => name(`_Neqb` ++ x#n ++ y#n) | true = Nat.eqb ?x ?y => name(`_Neqb` ++ x#n ++ y#n) | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. Ltac rename_hyp ::= rename_hyp_3. Ltac rename_depth ::= constr:(3). Close Scope autonaming_scope. Close Scope Z_scope. Open Scope nat_scope. Ltac test h th := match type of h with | th => idtac | ?actual => fail "test failed: expected " h ": " th "but got: " h ": " actual end. Ltac testg tg := match goal with | |- tg => idtac | |- ?actual => fail "test failed: expected goal" tg "but got: " actual end. Lemma test_autorename: forall x y, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> 0 = 1 -> (0 = 1)%Z -> ~x = y -> true = Nat.eqb 3 4 -> Nat.eqb 3 4 = true -> true = Nat.leb 3 4 -> 1 = 0 -> ~x = y -> ~1 < 0 -> (forall w w':nat , w = w' -> ~true=false) -> (forall w w':nat , w = w' -> true=false /\ True) -> (forall w w':nat , w = w' -> False /\ True) -> (exists w:nat , w = w -> ~(true=(andb false true)) /\ False) -> (exists w:nat , w = w -> True /\ False) -> (forall w w':nat , w = w' -> true=false) -> (forall w w':nat , w = w' -> Nat.eqb 3 4=Nat.eqb 4 3) -> List.length (cons 3 nil) = (fun x => 0)1 -> List.length (cons 3 nil) = 0 -> plus 0 y = y -> (true=false) -> (False -> (true=false)) -> forall (x : nat) (env : list nat), ~ List.In x nil -> cons x (cons 3 env) = cons 2 env -> forall z t:nat, IDProp -> (0 < 1 -> 0 < 0 -> true = false -> ~(true=false)) -> (~(true=false)) -> (forall w w',w < w' -> ~(true=false)) -> (0 < 1 -> ~(1<0)) -> (0 < 1 -> 1<0) -> 0 < z -> True. (* auto naming at intro: *) intros /n. test x nat. test y nat. test h_le_0_1_ (0 <= 1). test h_le_0_1_0 ((0 <= 1)%Z). test h_le_x_y_ (x <= y). test h_eq_x_y_ (x = y). test h_eq_0_1_ (0 = 1). test h_eq_0_1_0 (0%Z = 1%Z). test h_neq_x_y_ (x <> y). test h_Neqb_3_4_ (true = (3 =? 4)). test h_Neqb_3_4_0 ((3 =? 4) = true). test h_eq_true_leb_3_4_ (true = (3 <=? 4)). test h_eq_1_0_ (1 = 0). test h_neq_x_y_ (x <> y). test h_not_lt_1_0_ (~ 1 < 0). test h_all_tNEQf_ (forall w w' : nat, w = w' -> true <> false). test h_all_and_tEQf_True_ (forall w w' : nat, w = w' -> true = false /\ True). test h_all_and_False_True_ (forall w w' : nat, w = w' -> False /\ True). test h_ex_and_neq_False_ (exists w : nat, w = w -> true <> (false && true)%bool /\ False). test h_ex_and_True_False_ (exists w : nat, w = w -> True /\ False). test h_all_tEQf_ (forall w w' : nat, w = w' -> true = false). test h_all_eq_eqb_eqb_ (forall w w' : nat, w = w' -> (3 =? 4) = (4 =? 3)). test h_eq_length_cons_ (length [3] = (fun _ : nat => 0) 1). test h_eq_length_cons_0_ (length [3] = 0). test h_eq_add_0_y_y_ (0 + y = y). test h_tEQf_ (true = false). test h_impl_tEQf_ (False -> true = false). test x0 (nat). test env (list nat). test h_not_In_x0_nil_ (~ In x0 []). test h_eq_cons_x0_3_cons_2_ (x0 :: 3 :: env = 2 :: env). test h_IDProp_ (IDProp). test h_impl_tNEQf_ (0 < 1 -> 0 < 0 -> true = false -> true <> false). test h_tNEQf_ (true <> false). test h_all_tNEQf_0 ((forall w w' : nat, w < w' -> true <> false)). test h_impl_not_lt_ (0 < 1 -> ~ 1 < 0). test h_impl_lt_1_0_ (0 < 1 -> 1 < 0). test h_lt_0_z_ (0 < z). exact I. Qed. Import TacNewHyps.Notations. Lemma test_autorename_failing: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. (* Fails beause the ((fun f => x = y) true) is not renamable. *) Fail intros /n!. intros ; { autorename }. (* autorename does not fail if no renaming found *) test H ((fun _ : bool => x = y) true). auto. Qed. Lemma test_autorename_failing2: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros /n. (* /n does not fail, even if a hyp is not renamed *) test x (nat). test y (nat). test H (((fun _ : bool => x = y) true)). test h_le_0_1_ (0 <= 1). test h_le_0_1_0 ((0 <= 1)%Z). test h_le_x_y_ (x <= y). test h_eq_x_y_ (x = y). test h_impl_lt_1_0_ (0 < 1 -> 1 < 0). test h_lt_0_z_ (0 < z). exact I. Qed. Lemma test_rename_or_revert: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; { rename_or_revert }. testg ((fun _ : bool => x = y) true -> True). auto. Qed. Lemma test_rename_or_revert2: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros /n?. testg ((fun _ : bool => x = y) true -> True). test x (nat). test y (nat). (* Checking that hyps after the failed rename are introduced. *) test h_le_0_1_ (0 <= 1). test h_le_0_1_0 ((0 <= 1)%Z). test h_le_x_y_ (x <= y). test h_eq_x_y_ (x = y). test h_impl_lt_1_0_ (0 < 1 -> 1 < 0). test h_lt_0_z_ (0 < z). intro. exact I. Qed. Lemma test_revertHyp: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. (* Wrong order for revert. *) Fail intros ; { revertHyp }. intros ; {< revertHyp }. testg (forall x y : nat, (fun _ : bool => x = y) true -> bool -> bool -> forall z : nat, 0 <= 1 -> (0 <= 1)%Z -> x <= y -> x = y -> (0 < 1 -> 1 < 0) -> 0 < z -> True). intros. exact I. Qed. (* group_up_list is faster (called on the whole list of new hyps) and should be prefered. *) Lemma test_group_up_list2: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; {! group_up_list }. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. Lemma test_group_up_list21: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros /g. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. (* group_up_list is insensitive to order of hypothesis. It respects the respective order of variables in each segment. This has changed in version 2.0.5 together with a bug fix. Note that the deprecated move_up_types is sensitive to order. *) Lemma test_group_up_list1_rev: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; {!< group_up_list }. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. (* Two more tests for the case where the top hyp is Prop-sorted. *) Lemma test_group_up_list3: ((fun f => 0 = 1) true) -> forall x y:nat, forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; { move_up_types }. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. Lemma test_group_up_list2_rev: ((fun f => 0 = 1) true) -> forall x y:nat, forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; {< move_up_types }. lazymatch reverse goal with | Ha:_, Hb:_,Hx : _ , Hy:_ , Hz:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. (* Test for substHyp, the order in which subst are done *) Lemma test_subst: ((fun f => 0 = 1) true) -> forall x y:nat, forall a b: bool, forall z:nat, 0 <= 1 -> x = z -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; { substHyp }. (* x = z is subst first, and y = y remains *) lazymatch reverse goal with | H: y <= y |- True => idtac | _ => fail "test failed!" end. exact I. Qed. (* Checking the chaining of operators. *) Lemma test_group_up_after_subst: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. intros ; { subst_or_idtac } ; {! group_up_list }. lazymatch reverse goal with | Hb:_, Ha:_,Hz:_ , Hy:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH0:_,hH1:_, hH2:_, hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)): H0=hH0) in let t := constr:((ltac:(reflexivity)):H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. Ltac substHyp H ::= match type of H with | Depl => fail 1 (* fail immediately, we are applying on a list of hyps. *) | ?x = ?y => (* subst would maybe subst using another hyp, so use replace to be sure *) once ((is_var(x); replace x with y in *; [try clear x ; try clear H] ) + (is_var(y);replace y with x in * ; [ try clear H])) | _ => idtac end. (* Legacy Notations tac ;!; tac2. *) Lemma test_tactical_semi: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. (* move_up_types is there for backward compatibility. It moves Type-Sorted hyps up. *) intros ;; move_up_types. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)): H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. auto. Qed. (* Legacy Notations tac ;; tac2. *) Lemma test_tactical_semi_rev: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z u:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. (* move_up_types is there for backward compatibility. It moves Type-Sorted hyps up. *) intros ;!; move_up_types. lazymatch reverse goal with | Ha:_, Hb:_, Hz: _ , Hu : _ , Hy:_ , Hx:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hu=u) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in let t := constr:((ltac:(reflexivity)): Hx=x) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)): H1=hH1) in let t := constr:((ltac:(reflexivity)): H2=hH2) in let t := constr:((ltac:(reflexivity)): H3=hH3) in let t := constr:((ltac:(reflexivity)): H4=hH4) in let t := constr:((ltac:(reflexivity)): H5=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. auto. Qed. (* Legacy Notations !!!!tac. *) Import LibHyps.LegacyNotations. Lemma test_group_up_list_legacy: forall x y:nat, ((fun f => x = y) true) -> forall a b: bool, forall z:nat, 0 <= 1 -> (0%Z <= 1%Z)%Z -> x <= y -> x = y -> (0 < 1 -> 1<0) -> 0 < z -> True. Proof. (* move_up_types is there for backward compatibility. It moves Type-Sorted hyps up. *) !!!!intros. lazymatch reverse goal with | Hb:_, Ha:_,Hz : _ , Hy:_ |- True => let t := constr:((ltac:(reflexivity)): Hb=b) in let t := constr:((ltac:(reflexivity)): Ha=a) in let t := constr:((ltac:(reflexivity)): Hz=z) in let t := constr:((ltac:(reflexivity)): Hy=y) in (* let t := constr:((ltac:(reflexivity)): Hx=x) in *) idtac | _ => fail "test failed (wrong order of hypothesis)!" end. lazymatch goal with | hH1:_, hH2:_,hH3 : _ , hH4:_ , hH5:_ |- True => let t := constr:((ltac:(reflexivity)): h_le_0_1_=hH1) in let t := constr:((ltac:(reflexivity)): h_le_0_1_0=hH2) in let t := constr:((ltac:(reflexivity)): h_le_y_y_=hH3) in let t := constr:((ltac:(reflexivity)): h_impl_lt_1_0_=hH4) in let t := constr:((ltac:(reflexivity)): h_lt_0_z_=hH5) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. auto. Qed. (* This is supposed to be copy-pasted in README.md *) Lemma foo: forall x y z:nat, x = y -> forall a b t : nat, a+1 = t+2 -> b + 5 = t - 7 -> (forall u v, v+1 = 1 -> u+1 = 1 -> a+1 = z+2) -> z = b + x-> True. Proof. intros. (* ugly names *) Undo. (* Example of using the iterator on new hyps: this prints each new hyp name. *) (*intros; {fun h => idtac h}. Undo.*) (* This gives sensible names to each new hyp. *) intros ; { autorename }. Undo. (* short syntax: *) intros /n. Undo. (* same thing but use subst if possible, and group non prop hyps to the top. *) intros ; { substHyp }; { autorename}; {move_up_types}. Undo. (* short syntax: *) intros /s/n/g. Undo. (* Even shorter: *) intros /s/n/g. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type: *) (* BROKEN IN COQ 8.18 *) (* especialize h_all_eq_add_add_ at 2. { apply Nat.add_0_l. } (* now h_all_eq_add_add is specialized *) Undo 6. *) Undo 2. intros until 1. (** The taticals apply after any tactic. Notice how H:x=y is not new and hence not substituted, whereas z = b + x is. *) destruct x eqn:heq;intros /sng. - apply I. - apply I. Qed. (* Stressing the system with big goals *) Import TacNewHyps.Notations. Lemma foo': forall (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ : (forall (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :nat), True)) (a b:bool), True -> forall y z:nat, True. (* Time intros. (* .07s *) *) (* Time intros; { fun x => idtac x}. (* 1,6s *) *) Time intros /g. (* 3s *) (* Time intros ; { move_up_types }. (* ~7mn *) *) (* Time intros /n. (* 19s *) *) exact I. Qed. LibHyps-libhyps-2.0.8/LibHyps/LibSpecialize.v000066400000000000000000000441101453760644100210350ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (* proveprem H at i as h. Create an assert for the ith dependent premiss of hypothesis H and specialize H with the resulting proof. h is the (optional) name of the asserted premiss. *) Ltac freshable t := let x := fresh t "_dummy_sufx" in idtac. Ltac fresh_unfail H := match constr:(True) with | _ => fresh H "_" | _ => fresh "H_" end. Ltac proveprem_as_prem H i idpremis idnewH := (* prefer this to evar, which is not well "typed" by Ltac (does not know that it creates an evar (coq bug?). *) let ev := open_constr:((_:Prop)) in assert (idpremis:ev); [|specialize H with (i:=idpremis) as idnewH]. Tactic Notation "especialize" constr(H) "at" integer(i) "as" ident(idH) ":" ident(idprem) := proveprem_as_prem H i idprem idH. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i) ":" ident(idprem) := proveprem_as_prem H i idprem idH. Ltac proveprem_asg_newH H i idpremis := let prefx := fresh_unfail H in let idnewH := fresh prefx "spec" in (* FIXME: if H is not freshable? *) proveprem_as_prem H i idpremis idnewH. Tactic Notation "especialize" constr(H) "at" integer(i) "as" "?" ":" ident(idprem) := proveprem_asg_newH H i idprem. Tactic Notation "especialize" constr(H) "as" "?" "at" integer(i) ":" ident(idprem) := proveprem_asg_newH H i idprem. Ltac proveprem_as_premg H i idnewH := let prefx := fresh_unfail H in let idpremis := fresh prefx "prem" in proveprem_as_prem H i idpremis idnewH. Tactic Notation "especialize" constr(H) "at" integer(i) "as" ident(idH) ":" "?" := proveprem_as_premg H i idH. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i) ":" "?" := proveprem_as_premg H i idH. Ltac proveprem_asg_premg H i := let prefx := fresh_unfail H in let idnewH := fresh prefx "spec" in let idpremis := fresh prefx "prem" in proveprem_as_prem H i idpremis idnewH. Tactic Notation "especialize" constr(H) "at" integer(i) "as" "?" ":" "?" := proveprem_asg_premg H i. Tactic Notation "especialize" constr(H) "as" "?" "at" integer(i) ":" "?" := proveprem_asg_premg H i. Ltac proveprem_as H i idnewH := let prefx := fresh_unfail H in let idpremis := fresh prefx "prem" in proveprem_as_prem H i idpremis idnewH;[ | clear idpremis]. Tactic Notation "especialize" constr(H) "at" integer(i) "as" ident(idH) := proveprem_as H i idH. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i) := proveprem_as H i idH. Ltac proveprem_asg H i := let prefx := fresh_unfail H in let idnewH := fresh prefx "spec" in let idpremis := fresh prefx "prem" in proveprem_as_prem H i idpremis idnewH;[ | clear idpremis]. Tactic Notation "especialize" constr(H) "at" integer(i) "as" "?" := proveprem_asg H i. Tactic Notation "especialize" constr(H) "as" "?" "at" integer(i) := proveprem_asg H i. (* Version where specialize is not given a name (soeither H is a hypand it is modified, or the new hyp is generalized). *) Ltac proveprem_prem H i idpremis := let ev := open_constr:((_:Prop)) in assert (idpremis:ev); [|specialize H with (i:=idpremis)]. Tactic Notation "especialize" constr(H) "at" integer(i) ":" ident(idprem) := proveprem_prem H i idprem. Ltac proveprem_premg H i := let prefx := fresh_unfail H in let idpremis := fresh prefx "prem" in proveprem_prem H i idpremis. Tactic Notation "especialize" constr(H) "at" integer(i) ":" "?" := proveprem_premg H i. (* same as proveprem_prem but discard the created hypothesis once used in specialization *) Ltac proveprem H i := let prefx := fresh_unfail H in let idpremis := fresh prefx "prem" in proveprem_prem H i idpremis ; [ | clear idpremis]. Tactic Notation "especialize" constr(H) "at" integer(i) := proveprem H i. Tactic Notation "especialize" constr(H) "at" integer(i) := proveprem H i. (* Create a subgoal for each dependent premiss of H *) Ltac proveprem_all H := (especialize H at 1; [| proveprem_all H]) + idtac. Tactic Notation "especialize" constr(H) "at" "*" := ((try (is_var(H); fail 1)); (let prefx := fresh_unfail H in (let h := fresh prefx "spec" in specialize H as h; (* create the hyp *) proveprem_all h))) + proveprem_all H. Tactic Notation "especialize" constr(H) "at" "*" "as" ident(idH) := (let h := fresh idH in specialize H as h; (* create the hyp *) proveprem_all h). (* Create a subgoal for each dependent premiss of H *) Ltac proveprem_until H i := match i with 0 => idtac | (S ?i') => (especialize H at 1; [| proveprem_until H i']) end. Tactic Notation "especialize" constr(H) "until" constr(i) := (try (is_var(H); fail 1); (let prefx := fresh_unfail H in let h := fresh prefx "spec" in specialize H as h; (* create the hyp *) proveprem_until h i)) + proveprem_until H i. Tactic Notation "especialize" constr(H) "until" constr(i) "as" ident(idH) := (let h := fresh idH in specialize H as h; (* create the hyp *) proveprem_until h i). (* Same but discard the created hypothesis once used in specialization *) Ltac proveprem_as_2 H idnewH i1 i2 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in (* FIXME when H is not freshable, and in all others. *) let idprem2 := fresh prefx "_prem'" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [|specialize H with (i1:=idprem1) (i2:=idprem2) as idnewH ; clear idprem2 idprem1]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2) := proveprem_as_2 H idH i1 i2. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2) "as" ident(idH) := proveprem_as_2 H idH i1 i2. (* Same but discard the created hypothesis once used in specialization *) Ltac proveprem_2 H i1 i2 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem'" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [|specialize H with (i1:=idprem1) (i2:=idprem2) ; clear idprem2 idprem1]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2) := proveprem_2 H i1 i2. Ltac proveprem_as_3 H idnewH i1 i2 i3 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) as idnewH ; clear idprem3 idprem2 idprem1 ]]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2)"," integer(i3) := proveprem_as_3 H idH i1 i2 i3. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "as" ident(idH) := proveprem_as_3 H idH i1 i2 i3. Ltac proveprem_3 H i1 i2 i3 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) ; clear idprem3 idprem2 idprem1 ]]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) := proveprem_3 H i1 i2 i3. Ltac proveprem_as_4 H idnewH i1 i2 i3 i4 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) as idnewH ; clear idprem4 idprem3 idprem2 idprem1 ]]]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2) "," integer(i3) "," integer(i4) := proveprem_as_4 H idH i1 i2 i3 i4. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "as" ident(idH) := proveprem_as_4 H idH i1 i2 i3 i4. Ltac proveprem_4 H i1 i2 i3 i4 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) ; clear idprem4 idprem3 idprem2 idprem1 ]]]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) := proveprem_4 H i1 i2 i3 i4. Ltac proveprem_as_5 H idnewH i1 i2 i3 i4 i5 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5) as idnewH ; clear idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2) "," integer(i3) "," integer(i4) "," integer(i5) := proveprem_as_5 H idH i1 i2 i3 i4 i5. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) "as" ident(idH) := proveprem_as_5 H idH i1 i2 i3 i4 i5. Ltac proveprem_5 H i1 i2 i3 i4 i5 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5); clear idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) := proveprem_5 H i1 i2 i3 i4 i5. Ltac proveprem_as_6 H idnewH i1 i2 i3 i4 i5 i6 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let idprem6 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in let ev6 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | assert (idprem6:ev6); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5) (i6:=idprem6) as idnewH ; clear idprem6 idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2) "," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) := proveprem_as_6 H idH i1 i2 i3 i4 i5 i6. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) "as" ident(idH) := proveprem_as_6 H idH i1 i2 i3 i4 i5 i6. Ltac proveprem_6 H i1 i2 i3 i4 i5 i6 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let idprem6 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in let ev6 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | assert (idprem6:ev6); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5) (i6:=idprem6); clear idprem6 idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) := proveprem_6 H i1 i2 i3 i4 i5 i6. Ltac proveprem_as_7 H idnewH i1 i2 i3 i4 i5 i6 i7 := let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let idprem6 := fresh prefx "_prem" in let idprem7 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in let ev6 := open_constr:((_:Prop)) in let ev7 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | assert (idprem6:ev6); [ | assert (idprem7:ev7); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5) (i6:=idprem6) (i7:=idprem7) as idnewH ; clear idprem7 idprem6 idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]]]. Tactic Notation "especialize" constr(H) "as" ident(idH) "at" integer(i1) "," integer(i2) "," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) "," integer(i7) := proveprem_as_7 H idH i1 i2 i3 i4 i5 i6 i7. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) "," integer(i7) "as" ident(idH) := proveprem_as_7 H idH i1 i2 i3 i4 i5 i6 i7. Ltac proveprem_7 H i1 i2 i3 i4 i5 i6 i7:= let prefx := fresh_unfail H in let idprem1 := fresh prefx "_prem" in let idprem2 := fresh prefx "_prem" in let idprem3 := fresh prefx "_prem" in let idprem4 := fresh prefx "_prem" in let idprem5 := fresh prefx "_prem" in let idprem6 := fresh prefx "_prem" in let idprem7 := fresh prefx "_prem" in let ev1 := open_constr:((_:Prop)) in let ev2 := open_constr:((_:Prop)) in let ev3 := open_constr:((_:Prop)) in let ev4 := open_constr:((_:Prop)) in let ev5 := open_constr:((_:Prop)) in let ev6 := open_constr:((_:Prop)) in let ev7 := open_constr:((_:Prop)) in assert (idprem1:ev1); [ | assert (idprem2:ev2); [ | assert (idprem3:ev3); [ | assert (idprem4:ev4); [ | assert (idprem5:ev5); [ | assert (idprem6:ev6); [ | assert (idprem7:ev7); [ | specialize H with (i1:=idprem1) (i2:=idprem2) (i3:=idprem3) (i4:=idprem4) (i5:=idprem5) (i6:=idprem6) (i7:=idprem7); clear idprem7 idprem6 idprem5 idprem4 idprem3 idprem2 idprem1 ]]]]]]]. Tactic Notation "especialize" constr(H) "at" integer(i1) "," integer(i2)"," integer(i3) "," integer(i4) "," integer(i5) "," integer(i6) "," integer(i7) := proveprem_7 H i1 i2 i3 i4 i5 i6 i7. (* Definition eq_one (i:nat) := i = 1. Lemma test_esepec_6_7: (eq_one 2 -> eq_one 3 ->eq_one 4 ->eq_one 5 ->eq_one 6 ->eq_one 7 ->eq_one 8 -> eq_one 9 -> eq_one 1 -> False) -> True. Proof. intros H. especialize H at 3,1,4,5,2,7 as h; [ admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac "OK" end]. Undo. especialize H as h at 3,1,4,5,2,7; [ admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac "OK" end]. Undo. especialize H at 3,1,4,5,2,7; [ admit | admit | admit | admit | admit | admit | match type of H with eq_one 7 -> eq_one 9 -> eq_one 1 ->False=> idtac "OK" end]. Undo. especialize H at 3,1,4,5,2,7,9 as h; [ admit | admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> False => idtac "OK" end]. Undo. especialize H as h at 3,1,4,5,2,7,9; [ admit | admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> False => idtac "OK" end]. Undo. especialize H at 3,1,4,5,2,7,9; [ admit | admit | admit | admit | admit | admit | admit | match type of H with eq_one 7 -> eq_one 9 -> False => idtac "OK" end]. Undo. exact I. Qed. (* TEST *) Lemma foo: (eq_one 2 -> eq_one 1 -> False) -> False. Proof. intros H. especialize (le_sind 0) at 1 as hh : h. { admit. } especialize min_l at 1 as ? : ?. { apply (le_n O). } especialize H at 1 as hh : h. { reflexivity. } match type of h with False => idtac "OK" | _ => fail end. assumption. Qed. *) LibHyps-libhyps-2.0.8/LibHyps/TacNewHyps.v000066400000000000000000000250361453760644100203510ustar00rootroot00000000000000(* Copyright 2021 Pierre Courtieu This file is part of LibHyps. It is distributed under the MIT "expat license". You should have recieved a LICENSE file with it. *) (** This file defines tacticals for iterating a tactic on sets of hypothesis. In particular on the set of hypothesis generated by a tactic. For examples of use of this tacticals, see LibHyps.v and for to seee them working, see LibHypsDemo.v. [onAllHyp tac] applies [tac H] for each H of the proof context (natural order: newer hyps first). [onAllHypRev tac] like onAllHyp but applies [tac H] in reverse order. [tac_all_new_hyps tac1 tac2] applies tac1 on the current goal, then applies tac on each "new" hypothesis generated by tac1. A hypothesis is "new" if its name was not present before tac1 was applied. [tac_all_new_hyps_rev tac1 tac2] works like tac_all_new_hyps but applies tac2 in reverse order. In all these tacticals, a failure during tac makes the whole expression to fail. For efficiency and generality we also provide a tactical working on a list of hypothesis instead of only on at a time. *) (* Credit for the harvesting of hypothesis: Jonathan Leivant *) Ltac harvest_hyps harvester := constr:(ltac:(harvester; constructor) : True). Ltac harvest_hyps_h harvester h := constr:(ltac:(harvester h; constructor) : True). (* This will be stuck on section variables if some hypothesis really depends on it. We can use "revert dependent" but the hypothesis remains in the goal and make this tactic loop. The trick consisting of marking hyms with (id) fails on types. Needs more thinking. Meanwhile harvest_hyps will fail on some section variables. *) Ltac revert_clearbody_all := repeat lazymatch goal with H : _ |- _ => try clearbody H; revert H end. Ltac revert_clearbody_above Hyp := lazymatch goal with | _H : ?T |- _ => match constr:((_H , Hyp)) with | (?h,?h) => let dummy := constr:(ltac:(apply eq_refl): _H=Hyp) in (* we have foud Hyp, clear it and register everything up *) clear _H; revert_clearbody_all | _ => clear _H; revert_clearbody_above Hyp end end. (* THE GENERIC MECHANISM is to have a tactic that applies directly to the *list* of hypothesis. Most of the time it will be a simpl iteration on each hypothesis independently, but sometimes for efficiency we will need to be smarter (e.g. group_up_list). We don't use directly the product build by harvest_hyps for efficiency reasons. Instead we use the dependent list Depl defined below. *) Inductive Depl := | DNil: Depl | DCons: forall (A:Type) (x:A), Depl -> Depl. (* Transforming the product from harvest_hyps into a Depl. *) Ltac prod_to_list_ acc prod := match prod with | (?prod' ?h) => let t := type of h in let acc := constr:(DCons t h acc) in prod_to_list_ acc prod' | _ => acc end. Ltac prod_to_list prod := prod_to_list_ DNil prod. (* Same but reversing the list. *) Ltac prod_to_list_rev prod := match prod with | (?prod' ?h) => let t := type of h in let recres := prod_to_list_rev prod' in constr:(DCons t h recres) | _ => DNil end. (* { BUILDING THE LIST OF ALL HYPS } *) (* Builds the DList of all hyps *) Ltac all_hyps := let prod := harvest_hyps revert_clearbody_all in prod_to_list prod. Ltac all_hyps_rev := let prod := harvest_hyps revert_clearbody_all in prod_to_list_rev prod. (* { BUILDING THE LIST OF ALL HYPS ABOVE H }. (useful?). *) Ltac up_segment H := let prod := harvest_hyps_h revert_clearbody_above H in prod_to_list prod. Ltac up_segment_rev H := let prod := harvest_hyps_h revert_clearbody_above H in prod_to_list_rev prod. (* { GENERATING THE LIST OF "NEW" HYPOTHESIS } *) (* Remark: this version has several potential efficiency problems: 1) it is quadratic, but this may be unavoidable unless we replace list by trees. 2) it looks for hyp (context) names inside types, instead of only hyp names. Since context is quite fast it does not seem much visible, but on big types (class types for instance) it may become problematic. I have tried to optimize more the filtering. Mainly trying to avoid to look at types by iterating by hand in ltac on the list. No real speedup was observed. The filter_new_hyps_optim tactic does speed up significantly in most cases. *) (* Builds the list (DCons/DNil) of hypothesis appearing in lh2 that are not present in lh1. This version may be slow on big types because of the "context" will dive into them uselessly. However on standard goals it is quite efficient. See below for optimizations. *) Ltac filter_new_hyps lh2 lh1 := match lh2 with (DCons _ ?h ?lh2') => match lh1 with (* This context is fast but it may have bad complexity on big hyps types (e.g. type classes). *) | context [h] => filter_new_hyps lh2' lh1 | _ => let th := type of h in let recres := filter_new_hyps lh2' lh1 in constr:(DCons th h recres) end | _ => DNil end. (* This naive optimization works pretty well since most of the time lh1 and lh2 share a significant prefix. *) Ltac filter_new_hyps_optim lh2 lh1 := lazymatch lh2 with | (DCons _ ?h ?lh2') => lazymatch lh1 with | (DCons _ h ?lh1') => filter_new_hyps_optim lh2' lh1' | _ => filter_new_hyps lh2 lh1 end | _ => filter_new_hyps lh2 lh1 end. (* { TACTICALS ITERATING ON A GIVEN LIST OF HYPOTHESIS } *) (* Default way of iterating a tactic on all elements of a Decl. *) Ltac map_hyps tac l := match l with | DNil => idtac | DCons _ ?h ?l' => tac h; map_hyps tac l' end. (* Same thing in reverse order. Prefer map_hyps on reversed list? *) Ltac map_hyps_rev tac l := match l with | DNil => idtac | DCons _ ?h ?l' => map_hyps_rev tac l'; tac h end. (* { TACTICALS ITERATING ON ALL HYPOTHESIS OF A GOAL } *) (* Iterate tac on all hyps of a goal, top to bottom or reverse. *) Ltac map_all_hyps tac := map_hyps tac all_hyps. Ltac map_all_hyps_rev tac := map_hyps tac all_hyps_rev. (* For less parenthesis: OnAllHyp tacA;tac2. *) Tactic Notation (at level 4) "onAllHyps" tactic(Tac) := (map_all_hyps Tac). Tactic Notation (at level 4) "onAllHypsRev" tactic(Tac) := (map_all_hyps_rev Tac). (* { TACTICALS ITERATING ON *NEW* HYPOTHESIS AFTER APPLYING A TACTIC } The most common tacticals are then_eachnh and then_eachnh_rev, use then_allnh and then_allnh_rev for efficiency reason (see e.g. LibHyps.group_up_list). *) Ltac then_allnh_gen gathertac tac1 tac2 := let hyps_before_tac := gathertac idtac in tac1; let hyps_after_tac := gathertac idtac in let l_new_hyps := filter_new_hyps_optim hyps_after_tac hyps_before_tac in tac2 l_new_hyps. (* [then_allnh tac1 tac2] and [then_allnh_rev tac1 tac2] applies tac1 and then applies tac2 on the list of *new* hypothesis of the resulting goals. The list is of type [Decl]. NOTE: tac2 must operates directly on the whole list. For single-goal minded tac2, use then_eachnh(_rev), below. *) Ltac then_allnh tac1 tac2 := then_allnh_gen ltac:(fun x => all_hyps) tac1 tac2. Ltac then_allnh_rev tac1 tac2 := then_allnh_gen ltac:(fun x => all_hyps_rev) tac1 tac2. (* For a single-goal-minded tac2 (most common use case). *) Ltac then_eachnh_rev tac1 tac2 := then_allnh_rev tac1 ltac:(map_hyps tac2). Ltac then_eachnh tac1 tac2 := then_allnh tac1 ltac:(map_hyps tac2). Module Notations. (* Default syntax: *) Tactic Notation (at level 4) tactic4(tac)";" "{!" tactic(tach) "}" := then_allnh tac tach. Tactic Notation (at level 4) tactic4(tac)";" "{!<" tactic(tach)"}":= then_allnh_rev tac tach. (* single-goal-minded tach (most common use case). *) Tactic Notation (at level 4) tactic4(tac)";" "{" tactic(tach)"}":= then_eachnh tac tach. Tactic Notation (at level 4) tactic4(tac)";" "{<" tactic(tach)"}":= then_eachnh_rev tac tach. (* Legacy tacticals. Warning: not applicable for tactic operating directly on a list of hyps *) Tactic Notation (at level 4) tactic4(tac) ";;" tactic4(tach) := then_eachnh tac tach. Tactic Notation (at level 4) tactic4(tac) ";!;" tactic4(tach) := (then_eachnh_rev tac tach). End Notations. (* (* Tests. *) Ltac r h := revert h. Ltac rl lh := match lh with DCons ?t ?h ?lh' => revert h; rl lh' | DNil => idtac end. Ltac p h := idtac h. Ltac pl lh := match lh with DCons ?t ?h ?lh' => idtac h; pl lh' | DNil => idtac end. (* dummy rename *) Ltac n h := let nm := fresh "h" in rename h into nm. Ltac nl lh := match lh with DCons ?t ?h ?lh' => (let nm := fresh "h" in rename h into nm) ; nl lh' | DNil => idtac end. Import TacNewHyps.Notations. Goal forall x1:bool, forall a z e r t z e r t z e r t z e r t y: nat, True -> forall u i o p q s d f g:nat, forall x2:bool, True -> True. Proof. (* intros. let l := all_hyps in idtac l. (* pb dans l'ordre entre map_hyp et all_hyp *) *) (* intros ;; n. *) intros ; { p }; { n }; { r }. Undo. intros ; {! pl } ; { n }; { r }. Undo. intros ; { n }; { p }; { r }. Undo. intros ; {! nl }; { p }; { r }. Undo. Import TacNewHyps.SimpleNotations. intros ;!; ltac:(fun h => idtac h) ;; ltac:(fun h => revert h). ;!; ltac:(fun h => idtac h) then_nh ltac:(intros) ltac:(revert_l). *) (* Testing speedup for filter_new_hyps_optim, when there is a common prefix in the two lists. *) (* Lemma foo: forall (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ : (forall (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :nat), True)) (a b:bool), True -> forall y z:nat, True. intros. Ltac prefx n l := lazymatch n with 0%nat => DNil | S ?n' => lazymatch l with DCons ?a ?b ?l' => let p := prefx n' l' in constr:(DCons a b p) | DNil => DNil | _ => fail end end. time let all := all_hyps in let few := prefx 20 all in let diff := filter_new_hyps_optim all few in idtac. *) LibHyps-libhyps-2.0.8/Makefile.local000066400000000000000000000027041453760644100173110ustar00rootroot00000000000000 # This adds compilation of a test file, without adding it to the # install target. ## -async-proofs-cache force avoids slowdowns in presence of Undo. .PHONY: cleantests tests: @echo -n building tests... $(SHOW) 'COQC LibHyps/LibHypsTest.v' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) -async-proofs-cache force -w -undo-batch-mode $(COQLIBS) ./LibHyps/LibHypsTest.v $(TIMING_EXTRA) @echo " ==> tests passed." @echo -n building regression tests... $(SHOW) 'COQC LibHyps/LibHypsRegression.v' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) -async-proofs-cache force -w -undo-batch-mode $(COQLIBS) ./LibHyps/LibHypsRegression.v $(TIMING_EXTRA) @echo " ==> regression tests passed." @echo -n building demo file... $(SHOW) 'COQC Demo/demo.v > /dev/null' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) -async-proofs-cache force -w -undo-batch-mode $(COQLIBS) ./Demo/demo.v $(TIMING_EXTRA) > /dev/null @echo " ==> regression tests passed." cleantests: rm -f LibHyps/LibHypsRegression.vo LibHyps/LibHypsRegression.vok LibHyps/LibHypsRegression.vos LibHyps/LibHypsRegression.glob rm -f LibHyps/LibHypsTest.vo LibHyps/LibHypsTest.vok LibHyps/LibHypsTest.vos LibHyps/LibHypsTest.glob rm -f Demo/*.vo Demo/*.vok Demo/*.vos Demo/*.glob clean:: rm -f LibHyps/*.vo LibHyps/*.vos LibHyps/*.vok LibHyps/*.glob LibHyps/*.aux rm -f LibHyps/.*.vo LibHyps/.*.aux ### Local Variables: *** ### mode: makefile *** ### End: *** LibHyps-libhyps-2.0.8/README.md000066400000000000000000000171431453760644100160420ustar00rootroot00000000000000This Library provides several coq tactics and tacticals to deal with hypothesis during a proof. Main page and documentation: https://github.com/Matafou/LibHyps Demo file [demo.v](https://github.com/Matafou/LibHyps/blob/master/Demo/demo.v) acts as a documentation. # Short description: LibHyps provides utilities for hypothesis manipulations. In particular a new tactic `especialize H` and a set of tacticals to appy or iterate tactics either on all hypothesis of a goal or on "new' hypothesis after a tactic. It also provide syntax for a few predefined such iterators. ## QUICK REF: especialize (BROKEN IN COQ-8.18) This tactic is currently broken in coq v8.18. I am working on it. This may need some work on coq side. + `especialize H at n [as h].` Creates a subgoal to prove the nth dependent premise of `H`, creating necessary evars for non unifiable variables. Once proved the subgoal is used to remove the nth premise of `H` (or of a new created hypothesis if the `as` option is given). + `especialize H at * [as h].` Creates one subgoal for each dependent premise of `H`, creating necessary evars for non unifiable variables. Once proved the subgoal is used to remove the premises of `H` (or of a new createdd hypothesis if the `as` option is given). + `especialize H until n [as h].` Creates one subgoal for each n first dependent premises of `H`, creating necessary evars for non unifiable variables. Once proved the subgoal is used to remove the premises of `H` (or of a new created hypothesis if the `as` option is given). ## QUICK REF: Pre-defined tacticals /s /n... The most useful user-dedicated tacticals are the following + `tac /s` try to apply `subst` on each new hyp. + `tac /r` revert each new hyp. + `tac /n` auto-rename each new hyp. + `tac /g` group all non-Prop new hyp at the top of the goal. + combine the above, as in `tac /s/n/g`. + usual combinations have shortcuts: `\sng`, `\sn`,`\ng`,`\sg`... # Install ## Quick install using opam If you have not done it already add the coq platform repository to opam! ```bash opam repo add coq-released https://coq.inria.fr/opam/released ``` and then: ```bash opam install coq-libhyps ``` ## Quick install using github: Clone the github repository: ```bash git clone https://github.com/Matafou/LibHyps ``` then compile: ```bash configure.sh make make install ``` ## Quick test: ```coq Require Import LibHyps.LibHyps. ``` Demo files [demo.v](https://github.com/Matafou/LibHyps/blob/master/Demo/demo.v). # More information ## Deprecation from 1.0.x to 2.0.x + "!tac", "!!tac" etc are now only loaded if you do: `Import LibHyps.LegacyNotations.`, the composable tacticals described above are preferred. + "tac1 ;; tac2" remains, but you can also use "tac1; { tac2 }". + "tac1 ;!; tac2" remains, but you can also use "tac1; {< tac2 }". ## KNOWN BUGS Due to Ltac limitation, it is difficult to define a tactic notation `tac1 ; { tac2 }` which delays `tac1` and `tac2` in all cases. Sometimes (rarely) you will have to write `(idtac; tac1); {idtac; tac2}`. You may then use tactic notation like: `Tactic Notation tac1' := idtac; tac1.`. ## Examples ```coq Require Import LibHyps.LibHyps. Lemma foo: forall x y z:nat, x = y -> forall a b t : nat, a+1 = t+2 -> b + 5 = t - 7 -> (forall u v, v+1 = 1 -> u+1 = 1 -> a+1 = z+2) -> z = b + x-> True. Proof. intros. (* ugly names *) Undo. (* Example of using the iterator on new hyps: this prints each new hyp name. *) intros; {fun h => idtac h}. Undo. (* This gives sensible names to each new hyp. *) intros ; { autorename }. Undo. (* short syntax: *) intros /n. Undo. (* same thing but use subst if possible, and group non prop hyps to the top. *) intros ; { substHyp }; { autorename}; {move_up_types}. Undo. (* short syntax: *) intros /s/n/g. Undo. (* Even shorter: *) intros /s/n/g. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type: *) (* BROKEN IN COQ 8.18*) (* especialize h_all_eq_add_add_ at 2. { apply Nat.add_0_l. } (* now h_all_eq_add_add is specialized *) Undo 6. *) Undo 2. intros until 1. (** The taticals apply after any tactic. Notice how H:x=y is not new and hence not substituted, whereas z = b + x is. *) destruct x eqn:heq;intros /sng. - apply I. - apply I. Qed. ``` ## Short Documentation The following explains how it works under the hood, for people willing to apply more generic iterators to their own tactics. See also the code. ### Iterator on all hypothesis + `onAllHyps tac` does `tac H` for each hypothesis `H` of the current goal. + `onAllHypsRev tac` same as `onAllHyps tac` but in reverse order (good for reverting for instance). ### Iterators on ALL NEW hypothesis (since LibHyps-1.2.0) + `tac1 ;{! tac2 }` applies `tac1` to current goal and then `tac2` to *the list* of all new hypothesis in each subgoal (iteration: oldest first). The list is a term of type `LibHyps.TacNewHyps.DList`. See the code. + `tac1 ;{!< tac2 }` is similar but the list of new hyps is reveresed. ### Iterators on EACH NEW hypothesis + `tac1 ;{ tac2 }` applies `tac1` to current goal and then `tac2` to each new hypothesis in each subgoal (iteration: older first). + `tac1 ;{< tac2 }` is similar but applies tac2 on newer hyps first. + `tac1 ;; tac2` is a synonym of `tac1; { tac2 }`. + `tac1 ;!; tac2` is a synonym of `tac1; {< tac2 }`. ### Customizable hypothesis auto naming system Using previous taticals (in particular the `;!;` tactical), some tactic allow to rename hypothesis automatically. - `autorename H` rename `H` according to the current naming scheme (which is customizable, see below). - `rename_all_hyps` applies `autorename` to all hypothesis. - `!tac` applies tactic `tac` and then applies autorename to each new hypothesis. Shortcut for: `(Tac ;!; revert_if_norename ;; autorename).`.` - `!!tac` same as `!tac` with lesser priority (less than `;`) to apply renaming after a group of chained tactics. #### How to cstomize the naming scheme The naming engine analyzes the type of hypothesis and generates a name mimicking the first levels of term structure. At each level the customizable tactic `rename_hyp` is called. One can redefine it at will. It must be of the following form: ```coq (** Redefining rename_hyp*) (* First define a naming ltac. It takes the current level n and the sub-term th being looked at. It returns a "name". *) Ltac rename_hyp_default n th := match th with | (ind1 _ _) => name (`ind1`) | (ind1 _ _ ?x ?y) => name (`ind1` ++ x#(S n)x ++ y$n) | f1 _ ?x = ?y => name (`f1` ++ x#n ++ y#n) | _ => previously_defined_renaming_tac1 n th (* cumulative with previously defined renaming tactics *) | _ => previously_defined_renaming_tac2 n th end. (* Then overwrite the definition of rename_hyp using the ::= operator. :*) Ltac rename_hyp ::= my_rename_hyp. ``` Where: - `` `id` `` to use the name id itself - `t$n` to recursively call the naming engine on term t, n being the maximum depth allowed - `name ++ name` to concatenate name parts. #### How to define variants of these tacticals? Some more example of tacticals performing cleaning and renaming on new hypothesis. ```coq (* subst or revert *) Tactic Notation (at level 4) "??" tactic4(tac1) := (tac1 ;; substHyp ;!; revertHyp). (* subst or rename or revert *) Tactic Notation "!!!" tactic3(Tac) := (Tac ;; substHyp ;!; revert_if_norename ;; autorename). (* subst or rename or revert + move up if in (Set or Type). *) Tactic Notation (at level 4) "!!!!" tactic4(Tac) := (Tac ;; substHyp ;!; revert_if_norename ;; autorename ;; move_up_types). ``` LibHyps-libhyps-2.0.8/TODO.md000066400000000000000000000032141453760644100156440ustar00rootroot00000000000000# Suggestion by Sylvain Boulme: ## Looks like "exploit" developped in compcert. exploit creates evars for all premisses of a hyp. especialize creates evars for ONE premiss. Maybe we could have the best of both? like: ``` especialize h at 1,4,6. (* fine grained exploit *) especialize h at *. (* equivalent to exploit *) ``` # have a true replacement for "as" Syntax suggestion: tac : [ H 1 H 2 | x y Hx Hy H | ...]. applies tac and then destruct each new hyp with the corresponding intropattern. Seems to need ocaml code because tactic notation are not suitable. ## Remaining question how to deal with several subgoals? Is it possible to split a disjunctive intropattern for each subgoal? # Find a better syntax? I find "tac1 ; { tac2 }." is nice because it resembles "tac ; [ tac2 ]." but curly braces are already over-overloaded. ## Maybe keep the square brackets? tac1 ; [[ tac2 ]]. ## or go back to double semi-colon? tac1 ;; tac2. but we need 4 variants. ;<; ;!; ;!<; which are quite ugly. # Are shortcuts reasonable wrt to ssreflect? tac /sn. may clash with ssreflect. ## go back to prefix "!" ? we need to have vaiants /s /n /g /r and all interesting combinations. # Naming: decide on ids make possible the fact to decide to use an arg name only if it is an id. typically: "h_eq_add_add" is not so interesting # Naming : distinguish sub terms in the name Typically "h_add_x_y_z" would maybe be better as "h_add_x_y__z" # Switch to ocaml ## Augment "Arguments" with naming information - which args to ignore - Auto ignore implicit args - make the new "as" implementable? # ideas for other post-tactic cleaning ## decomp? /d ## cbn ## ? LibHyps-libhyps-2.0.8/_CoqProject000066400000000000000000000002001453760644100167000ustar00rootroot00000000000000-R LibHyps LibHyps LibHyps/LibHypsNaming.v LibHyps/LibHypsTactics.v LibHyps/LibDecomp.v LibHyps/TacNewHyps.v LibHyps/LibHyps.v LibHyps-libhyps-2.0.8/configure.sh000077500000000000000000000005701453760644100170770ustar00rootroot00000000000000#!/bin/sh FILES=`find . -name "*.v" -exec echo {} \;` echo "-R LibHyps LibHyps" > _CoqProject echo "" >> _CoqProject for i in `find LibHyps -name "*.v"| grep -v LibHypsNaming2 | grep -v LibSpecialize.v | grep -v LibHypsExamples | grep -v LibHypsDemo | grep -v LibHypsTest | grep -v LibHypsRegression`; do echo $i >> _CoqProject done coq_makefile -f _CoqProject -o Makefile LibHyps-libhyps-2.0.8/coq-libhyps.opam000066400000000000000000000027001453760644100176640ustar00rootroot00000000000000# this is a mirror of an opam description file in the # opam-coq-archive at: # https://github.com/coq/opam-coq-archive/tree/master/released/packages/coq-libhyps # the latter being official and probably more up to date. opam-version: "2.0" maintainer: "Pierre.Courtieu@lecnam.net" synopsis: "Hypotheses manipulation library" homepage: "https://github.com/Matafou/LibHyps" dev-repo: "git+https://github.com/Matafou/LibHyps.git" bug-reports: "https://github.com/Matafou/LibHyps/issues" doc: "https://github.com/Matafou/LibHyps/blob/master/Demo/demo.v" license: "MIT" build: [ ["./configure.sh"] [make "-j%{jobs}%"] ] run-test: [ ["./configure.sh"] [make "-j%{jobs}%"] [make "tests"] ] install: [make "install"] depends: [ "coq" {(>= "8.11" & < "8.19~") | (= "dev")} ] tags: [ "keyword:proof environment manipulation" "keyword:forward reasoning" "keyword:hypothesis naming" "category:Miscellaneous/Coq Tactics Library" "logpath:LibHyps" ] authors: [ "Pierre Courtieu" ] description: " This library defines a set of tactics to manipulate hypothesis individually or by group. In particular it allows applying a tactic on each hypothesis of a goal, or only on *new* hypothesis after some tactic. Examples of manipulations: automatic renaming, subst, revert, or any tactic expecting a hypothesis name as argument. It also provides the especialize tactic to ease forward reasoning by instantianting one, several or all premisses of a hypothesis. "