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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user