pax_global_header00006660000000000000000000000064151665445140014525gustar00rootroot0000000000000052 comment=112b2735a4ca0bf14d14579b67f5d4c79982c77a Matafou-LibHyps-112b273/000077500000000000000000000000001516654451400147345ustar00rootroot00000000000000Matafou-LibHyps-112b273/.github/000077500000000000000000000000001516654451400162745ustar00rootroot00000000000000Matafou-LibHyps-112b273/.github/workflows/000077500000000000000000000000001516654451400203315ustar00rootroot00000000000000Matafou-LibHyps-112b273/.github/workflows/ci-libhyps.yml000066400000000000000000000026171516654451400231250ustar00rootroot00000000000000# 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 builds libhyps and also runs the tests build-and-test: # The type of runner that the job will run on runs-on: ubuntu-latest # this shell variable is detected by "opam install" and triggers # the "run-test" part of the opam project file env: OPAMWITHTEST: 'true' strategy: matrix: image: - 'rocq/rocq-prover:latest' - 'rocq/rocq-prover:dev' - 'rocq/rocq-prover:9.2' - 'rocq/rocq-prover:9.1' - 'rocq/rocq-prover:9.0' # 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: 'rocq-libhyps.opam' custom_image: ${{ matrix.image }} export: 'OPAMWITHTEST' # space-separated list of variables Matafou-LibHyps-112b273/.gitignore000066400000000000000000000002761516654451400167310ustar00rootroot00000000000000Makefile.conf .coqdeps.d tests/_CoqProject tests/Makefile tests/CoqMakefile tests/Makefile tests/Makefile.conf LibHyps/_CoqProject LibHyps/Makefile LibHyps/Makefile.conf LibHyps/CoqMakefile Matafou-LibHyps-112b273/CHANGES.md000066400000000000000000000103751516654451400163340ustar00rootroot00000000000000# Changes from 4 to 5.0 ## Under the hood: switch to Ltac2 Almost all tactics are now implementd in Ltac2. They are musch faster. This implies a few changes: - no more "list" variant of the tactical `; { }`. See below. - Customization must be written in ltac2, to come back to ltac1 standard mode you need to do `Local Set Default Proof Mode "Classic".` ## Incompatibilities Things should me mostly forwward compatible except customization that must be written in Ltac2. ## New features - With `especialize` subgoals generated from a hypothesis H now depends on all premises quantified before H. This is logically more sound. This should not introduce incompatibilities buy itself from libhyps 4. - Since libhyps 4 `especialize` now by default quantifies hypothesis that are not mentioned instead of declaring evars. To build evars instead, use the `with x,y` argument. See README.md. - new experimental tactic `assert premise i of H` generate a subgoal (like assert) for the `i`th premise of H. The asserted subgoal is not applied to `H` (but can be used later on to do so). See README.md. ## Changes concerning the user customization ### Custom auto naming must now be written in ltac2. Tranlation from ltac1 is straightforward. Example: ``` coq Require Import Ltac2.Ltac2. From Stdlib Require Import List. Import ListNotations. Local Set Default Proof Mode "Classic". (* Optional This restores ltac1 proof mode. *) Ltac2 rename_hyp_2 _ th := match! th with | true <> false => [ String "tNEQf" ] | true = false => [ String "tEQf" ] end. Ltac2 Set rename_hyp := rename_hyp_2. (* Suppose I want to add later another naming rule: *) Ltac2 rename_hyp_3 n th := match! th with | Nat.eqb ?x ?y = true => [ String "Neqb"; Rename x ; Rename y ] | true = Nat.eqb ?x ?y => [ String "Neqb" ; Rename x ; Rename y ] | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_3. ``` ### No more "list" variant of the tactical `; { }`. Ltac2 being much faster, no more need for those variants. Typically `/g` now is a shotcut for `; { move_up_types }` (`group_up_list` removed). ## Unplugged syntax - `tac1 ;; tac2` a,d `tac1 ;!; tac2` syntax definitely disabled. Although you can re-enable it with: ``` coq 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). ``` # Changes from 1.x to 2.x ## New Syntax + The tactical `then_eachnh tac1 tac2` has now syntax `tac1 ; { tac2 }`. + The tactical `then_eachnh_rev tac1 tac2` has now syntax `tac1 ; {< tac2 }`. + `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`... ## Old 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: ## New Tactical for tactical dealing with all hyps at once (OBSOLETE IN > 5.0) + "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 }. ``` Matafou-LibHyps-112b273/LICENSE000066400000000000000000000020441516654451400157410ustar00rootroot00000000000000Copyright (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. Matafou-LibHyps-112b273/LibHyps/000077500000000000000000000000001516654451400163065ustar00rootroot00000000000000Matafou-LibHyps-112b273/LibHyps/.gitignore000066400000000000000000000000221516654451400202700ustar00rootroot00000000000000*.glob *.vo *.v.d Matafou-LibHyps-112b273/LibHyps/AssertPremise.v000066400000000000000000000263641516654451400212760ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Require Sorting.Mergesort Structures.OrdersEx. From Ltac2 Require Import Option Constr Printf. Import Constr.Unsafe. Local Set Default Proof Mode "Classic". (* Require Import LibHyps.LibHypsDebug. *) (* Utilities *) Local Ltac2 invalid_arg (msg:string) := Control.throw (Invalid_argument (Some (Message.of_string msg))). Local Ltac2 mk_evar ename typ := let tac := ltac1:(ename typ|- evar (ename:typ)) in tac (Ltac1.of_ident ename) (Ltac1.of_constr typ). Local Ltac2 Type premise := [ Int(int) | Ident(ident) ]. Local Ltac2 pr_premise () a := match a with | Int(i) => fprintf "Int(%i)" i | Ident(id) => fprintf "Ident(%I)" id end. Local Ltac2 minus_one (x:premise):premise := match x with | Int n => Int (Int.sub n 1) | _ => x end. Local Ltac2 map_minus_one (li:premise list) : premise list := List.map minus_one li. Ltac2 Type when_cited := [ Evarize | Quantify]. Ltac2 mutable on_cited_vars := Quantify. Ltac2 mutable dont_quantif_unused := true. Local Ltac2 andb := Bool.and. Local Ltac2 negb := Bool.neg. Local Ltac2 orb := Bool.or. Local Ltac2 Type whatToDo := [ ForceQuantif (binder) | ForceEvar(ident) | OptQuantif (binder) | OptEvar(ident) ]. (* Local Ltac2 pr_whattodo () a := match a with ForceQuantif bnd => fprintf "ForceQuantif(%a)" pr_binder bnd | OptQuantif bnd => fprintf "OptQuantif(%a)" pr_binder bnd | ForceEvar id => fprintf "ForceEvar(%I)" id | OptEvar id => fprintf "OptEvar(%I)" id end. *) (* build_premise_type (forall x,y, h1 -> h2 -> forall n,n, h3 -> h4) [2;3] return the "forall ..., (h2 -> h3)" where ... are the variables appearing in (h2 -> h3). *) Local Ltac2 rec build_premise_type (t:constr) (li:int list) (lid:ident list) : constr := match Unsafe.kind t with | Prod bnd t' => let h_premis:ident option := Constr.Binder.name bnd in let typ_premis:constr := Constr.Binder.type bnd in let is_dep := Bool.neg (noccurn 1 t') in if is_dep (* dep product; forall x:T, U. *) then let (whattodo,lid'):(whatToDo*ident list) := match lid, on_cited_vars with | [], Evarize => (OptQuantif(bnd),lid) | [], Quantify => (OptEvar(Option.get h_premis),lid) | id :: lid'' , Quantify => if Ident.equal id (Option.get h_premis) then (ForceQuantif(bnd), lid'') else (OptEvar(Option.get h_premis) , lid) | id :: lid'' , Evarize => if Ident.equal id (Option.get h_premis) then (ForceEvar(Option.get h_premis) , lid'') else (OptQuantif(bnd), lid) end in let res := build_premise_type t' li lid' in match whattodo with | ForceQuantif bnd => make (Prod bnd res) | ForceEvar id => let ename:ident := Fresh.in_goal id in mk_evar ename typ_premis; let ev:constr := make (Var ename) in let ressubst := substnl [ev] 0 res in (* this also performs a pop *) (if (noccurn 1 res) (* andb (default_ignore_unused) the evar will disappear if we ignore it *) then printf "Warning: an evar is created (?%I) but there is no reference to it in goals" ename else ()); ressubst | OptQuantif bnd => if andb (noccurn 1 res) dont_quantif_unused then liftn -1 1 res else make (Prod bnd res) | OptEvar id => if (noccurn 1 res) (* andb (default_ignore_unused) the evar will disappear if we ignore it *) then liftn -1 1 res else let ename:ident := Fresh.in_goal id in mk_evar ename typ_premis; let ev:constr := make (Var ename) in let ressubst := substnl [ev] 0 res in (* this also performs a pop *) ressubst end else (* non dep premise: T -> U *) match li with | [] => invalid_arg "Empty occurence list, please report." | n :: li' => if Int.le n 1 (* either the final premise, or we want to quantify it *) then if List.is_empty li' then if List.is_empty lid then typ_premis (* We found the final premise *) else invalid_arg "the list of variables is too long (or not in the right order?)" else (* We found a dependent premise we want to keep, but not the final one *) let popli' := List.map (fun x => Int.sub x 1) li' in let res := build_premise_type t' popli' lid in make (Prod bnd res) (* we keep the premise *) else (* We found a dependent premise we want to ignore *) let popli := List.map (fun x => Int.sub x 1) li in let res := build_premise_type t' popli lid in if noccurn 1 res (* if premise does NOT occur in result *) then let r := liftn -1 1 res in (* forget premis, pop rels accordingly. *) r else (* this dependent premise is actually needed for typing the result *) invalid_arg "Some other premise occurs in the built type." end | _ => invalid_arg "Not enough products" end. (* Goal True. ltac2:(let t := build_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [1] [ident:(n) ] in printf "res = %t" t). Undo. ltac2:(let t := build_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [1;2] [ident:(n) ] in printf "res = %t" t). Undo. ltac2:(let t := build_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [1;2] [ident:(n); ident:(m) ] in printf "res = %t" t). Undo. ltac2:(let t := build_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [Ident ident:(n) ; Int 1; Int 3] in printf "res = %t" t). Abort. *) (* Local Ltac2 rec assert_premise (t:constr) (li:int list) : unit := *) (* let typ := build_premise_type t li in *) (* Std.assert (Std.AssertType None typ None). *) (* Pure Ltac2 tactics *) Module Ltac2. Ltac2 all_hyps_ident() := List.map (fun (x,_,_) => x) (Control.hyps ()). Ltac2 iter_hyps (tac:ident -> unit) (lh:ident list) := List.iter tac lh. Ltac2 map_all_hyps (tac:'a -> unit) := let all_hyps := all_hyps_ident() in iter_hyps tac all_hyps. Ltac2 map_all_hyps_rev (tac: 'a -> unit) := let all_hyps := List.rev (all_hyps_ident()) in iter_hyps tac all_hyps. Ltac2 then_eachnh_gen (tac1:'a -> unit) (tac2:ident -> unit) (rev:bool) := let hyps_before := all_hyps_ident() in let _ := tac1() in Control.enter (fun () => let hyps_after := all_hyps_ident() in let new_hyps: ident list := List.filter_out (fun id => List.mem Ident.equal id hyps_before) hyps_after in iter_hyps tac2 (if rev then List.rev new_hyps else new_hyps)). Ltac2 then_eachnh (tac1:'a -> unit) (tac2:ident -> unit) := then_eachnh_gen tac1 tac2 false. Ltac2 then_eachnh_rev (tac1:'a -> unit) (tac2:ident -> unit) := then_eachnh_gen tac1 tac2 true. End Ltac2. Local Ltac2 rec assert_premise_type (t:constr) (li:int list) (lid:ident list) (name:ident option) : unit := (* We call the tactic then subst any let ins (created along with evars). *) Ltac2.then_eachnh_rev (fun () => let typ := build_premise_type t li lid in let intro_ptn := Option.map (fun x => (Std.IntroNaming (Std.IntroIdentifier x))) name in Std.assert (Std.AssertType (intro_ptn) typ None)) (fun (h:ident) => match Control.hyp_value h with | None => () | Some _ => Std.subst [h] end). (* Goal forall x y:nat, True. intros x y. (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1;2;3] [] None)). Undo. (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1;2;3] [ident:(n)] None)). Undo. (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1;2;3] [ident:(n); ident:(m)] None)). Undo. (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1; 2; 3] [ident:(n);ident:(p)] None)). Undo. (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1; 2; 3] [ident:(n);ident:(p);ident:(m)] None)). Undo. (* wrong order in variables: n remains in the list after depleting ints *) Fail (ltac2:(assert_premise_type constr:(forall n p m:nat, n<=m -> n n=p -> False) [ 1; 2; 3] [ident:(p); ident:(n)] None)). Abort. *) Local Ltac2 interp_ltac1_int_or_id_list (li:Ltac1.t list) : premise list := List.map (fun x => match Ltac1.to_int x with None => match (Ltac1.to_ident x) with | None => invalid_arg "not an integer nor a ident" | Some id => Ident id end | Some i => Int i end) li. Local Ltac2 interp_ltac1_id_list (lid:Ltac1.t list) : ident list := List.map (fun x => Option.get (Ltac1.to_ident x)) lid. Local Ltac2 interp_ltac1_int_list (li:Ltac1.t list) : int list := List.map (fun x => Option.get (Ltac1.to_int x)) li. Local Ltac2 rec assert_premise_from_ltac1 (h:Ltac1.t) (li:Ltac1.t) (lid:Ltac1.t) (name:Ltac1.t) : unit := let h' := Option.get (Ltac1.to_constr h) in (* if li is not a list, then it means no li has been given, thus []. *) let li' := interp_ltac1_int_list (default [] (Ltac1.to_list li)) in let lid' := interp_ltac1_id_list (default [] (Ltac1.to_list lid)) in (* If name is not recognized it means that no name was given, thus None. *) let name' := Ltac1.to_ident name in let th' := type h' in assert_premise_type th' li' lid' name'. Local Ltac dummy_term := constr:(Prop). Global Tactic Notation "assert" "premise" ne_integer_list_sep(li,"->") "of" constr(h) "with" ne_ident_list_sep(lid,",") "as" ident(newH) := let tac := ltac2:(h li lid newH |- assert_premise_from_ltac1 h li lid newH) in tac h li lid newH. Global Tactic Notation "assert" "premise" ne_integer_list_sep(li,"->") "of" constr(h) "with" ne_ident_list_sep(lid,",") := let tac := ltac2:(h li lid newH |- assert_premise_from_ltac1 h li lid newH) in let newH := dummy_term in tac h li lid newH. Global Tactic Notation "assert" "premise" ne_integer_list_sep(li,"->") "of" constr(h) "as" ident(newH) := let tac := ltac2:(h li lid newH |- assert_premise_from_ltac1 h li lid newH) in let lid := dummy_term in tac h li lid newH. Global Tactic Notation "assert" "premise" ne_integer_list_sep(li,"->") "of" constr(h) := let tac := ltac2:(h li lid newH |- assert_premise_from_ltac1 h li lid newH) in let lid := dummy_term in let newH := dummy_term in tac h li lid newH. Matafou-LibHyps-112b273/LibHyps/Especialize.v000066400000000000000000001202661516654451400207410ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Require Sorting.Mergesort Structures.OrdersEx. From Ltac2 Require Import Option Constr Printf. Import Constr.Unsafe. Local Set Default Proof Mode "Classic". (* Require Import LibHyps.LibHypsDebug. *) (* Utilities *) Local Ltac2 is_dep_prod (t:constr): bool := match kind t with | Prod _ subt => Bool.neg (is_closed subt) | _ => false end. (* ESPECIALIZE INTERNAL DOC *) (* We show here by hand what the especialize tactic does. We start with a hypothesis H of type H: (forall n m:nat, n n<=m -> forall p:nat, p>0 -> p+1 = m+n) Suppose we want: 1. let the user prove that the premise (n <= m) can be proved from the other premise (n < m) and can thus be removed from H 2. let the user prove the premise (p > 0) for a p yet to be determined (evar) and remove both p and (p>0) from H. *) Lemma foo: forall x y : nat, (forall n m:nat, n < m -> n <= m -> forall p:nat, p > 0 -> p+1 = m+n) -> False. Proof. intros x y H. (* - We start from a goal evarEV with no typing constraint. *) let ev1 := open_constr:(_) in assert ev1 as newH. (* then we refine this unknown goal by mimick H until we reach the premise we want to remove: *) intro n. (*or refine (fun (n:nat) => _) *) specialize (H n). intro m. specialize (H m). (* 1 more times, but more automatic *) match type of H with (forall nme:?t, _) => (intro nme) (*refine (fun nme:t => _)*); specialize (H nme) end. (* We want to prove (n<=m) as a consequence of (n 0) *) assert (?p>0) as h'. all:swap 1 2. (* we go on by specializing H with this new goal *) specialize (H h'). (* Now we have finished, we finish refining the unknown goal with H itself. *) exact H. (* Building the new hyp: the specialized version of H. *) (* Now we are left with 2 subgoals and the initial goal where H has been specialized. *) Abort. Lemma foo: forall x y : nat, (forall n m:nat, n < m -> n <= m -> forall p:nat, p >= 0 -> p+1 = m+n) -> True. Proof. intros x y H. (* - We start from a goal evarEV with no typing constraint. *) let ev1 := open_constr:(_) in assert ev1 as newH. (* then we refine this unknown goal by mimick H until we reach the premise we want to remove: *) (* ignore n, m n= 0) as h. 2:{ exact h. } (* Building the new hyp: h itself, that is the premise of H *) { unfold p. apply OrdersEx.Nat_as_OT.le_0_1. } specialize H with (3:=newH). Abort. Local Ltac2 Type directarg := [ Quantif | QuantifIgnore | SubGoal | Evar(ident) ]. Local Ltac2 Type namearg := [ SubGoalAtName(ident) (* make a subgoal with named arg *) | EvarAtName(ident,ident) (* make an evar with the named arg. *) ]. Local Ltac2 Type numarg := [ | SubGoalAtNum(int) (* make a subgoal with arg's number *) | SubGoalUntilNum(int) (* make subgoals with all non dep hyp until nth one. *) | SubGoalAtAll (* make subgoals with all non dep hyp. *) ]. Local Ltac2 pr_numarg () a := match a with | SubGoalAtNum(i) => fprintf "SubGoalAtNum(%i)" i | SubGoalUntilNum(i) => fprintf "SubGoalUntilNum(%i)" i | SubGoalAtAll => fprintf "SubGoalAtAll" end. Local Ltac2 pr_directarg () a := match a with | Quantif => fprintf "Quantif" | QuantifIgnore => fprintf "QuantifIgnore" | SubGoal => fprintf "SubGoal" | Evar(id) => fprintf "Evar(%I)" id end. Local Ltac2 pr_namearg () a := match a with | SubGoalAtName id => fprintf "SubGoalAtName(%I)" id | EvarAtName id1 id2 => fprintf "EvarAtName(%I,%I)" id1 id2 end. (* Goal True. ltac2:(printf "%a" pr_namearg (SubGoalAtName @toto)). ltac2:(printf "%a" (pr_list pr_namearg) ([SubGoalAtName @toto; EvarAtName @titi1 @titi2])). *) Local Ltac2 backtrack (msg:string) := Control.zero (Tactic_failure (Some (fprintf "Backtrack: %s" msg))). Local Ltac2 invalid_arg (msg:string) := Control.throw (Invalid_argument (Some (Message.of_string msg))). Local Ltac2 mk_evar ename typ := let tac := ltac1:(ename typ|- evar (ename:typ)) in tac (Ltac1.of_ident ename) (Ltac1.of_constr typ). Local Ltac2 assert_evar nme := let tac := ltac1:(nme |-let ev1 := open_constr:(_) in assert ev1 as nme) in tac (Ltac1.of_ident nme). Local Ltac2 intro_typed (name:ident) (typ:constr) := let tac := ltac1:(name typ |- refine (fun (name:typ) => _)) in tac (Ltac1.of_ident name) (Ltac1.of_constr typ). Local Ltac2 specialize_id_id (h:ident) (arg:ident) : unit := let newhyp := Control.hyp arg in let hc:constr := Control.hyp h in let special := Unsafe.make (Unsafe.App hc [|newhyp|]) in Std.specialize (special , Std.NoBindings) None. Local Ltac2 specialize_id_cstr (h:ident) (c:constr) : unit := let hc:constr := Control.hyp h in let special := Unsafe.make (Unsafe.App hc [|c|]) in Std.specialize (special , Std.NoBindings) None. (* Local Ltac2 pr_debug (h:ident) (ldirectarg:directarg list) (lnameargs:namearg list) *) (* (lnumargs:numarg list) (n:int) := *) (* let hc := Control.hyp h in *) (* let th := Constr.type hc in *) (* LibHyps.LibHypsDebug.msgs "--------------"; *) (* (* LibHyps.dev.LibHypsDebug.pr_goal(); *) *) (* printf "n = %i ; th = %t" n th; *) (* printf "lnumargs = %a" (pr_list pr_numarg) lnumargs; *) (* printf "lnameargs = %a" (pr_list pr_namearg) lnameargs; *) (* printf "ldirectarg = %a" (pr_list pr_directarg) ldirectarg. *) (* The main function is refine_hd. It interprets all available directargs. The two other functions refine_hd_name and refine_hd_num are applied when no directarg is available. They compute the next directarg and call the main function. n is the last seen dephyp number. *) Local Ltac2 rec refine_hd (only_premis:bool) (h:ident) (ldirectarg:directarg list) (lnameargs:namearg list) (lnumargs:numarg list) (n:int) : unit := (* pr_debug h ldirectarg lnameargs lnumargs n; *) let hc := Control.hyp h in let th := Constr.type hc in let newn := if is_dep_prod th then n else (Int.add n 1) in (* msgc th; *) match Unsafe.kind th with | Prod _ _ => match ldirectarg with | directarg::ldirectarg' => match Unsafe.kind th with | Prod bnd _ => let h_premis:ident option := Constr.Binder.name bnd in let typ_premis := Constr.Binder.type bnd in let intronme:ident := match h_premis with None => let id := Option.map Fresh.in_goal (Ident.of_string "h_premis") in Option.get id | Some idh => idh end in match directarg with | Quantif => intro_typed intronme typ_premis; specialize_id_id h intronme; refine_hd only_premis h ldirectarg' lnameargs lnumargs newn | QuantifIgnore => intro_typed intronme typ_premis; specialize_id_id h intronme; clear $intronme; refine_hd only_premis h ldirectarg' lnameargs lnumargs newn | Evar ename => let ename := Fresh.in_goal ename in mk_evar ename typ_premis; specialize_id_id h ename; subst $ename; refine_hd only_premis h ldirectarg' lnameargs lnumargs newn | SubGoal => let gl := Fresh.in_goal @h in (* this uses base name "h" *) (unshelve (epose (_:$typ_premis) as $gl)) > [ | if only_premis then match ldirectarg' with | _ :: _ => invalid_arg "only one subgoal allowed." | [] => let special := Control.hyp gl in exact $special (* base case: we only create a premise *) end else let special := Control.hyp gl in specialize_id_cstr h special; refine_hd only_premis h ldirectarg' lnameargs lnumargs newn ] end | _ => invalid_arg "Not a product (directarg)" end | [] => (* If this succeeds, never go back here from later backtrack. *) Control.once (fun () => Control.plus (fun() => refine_hd_name only_premis h lnameargs lnumargs n) (fun _ => (* msgs "Backtracking from refine_hd_name "; *) Control.plus (fun () => refine_hd_num only_premis h lnameargs lnumargs n) (* neither matching a namearg nor a numarg, let us generate a Quantif and let refine_hd deal with it. *) (fun _ => (*msgs "Backtracking from refine_hd_num "; *) refine_hd only_premis h [Quantif] lnameargs lnumargs n))) end | _ => (*base case *) match ldirectarg,lnameargs,lnumargs with | [],[],[] => exact $hc | [],[],[SubGoalAtAll] => exact $hc | _ => invalid_arg "Not a product (others)" end end (* Try to match the first namearg with the name of the head product. If yes, apply the namearg (by inserting the corresponding directarg), otherwise backtrack. *) with refine_hd_name (only_premis:bool) (h:ident) (lnameargs:namearg list) (lnumargs:numarg list) (n:int) := let hc:constr := Control.hyp h in let th:constr := Constr.type hc in match lnameargs with | namearg :: lnameargs' => match Unsafe.kind th with | Prod bnd _ => let h_premis := Constr.Binder.name bnd in match namearg with | SubGoalAtName nme => if map_default (Ident.equal nme) false h_premis then refine_hd only_premis h [SubGoal] lnameargs' lnumargs n else backtrack "refine_hd_name: SubGoalAtName" | EvarAtName nme nameevar => if map_default (Ident.equal nme) false h_premis then refine_hd only_premis h [Evar nameevar] lnameargs' lnumargs n else backtrack "refine_hd_name: EvarAtName" end | _ => invalid_arg "Not a product (refine_hd_name)" end | _ => backtrack "refine_hd_name: no namearg" end (* compute the num corresponding to the current hyp (newn), then try to match the first numarg with it. If yes, apply the numarg (by inserting the corresponding directarg), otherwise backtrack. *) with refine_hd_num (only_premis:bool) (h:ident) (lnameargs:namearg list) (lnumargs:numarg list) (n:int) := let hc:constr := Control.hyp h in (* h as a constr *) let th:constr := Constr.type hc in (* type of h as a constr *) let newn := if is_dep_prod th then n else (Int.add n 1) in match lnumargs with | numarg::lnumargs' => match Unsafe.kind th with | Prod _ _ => match numarg with | SubGoalAtNum num => if is_dep_prod th then backtrack "refine_hd_num: SubGoalAtNum, dep" else if Int.le newn num then if Int.equal newn num then refine_hd only_premis h [SubGoal] lnameargs lnumargs' n else backtrack "refine_hd_num: SubGoalAtNum,nodep" else invalid_arg "Did you not order the evar numbers?" | SubGoalUntilNum num => if is_dep_prod th then backtrack "refine_hd_num: SubGoalUntilNum, dep" else if Int.equal newn num then refine_hd only_premis h [SubGoal] lnameargs lnumargs' n else refine_hd only_premis h [SubGoal] lnameargs lnumargs n | SubGoalAtAll => if is_dep_prod th then backtrack "refine_hd_num: SubGoalAtAll, dep" else refine_hd only_premis h [SubGoal] lnameargs lnumargs n end | _ => invalid_arg "Not a product (refine_hd_num)." end | _ => backtrack "refine_hd_num: no numarg" end. (* initialize n to zero. *) Local Ltac2 refine_spec (only_premis:bool) h lnameargs lnumargs := refine_hd only_premis h [] lnameargs lnumargs 0. (* (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_esepec: True. Proof. specialize ex_hyp as H. let ev1 := open_constr:(_) in assert ev1 as hhh;[ ltac2:(refine_spec true (Option.get (Ident.of_string "H")) [EvarAtName @b @b; EvarAtName @x @x; EvarAtName @y @y] [SubGoalAtNum 3;SubGoalAtNum 5]) | ]. *) (* num args should be sorted. *) Local Ltac2 cmp_numarg a b := match a with SubGoalAtNum na => match b with SubGoalAtNum nb => Int.compare na nb | _ => -1 end | _ => -1 end. Local Ltac2 sort_numargs (l: numarg list): numarg list:= List.sort cmp_numarg l. (* TODO:sort the names or work modulo order on names? Or simply avoid infinite loops. TODO: if there is only one "at" and no "with" nor "until", then allow for the subgoal to be kept like an assert. *) (* builds the inital unknown goal, call the refining tactic, end up by replacing h or naming the new hyp. *) (* Precondition: name is already fresh *) Local Ltac2 dest_var (c:constr) : ident := match Unsafe.kind c with | Unsafe.Var x => x | _ => Control.throw (Invalid_argument (Some (Message.of_string "dest_var"))) end. Local Ltac2 espec_gen (h:constr) lnames lnums name (replaceb:bool) := let lnums := sort_numargs lnums in if is_var h then let h := dest_var h in match replaceb with true => assert_evar name > [ (refine_spec false h lnames lnums) | Std.clear [h]; Std.rename [(name, h)] ] | false => assert_evar name > [ (refine_spec false h lnames lnums) | ] end else (* replaceb should be false in this case. *) (let h' := Fresh.in_goal @H in Std.specialize (h , Std.NoBindings) (Some (Std.IntroNaming (Std.IntroIdentifier h'))); assert_evar name > [ (refine_spec false h' lnames lnums) | Std.clear [h'] ]). (* One num (the hypothesis one wants to prove, some args to evarize. *) Local Ltac2 epremis_gen (h:constr) lnames (num:numarg) name := let lnums := sort_numargs [num] in if is_var h then let h := dest_var h in assert_evar name > [ (refine_spec true h lnames lnums) | ] else let h' := Fresh.in_goal @H_temp in Std.specialize (h , Std.NoBindings) (Some (Std.IntroNaming (Std.IntroIdentifier h'))); assert_evar name > [ (refine_spec true h' lnames lnums) | Std.clear [h'] ]. Local Ltac2 sgatnum_from_lint (li:int list): numarg list := List.map (fun i => SubGoalAtNum i) li. Local Ltac2 evatname_from_lid (li:ident list): namearg list := List.map (fun i => EvarAtName i i) li. (* FIXME li should really be a single int *) Local Ltac2 sguntilnum_from_lid (li:int list): numarg list := List.map (fun i => SubGoalUntilNum i) li. Local Ltac2 espec_at_using_ltac1_gen (h:constr) (li:int list) (occsevar:ident list) (newH: ident) (replaceb:bool):unit := if Bool.and (Bool.neg (is_var h)) replaceb then Control.zero (Tactic_failure (Some (fprintf "You must provide a name with 'as'."))) else espec_gen h (evatname_from_lid occsevar) (sgatnum_from_lint li) newH replaceb. Local Ltac2 espec_until_using_ltac1_gen (h:constr) (li:int list) (occsevar:ident list) (newH: ident) (replaceb:bool) (atAll:bool):unit := (* FIXME: we should also refuse when a section variables is given. *) if Bool.and (Bool.neg (is_var h)) replaceb then Control.zero (Tactic_failure (Some (fprintf "You must provide a name with 'as'."))) else let c1 := if atAll then [SubGoalAtAll] else sguntilnum_from_lid li in espec_gen h (evatname_from_lid occsevar) c1 newH replaceb. (* Create a new subgoal, based ont the ith dependent premise of h. named newH. Creating occsevar on the fly.*) Local Ltac2 eprem_at_using_ltac1_gen (h:constr) (i:int) (occsevar:ident list) (newH: ident):unit := let lid' := evatname_from_lid occsevar in epremis_gen h lid' (SubGoalAtNum i) newH. Local Ltac2 interp_ltac1_id_list (lid:Ltac1.t list) : ident list := List.map (fun x => Option.get (Ltac1.to_ident x)) lid. Local Ltac2 interp_ltac1_int_list (li:Ltac1.t list) : int list := List.map (fun x => Option.get (Ltac1.to_int x)) li. Local Ltac2 interp_ltac1_hyp (h:Ltac1.t) : constr := Option.get (Ltac1.to_constr h). Local Ltac2 default := Option.default. (* call Ltac2'especialize on argscoming from Ltac1 notation *) Local Ltac2 call_specialize_ltac2_gen (h:Ltac1.t) (li:Ltac1.t) levars newh (replaceb:bool) := let li2 := interp_ltac1_int_list (default [] (Ltac1.to_list li)) in let levar2 := interp_ltac1_id_list (default [] (Ltac1.to_list levars)) in let nme := Option.get (Ltac1.to_ident newh) in espec_at_using_ltac1_gen (interp_ltac1_hyp h) li2 levar2 nme replaceb. (* call Ltac2'especialize on argscoming from Ltac1 notation *) Local Ltac2 call_specialize_until_ltac2_gen (h:Ltac1.t) li levars newh replaceb (atAll:bool) := let li2 := interp_ltac1_int_list (default [] (Ltac1.to_list li)) in let levar2 := interp_ltac1_id_list (default [] (Ltac1.to_list levars)) in if Int.gt (List.length li2) 1 then Control.zero (Tactic_failure (Some (fprintf "In 'specialize X until I', I must be a singleton."))) else let nme := Option.get (Ltac1.to_ident newh) in espec_until_using_ltac1_gen (interp_ltac1_hyp h) li2 levar2 nme replaceb atAll. (* Local Ltac2 call_premise_ltac2_gen (h:Ltac1.t) (i:Ltac1.t) levars (newh:Ltac1.t) := let i2 := Option.get (Ltac1.to_int i) in let levar2 := interp_ltac1_id_list (default [] (Ltac1.to_list levars)) in match Ltac1.to_ident newh with | None => Control.zero (Tactic_failure (Some (fprintf "You must provide a name with 'as'."))) | Some newh2 => eprem_at_using_ltac1_gen (interp_ltac1_hyp h) i2 levar2 newh2 end.*) (* Create a new subgoal, based ont the ith dependent premise of h, named newh, creating levars on the fly.. *) Local Ltac2 call_premise_ltac2_gen (h:Ltac1.t) (i:Ltac1.t) levars (newh:Ltac1.t) := let i2 := Option.get (Ltac1.to_int i) in let levar2 := interp_ltac1_id_list (default [] (Ltac1.to_list levars)) in let newh2 := Option.default (Fresh.in_goal @H) (Ltac1.to_ident newh) in eprem_at_using_ltac1_gen (interp_ltac1_hyp h) i2 levar2 newh2. Ltac gen_hyp_name h := match goal with | |- _ => let _ := is_var h in fresh h "_spec_" | |- _ => fresh "H_spec_" end. Ltac dummy_term := constr:(Prop). (* TODO only one integer, + evars + as => create a subgoal that wioll be added as hyp, h is not specialized. Since a new hyp is created, the "as" field is mandatory. *) Tactic Notation "assert" "premise" int(n) "of" constr(h) "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in tac h n levars newH. Tactic Notation "assert" "premise" int(n) "of" constr(h) "as" ident(newH) := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in let levars := dummy_term in (* something that is not a list. *) tac h n levars newH. (* Explicitely asking for a autogen name, this is discouraged unless you use another naming mechanism e.g. LibHyps's "/n" tactical. *) Tactic Notation "assert" "premise" int(n) "of" constr(h) "with" ne_ident_list_sep(levars,",") "as" "?" := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in let newH := fresh "HHH" in tac h n levars newH. Tactic Notation "assert" "premise" int(n) "of" constr(h) "as" "?" := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in let levars := dummy_term in (* something that is not a list. *) let newH := fresh "HHH" in tac h n levars newH. (* VERSION WITHOUT "AS". Should it be forbidden? *) (* TODO only one integer, + evars + as => create a subgoal that wioll be added as hyp, h is not specialized *) Tactic Notation "assert" "premise" int(n) "of" constr(h) "with" ne_ident_list_sep(levars,",") := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in let newH := dummy_term in tac h n levars newH. Tactic Notation "assert" "premise" int(n) "of" constr(h) := let tac := ltac2:(h n levars newH |- call_premise_ltac2_gen h n levars newH) in let levars := dummy_term in (* something that is not a list. *) let newH := dummy_term in tac h n levars newH. (* Ltac2 foo () := let h' := Fresh.in_goal @H in printf "%I" h'. Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Require Import Arith ZArith List. Lemma test_espec_namings: forall n:nat, (forall m:nat, eq_one n -> eq_one 1 -> eq_one m -> False) -> True. Proof. intros n h_premis. specialize Nat.quadmul_le_squareadd as hle. Check Nat.quadmul_le_squareadd. assert premise 1 of Nat.quadmul_le_squareadd with a as h. { apply OrdersEx.Nat_as_OT.le_0_1. } Undo 4. assert premise 1 of Nat.quadmul_le_squareadd with a as ?. { apply OrdersEx.Nat_as_OT.le_0_1. } Undo 4. assert premise 1 of Nat.quadmul_le_squareadd as h. { apply OrdersEx.Nat_as_OT.le_0_l. } Undo 4. assert premise 1 of Nat.quadmul_le_squareadd as ?. { apply OrdersEx.Nat_as_OT.le_0_l. } Undo 4. *) (* ESPECIALIZE AT *) (* ********************* *) Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" ne_integer_list_sep(li,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in tac h li levars newH. Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in tac h li levars newH. Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" ne_integer_list_sep(li,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let newH := gen_hyp_name h in tac h li levars ident:(newH). Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let newH := gen_hyp_name h in tac h li levars ident:(newH). (* ********************* *) Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH true) in let dummy_id := gen_hyp_name h in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" ne_integer_list_sep(li,",") := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH true) in let dummy_id := gen_hyp_name h in tac h li levars ident:(dummy_id). (* ********************* *) Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let li := dummy_term in (* something that is not a list. *) tac h li levars newH. Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let li := dummy_term in (* something that is not a list. *) let newH := gen_hyp_name h in tac h li levars ident:(newH). (* ********************* *) Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let levars := dummy_term in (* something that is not a list. *) tac h li levars newH. (* ********************* *) Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let levars := dummy_term in (* something that is not a list. *) let newH := gen_hyp_name h in tac h li levars ident:(newH). (* ********************* *) Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH true) in let li := dummy_term in (* something that is not a list. *) let dummy_id := gen_hyp_name h in tac h li levars ident:(dummy_id). (* ********************* *) Tactic Notation "especialize" constr(h) "at" ne_integer_list_sep(li,",") := let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH true) in let levars := dummy_term in (* something that is not a list. *) let dummy_id := gen_hyp_name h in tac h li levars ident:(dummy_id). (* ESPECIALIZE UNTIL *) (* ********************* *) (* at * is actually a special case of until *) Tactic Notation "especialize" constr(h) "at" "*" "with" ne_ident_list_sep(levars,",") := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true true) in let dummy_id := gen_hyp_name h in let li := dummy_term in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" "*" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true true) in let dummy_id := gen_hyp_name h in let li := dummy_term in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "at" "*" "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false true) in let li := dummy_term in tac h li levars newH. Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" "*" "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false true) in let li := dummy_term in tac h li levars newH. Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "at" "*" "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false true) in let li := dummy_term in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "at" "*" "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false true) in let levars := dummy_term in (* something that is not a list. *) let dummy_id := gen_hyp_name h in let li := dummy_term in tac h li levars newH. Tactic Notation "especialize" constr(h) "at" "*" "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false true) in let levars := dummy_term in (* something that is not a list. *) let dummy_id := gen_hyp_name h in let li := dummy_term in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "at" "*" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true true) in let levars := dummy_term in (* something that is not a list. *) let dummy_id := gen_hyp_name h in let li := dummy_term in tac h li levars ident:(dummy_id). Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in tac h li levars newH. (* Strangely putting "with" before "until" is not recognized at parsing. Probably because "until" is not a keyword. Error: Syntax error: [ltac_use_default] expected after [tactic] (in [tactic_command]). *) Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "until" ne_integer_list_sep(li,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in tac h li levars newH. Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in tac h li levars newH. Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in let nme := gen_hyp_name h in tac h li levars ident:(nme). Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "until" ne_integer_list_sep(li,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in let nme := gen_hyp_name h in tac h li levars ident:(nme). (* "with" must be first, probably because it is not a keyword: *) Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "with" ne_ident_list_sep(levars,",") := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true false) in let nme := gen_hyp_name h in tac h li levars ident:(nme). (* "with" must be first, probably because it is not a keyword: *) Tactic Notation "especialize" constr(h) "with" ne_ident_list_sep(levars,",") "until" ne_integer_list_sep(li,",") := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true false) in let nme := gen_hyp_name h in tac h li levars ident:(nme). (* "with" must be first, probably because it is not a keyword: *) Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "as" ident(newH) := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in let levars := dummy_term in tac h li levars ident:(newH). (* "with" must be first, probably because it is not a keyword: *) Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") "as" "?" := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH false false) in let nme := gen_hyp_name h in let levars := dummy_term in tac h li levars ident:(nme). (* "with" must be first, probably because it is not a keyword: *) Tactic Notation "especialize" constr(h) "until" ne_integer_list_sep(li,",") := let tac := ltac2:(h li levars newH |- call_specialize_until_ltac2_gen h li levars newH true false) in let nme := gen_hyp_name h in let levars := dummy_term in tac h li levars ident:(nme). (* (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_espec_namings: forall n:nat, (eq_one n -> eq_one 1 -> False) -> True. Proof. intros n h_eqone. specialize min_l as hhh. ltac2:(espec_at_using_ltac1_gen constr:(hhh) [1] [@n; @m] @hhh' false). let tac := ltac2:(hhh |- call_specialize_ltac2_gen hhh [1] [@n; @m] hhh' false) in tac hhh. let tac := ltac2:(h li levars newH |- call_specialize_ltac2_gen h li levars newH false) in let newH := gen_hyp_name hhh in tac hhh li levars ident:(newH). especialize hhh with n,m at 1 as ?. especialize min_l with n,m at 1 as ?. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. ltac2:(espec_at_using_ltac1_gen constr:(H) [2;4] [@m; @p] @toto false). Undo 1. ltac2:(espec_at_using_ltac1_gen constr:(H) [2;4] [@m; @p] @toto true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [] [@m] @toto false true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [] [@m] @toto true true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [3] [@m] @toto false false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [3] [@m] @toto true false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [4] [@n ; @m] @toto false false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [4] [@n ; @m] @toto true false). Undo 1. *) (* TEST *) (* Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_espec_namings: forall n:nat, (forall m:nat, eq_one n -> eq_one 1 -> eq_one m -> False) -> True. Proof. intros n h_eqone. ltac2: prove_premise h_eqone with m at 3 as hhhh. { admit. } Undo 4. prove_premise h_eqone at 3 with m as hhhh. { admit. } Undo 4. prove_premise h_eqone at 3 as hhh. { admit. } Undo 4. prove_premise h_eqone with m at 3. { admit. } Undo 4. prove_premise h_eqone at 3 with m. { admit. } Undo 4. prove_premise h_eqone at 3. { admit. } Undo 4. *) (* TEST *) (* (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. ltac2:(espec_gen constr:(H) [EvarAtName @m @m] [SubGoalAtAll] @toto false). Undo 1. ltac2:(espec_gen constr:(H) [EvarAtName @m @m] [SubGoalAtAll] @toto true). Undo 1. ltac2:(espec_gen constr:(H) [EvarAtName @m @m] [SubGoalUntilNum 3] @toto false). 4:let ttoto := type of toto in match ttoto with | nat -> forall p : nat, p > 2 -> p > 1 -> hidden_product => idtac end. Undo 2. ltac2:(espec_gen constr:(H) [EvarAtName @m @m] [SubGoalUntilNum 3] @toto true). Undo 1. ltac2:(espec_gen constr:(H) [EvarAtName @m @m] [SubGoalAtAll] @toto false). Undo 1. ltac2:(espec_gen constr:(H) [EvarAtName @n @n; EvarAtName @m @m] [SubGoalAtNum 4] @toto false). Undo 1. ltac2:(espec_gen constr:(H) [EvarAtName @n @n; EvarAtName @m @m] [SubGoalAtNum 4] @toto true). Undo 1. ltac2:(epremis_gen constr:(H) [EvarAtName @m @m] [SubGoalAtAll] @toto). 2:let ttoto := type of toto in match ttoto with | (forall n : nat, nat -> n < _) => idtac end. Undo 2. ltac2:(epremis_gen constr:(H) [EvarAtName @m @m] [SubGoalUntilNum 3] @toto). 2:{ Undo 1. ltac2:(epremis_gen constr:(H) [EvarAtName @m @m] [SubGoalUntilNum 3] @toto true). Undo 1. ltac2:(epremis_gen constr:(H) [EvarAtName @m @m] [SubGoalAtAll] @toto false). Undo 1. ltac2:(epremis_gen constr:(H) [EvarAtName @n @n; EvarAtName @m @m] [SubGoalAtNum 4] @toto false). Undo 1. ltac2:(epremis_gen constr:(H) [EvarAtName @n @n; EvarAtName @m @m] [SubGoalAtNum 4] @toto true). Undo 1. *) (* Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_espec_namings: forall n:nat, (forall m:nat, eq_one n -> eq_one 1 -> eq_one m -> False) -> True. Proof. intros n h_eqone. prove_premise h_eqone with m at 3 as h. { admit. } Undo 4. prove_premise h_eqone at 3 as h. { admit. } Undo 4. especialize h_eqone with m at 3. { admit. } Undo 4. specialize h_eqone with (1:=h). prove_premise h_eqone with m at 1 as h. { admit. } specialize h_eqone with (1:=h). *) (* (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. especialize H with m,p at * as toto. Undo 1. especialize H with m,p until 3 as toto. Undo. (* evar names must be given in order. *) Fail especialize H with p,m at 2,4 as toto. ltac2:(espec_at_using_ltac1_gen constr:(H) [2;4] [@m; @p] @toto false). Undo 1. ltac2:(espec_at_using_ltac1_gen constr:(H) [2;4] [@m; @p] @toto true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [] [@m] @toto false true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [] [@m] @toto true true). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [3] [@m] @toto false false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [3] [@m] @toto true false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [4] [@n ; @m] @toto false false). Undo 1. ltac2:(espec_until_using_ltac1_gen constr:(H) [4] [@n ; @m] @toto true false). Undo 1. *) (* Experimenting a small set of tactic to manipulate a hyp: *) (* Ltac quantify H := match type of H with (forall x:?t, _) => refine (fun (x:t) => _); specialize (H x) end. Ltac evary H := match type of H with (forall x:?t, _) => evar (x:t); specialize (H x);subst x end. Ltac goaly H := match type of H with (forall x:?t, _) => [> assert (x:t); [ | specialize (H x)]] end. Ltac stopy H := exact H. Ltac start name := let ev1 := open_constr:(_) in assert ev1 as name. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p+m=n) -> False. Proof. intros x y H. start newH. quantify H. quantify H. quantify H. quantify H. goaly H. { now apply PeanoNat.Nat.lt_le_incl. } stopy H. Abort. *) (* (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Lemma foo: forall x y n m p :nat, (forall (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y n m p H. especialize H at *;[ | | | | | ]. 5: match goal with H1 : n < m , H2 : n <= m , H3 : p > 0 , H4 : p > 2 |- _ => idtac end. Abort. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. Abort. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_esepec: True. Proof. (* specialize ex_hyp as h. *) (* especialize ex_hyp at 2 as h. *) especialize ex_hyp at 3 with b,x,y as h;[ .. | match type of h with eq_one 1 -> eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. Abort. Lemma test_espec_namings: forall n:nat, (eq_one n -> eq_one 1 -> False) -> True. Proof. intros n h_eqone. especialize min_l with n,m at 1 as ?. (* especialize PeanOant.Nat.quadmul_le_squareadd with a at 1 as hh : h. *) especialize PeanoNat.Nat.quadmul_le_squareadd with a at 1 as hh. { apply le_n. } specialize min_l as hhh. especialize hhh with n,m at 1 as ?. especialize min_l with n,m at 1 as ?. { apply (le_n O). } especialize h_eqone at 2 as h1. { reflexivity. } unfold eq_one in min_l_spec_. (* 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. *) Matafou-LibHyps-112b273/LibHyps/LibHyps.v000066400000000000000000000100711516654451400200460ustar00rootroot00000000000000(* 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.Especialize. Require Export LibHyps.AssertPremise. Require Export LibHyps.LibHypsTactics. (* Some usual tactics one may want to use on new hyps. *) Ltac rename_or_revert H := autorename_strict H + generalize dependent H. (* 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 | generalize dependent 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. (* TACTIC NOTATIONS *) (* This exports the "tac ; { } ." syntax for then_eachnh. *) 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). Tactic Notation (at level 4) tactic4(Tac) "/" "g" := Tac ; { move_up_types }. Tactic Notation (at level 4) "/" "g" := (onAllHyps move_up_types). 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) ; (onAllHyps move_up_types) ). 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. Matafou-LibHyps-112b273/LibHyps/LibHypsDebug.v000066400000000000000000000037221516654451400210220ustar00rootroot00000000000000Require Import Ltac2.Ltac2. From Ltac2 Require Import Option Constr Printf. (* debug *) (* Require LibHyps.LibHypsTactics. Module Prgoal_Notation. Ltac pr_goal := match goal with |- ?g => let allh := LibHyps.TacNewHyps.harvest_hyps LibHyps.TacNewHyps.revert_clearbody_all in (* let allh := all_hyps in *) idtac "GOAL: " allh " ⊢ " g end. End Prgoal_Notation. *) Ltac2 tag_info s := (String.concat "" [ ""; s; "" ]). Ltac2 tag_msg m := Message.concat (Message.concat (Message.of_string "") m) (Message.of_string ""). Ltac2 str_to_msg s := tag_msg (Message.of_string s). Ltac2 int_to_msg i := tag_msg (Message.of_int i). Ltac2 id_to_msg id := tag_msg (Message.of_ident id). Ltac2 constr_to_msg c := tag_msg (Message.of_constr c). Ltac2 msgm m := Message.print (tag_msg m). Ltac2 msgs s := Message.print (str_to_msg s). Ltac2 msgi i := Message.print (int_to_msg i). Ltac2 msgc c := Message.print (constr_to_msg c). Ltac2 msgid id := Message.print (id_to_msg id). Ltac2 pr_list (pr: unit -> 'a -> message) () (l: 'a list) : message := let rec pr_list_ () (l: 'a list) := match l with | [] => fprintf "" | [e] => fprintf "%a" pr e | e::l' => fprintf "%a , %a" pr e pr_list_ l' end in fprintf "[ %a ]" pr_list_ l. Ltac2 pr_binder () (b:binder):message := let nme:ident option := Binder.name b in let typ:constr := Binder.type b in fprintf "(%I:%t)" (Option.get nme) typ. Ltac2 pr_string () (s:string): message := fprintf "%s" s. Ltac2 pr_ident () (id:ident): message := fprintf "%I" id. Ltac2 pr_bool () (b:bool): message := fprintf "%s" (if b then "true" else "false"). Ltac2 pr_goal() := let l := Control.hyps() in printf " Goal:"; List.iter (fun (nme,_,typ) => printf "%I : %t" nme typ) l; printf "⊢ %t" (Control.goal()); printf "". Ltac2 pr_acc () (acc:string list) := fprintf "[%a]" (pr_list pr_string) acc. Matafou-LibHyps-112b273/LibHyps/LibHypsNaming.v000066400000000000000000000627431516654451400212150ustar00rootroot00000000000000(* 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 a tactic "autorename h" (and "autorename_strict h") that automatically rename hypothesis h following a systematic, but customizable heuristic. Comments welcome. *) Require Import Arith ZArith List. Require LibHyps.TacNewHyps. (* Import ListNotations. *) (* Local Open Scope list. *) Require Import Ltac2.Ltac2. From Ltac2 Require Import Option Constr Printf. Import Constr.Unsafe. Local Set Default Proof Mode "Classic". (* Require Import LibHyps.LibHypsDebug. *) Local Ltac2 backtrack (msg:string) := Control.zero (Tactic_failure (Some (fprintf "Backtrack: %s" msg))). Local Ltac2 control_try tac := Control.plus tac (fun _ => ()). (* Comment this and the Z-dependent lines below if you don't want ZArith to be loaded *) Require Import ZArith. Ltac2 decr (n:int):int := if Int.equal n 0 then 0 else Int.sub n 1. Ltac2 incr (n:int):int := Int.add n 1. Ltac2 Type rename_directive := [ String(string) | Rename(constr) | RenameN(int,constr) ]. Ltac2 Type rename_directives := rename_directive list. (* For debugging *) Module Debug. Ltac2 pr_directive () (d:rename_directive) := match d with String s => fprintf "%s" s | Rename c => fprintf "%t" c | RenameN i c => fprintf "N(%i,%t)" i c end. End Debug. Ltac2 Type hypnames := string list. (** 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. *) Ltac2 mutable rename_depth := 3. (* The pretty printing of numerical values is by default 1, 2... Set this to true (Ltac2 Set numerical_sufs := true) to have 1z, 1n or 1N depending of the type nat, Z or N. *) Ltac2 mutable numerical_sufx := false. (* Whether autorename should add a "_" at the end of every hypothesis name *) Ltac2 mutable add_suffix := true. (* Whether autornename should add "h_" at the beginniong of each hypothesis name *) Ltac2 mutable add_prefix := true. (** Default prefix for hypothesis names. *) Ltac2 default_prefix():string := "h". (** A few special default chunks, for special cases in the naming heuristic. *) Ltac2 impl_prefix() := "impl". Ltac2 forall_prefix() := "all". Ltac2 exists_prefix() := "ex". (** ** The custom renaming tactic This is the customizable naming tactic that the user should REDEFINE along his development. See below 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. *) #[warnings="-ltac2-unused-variable"] Ltac2 mutable rename_hyp (stop:int) (th:constr): rename_directives := backtrack "rename_hyp". (* Typical use, in increasing order of complexity, approximatively equivalent to the decreasing order of interest. *) (** << From Stdlib Require Import Sorting.SetoidList. Ltac2 rename_hyp_2 n th := match! th with | true <> false => [String "tNEQf"] | true = false => [String "tEQf"] end. Ltac2 rename_hyp_3 n th := match! th with | List.In ?e ?l => [String "lst_in" ; RecRename n e ; RecRename 0 l] | InA _ ?e ?l => [String "inA" ; RecRename n e ; RecRename 0 l ] | @StronglySorted _ ?ord ?l => [ String"strgSorted" ; RecRename (Int.add 2 n) l] | @Forall _ ?p ?x => [String "lst_forall" ; RecRename n p ; RecRename n x] | @Forall2 _ _ ?p ?x ?y => [String "_lst_forall2" ; RecRename n p ; RecRename n x; RecRename n y] | NoDupA _ ?l => [String "_NoDupA" ; RecRename n l ] | NoDup _ ?l => [String "_NoDup" ; RecRename n l ] | _ => rename_hyp_2 n th end. Ltac2 Set rename_hyp := rename_hyp_3. >> *) (* This one is similar but for internal use *) #[global,warnings="-ltac2-unused-variable"] Ltac2 mutable rename_hyp_default (n:int) (th:constr): rename_directives := backtrack "rename_hyp_default". Module Ltac2. (* from [ "foo" ; "bar" ; "oof" ] to "h_oof_bar_foo_". Note the reversing of the list *) Ltac2 build_name_gen (sep:string) (prefx:bool) (suffx:bool) (l:string list) := let l := if prefx then (default_prefix()::l) else l in (String.app (String.concat sep l) (if suffx then "_" else "")). Ltac2 build_name (l:string list): string := build_name_gen "_" add_prefix add_suffix (List.rev l). Ltac2 string_of_int (i:int) := Message.to_string (Message.of_int i). Ltac2 string_forall (p:char -> bool) (s:string) : bool := let rec check i := if Int.ge i (String.length s) then true else if p (String.get s i) then check (Int.add 1 i) else false in check 0. Ltac2 codepercent():int := (Char.to_int (String.get "%" 0)). Ltac2 code0() := Char.to_int (String.get "0" 0). Ltac2 code9() := Char.to_int (String.get "9" 0). Ltac2 is_digit (c:char): bool := let code := Char.to_int c in Bool.and (Int.le (code0()) code) (Int.le code (code9())). Ltac2 string_first (p:char -> bool) (s:string) : int := let lgth := String.length s in let rec count i := if Int.ge i lgth then i else if p (String.get s i) then i else count (Int.add 1 i) in count 0. Ltac2 Eval (string_first (fun c => Int.equal (Char.to_int c) (codepercent())) "xxxcc"). Ltac2 string_shorten_percent (s:string) : string := let i := string_first (fun c => Int.equal (Char.to_int c) (codepercent())) s in String.sub s 0 i. (** 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 *) (* FIXME: this relies on printf to build a string from a constr in nat, Z and N. It feels wrong. *) Ltac2 build_numerical_name (t:constr):string := let s := Message.to_string (fprintf "%t" t) in let s := string_shorten_percent s in (* remove trailing "%scope" *) if string_forall is_digit s then if Bool.neg numerical_sufx then s else let typ := Constr.type t in match! typ with | Z => String.app s "z" | nat => String.app s "n" | N => String.app s "N" end else backtrack "numerical_names_nosufx". (* FIXME: find something better to detect implicits!! *) (* Determines the number of non "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. *) Ltac2 count_impl th := (* match Unsafe.kind th with | App _ args => Array.length args | _ => 0 end. *) match Unsafe.kind th with | App _ _ => lazy_match! th with | (?z _ _ _ _ _ _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ _ _ _ i j k)) in 3 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ _ _ h i j k)) in 4 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ _ g h i j k)) in 5 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ _ f g h i j k)) in 6 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ _ e f g h i j k)) in 7 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ _ d e f g h i j k)) in 8 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ _ c d e f g h i j k)) in 9 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z _ b c d e f g h i j k)) in 10 | _ => let _ := constr:(fun a b c d e f g h i j k => ($z a b c d e f g h i j k , $z a b c d e f g h i j k)) in 11 end | (?z _ _ _ _ _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ _ _ _ i j k)) in 3 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ _ _ h i j k)) in 4 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ _ g h i j k)) in 5 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ _ f g h i j k)) in 6 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ _ e f g h i j k)) in 7 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ _ d e f g h i j k)) in 8 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z _ c d e f g h i j k)) in 9 | _ => let _ := constr:(fun b c d e f g h i j k => ($z b c d e f g h i j k , $z b c d e f g h i j k)) in 10 end | (?z _ _ _ _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ _ _ _ i j k)) in 3 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ _ _ h i j k)) in 4 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ _ g h i j k)) in 5 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ _ f g h i j k)) in 6 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ _ e f g h i j k)) in 7 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z _ d e f g h i j k)) in 8 | _ => let _ := constr:(fun c d e f g h i j k => ($z c d e f g h i j k , $z c d e f g h i j k)) in 9 end | (?z _ _ _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ _ _ _ i j k)) in 3 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ _ _ h i j k)) in 4 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ _ g h i j k)) in 5 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ _ f g h i j k)) in 6 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z _ e f g h i j k)) in 7 | _ => let _ := constr:(fun d e f g h i j k => ($z d e f g h i j k , $z d e f g h i j k)) in 8 end | (?z _ _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ _ _ _ i j k)) in 3 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ _ _ h i j k)) in 4 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ _ g h i j k)) in 5 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z _ f g h i j k)) in 6 | _ => let _ := constr:(fun e f g h i j k => ($z e f g h i j k , $z e f g h i j k)) in 7 end | (?z _ _ _ _ _ _) => match! th with | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z _ _ _ _ _ k)) in 1 | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z _ _ _ _ j k)) in 2 | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z _ _ _ i j k)) in 3 | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z _ _ h i j k)) in 4 | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z _ g h i j k)) in 5 | _ => let _ := constr:(fun f g h i j k => ($z f g h i j k , $z f g h i j k)) in 6 end | (?z _ _ _ _ _) => match! th with | _ => let _ := constr:(fun g h i j k => ($z g h i j k , $z _ _ _ _ k)) in 1 | _ => let _ := constr:(fun g h i j k => ($z g h i j k , $z _ _ _ j k)) in 2 | _ => let _ := constr:(fun g h i j k => ($z g h i j k , $z _ _ i j k)) in 3 | _ => let _ := constr:(fun g h i j k => ($z g h i j k , $z _ h i j k)) in 4 | _ => let _ := constr:(fun g h i j k => ($z g h i j k , $z g h i j k)) in 5 end | (?z _ _ _ _) => match! th with | _ => let _ := constr:(fun h i j k => ($z h i j k , $z _ _ _ k)) in 1 | _ => let _ := constr:(fun h i j k => ($z h i j k , $z _ _ j k)) in 2 | _ => let _ := constr:(fun h i j k => ($z h i j k , $z _ i j k)) in 3 | _ => let _ := constr:(fun h i j k => ($z h i j k , $z h i j k)) in 4 end | (?z _ _ _) => match! th with | _ => let _ := constr:(fun a b c => ($z a b c, $z _ _ c)) in 1 | _ => let _ := constr:(fun a b c => ($z a b c, $z _ b c)) in 2 | _ => let _ := constr:(fun a b c => ($z a b c, $z a b c)) in 3 end | (?z _ _) => match! th with | _ => let _ := constr:(fun a b => ($z a b, $z _ b)) in 1 | _ => let _ := constr:(fun a b => ($z a b, $z a b)) in 2 end | (?z _) => match! th with | _ => let _ := constr:(fun b => ($z b, $z _)) in 0 | _ => let _ := constr:(fun b => ($z b, $z b)) in 1 end end | _ => 0 end. Ltac2 arobase():char := (Char.of_int 64). (** Build a chunk from a simple term: either a number or a freshable term. *) Ltac2 box_name t : string := (* Hackish? *) let s:string := Message.to_string (fprintf "%t" t) in let s := if Char.equal (String.get s 0) (arobase()) then String.sub s 1 (Int.sub (String.length s) 1) else s in match Ident.of_string s with | Some _ => s | None => match Unsafe.kind t with | Unsafe.Constant cstt _ => let id:ident := List.last (Env.path (Std.ConstRef cstt)) in Ident.to_string id | Unsafe.Var id => Ident.to_string id | Unsafe.Ind _ _ => (* printf "IND: %t" t; *) let s:string := Message.to_string (fprintf "%t" t) in let s := if Char.equal (String.get s 0) (arobase()) then String.sub s 1 (Int.sub (String.length s) 1) else s in s | _ => build_numerical_name t end end. Local Ltac2 is_dep_prod (t:constr): bool := match kind t with | Prod _ subt => Bool.neg (is_closed subt) | _ => false end. Ltac2 is_hyp (id:ident) := let hyps := Control.hyps () in List.exist (fun (x,_,_) => Ident.equal id x) hyps. (** 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 ignored as implicits. *) Ltac2 rec rename_app (nonimpl:int) (stop:int) (acc:string list ref) th: unit := Control.once_plus (fun () => let s := box_name th in Ref.set acc (s:: Ref.get acc)) (fun _ => match Unsafe.kind th with | App f args => (* control_try? *) (let fun_name:string := box_name f in Ref.set acc (fun_name:: Ref.get acc)); let newstop:int := Int.sub stop 1 in let nonimplicitsargs := Array.sub args (Int.sub (Array.length args) nonimpl) nonimpl in Array.iter (fun arg => (fallback_rename_hyp newstop acc arg)) nonimplicitsargs | _ => control_try (fun() => Ref.set acc (box_name th :: Ref.get acc)) 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 rename_hyp_chained_quantifs stop (acc:string list ref) (th:constr) : unit := let _newstop := Int.sub stop 1 in match Unsafe.kind th with | Prod bnd subth => if is_dep_prod th then let nme:ident := Option.get(Binder.name bnd) in let typ := Binder.type bnd in (* If there is already a hyp named nme, we rename it so that the 'in_context nme ...' below does not fail. We could rename the other way around but we prefer keeping the name found in the binder. *) (if is_hyp nme then Std.rename [(nme , Fresh.in_goal nme)] else ()) ; (* Ref.set acc (Ident.to_string nme :: Ref.get acc); *) let tac_under_binder := fun () => let nme_c:constr := Unsafe.make (Var(nme)) in let subth' := Constr.Unsafe.substnl [nme_c] 0 subth in rename_hyp_chained_quantifs stop acc subth' in let _ := in_context nme typ tac_under_binder in () else rename_hyp_chained_quantifs stop acc subth | _ => fallback_rename_hyp stop acc th end with fallback_rename_hyp_quantif stop (acc:string list ref) (th:constr) : unit := let newstop := Int.sub stop 1 in match Unsafe.kind th with | Prod bnd subth => if is_dep_prod th then let nme:ident := Option.get(Binder.name bnd) in let typ := Binder.type bnd in (* If there is already a hyp named nme, we rename it so that the 'in_context nme ...' below does not fail. We could rename the other way around but we prefer keeping the name found in the binder. *) (if is_hyp nme then Std.rename [(nme , Fresh.in_goal nme)] else ()) ; Ref.set acc ((*Ident.to_string nme ::*) forall_prefix() :: Ref.get acc); let tac_under_binder := fun () => let nme_c:constr := Unsafe.make (Var(nme)) in let subth' := Constr.Unsafe.substnl [nme_c] 0 subth in rename_hyp_chained_quantifs newstop acc subth' in let _ := in_context nme typ tac_under_binder in () else (Ref.set acc (impl_prefix() :: Ref.get acc); rename_hyp_chained_quantifs newstop acc subth) | App f args => match Unsafe.kind f, Unsafe.kind constr:(@Init.Logic.ex) with | Ind ind _, Ind ind' _ => if Ind.equal ind ind' then ( Ref.set acc ((*Ident.to_string a ::*) exists_prefix() :: Ref.get acc); match Unsafe.kind (Array.get args 1) with | Lambda _bnd subth => rename_hyp_chained_quantifs newstop acc subth | _ => backtrack "not exist" end) else backtrack "not exist" | _ => backtrack "not exist" end | _ => backtrack "no quantif" end with fallback_rename_hyp_specials stop (acc:string list ref) th :unit := let newstop := Int.sub stop 1 in let freeze := Ref.get acc in Control.once_plus (* First see if user has something that applies *) (fun() => let dirs := rename_hyp newstop th in interp_directives newstop acc (List.rev dirs) ) (* if it fails try default specials *) (fun _ => let dirs := rename_hyp_default newstop th in Ref.set acc freeze; (* backtracking acc by hand here *) interp_directives newstop acc (List.rev dirs)) with fallback_rename_hyp stop (acc:string list ref) th:unit := if Int.le stop 0 then () else Control.once_plus (fun () => fallback_rename_hyp_specials stop acc th) (fun _ => lazy_match! th with | forall _, _ => fallback_rename_hyp_quantif stop acc th | exists _, _ => fallback_rename_hyp_quantif stop acc th | _ => let numnonimpl := count_impl th in let _ := rename_app numnonimpl stop acc th in () end) with interp_directives stop acc ld:unit := List.fold_right (fun d _ => interp_directive stop acc d) ld () with interp_directive stop acc d := (* printf "interp_directive %a %a" pr_acc (Ref.get acc) pr_directive d; *) match d with | String s => Ref.set acc (s :: (Ref.get acc)) | Rename t => fallback_rename_hyp stop acc t | RenameN n t => fallback_rename_hyp n acc t end. (* Like in_context but then forget about the new goal. Only side effects are kept *) Ltac2 in_context_then_forget nme typ f := Control.once_plus (fun () => let _ := in_context nme typ f in backtrack "forget in_context subgoal") (fun _ => ()). Ltac2 rename_acc n th := let acc := Ref.ref [] in (* We intentionally create a separate goal and backtrack it at the end. We only keep the name stored in acc. *) let dummy_nme := Option.get (Ident.of_string "DUMMY_SUBGOAL") in in_context_then_forget dummy_nme constr:(Prop) (fun () => fallback_rename_hyp n acc th); Ref.get acc. Ltac2 fallback_rename_hyp_name th: ident := let depth := rename_depth in let l := rename_acc depth th in (* printf "ICI10 : %a" pr_acc l; *) match l with [] => backtrack "No name built" | _ => let nme := build_name l in let id := Option.get (Ident.of_string nme) in Fresh.in_goal id end. (* This entry point is for really adhoc user renaming that need to inspect the goal in depth. For instance itf the name of a variable depends on the presence of some hypothesis. Currently unplugged.*) #[warnings="-ltac2-unused-variable"] Local Ltac2 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). *) Local Ltac2 autorename_strict (h:ident) := let th := Constr.type (Control.hyp h) in let tth := Constr.type th in (* printf "th = %t" tth ; *) lazy_match! tth with (* TODO: the deep entry point *) (* | _ => *) (* 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.in_goal (Option.get (Ident.of_string "dummy")) in Std.rename [(h , dummy_name)]; (* frees current name of H, in case of idempotency *) let newname := fallback_rename_hyp_name th in Std.rename [(dummy_name,newname)] | Prop => let msg := fprintf "no renaming pattern for %I : %t" h th in backtrack (Message.to_string msg) | _ => if Constr.equal constr:(Prop) tth then let msg := fprintf "no renaming pattern for %I : %t" h th in backtrack (Message.to_string msg) else () (* not in Prop or "no renaming pattern for " $h *) end. (* Tactic renaming hypothesis H. *) Local Ltac2 ltac2_autorename (h:ident) := control_try (fun () => autorename_strict h). Ltac2 ltac1_autorename (h:Ltac1.t) := let h: ident := Option.get (Ltac1.to_ident h) in ltac2_autorename h. Ltac2 ltac1_autorename_strict (h:Ltac1.t) := let h: ident := Option.get (Ltac1.to_ident h) in autorename_strict h. Ltac2 rename_list l acc s := List.iter (fun (n,t) => fallback_rename_hyp n acc t) l; Ref.set acc (s :: (Ref.get acc)). End Ltac2. (* This is the default renaming hard-coded in LibHYps *) Ltac2 Set rename_hyp_default := fun n th => if Int.lt n 0 then [] else lazy_match! th with | ?x <> ?y => [ String "neq" ; Rename x ; Rename y ] | (@Some _ ?x) => [RenameN (incr n) x] | (@None _) => [String "None"] end. Local Tactic Notation "Lautorename" hyp(h) := let tac := ltac2:(h |- Ltac2.ltac1_autorename h) in tac h. Local Tactic Notation "Lautorename_strict" hyp(h) := let tac := ltac2:(h |- Ltac2.ltac1_autorename_strict h) in tac h. (* GLOBAL TACTICS *) Global Ltac autorename h := Lautorename h. Global Ltac autorename_strict h := Lautorename_strict h. Matafou-LibHyps-112b273/LibHyps/LibHypsTactics.v000066400000000000000000000072201516654451400213630ustar00rootroot00000000000000(* 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 Ltac2.Ltac2. (* HYPS GROUPING *) Ltac2 rec find_above_which (foundone:bool) (t:constr) (lH:(ident * constr option * constr) list): ident option := match lH with | (id,_,tid)::lH' => if Constr.equal (Constr.type tid) constr:(Prop) then Some id else if Constr.equal tid t then match find_above_which true t lH' with | Some x => Some x | None => Some id end else if foundone then Some id else find_above_which false t lH' | [] => None end. Ltac2 rec cut_at (h:ident) (lH:(ident * constr option * constr) list) := match lH with | ((id,_,_) as elt)::lH' => if Ident.equal id h then [elt] else elt :: (cut_at h lH') | [] => Control.throw (Invalid_argument None) (* Should we fail here? h should always be in lH *) end. Ltac2 move_up_types (h:ident) := let t := Constr.type (Control.hyp h) in let tt := Constr.type t in if Constr.equal constr:(Prop) tt then () else let l := (Control.hyps()) in let l := cut_at h l in let aboveh := find_above_which false t l in match aboveh with | None => () | Some aboveh => if Ident.equal aboveh h then () else Std.move h (Std.MoveAfter aboveh) end. Ltac2 ltac1_move_up_types (h:Ltac1.t) := let h: ident := Option.get (Ltac1.to_ident h) in move_up_types h. Local Tactic Notation "Lmove_up_type" hyp(h) := let tac := ltac2:(h |- ltac1_move_up_types h) in tac h. (* GLOBAL TACTICS *) Global Ltac move_up_types h := Lmove_up_type h. (* SUBST WITH ONLY ONE HYP *) (* 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 *) Global 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. (* DECOMPOSE LOGICAL CONNECTORS *) Global 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. Matafou-LibHyps-112b273/LibHyps/TacNewHyps.v000066400000000000000000000141441516654451400205260ustar00rootroot00000000000000(* 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. *) Require Import Ltac2.Ltac2. From Ltac2 Require Import Option Constr Printf. Import Constr.Unsafe. Local Set Default Proof Mode "Classic". (* Require Import LibHyps.LibHypsDebug. *) (* Utilities *) Local Ltac2 is_dep_prod (t:constr): bool := match kind t with | Prod _ subt => Bool.neg (is_closed subt) | _ => false end. Local Ltac2 pr_list (pr: unit -> 'a -> message) () (l: 'a list) := let rec pr_list_ () (l: 'a list) := match l with | [] => fprintf "" | [e] => fprintf "%a" pr e | e::l' => fprintf "%a , %a" pr e pr_list_ l' end in fprintf "[ %a ]" pr_list_ l. (* Pure Ltac2 tactics *) Module Ltac2. Ltac2 all_hyps_ident() := List.map (fun (x,_,_) => x) (Control.hyps ()). Ltac2 iter_hyps (tac:ident -> unit) (lh:ident list) := List.iter tac lh. Ltac2 map_all_hyps (tac:'a -> unit) := let all_hyps := all_hyps_ident() in iter_hyps tac all_hyps. Ltac2 map_all_hyps_rev (tac: 'a -> unit) := let all_hyps := List.rev (all_hyps_ident()) in iter_hyps tac all_hyps. Ltac2 then_eachnh_gen (tac1:'a -> unit) (tac2:ident -> unit) (rev:bool) := let hyps_before := all_hyps_ident() in let _ := tac1() in Control.enter (fun () => let hyps_after := all_hyps_ident() in let new_hyps: ident list := List.filter_out (fun id => List.mem Ident.equal id hyps_before) hyps_after in iter_hyps tac2 (if rev then List.rev new_hyps else new_hyps)). Ltac2 then_eachnh (tac1:'a -> unit) (tac2:ident -> unit) := then_eachnh_gen tac1 tac2 false. Ltac2 then_eachnh_rev (tac1:'a -> unit) (tac2:ident -> unit) := then_eachnh_gen tac1 tac2 true. End Ltac2. (* Ltac2 tacticals on Ltac1 tactics and values. Mainly work translating them to ltac2 values and call tactical from Ltac2 above.*) Module Ltac1. Ltac2 apply_run (tac:Ltac1.t) lid := let larg := List.map Ltac1.of_ident lid in Ltac1.apply tac larg (fun t => Ltac1.run t). Ltac2 iter_hyps (tac:Ltac1.t) (lh:ident list): unit := let tac2:ident -> unit := (fun (id:ident) => apply_run tac [id]) in Ltac2.iter_hyps tac2 lh. (* Iterate tac on all hyps of a goal, top to bottom or reverse. *) Ltac2 map_all_hyps (tac:Ltac1.t) := let tac2:ident -> unit := (fun (id:ident) => apply_run tac [id]) in Ltac2.map_all_hyps tac2. Ltac2 map_all_hyps_rev (tac:Ltac1.t) := let tac2:ident -> unit := (fun (id:ident) => apply_run tac [id]) in Ltac2.map_all_hyps_rev tac2. Ltac2 then_eachnh (tac1:Ltac1.t) (tac2:Ltac1.t) := let tac1':unit -> unit := (fun () => Ltac1.run tac1) in let tac2':ident -> unit := (fun id => apply_run tac2 [id]) in Ltac2.then_eachnh tac1' tac2'. Ltac2 then_eachnh_rev (tac1:Ltac1.t) (tac2:Ltac1.t) := let tac1':unit -> unit := (fun () => Ltac1.run tac1) in let tac2':ident -> unit := (fun id => apply_run tac2 [id]) in Ltac2.then_eachnh_rev tac1' tac2'. End Ltac1. Ltac map_all_hyps tac := let t := ltac2:(tac |- Ltac1.map_all_hyps tac) in t tac. Ltac map_all_hyps_rev tac := let t := ltac2:(tac |- Ltac1.map_all_hyps_rev tac) in t tac. (* Ltac tacticals *) Ltac then_eachnh tac1 tac2 := let t := ltac2:(tac1 tac2 |- Ltac1.then_eachnh tac1 tac2) in t tac1 tac2. Ltac then_eachnh_rev tac1 tac2 := let t := ltac2:(tac1 tac2 |- Ltac1.then_eachnh_rev tac1 tac2) in t tac1 tac2. (* then_allnh_rev tac1 ltac:(map_hyps tac2). *) (* Ltac then_eachnh tac1 tac2 := then_allnh tac1 ltac:(map_hyps tac2). *) (* 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. 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. Import Notations. (* Goal forall n m p q : nat, n m

p<=q -> True. Proof. intros n m p q H H0 H1. Unset Silent. map_all_hyps ltac:(fun h => idtac h). map_all_hyps_rev ltac:(fun h => idtac h). onAllHyps (fun h => idtac h). onAllHypsRev (fun h => idtac h). ltac2:(Ltac2.then_eachnh (fun () => induction H) (fun id => printf "%I" id)). Undo 1. then_eachnh ltac:(induction H) ltac:(fun h => idtac h). Undo 1. then_eachnh_rev ltac:(induction H) ltac:(fun h => idtac h). Undo 1. induction H ;{ fun h => idtac h }. Undo 1. induction H ;{< fun h => idtac h }. *) Matafou-LibHyps-112b273/Makefile000066400000000000000000000005701516654451400163760ustar00rootroot00000000000000 .PHONY: tests LibHyps lib: sanity make -C LibHyps # Use this instead of make lib when the debug code is present make debug: make -C LibHyps make -C tests tests: lib make -C tests all: lib tests tests-nolib: make -C tests clean: make -C LibHyps clean make -C tests clean # Don't install test files install: lib make -C LibHyps install sanity: @./testDebug.sh Matafou-LibHyps-112b273/README.md000066400000000000000000000255011516654451400162160ustar00rootroot00000000000000This 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/tests/demo.v) acts as a documentation. # Short description: LibHyps provides utilities for hypothesis manipulations. For example a few tacticals to deal with "new" hypothesis (new = their name did not appear in the previous goal): - `tac /r`: applies tac then revert new hypothesis. - `tac /s`: applies tac then try to `subst` with new hyps. - `tac /n`: applies tac then try to automatically rename new hyps from their type. - `tac /g`: applies tac then try to tidy non-prop hyps to save room in your goal. - `tac/sng` : combination of the above - `tac1 ; { tac2 }` applies tac1, then tac2 on each new hyp (generic version of above). - `especialize H at ...` to generate one or several subgoals from the premise(s) of `H` (which can be a hypothesis name or an lemma name). This tactic comes with many variants. See below. - `assert premise i of H` generates a subgoal to prove the `i`th premise of `H`, without specializing `H`. # Quick Test ## 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/tests/demo.v). ## The especialize tactic Let `H` be a hypothesis (or lemma) with type `∀ x y z, H1 x -> H2 y -> H3 x y -> C x y z`. ``` especialize H at 2. ``` Creates a subgoal of the form: ``` ∀ x y z, H1 x -> H2 y ``` and applies it the subgoal to `H` which thus becomes: ``` H: ∀ x y z, H1 x -> H3 x y -> C x y z ``` Variants + `especialize H at 2 as h.` specializes a *copy* of `H` named `h`. Leaves `H` unchanged. quantifying them. + `especialize H at 2,3.` + `especialize H at *.` means specialize *all* premises + `especialize H until 2.` all premises until the 2nd. + By default all non-dependent hypothesis of `H` are left quantified (hence its type above `∀ x y z, H1 -> H2`). But you can specify the ones that should rather be transformed into existential variables. Examples: + `especialize H at 2 with y.` Creates an evar `?y` subgoal of the form: ``` ∀ x z, H1 x -> H2 ?y ``` and specializes `H` with this subgoal and evar `?y`: ``` H: ∀ x z, H1 x -> H3 x ?y -> C x ?y z ``` (where H1 and H3 reference `?y` now). + Several evars can be specified, they must be in order: ```especialize H at 2 with x,y.``` Note that (contrary to previous versions of this library), if you forget to list a variable, the tactic won't fail. Instead it will simply leave the variable quantified in the original hypothesis **and in subsequently created subgoals**. For example, after this: ``` coq Lemma test_espec8: forall x:nat, (forall a :nat, a = 1 -> x = 1 -> False) -> x > 1. Proof. intros x h. ``` the goal looks like this ``` coq x : nat h : forall a : nat, a = 1 -> x = 1 -> False ============================ x > 1 ``` the following tactic: ``` coq especialize h with a at 1. ``` gives two subgoals: ``` coq x : nat ============================ ?a = 1 x : nat h : x = 1 -> False ============================ x > 1 ``` Whereas ``` coq especialize h at 1. ``` gives (note how `a` is quantified in both subgoals, which makes the first one unprovable): ``` coq x, a : nat ============================ a = 1 x : nat h : nat -> x = 1 -> False ============================ x > 1 ``` ## 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 # 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 /sng. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type. And instantiating u with an evar. *) especialize h_all_eq_add_add_ with u at 2. { apply Nat.add_0_l. } Undo 6. 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. 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 /sng. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type: *) especialize h_all_eq_add_add_ with u at 2. { apply Nat.add_0_l. } (* now h_all_eq_add_add is specialized *) Undo 6. 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 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. ### 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). - Hence `onAllHyps autorename` applies `autorename` to all hypothesis. #### 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 (Ltac2): ```coq Require Import Ltac2.Ltac2. From Stdlib Require Import List. Import ListNotations. Local Set Default Proof Mode "Classic". (* Optional This restores ltac1 proof mode. *) (** 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". *) Ltac2 rename_hyp_2 _ th := match! th with | true <> false => [ String "tNEQf" ] | true = false => [ String "tEQf" ] end. Ltac2 Set rename_hyp := rename_hyp_2. (* Suppose I want to add later another naming rule: *) Ltac2 rename_hyp_3 n th := match! th with | Nat.eqb ?x ?y = true => [ String "Neqb"; Rename x ; Rename y ] | true = Nat.eqb ?x ?y => [ String "Neqb" ; Rename x ; Rename y ] | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. (* Then overwrite the definition of rename_hyp using the ::= operator. :*) Ltac2 Set rename_hyp := rename_hyp_3. ``` Where `Rename` stands for calling the naming scheme recursively (unless the maximum depth is reached). #### 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). ``` # About the logical "completeness" of `especialize` Suppose we have this goal: ```coq Lemma foo: (forall x:nat, x = 1 -> (x>0) -> x < 0) -> False. Proof. intros h. h : forall x : nat, x = 1 -> x > 0 -> x < 0 ============================ False especialize h with x at 2. h : ?x = 1 -> ?x > 0 -> ?x < 0 ============================ ?x > 0 goal 2 (ID 88) is: False ``` Note that in this case it would be preferable (and logically more accurate) to have a hypothesis `h2: ?x = 1` in the context, since the premise 2 of H needs only to be proved when premise 1 is true. Note however that in this kind of situation most users would wait to be able to prove premise 1 before instantiating premise 2. `especialize` does not cover this kind of subtleties. Another tactic is under development to support this kind of reasoning. Matafou-LibHyps-112b273/TODO.md000066400000000000000000000027771516654451400160400ustar00rootroot00000000000000# Suggestion by Sylvain Boulme: # 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. tac1 ;<; tac2. We don't need the 4 variants anymore (ltac2 is fast enough to avoid the list variants). # 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 idea yet to be refined: at last level if seeing a hyp name then use it else don't generate the last level. # 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 ## ? Matafou-LibHyps-112b273/configure.sh000077500000000000000000000037371516654451400172660ustar00rootroot00000000000000#!/bin/bash DEVOPT=no STDLIB= POSITIONAL=() while [[ $# -gt 0 ]] do key="$1" case $key in --stdlib|-stdlib) shift STDLIB=$1 shift ;; -dev|--dev) DEVOPT=yes shift ;; *) # unknown option POSITIONAL+=("$1") # save it in an array for later shift # past argument ;; esac done set -- "${POSITIONAL[@]}" # restore positional parameters (i.e. # parameters that were not recognized by the # previous code.) function gen_projet_file () { FILES="$1" DIR=$2 STDLIB=$4 PROJECTFILE=$DIR/_CoqProject RESOURCEFILE=$3 if [ "$STDLIB" != "" ] then echo "stdlib detected" echo "-Q $STDLIB Stdlib" > "$PROJECTFILE" else echo "" > "$PROJECTFILE" fi cat < $RESOURCEFILE >> "$PROJECTFILE" echo "" >> "$PROJECTFILE" for i in $FILES do echo "$i" >> "$PROJECTFILE" done echo "Content of $PROJECTFILE" cat < $PROJECTFILE command -v rocq ; rocqexists=$? if [ $rocqexists -eq 0 ] then echo "Calling rocq makefile in $DIR" (cd $DIR && rocq makefile -f _CoqProject -o Makefile ) else command -v coqc ; coqexists=$? if [ $coqexists -eq 0 ] then echo "Calling coq_makefile in $DIR" (cd $DIR && coq_makefile -f _CoqProject -o Makefile ) else echo "Neither rocq nor coq executable found" exit 1 fi fi } if [ "$DEVOPT" = "no" ] then FILESLH=$(cd LibHyps && find . -name "*.v" | grep -v "LibHypsDebug" ) else FILESLH=$(cd LibHyps && find . -name "*.v" ) fi PROJECTDIRLH="LibHyps" gen_projet_file "$FILESLH" "$PROJECTDIRLH" "resources/coq_project.libhyps" "$STDLIB" FILESTEST=$(cd tests && find . -name "*.v" | grep -v "incremental" | grep -v "\#" ) PROJECTDIRTESTS="tests" gen_projet_file "$FILESTEST" "$PROJECTDIRTESTS" "resources/coq_project.tests" "$STDLIB" Matafou-LibHyps-112b273/resources/000077500000000000000000000000001516654451400167465ustar00rootroot00000000000000Matafou-LibHyps-112b273/resources/coq_project.libhyps000066400000000000000000000000711516654451400226500ustar00rootroot00000000000000-R . LibHyps.LibHyps -arg -w -arg -deprecated-since-9.0 Matafou-LibHyps-112b273/resources/coq_project.tests000066400000000000000000000002271516654451400223430ustar00rootroot00000000000000-R . LibHyps.tests -R ../LibHyps LibHyps.LibHyps -arg -async-proofs-cache -arg force -arg -w -arg -undo-batch-mode -arg -w -arg -deprecated-since-9.0 Matafou-LibHyps-112b273/resources/opam_howto.md000066400000000000000000000060321516654451400214450ustar00rootroot00000000000000# see https://rocq-prover.org/docs/opam-packaging for how to update this: ## Tag a version ```bash git tag 1.0.0 git push origin 1.0.0 ``` If your repository is on GitHub at $YOU/foo (where $YOU is your GitHub user name), the archive corresponding to the tag 1.0.0 can be downloaded from this URL: https://github.com/$YOU/foo/archive/1.0.0.tar.gz, using `curl -L` or your browser for example. ## checksum You can then record its checksum which will be used in the package definition using: ```bash YOURHASH=`shasum -a 512 1.0.0.tar.gz` ``` ## upload (?) Finally, you must upload the archive on GitHub as an asset of your release (using Edit Release). This is necessary as GitHub does not guarantee the checksum stability of auto-generated /archive/ tarballs. One can also use the gh CLI tool to upload an archive to a release (gh release upload tag archive.tar.gz). Your release will then have an url of shape: https://github.com/$YOU/foo/releases/download/1.0.0/1.0.0.tar.gz ## update the rocq repository opam archive ## fork it if not alerady done ### Clone it This creates a clone with two remotes, one for the official archive, called upstream, and one for your fork, called origin. ``` bash git clone https://github.com/rocq-prover/opam -o upstream ``` ## add your fork as a remote ``` bash cd opam git remote add origin https://github.com/$YOU/opam ``` ## create a branch ``` bash git checkout -b rocq-foo.1.0.0 upstream/master ``` # Create a new directory for the new version In the rocq-prover/opam directory, create a sub-directory named as follows: ``` bash mkdir -p released/packages/rocq-foo/rocq-foo.1.0.0 ``` # add a opam file in this diorectory Template below: when updating an existing one: - update url/src - update url/checksum - update dates - update dependencies with coq versions and other package versions (Ltac2?) - check the `build`, `install` and `test` commands ``` bash opam-version: "2.0" synopsis: "A Rocq library doing wonders" # One-line description description: """ Foo does bar with baz. """ # Longer description, can span several lines homepage: "https://github.com/$YOU/foo" dev-repo: "git+https://github.com/$YOU/foo.git" bug-reports: "https://github.com/$YOU/foo/issues" doc: "https://$YOU.github.io/foo/" maintainer: "your@email.address" authors: [ "You" ] license: "MIT" # Make sure this is reflected by a LICENSE file in your sources depends: [ "rocq-core" {>= "9.0" & < "9.1~"} "rocq-stdlib" {>= "9.0" & < "9.1~"} # If necessary ] build: [ [make "-j%{jobs}%"] ] install: [ [make "install"] ] run-test: [ ["./configure.sh"] [make lib "-j%{jobs}%"] [make tests ] ] url { src: "https://github.com/$YOU/foo/releases/download/1.0.0/1.0.0.tar.gz" checksum: "sha512=$YOURHASH" } tags: [ "keyword:fooish" "category:Miscellaneous/Rocq Extensions" "date:2025-07-01" "logpath:Foo" ] ``` # Commit the opam file git add released/packages/rocq-foo/rocq-foo.1.0.0/opam git commit -m 'Package rocq-foo.1.0.0' # call the linter opam lint --check-upstream released/packages/rocq-foo/rocq-foo.1.0.0/opam Matafou-LibHyps-112b273/resources/opam_skel000066400000000000000000000033111516654451400206410ustar00rootroot00000000000000# 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 lib "-j%{jobs}%"] ] run-test: [ ["./configure.sh"] [make lib "-j%{jobs}%"] [make tests ] ] install: [make "install"] depends: [ "rocq-core" {(>= "9" & <= "9.2~") | (= "dev")} ] tags: [ "keyword:proof environment manipulation" "keyword:forward reasoning" "keyword:hypothesis naming" "category:Miscellaneous/Coq Tactics Library" "logpath:LibHyps" "date:2024-12-19" ] 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. " url { src: "https://github.com/Matafou/LibHyps/archive/refs/tags/3.0.1.tar.gz" checksum: "sha512=d29114cd6ed5a4c88283b7598a0720b693bf978c4e5c42d5451e1bf21e8bfdc7d9b0a274ef34b27f8ab97635240628a1349c175bd52fc3acedb993dd3e816548" } Matafou-LibHyps-112b273/rocq-libhyps.opam000066400000000000000000000027271516654451400202360ustar00rootroot00000000000000# 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: [ "ocaml" "rocq-core" { (>= "9.0" ) | ( = "dev") } "rocq-stdlib" ] 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. " Matafou-LibHyps-112b273/testDebug.sh000077500000000000000000000013051516654451400172200ustar00rootroot00000000000000#!/bin/bash ## Explanation # - Debug code is in LibHyps/LibHypsDebug.v # # - by default ./configure.sh does ignores this file # - unless we use ./configure.sh --dev # # - the present test checks that we have not forgotten to remove # - refrences to the debug file (by doing ./configure.sh). # echo "Sanity check (debug files)" if grep -q "LibHypsDebug.v" LibHyps/_CoqProject then echo "REMAINING DEBUG CODE: ABORTING." echo "LibHypsDebug.v shoiuld not be compiled in a released code." echo "Use ./configure.sh to remove rerferences to debug code." echo "then make clean; make lib tests" echo "If this fails, remove the calls to LibHypsDebug.v in the code" exit 1 else exit 0 fi Matafou-LibHyps-112b273/tests/000077500000000000000000000000001516654451400160765ustar00rootroot00000000000000Matafou-LibHyps-112b273/tests/Especialize_tests.v000066400000000000000000000754101516654451400217530ustar00rootroot00000000000000(* Require Import LibHyps.LibHypsTactics. *) Require Import LibHyps.Especialize. (* tests *) Definition eq_one (i:nat) := i = 1. Definition hidden_product := forall i j :nat, i+1=j -> i+1=j -> i+1=j. Lemma foo: forall x y n m p :nat, (forall (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y n m p H. especialize H at *;[ | | | | | ]. 5: match goal with H1 : n < m , H2 : n <= m , H3 : p > 0 , H4 : p > 2 |- _ => idtac end. Abort. Lemma foo: forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. (* evar names must be given in order. *) Fail especialize H at * with n,p,m. (* Fail especialize (let x:=not_eq_S in x) with n,m at *. *) especialize H at * with n,m,p. 5:{ match goal with H1 : ?n < ?m , H2 : ?n <= ?m , H3 : ?p > 0 , H4 : ?p > 2 |- _ => idtac end. admit. } Undo 5. especialize H at 2. 2:{ match goal with | |- False => idtac end. match type of H with forall (n:_) (m:_) (p:_), n < m -> _ => idtac end. admit. } Undo 6. especialize H at 2 as h; [ now apply PeanoNat.Nat.lt_le_incl | match goal with | |- False => idtac end; match type of h with forall (n:_) (m:_) (p:_), n < m -> _ => idtac end ]. Undo 1. especialize H at 2 as ?; [ now apply PeanoNat.Nat.lt_le_incl | match goal with | |- False => idtac end; match type of H_spec_ with forall (n:_) (m:_) (p:_), n < m -> _ => idtac end ]. Undo 1. especialize H with p; [ match goal with | |- False => idtac end; match type of H with forall (n:_) (m:_), n < m -> _ => idtac end ]. Undo 1. especialize H with n, p; [ match goal with | |- False => idtac end; match type of H with forall (m:_), _ < m -> _ => idtac end ]. Undo 1. especialize H with p as h; [ match goal with | |- False => idtac end; match type of h with forall (n:_) (m:_), n < m -> _ => idtac end ]. Undo 1. especialize H with n, p as h; [ match goal with | |- False => idtac end; match type of h with forall (m:_), _ < m -> _ => idtac end ]. Undo 1. especialize H with p as ?; [ match goal with | |- False => idtac end; match type of H_spec_ with forall (n:_) (m:_), n < m -> _ => idtac end ]. Undo 1. especialize H with n, p as ?; [ match goal with | |- False => idtac end; match type of H_spec_ with forall (m:_), _ < m -> _ => idtac end ]. Undo 1. especialize H at 4 with p;[ match goal with h: ?n < ?m , h':?n <= ?m, H'':?p > 0 |- ?p > 2 => idtac end | match goal with |- False => idtac end; match type of H with forall n m, (n < m) -> _ => idtac end ]. Undo 1. especialize H at 3 with n, p; [ match goal with | h: ?n < ?m , h':?n <= ?m |- ?p > 0 => is_evar p end | match goal with | |- False => idtac end; match type of H with forall (m:_), _ < m -> _ => idtac end ]. Undo 1. especialize H with p at 3; [ match goal with | h: ?n < ?m , h':?n <= ?m |- ?p > 0 => is_evar p end | match goal with | |- False => idtac end; match type of H with forall (n:_) (m:_), n < m-> _ => idtac end ]. Undo 1. especialize H with n, p at 3; [ match goal with | h: ?n < ?m , h':?n <= ?m |- ?p > 0 => is_evar p end | match goal with | |- False => idtac end; match type of H with forall (m:_), _ < m -> _ => idtac end ]. Undo 1. especialize H at 2 with p as h2; [ match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of h2 with forall n m, (n < m) -> _ => idtac end ]. Undo 1. especialize H with p at 2 as h2; [ match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of h2 with forall n m, (n < m) -> _ => idtac end ]. Undo 1. especialize H at 2 with p as ?; [ match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of H_spec_ with forall n m, (n < m) -> _ => idtac end ]. Undo 1. especialize H with p at 2 as ?; [ match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of H_spec_ with forall n m, (n < m) -> _ => idtac end ]. Undo 1. especialize H until 2 with p as h ; [ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of h with forall n m, (?q > _) -> _ => idtac end ]. Undo 1. (* This syntax ("with" before "until") does not work due to "until" not being a keyword. *) especialize H with p until 2 as h ; [ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of h with forall n m, (?q > _) -> _ => idtac end ]. Undo 1. rename H into Hyp; especialize Hyp until 2 with p as ?; [ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of Hyp_spec_ with forall n m, (?q > _) -> _ => idtac end ]. Undo 1. especialize H until 2 as h; [ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of h with forall n m p, (?q > _) -> _ => idtac end ]. Undo 1. rename H into hyp; especialize hyp until 2 as ?; [ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of hyp_spec_ with forall n m p, (?q > _) -> _ => idtac end ]. Undo 1. especialize H until 2;[ match goal with |- ?n < ?m => idtac end | match goal with H:?n < ?m |- ?n <= ?m => idtac end | match goal with |- False => idtac end; match type of H with forall n m p, (?q > _) -> _ => idtac end ]. Fail Check h. Undo 1. especialize H until 3 with n, p; [ match goal with | |- ?n < ?m => idtac end | match goal with | h: ?n < ?m |- ?n <= ?m => idtac end | match goal with | h: ?n < ?m , h':?n <= ?m |- ?p > 0 => idtac end | match goal with | |- False => idtac end]. Undo 1. especialize H at 2, 4 with n, m. 1: match goal with |- ?lft <= ?rght => is_evar lft; is_evar rght end. 2: match goal with H: p > 0 , H':?lft <= ?rght |- p > 2 => is_evar lft; is_evar rght end. 3: match goal with H: forall p:nat, ?lft < ?rght -> p > 0 -> p > 1 -> _ |- False => is_evar lft; is_evar rght end. Undo 4. Abort. Lemma foo': forall x y : nat, (forall (n m p :nat) (hhh:n < m) (iii:n <= m), p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 0 -> p > 2 -> p > 1 -> hidden_product) -> False. Proof. intros x y H. especialize H at 19, 20 with p;[ | | ]; [ (* test generated names *) match type of h_premis with _> _ => idtac end; match goal with hhh : ?n < ?m, iii : ?n <= ?m |- _ > 2 => idtac end | match goal with hhh : ?n < ?m, iii : ?n <= ?m |- _ > 1 => idtac end | match goal with | |- False => idtac end ]. Undo 1. Abort. Module AS. Lemma test_espec: forall x:nat, x = 1 -> (x = 1 -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone at 1 . + assumption. + match type of h_eqone with False => idtac | _ => fail "test failed!" end. contradiction. Qed. Lemma test_espec2: forall x:nat, x = 1 -> (x = 1 -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone at 1 as h. + assumption. + match type of h with False => idtac | _ => fail "test failed!" end. contradiction. Qed. Lemma test_espec3: forall x:nat, x = 1 -> (x = 1 -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone at 1 as ?. + assumption. + match type of h_eqone_spec_ with False => idtac | _ => fail "test failed!" end. contradiction. Qed. Lemma test_espec4: forall x:nat, x = 1 -> (x = 1 -> x = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone at 1, 2 as ?. + assumption. + reflexivity. + match type of h_eqone_spec_ with False => idtac | _ => fail "test failed!" end. contradiction. Qed. Lemma test_espec5: forall x:nat, x = 1 -> (x = 1 -> x = x -> x = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone at 1, 2, 3 as ?. + assumption. + reflexivity. + reflexivity. + match type of h_eqone_spec_ with False => idtac | _ => fail "test failed!" end. contradiction. Qed. Lemma test_espec_h: forall x:nat, x = 1 -> (forall a y z:nat, x = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a, y at 1, 2 as h. + assumption. + reflexivity. + exfalso. apply h with 0. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a, y at 1, 2 as ?. + reflexivity. + reflexivity. + exfalso. apply h_eqone_spec_ with 0. * reflexivity. * symmetry. assumption. Qed. End AS. Module Using. Lemma test_espec: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y at 1,2 . + reflexivity. + reflexivity. + exfalso. apply h_eqone with 0. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y at 1,2 as h. + reflexivity. + reflexivity. + exfalso. apply h with 0. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y at 1,2 as ?. + reflexivity. + reflexivity. + exfalso. apply h_eqone_spec_ with 0. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y at 2 . + reflexivity. + exfalso. apply h_eqone with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec2_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y at 2 as h. + reflexivity. + exfalso. apply h with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec2_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y at 2 as ?. + reflexivity. + exfalso. apply h_eqone_spec_ with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec3: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y , z at 2 . + reflexivity. + exfalso. apply h_eqone with 1. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec3_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y , z at 2 as h. + reflexivity. + exfalso. apply h with 1. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec3_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with y , z at 2 as ?. + reflexivity. + exfalso. apply h_eqone_spec_ with 1. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec4: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a, y, z at 1 . + reflexivity. + exfalso. apply h_eqone. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec4_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a, y, z at 1 as h. + reflexivity. + exfalso. apply h. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec4_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a, y, z at 1 as ?. + reflexivity. + exfalso. apply h_eqone_spec_. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec5: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y,z at 1 . + reflexivity. + exfalso. apply h_eqone. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec5_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y,z at 1 as h. + reflexivity. + exfalso. apply h. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec5_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,y,z at 1 as ?. + reflexivity. + exfalso. apply h_eqone_spec_. * reflexivity. * instantiate (z:=0). reflexivity. * symmetry. assumption. Qed. Lemma test_espec6: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a at 1 . + reflexivity. + exfalso. apply h_eqone with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec6_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a at 1 as h. + reflexivity. + exfalso. apply h with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec6_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a at 1 as ?. + reflexivity. + exfalso. apply h_eqone_spec_ with 1 0. * reflexivity. * reflexivity. * symmetry. assumption. Qed. Lemma test_espec7: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,z at 1,4 . + reflexivity. + rewrite hx. instantiate (z:=0). reflexivity. + exfalso. apply h_eqone with 1. * reflexivity. * reflexivity. Qed. Lemma test_espec7_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,z at 1,4 as h. + reflexivity. + rewrite hx. instantiate (z:=0). reflexivity. + exfalso. apply h with 1. * reflexivity. * reflexivity. Qed. Lemma test_espec7_h2: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a,z at 1,4 as ?. + reflexivity. + rewrite hx. instantiate (z:=0). reflexivity. + exfalso. apply h_eqone_spec_ with 1. * reflexivity. * reflexivity. Qed. (* This tests only hold for coq >= 8.18 *) Lemma test_espec8: forall x:nat, (forall a :nat, a = 1 -> x = 1 -> False) -> x > 1. Proof. intros x h. especialize h at 1. Undo 1. especialize h with a at 1. Abort. (* Lemma test_espec8: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. especialize h_eqone with a at 1,4 . Abort. Lemma test_espec8_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. Fail especialize h_eqone with a at 1,4 as h. Abort. Lemma test_espec8_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. Fail especialize h_eqone with a at 1,4 as ?. Abort. Lemma test_espec9: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. Fail especialize h_eqone at 1,4. Abort. Lemma test_espec9_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. Fail especialize h_eqone at 1,4 as h. Abort. Lemma test_espec9_h: forall x:nat, x = 1 -> (forall a y z:nat, a = 1 -> y = 1 -> z+y+a = 2 -> z+1 = x -> False) -> x > 1. Proof. intros x hx h_eqone. Fail especialize h_eqone at 1,4 as ?. Abort. *) End Using. 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 1,2,3,4,5,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 end. Undo. especialize H at 1,2,3,4,5,7,9 as h; [ admit | admit | admit | admit | admit | admit | admit | match type of h with eq_one 7 -> eq_one 9 -> False => idtac end]. Undo. exact I. Qed. Axiom ex_hyp : (forall (b:bool), forall x: nat, eq_one 1 -> forall y:nat, eq_one 2 ->eq_one 3 ->eq_one 4 ->eq_one x ->eq_one 6 ->eq_one y -> eq_one 8 -> eq_one 9 -> False). Lemma test_esepec: True. Proof. (* specialize ex_hyp as h. *) (* especialize ex_hyp at 2 as h. *) especialize ex_hyp at 3 with b,x,y as h;[ .. | match type of h with eq_one 1 -> eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) at 2 as h;[ .. | match type of h with forall x: nat, eq_one 1 -> forall y:nat, eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) at 2,3 as h;[ .. | match type of h with forall x: nat, eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. Fail especialize H at 2,3,5 as h. Undo. especialize (ex_hyp true) with x at 2,3,5 as h ;[ .. | match type of h with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) with x at 2,3,5,6 as h ;[ .. | match type of h with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. Fail especialize H with x at 2,3,5,7 as h. especialize (ex_hyp true) with x,y at 2,3,5,7 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) with x,y at 2,3,5,7,9 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize (ex_hyp true) with x,y at 2,3,5,7,8,9 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac end]. Undo. especialize (ex_hyp true) at 2 as ?;[ .. | match type of H_spec_ with forall x: nat, eq_one 1 -> forall y:nat, eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) at 2,3 as ?;[ .. | match type of H_spec_ with forall x: nat, eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. Fail especialize H at 2,3,5 as ?. Undo. especialize (ex_hyp true) with x at 2,3,5 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) with x at 2,3,5,6 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) with x at 3,2,5,6 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. Fail especialize H with x at 2,3,5,7 as ?. especialize (ex_hyp true) with x,y at 2,3,5,7 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize (ex_hyp true) with x,y at 2,3,5,7,9 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize (ex_hyp true) with x,y at 1,2,3,5,7,9 as ?;[ .. | match type of H_spec_ with eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize (ex_hyp true) with x,y at 2,3,5,7,8,9 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac end]. Undo. (* when the argument is not a hyptothesis we must give a name.*) Fail especialize (ex_hyp true) at 2. Undo. generalize (ex_hyp true) as H. intro. especialize H at 2 as h;[ .. | match type of h with forall x: nat, eq_one 1 -> forall y:nat, eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H at 2,3 as h;[ .. | match type of h with forall x: nat, eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H at 2,3,5 as h. *) especialize H with x at 2,3,5 as h ;[ .. | match type of h with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x at 2,3,5,6 as h ;[ .. | match type of h with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H with x at 2,3,5,7 as h. *) especialize H with x,y at 2,3,5,7 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,9 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 1,2,3,5,7,9 as h ;[ .. | match type of h with eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,8,9 as h ;[ .. | match type of h with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac end]. Undo. especialize H at 2 as ?;[ .. | match type of H_spec_ with forall x: nat, eq_one 1 -> forall y:nat, eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H at 2,3 as ?;[ .. | match type of H_spec_ with forall x: nat, eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H at 2,3,5 as ?. *) especialize H with x at 2,3,5 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x at 2,3,5,6 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H with x at 2,3,5,7 as ?. *) especialize H with x,y at 2,3,5,7 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,9 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 1,2,3,5,7,9 as ? ;[ .. | match type of H_spec_ with eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,8,9 as ? ;[ .. | match type of H_spec_ with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac end]. Undo. especialize H at 2;[ .. | match type of H with forall x: nat, eq_one 1 -> forall y:nat, eq_one 3 -> eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H at 2,3;[ .. | match type of H with forall x: nat, eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H at 2,3,5. *) especialize H with x at 2,3,5 ;[ .. | match type of H with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one 6 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x at 2,3,5,6 ;[ .. | match type of H with eq_one 1 -> forall y:nat, eq_one 4 -> eq_one _ -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. (* Only for coq >= 8.18 *) (* Fail especialize H with x at 2,3,5,7. *) especialize H with x,y at 2,3,5,7 ;[ .. | match type of H with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> eq_one 9 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,9 ;[ .. | match type of H with eq_one 1 -> eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 1,2,3,5,7,9 ;[ .. | match type of H with eq_one 4 -> eq_one 6 -> eq_one 8 -> False => idtac end]. Undo. especialize H with x,y at 2,3,5,7,8,9 ;[ .. | match type of H with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac end]. Undo. especialize H with x,y at 8,2,3,5,7,9 ;[ .. | match type of H with eq_one 1 -> eq_one 4 -> eq_one 6 -> False => idtac 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 PeanOant.Nat.quadmul_le_squareadd with a at 1 as hh : h. *) especialize PeanoNat.Nat.quadmul_le_squareadd with a at 1 as hh. { apply le_n. } especialize min_l with n,m at 1 as ?. { apply (le_n O). } especialize h_eqone at 2 as h1. { reflexivity. } unfold eq_one in min_l_spec_. (* 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. (* "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 *) (* if arg not a hyp then "as" is mandatory *) Fail especialize (let x:=not_eq_S in x) with n,m at *. Undo. especialize (let x:=not_eq_S in x) with n,m at * as h; [ .. | match type of h with (S _)<>(S _) => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=not_eq_S in x) with n,m until 1 as ?; [ .. | match type of H_spec_ with (S _)<>(S _) => idtac | _ => fail "Test failed!" end]. Undo. (* name mandatory *) Fail especialize (let x:=not_eq_S in x) with n,m until 1. Undo. especialize (let x:=not_eq_S in x) with n,m at * as h; [ .. | match type of h with (S _)<>(S _) => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=PeanoNat.Nat.add_sub_eq_nz in x) with n,m,p until 2 as h; [ .. | match type of h with ?m + ?p = ?n => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:= PeanoNat.Nat.add_sub_eq_nz in x) with p until 1 as h; [ .. | match type of h with forall n m : nat, n - m = ?p -> m + ?p = n => idtac | _ => fail "Test failed!" end]. Undo. especialize (let x:=h_eqone in x) at * as ? ; [ .. | 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 as ? ; [ 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 * ; [ .. | 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. Matafou-LibHyps-112b273/tests/LibHypsRegression.v000066400000000000000000000220551516654451400217040ustar00rootroot00000000000000(* 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.LibHyps. Export TacNewHyps.Notations. Require Import Arith ZArith List. Require Import Ltac2.Ltac2. From Ltac2 Require Import Option Constr Printf. Local Set Default Proof Mode "Classic". Import ListNotations. Import LibHyps.LegacyNotations. (* This settings should reproduce the naming scheme of libhypps-1.0.0 and libhypps-1.0.1. *) Ltac2 Set numerical_sufx := true. Ltac2 Set add_suffix := false. Ltac2 rename_hyp_1 n th := if Int.lt n 0 then [] else lazy_match! th with | @cons _ ?x (cons ?y ?l) => [String "cons"; Rename x; Rename y; RenameN (decr (decr n)) l] | @cons _ ?x ?l => if Int.ge n 1 then [String "cons"; Rename x; RenameN (decr n) l] else [String "cons"] end. Ltac2 rename_hyp_2 n th := match! th with | true <> false => [ String "tNEQf" ] | true = false => [ String "tEQf"] | _ => rename_hyp_1 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_2. Ltac2 rename_hyp_3 n th := match! th with | Nat.eqb ?x ?y = true => [ String "Neqb" ; Rename x ; Rename y ] | true = Nat.eqb ?x ?y => [ String "Neqb" ; Rename x ; Rename y ] | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_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 -> Nat.eqb (x + 1) 0 <> Nat.eqb 1 y -> true = Nat.eqb 3 4 -> Nat.eqb (x + 3) 4 = true -> Nat.eqb (2 * (x + 3)) 4 = true -> 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_Neqb_mul_2n_add_4n with (2 * (x + 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_neq_eqb_add_0n_eqb_1n_y with (x + 1 =? 0) <> (1 =? 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. Restart. intros /ng. lazymatch reverse goal with | Ht:_,Hz:_, Hx0:_,Hy:_ , Hx:_ |- True => let _ := constr:((ltac:(reflexivity)): Hx=x) in let _ := constr:((ltac:(reflexivity)): Hy=y) in let _ := constr:((ltac:(reflexivity)): Hx0=x0) in let _ := constr:((ltac:(reflexivity)): Ht=t) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. Restart. intros /sng. lazymatch reverse goal with | Ht:_,Hz:_, Hx0:_,Hy:_ |- True => let _ := constr:((ltac:(reflexivity)): Hy=y) in let _ := constr:((ltac:(reflexivity)): Hx0=x0) in let _ := constr:((ltac:(reflexivity)): Ht=t) in idtac | _ => fail "test failed (wrong order of hypothesis)!" end. exact I. Qed. Definition eq_one (i:nat) := i = 1. Lemma test_espec_namings: forall n:nat, (forall m, eq_one n -> eq_one 1 -> eq_one m -> m = n) -> True. Proof. intros n h_eqone. especialize Nat.quadmul_le_squareadd with a at 1 as hh (*: h*). { apply le_n. } especialize min_l with n,m at 1 as ?. { apply (le_n O). } especialize h_eqone at 3 as h1 (*: h2 *). { admit. } (* unfold eq_one in h2. *) (* match type of h2 with 1 = 1 => idtac | _ => fail end. *) match type of h1 with forall m : nat, eq_one n -> eq_one 1 -> m = n => idtac | _ => fail end. exact I. Abort. Ltac2 rename_hyp_4 n th := match! th with | length ?l => [ String "lgth" ; Rename l ] | _ => rename_hyp_3 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_4. Ltac2 Set rename_depth := 3. 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 ?/n. (* then_allnh_gen ltac:(fun x => all_hyps) ltac:(fun _ => decomp_logicals h) ltac:(fun lh => idtac lh) . *) (* Set Ltac Debug. *) decomp_logicals h_and_eq_lgth_lgth_eq_lgth_lgth /sn. match goal with |- _ => match type of h_eq_lgth_l1_lgth_l2 with length l1 = length l2 => idtac | _ => fail "Test failed (wrong type)!" end | _ => fail "Test failed (wrong name)!" end. exact I. Qed. (* example of new tactical from the documentation. *) Tactic Notation "!!!" tactic3(Tac) := Tac ;{ substHyp } ;{< rename_or_revert }; { autorename}. 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) -> (fun x => x <= 0) 0 -> z = b + x-> True. Proof. !!!intros. match goal with | |- (0 <= 0) -> True => idtac end. match type of h_eq_add_a_1n_add_t_2n with | a + 1 = t + 2 => idtac end. Abort. Matafou-LibHyps-112b273/tests/LibHypsTest.v000066400000000000000000000411661516654451400205070ustar00rootroot00000000000000(* 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. Require Import LibHyps.LibHyps (*LibHyps.LibSpecialize*). Require Import Ltac2.Ltac2. Require Import List. Import ListNotations. Ltac2 rename_hyp_2 _ th := match! th with | true <> false => [ String "tNEQf" ] | true = false => [ String "tEQf" ] end. Ltac2 Set rename_hyp := rename_hyp_2. (* Suppose I want to add later another naming rule: *) Ltac2 rename_hyp_3 n th := match! th with | Nat.eqb ?x ?y = true => [ String "Neqb"; Rename x ; Rename y ] | true = Nat.eqb ?x ?y => [ String "Neqb" ; Rename x ; Rename y ] | _ => rename_hyp_2 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_3. Ltac2 rename_hyp_4 n th := lazy_match! th with | @cons _ ?x (cons ?y ?l) => [String "cons"; Rename x; Rename y; RenameN (decr (decr n)) l] | @cons _ ?x ?l => if Int.ge n 1 then [String "cons"; Rename x; RenameN (decr n) l] else [String "cons"] | _ => rename_hyp_3 n th (* call the previously defined tactic *) end. Ltac2 Set rename_hyp := rename_hyp_4. Ltac2 rename_depth := 3. Close Scope Z_scope. Open Scope nat_scope. Local Set Default Proof Mode "Classic". 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 }. match goal with | |- _ -> True => idtac end. 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?. match goal with | |- _ -> True => idtac end. 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 ; { 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_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. (* 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 } ; { move_up_types }. 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. (* 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. (* Ltac with cache: 3s, Ltac2: 0,04s *) (* Time intros ; { move_up_types }. (* ~7mn *) *) (* Time intros /n. (* 19s *) *) exact I. Qed. Matafou-LibHyps-112b273/tests/demo.org000066400000000000000000000124721516654451400175410ustar00rootroot00000000000000 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 Matafou-LibHyps-112b273/tests/demo.v000066400000000000000000000320531516654451400172140ustar00rootroot00000000000000(* 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 ***) Require Import Arith ZArith List. Require Import LibHyps.LibHyps. (* Quick demo of especialize. *) Lemma demo_especialize: forall x y z:nat, forall t : nat, (forall u v, v+t = 1 -> u+1 = 1 -> u = v -> v+x = z+y) -> True. Proof. intros x y z t H. especialize H at 2. Undo 1. especialize H at 2 with u. (* Creates one subgoal and on evar and specialize H3 *) Show 2. (* u and 2nd hypothesis of H disappeard. *) Undo. especialize H at 1,2 with u,v. (* Creates two subgoals specializes H3 *) Show 3. (* u,v and 1st and 2nd hypothesis of H disappeard. *) Undo. especialize H at * with u,v. (* Creates subgoals for all hyps and specialize *) Show 4. (* u,v and all hypothesis of H disappeard. *) Undo. especialize H until 2 with u,v. (* Creates subgoals for the 2 first hyps and specialize *) Show 3. Abort. (* Quick demo of "assert premise". Same idea as especialize but: - only creates (one) subgoal without specialize the hypothesis - by default evarize variables occuring in the sugoal. *) Lemma demo_assert_premise: forall x y z:nat, forall t : nat, (forall u v, v+t = 1 -> u+1 = 1 -> u = v -> v+x = z+y) -> True. Proof. intros x y z t H. assert premise 2 of H. (* Creates one subgoal. Creates an evar for variables appearing in the subgoal *) Undo 1. assert premise 2 of H with u. (* quantifies u instead instead of evarize it. *) Undo. assert premise 1 -> 2 of H with u,v. (* the subgoal has a premise *) Undo. Abort. 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 /sng. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type. And instantiating u with an evar. *) especialize h_all_eq_add_add_ with u at 2. { apply Nat.add_0_l. } Undo 6. 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. Lemma demo: forall x y z:nat, x = y -> x+y = y+ z -> 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 /sng. (* Let us instantiate the 2nd premis of h_all_eq_add_add without copying its type. Having variable u evarized (and then instantitated): *) especialize h_all_eq_add_add_ with u at 2. { apply Nat.add_0_l. } (* See how both u and (u + 1) have been removed from the hypothesis. *) Undo 4. (* We can do it for several hyps at a time: *) especialize h_all_eq_add_add_ with u,v until 2. { apply Nat.add_0_l. } { apply Nat.add_0_l. } Undo 7. (* We can do it for several hyps at a time: *) especialize h_all_eq_add_add_ with u,v at *. { apply Nat.add_0_l. } { apply Nat.add_0_l. } Undo 7. (* We can do it for several hyps at a time: *) especialize h_all_eq_add_add_ with u,v at 1,2. { apply Nat.add_0_l. } { apply Nat.add_0_l. } Undo 7. Restart. intros until 1. (** The taticals apply after any tactic. Notice how H:x=y is not new and hence not substituted (and becomes 0=y), whereas z = b + x is. *) destruct x eqn:heq;intros /sng. - apply I. - apply I. Qed. Unset Printing Compact Contexts. 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 => generalize 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 => generalize 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. ***) Unset Silent. 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 HAS CHANGED in libHyps 3 *) especialize H3 with p 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 numbers. *) (* THIS HAS CHANGED in libHyps 3 *) especialize H3 with n,m,p at 2,3. Undo. (* you can ask a goal for all premisses, in the spirit of the "exploit" tactic from CompCert. *) (* THIS HAS CHANGED in libHyps 3 *) especialize H3 with n,m,p at *. Undo. (* You can also specify that you want to instantiate the n first premisses. *) (* THIS HAS CHANGED in libHyps 3 *) especialize H3 with n,m,p until 3. (* Show 4. *) Undo. (* Note that non dependent variables must be given in order: *) Fail especialize H3 with n,p,m until 3. (* 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. (* Shortcut: *) 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. Require Import Ltac2.Ltac2. (* 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. *) Ltac2 rename_hyp_2 _n th := match! th with | Nat.eqb ?x ?y => [ String "Neqb" ; Rename x ; Rename y] end. (* Then overwrite the customization hook of the naming tactic *) Ltac2 Set rename_hyp := rename_hyp_2. (** 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. *) Ltac2 rename_hyp_3 n th := match! th with | ?x = false => [ Rename x ; String "isf" ] | ?x = true => [ Rename x ; String "ist" ] | _ => rename_hyp_2 n th (* previous naming scheme *) end. (* Then update the customization hook *) Ltac2 Set rename_hyp := rename_hyp_3. (* Close the naming scope *) Local Set Default Proof Mode "Classic". 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 *) Ltac2 Set rename_depth := 3. intros/n/g. Undo. (* Have shorter names: *) Ltac2 Set rename_depth := 2. intros/n/g. Abort. (*** Local Variables: ***) (*** eval: (company-coq-mode 1) ***) (*** End: ***) Matafou-LibHyps-112b273/tests/incremental1.v000066400000000000000000000036151516654451400206540ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental1_fix.v000066400000000000000000000040001516654451400215070ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental2.v000066400000000000000000000045231516654451400206540ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental2_fix.v000066400000000000000000000051671516654451400215270ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental3.v000066400000000000000000000050351516654451400206540ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental3_fix.v000066400000000000000000000051631516654451400215240ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental5.v000066400000000000000000000115071516654451400206570ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental5_libhyp.v000066400000000000000000000066761516654451400222410ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/incremental5_nolibhyps.v000066400000000000000000000076471516654451400227600ustar00rootroot00000000000000(* 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: ***) Matafou-LibHyps-112b273/tests/test_assert_premise.v000066400000000000000000000133311516654451400223520ustar00rootroot00000000000000Require Import Arith. Require Import LibHyps.LibHyps. Require Import Ltac2.Ltac2. Local Set Default Proof Mode "Classic". Definition eq_one (i:nat) := i = 1. (* Default configuration: variables are quantified unless not appearing in the type of the created hypothesis *) Ltac2 Set on_cited_vars := Evarize. Ltac2 Set dont_quantif_unused := true. Lemma test_espec_namings_premis: forall n:nat, (eq_one n -> eq_one 1 -> False) -> True. Proof. intros n h_eqone. assert premise 1 of Nat.quadmul_le_squareadd with a as h. { apply le_n. } Undo 4. assert premise 1 of Nat.quadmul_le_squareadd with a as hh (*: h*). { apply le_n. } Undo 4. assert premise 1 of min_l with n,m as hhh. { apply (le_n O). } Undo 4. assert premise 1 of min_l as hhh. { admit. } Undo 4. especialize h_eqone at 2 as h1 (*: h2 *). { reflexivity. } (* unfold eq_one in h2. *) (* 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. (* Testing the four variants of these config. *) Ltac2 Set on_cited_vars := Evarize. Ltac2 Set dont_quantif_unused := false. Goal (forall n p m:nat, n<=m -> n n=p -> False) -> True. intros h. assert premise 1 -> 2 of h with n,m as hh. match goal with | |- (nat -> ?n <= ?m -> ?n < ?m) => idtac end. 2:match type of hh with (nat -> ?n <= ?m -> ?n < ?m) => idtac end. Undo 3. assert premise 2 of h with n as hh. match goal with | |- nat -> forall m : nat, ?n < m => idtac end. Undo 2. assert premise 2 of h as hh. match goal with | |- forall n : nat, nat -> forall m : nat, n < m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h as hh. match goal with | |- forall n p m : nat, n <= m -> n < m -> n = p => idtac end. Undo 2. assert premise 1 -> 2 of h with n,m. match goal with | |- (nat -> ?n <= ?m -> ?n < ?m) => idtac end. 2:match type of H with (nat -> ?n <= ?m -> ?n < ?m) => idtac end. Undo 3. assert premise 2 of h with n. match goal with | |- nat -> forall m : nat, ?n < m => idtac end. Undo 2. assert premise 2 of h. match goal with | |- forall n : nat, nat -> forall m : nat, n < m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h. match goal with | |- forall n p m : nat, n <= m -> n < m -> n = p => idtac end. Undo 2. Ltac2 Set on_cited_vars := Evarize. Ltac2 Set dont_quantif_unused := true. assert premise 1 -> 2 of h with n,m as hh. match goal with | |- (?n <= ?m -> ?n < ?m) => idtac end. 2:match type of hh with (?n <= ?m -> ?n < ?m) => idtac end. Undo 3. assert premise 2 of h with n as hh. match goal with | |- forall m : nat, ?n < m => idtac end. Undo 2. assert premise 2 of h as hh. match goal with | |- forall n : nat, forall m : nat, n < m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h as hh. match goal with | |- forall n p m : nat, n <= m -> n < m -> n = p => idtac end. Undo 2. assert premise 1 -> 2 of h with n,m. match goal with | |- (?n <= ?m -> ?n < ?m) => idtac end. 2:match type of H with (?n <= ?m -> ?n < ?m) => idtac end. Undo 3. assert premise 2 of h with n. match goal with | |- forall m : nat, ?n < m => idtac end. Undo 2. assert premise 2 of h. match goal with | |- forall n : nat, forall m : nat, n < m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h. match goal with | |- forall n p m : nat, n <= m -> n < m -> n = p => idtac end. Undo 2. Ltac2 Set on_cited_vars := Quantify. Ltac2 Set dont_quantif_unused := false. assert premise 1 -> 2 of h with n,m as hh. match goal with | |- forall n m : nat, n <= m -> n < m => idtac end. 2:match type of hh with (forall n m : nat, n <= m -> n < m) => idtac end. Undo 3. assert premise 2 of h with n as hh. match goal with | |- forall n : nat, n < ?m => idtac end. Undo 2. assert premise 2 of h as hh. match goal with | |- ?n < ?m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h as hh. match goal with | |- ?n <= ?m -> ?n < ?m -> ?n = ?p => idtac end. Undo 2. assert premise 1 -> 2 of h with n,m. match goal with | |- forall n m : nat, n <= m -> n < m => idtac end. 2:match type of H with (forall n m : nat, n <= m -> n < m) => idtac end. Undo 3. assert premise 2 of h with n. match goal with | |- forall n : nat, n < ?m => idtac end. Undo 2. assert premise 2 of h. match goal with | |- ?n < ?m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h. match goal with | |- ?n <= ?m -> ?n < ?m -> ?n = ?p => idtac end. Undo 2. Ltac2 Set on_cited_vars := Quantify. Ltac2 Set dont_quantif_unused := true. (* should not change anything, since we (don't) evar unused vars anyways. *) assert premise 1 -> 2 of h with n,m as hh. match goal with | |- forall n m : nat, n <= m -> n < m => idtac end. 2:match type of hh with (forall n m : nat, n <= m -> n < m) => idtac end. Undo 3. assert premise 2 of h with n as hh. match goal with | |- forall n : nat, n < ?m => idtac end. Undo 2. assert premise 2 of h as hh. match goal with | |- ?n < ?m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h as hh. match goal with | |- ?n <= ?m -> ?n < ?m -> ?n = ?p => idtac end. Undo 2. assert premise 1 -> 2 of h with n,m. match goal with | |- forall n m : nat, n <= m -> n < m => idtac end. 2:match type of H with (forall n m : nat, n <= m -> n < m) => idtac end. Undo 3. assert premise 2 of h with n. match goal with | |- forall n : nat, n < ?m => idtac end. Undo 2. assert premise 2 of h. match goal with | |- ?n < ?m => idtac end. Undo 2. assert premise 1 -> 2 -> 3 of h. match goal with | |- ?n <= ?m -> ?n < ?m -> ?n = ?p => idtac end. Undo 2. Abort.