Get a quotient from an implementation

This commit is contained in:
dan committed 2017-08-08 17:31:23 +02:00
1 parent 3cda0d9bf2
commit 80dabe3162
2 files changed
+236 -39

No files matched your search

+28 -27
View File
@@ -11,38 +11,39 @@ Definition hrecursion (H : Type) {HR : HitRecursion H} : @recTy H HR :=
Definition hinduction (H : Type) {HR : HitRecursion H} : @indTy H HR :=
@H_inductor H HR.
(* TODO: use information from recTy instead of [typeof hrec]? *)
Ltac hrecursion_ :=
lazymatch goal with
| [ |- ?T -> ?P ] =>
let hrec1 := eval cbv[hrecursion H_recursor] in (hrecursion T) in
let hrec := eval simpl in hrec1 in
match type of hrec with
| ?Q =>
match (eval simpl in Q) with
| forall Y, T -> Y =>
simple refine (hrec P)
| forall Y _, T -> Y =>
simple refine (hrec P _)
| forall Y _ _, T -> Y =>
simple refine (hrec P _ _)
| forall Y _ _ _, T -> Y =>
simple refine (hrec P _ _ _)
| forall Y _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _)
| forall Y _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _)
| forall Y _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _ _ _)
| _ => fail "Cannot handle the recursion principle (too many parameters?) :("
end
let hrecTy1 := eval cbv[recTy] in (@recTy T _) in
let hrecTy := eval simpl in hrecTy1 in
match hrecTy with
| forall Y, T -> Y =>
simple refine (hrec P)
| forall Y _, T -> Y =>
simple refine (hrec P _)
| forall Y _ _, T -> Y =>
simple refine (hrec P _ _)
| forall Y _ _ _, T -> Y =>
simple refine (hrec P _ _ _)
| forall Y _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _)
| forall Y _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _)
| forall Y _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _ _)
| forall Y _ _ _ _ _ _ _ _ _ _, T -> Y =>
simple refine (hrec P _ _ _ _ _ _ _ _ _ _)
| _ => fail "Cannot handle the recursion principle (too many parameters?) :("
end
| [ |- forall (target:?T), ?P] =>
let hind1 := eval cbv[hinduction H_inductor] in (hinduction T) in