1
0
mirror of https://github.com/nmvdw/HITs-Examples synced 2025-11-03 07:03:51 +01:00

Get a quotient from an implementation

This commit is contained in:
2017-08-08 17:06:53 +02:00
parent 3cda0d9bf2
commit 80dabe3162
2 changed files with 236 additions and 39 deletions

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