aboutsummaryrefslogtreecommitdiff
path: root/contrib/subtac/SubtacTactics.v
blob: 8c8f7c43ace0ca0550c188f174358168e518d5be (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Ltac induction_with_subterm c H :=
  let x := fresh "x" in
  let y := fresh "y" in
  (set(x := c) ; assert(y:x = c) by reflexivity ;
  rewrite <- y in H ; 
  induction H ; subst).

Ltac induction_on_subterm c :=
  let x := fresh "x" in
  let y := fresh "y" in
  (set(x := c) ; assert(y:x = c) by reflexivity ; clearbody x ; induction x ; inversion y ; try subst ; 
  clear y).

Ltac induction_with_subterms c c' H :=
  let x := fresh "x" in
  let y := fresh "y" in
  let z := fresh "z" in
  let w := fresh "w" in
  (set(x := c) ; assert(y:x = c) by reflexivity ;
  set(z := c') ; assert(w:z = c') by reflexivity ;
  rewrite <- y in H ; rewrite <- w in H ; 
  induction H ; subst).


Ltac destruct_one_pair :=
 match goal with
 | [H : (ex _) |- _] => destruct H
 | [H : (ex2 _) |- _] => destruct H
 | [H : (sig _) |- _] => destruct H
 | [H : (_ /\ _) |- _] => destruct H
end.

Ltac destruct_exists := repeat (destruct_one_pair) .

(* Destructs calls to f in hypothesis or conclusion, useful if f creates a subset object *)
Ltac destruct_call f :=
  match goal with
    | H : ?T |- _  =>
      match T with
         context [f ?x ?y ?z] => destruct (f x y z)
       | context [f ?x ?y] => destruct (f x y)
       | context [f ?x] => destruct (f x)        
      end
    | |- ?T  =>
      match T with
        context [f ?x ?y ?z] => let n := fresh "H" in set (n:=f x y z); destruct n
        | context [f ?x ?y] => let n := fresh "H" in set (n:=f x y); destruct n
        | context [f ?x] => let n := fresh "H" in set (n:=f x); destruct n
      end
    end.

Ltac myinjection :=
      let tac H := inversion H ; subst ; clear H in
        match goal with
          | [ H : ?f ?a = ?f' ?a' |- _ ] => tac H
          | [ H : ?f ?a ?b = ?f' ?a' ?b'  |- _ ] => tac H
          | [ H : ?f ?a ?b ?c = ?f' ?a' ?b' ?c' |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d= ?f' ?a' ?b' ?c' ?d' |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d ?e= ?f' ?a' ?b' ?c' ?d' ?e' |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d ?e ?g= ?f' ?a' ?b' ?c' ?d' ?e' ?g'  |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d ?e ?g ?h= ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' |- _ ] => tac H
          | [ H : ?f ?a ?b ?c ?d ?e ?g ?h ?i ?j = ?f' ?a' ?b' ?c' ?d' ?e'?g' ?h' ?i' ?j' |- _ ] => tac H
          | _ => idtac
        end.

Ltac destruct_nondep H := let H0 := fresh "H" in assert(H0 := H); destruct H0.

Ltac bang :=
  match goal with
    | |- ?x => 
      match x with
        | context [False_rect _ ?p] => elim p
      end
  end.

Ltac elim_eq_rect :=
  match goal with
    | [ |- ?t ] => 
      match t with
        context [ @eq_rect _ _ _ _ _ ?p ] => try case p ; simpl
      end
  end.