Commit 133d0628 authored by Adam Chlipala's avatar Adam Chlipala

Start of MoreDep port; new [dep_destruct] based on [dependent destruction]

parent cffeeacc
(* Copyright (c) 2008, Adam Chlipala (* Copyright (c) 2008-2009, Adam Chlipala
* *
* This work is licensed under a * This work is licensed under a
* Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
......
(* Copyright (c) 2008, Adam Chlipala (* Copyright (c) 2008-2009, Adam Chlipala
* *
* This work is licensed under a * This work is licensed under a
* Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
......
This diff is collapsed.
(* Copyright (c) 2008, Adam Chlipala (* Copyright (c) 2008-2009, Adam Chlipala
* *
* This work is licensed under a * This work is licensed under a
* Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
......
(* Copyright (c) 2008, Adam Chlipala (* Copyright (c) 2008-2009, Adam Chlipala
* *
* This work is licensed under a * This work is licensed under a
* Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 * Creative Commons Attribution-Noncommercial-No Derivative Works 3.0
......
...@@ -143,45 +143,14 @@ Ltac crush' lemmas invOne := ...@@ -143,45 +143,14 @@ Ltac crush' lemmas invOne :=
Ltac crush := crush' false fail. Ltac crush := crush' false fail.
Theorem dep_destruct : forall (T : Type) (T' : T -> Type) x (v : T' x) (P : T' x -> Type), Require Import Program.Equality.
(forall x' (v' : T' x') (Heq : x' = x), P (match Heq in (_ = x) return (T' x) with
| refl_equal => v'
end))
-> P v.
intros.
generalize (X _ v (refl_equal _)); trivial.
Qed.
Ltac dep_destruct E := Ltac dep_destruct E :=
let doit A := let x := fresh "x" in
let T := type of A in remember E as x; simpl in x; dependent destruction x;
generalize dependent E; try match goal with
let e := fresh "e" in | [ H : _ = E |- _ ] => rewrite <- H in *; clear H
intro e; pattern e; end.
apply (@dep_destruct T);
let x := fresh "x" with v := fresh "v" in
intros x v; destruct v; crush;
let bestEffort Heq E tac :=
repeat match goal with
| [ H : context[E] |- _ ] =>
match H with
| Heq => fail 1
| _ => generalize dependent H
end
end;
generalize Heq; tac Heq; clear Heq; intro Heq;
rewrite (UIP_refl _ _ Heq); intros in
repeat match goal with
| [ Heq : ?X = ?X |- _ ] =>
generalize (UIP_refl _ _ Heq); intro; subst; clear Heq
| [ Heq : ?E = _ |- _ ] => bestEffort Heq E ltac:(fun E => rewrite E)
| [ Heq : _ = ?E |- _ ] => bestEffort Heq E ltac:(fun E => rewrite <- E)
end
in match type of E with
| _ ?A => doit A
| _ _ ?A => doit A
| _ _ _ ?A => doit A
end.
Ltac clear_all := Ltac clear_all :=
repeat match goal with repeat match goal with
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment