diff --git a/FinSets.v b/FinSets.v index 3b9d2c0..6bbeafc 100644 --- a/FinSets.v +++ b/FinSets.v @@ -1,5 +1,5 @@ -Require Import HoTT. Require Export HoTT. +Require Import HitTactics. Module Export FinSet. @@ -45,6 +45,10 @@ Fixpoint FinSets_rec (FinSets_rec A P e l u assocP commP nlP nrP idemP z) end) assocP commP nlP nrP idemP. +Definition FinSetsCL A : HitRec.class (FinSets A) _ := + HitRec.Class (FinSets A) (fun x P e l u aP cP lP rP iP => FinSets_rec A P e l u aP cP lP rP iP x). +Canonical Structure FinSetsTy A : HitRec.type := HitRec.Pack _ _ (FinSetsCL A). + Axiom FinSets_beta_assoc : forall (A : Type) (P : Type) @@ -133,129 +137,66 @@ Axiom FinSets_beta_idem : forall idemP x. End FinSet. -Definition isIn : forall - (A : Type) - (eq : A -> A -> Bool), - A -> FinSets A -> Bool. +Section functions. +Parameter A : Type. +Parameter eq : A -> A -> Bool. +Definition isIn : A -> FinSets A -> Bool. Proof. -intro A. -intro eq. -intro a. -refine (FinSets_rec A _ _ _ _ _ _ _ _ _). - Unshelve. - - Focus 6. - apply false. - - Focus 6. - intro a'. - apply (eq a a'). - - Focus 6. - intro b. - intro b'. - apply (orb b b'). - - Focus 3. - intros. - compute. - reflexivity. - - Focus 1. - intros. - compute. - destruct x. - reflexivity. - destruct y. - reflexivity. - reflexivity. - - Focus 1. - intros. - compute. - destruct x. - destruct y. - reflexivity. - reflexivity. - destruct y. - reflexivity. - reflexivity. - - Focus 1. - intros. - compute. - destruct x. - reflexivity. - reflexivity. - - intros. - compute. - destruct (eq a x). - reflexivity. - reflexivity. +intros a X. +hrecursion X. +- exact false. +- intro a'. apply (eq a a'). +- apply orb. +- intros x y z. compute. destruct x; reflexivity. +- intros x y. compute. destruct x, y; reflexivity. +- intros x. compute. reflexivity. +- intros x. compute. destruct x; reflexivity. +- intros a'. compute. destruct (eq a a'); reflexivity. Defined. -Definition comprehension : forall - (A : Type) - (eq : A -> A -> Bool), + +Definition comprehension : (A -> Bool) -> FinSets A -> FinSets A. Proof. -intro A. -intro eq. -intro phi. -refine (FinSets_rec A _ _ _ _ _ _ _ _ _). - Unshelve. - - Focus 6. - apply empty. - - Focus 6. - intro a. - apply (if (phi a) then L A a else (empty A)). - - Focus 6. - intro x. - intro y. - apply (U A x y). - - Focus 3. - intros. - compute. - apply nl. - - Focus 1. - intros. - compute. - apply assoc. - - Focus 1. - intros. - compute. - apply comm. - - Focus 1. - intros. - compute. - apply nr. - - intros. - compute. - destruct (phi x). - apply idem. - apply nl. +intros P X. +hrecursion X. +- apply empty. +- intro a. + refine (if (P a) then L A a else empty A). +- intros X Y. + apply (U A X Y). +- intros. cbv. apply assoc. +- intros. cbv. apply comm. +- intros. cbv. apply nl. +- intros. cbv. apply nr. +- intros. cbv. + destruct (P x); simpl. + + apply idem. + + apply nl. Defined. -Definition intersection : forall (A : Type) (eq : A -> A -> Bool), +Definition intersection : FinSets A -> FinSets A -> FinSets A. Proof. -intro A. -intro eq. -intro x. -intro y. -apply (comprehension A eq (fun (a : A) => isIn A eq a x) y). +intros X Y. +apply (comprehension (fun (a : A) => isIn a X) Y). Defined. -Definition subset (A : Type) (eq : A -> A -> Bool) (x : FinSets A) (y : FinSets A) : Bool. +Definition subset (x : FinSets A) (y : FinSets A) : Bool. +Proof. +hrecursion x. +- apply true. +- intro a. apply (isIn a y). +- apply andb. +- intros a b c. compute. destruct a; reflexivity. +- intros a b. compute. destruct a, b; reflexivity. +- intros x. compute. reflexivity. +- intros x. compute. destruct x;reflexivity. +- intros a. simpl. + destruct (isIn a y); reflexivity. +Defined. + +Definition subset' (x : FinSets A) (y : FinSets A) : Bool. Proof. refine (FinSets_rec A _ _ _ _ _ _ _ _ _ _). Unshelve. @@ -268,7 +209,7 @@ refine (FinSets_rec A _ _ _ _ _ _ _ _ _ _). Focus 6. intro a. - apply (isIn A eq a y). + apply (isIn a y). Focus 6. intro b. @@ -308,15 +249,16 @@ refine (FinSets_rec A _ _ _ _ _ _ _ _ _ _). reflexivity. intros. - destruct (isIn A eq x0 y). + destruct (isIn x0 y). compute. reflexivity. compute. reflexivity. Defined. +(* TODO: subset = subset' *) -Definition equal_set (A : Type) (eq : A -> A -> Bool) (x : FinSets A) (y : FinSets A) : Bool - := andb (subset A eq x y) (subset A eq y x). +Definition equal_set (x : FinSets A) (y : FinSets A) : Bool + := andb (subset x y) (subset y x). Fixpoint eq_nat n m : Bool := match n, m with @@ -324,4 +266,6 @@ Fixpoint eq_nat n m : Bool := | O, S _ => false | S _, O => false | S n1, S m1 => eq_nat n1 m1 - end. \ No newline at end of file + end. + +End functions. \ No newline at end of file diff --git a/HitTactics.v b/HitTactics.v new file mode 100644 index 0000000..d43f35b --- /dev/null +++ b/HitTactics.v @@ -0,0 +1,72 @@ +Module HitRec. +Record class (H : Type) (* The HIT type itself *) + (recTy : H -> Type) (* The type of the recursion principle *) + := Class { recursion_term : forall (x : H), recTy x }. +Structure type := Pack { obj : Type ; rec : obj -> Type ; class_of : class obj rec }. +Definition hrecursion (e : type) : forall x, rec e x := + let 'Pack _ _ (Class r) := e + in r. +Arguments hrecursion {e} x : simpl never. +Arguments Class H {recTy} recursion_term. +End HitRec. + +Ltac hrecursion_ target := + generalize dependent target; + match goal with + | [ |- forall target, ?P] => intro target; + match type of (HitRec.hrecursion target) with + | ?Q => + match (eval simpl in Q) with + | forall Y , Y target => + simple refine (HitRec.hrecursion target (fun target => P) _) + | forall Y _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _) + | forall Y _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _) + | forall Y _ _ _, Y target => + let hrec:=(eval hnf in (HitRec.hrecursion target)) in + simple refine (hrec (fun target => P) _ _ _) + | forall Y _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _) + | forall Y _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _) + | forall Y _ _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _ _ _, Y target => + simple refine (HitRec.hrecursion target (fun target => P) _ _ _ _ _ _ _ _ _) + | forall Y, Y => + simple refine (HitRec.hrecursion target P) + | forall Y _, Y => + simple refine (HitRec.hrecursion target P _) + | forall Y _ _, Y => + simple refine (HitRec.hrecursion target P _ _) + | forall Y _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _) + | forall Y _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _) + | forall Y _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _) + | forall Y _ _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _ _ _ _ _) + | forall Y _ _ _ _ _ _ _ _ _ _, Y => + simple refine (HitRec.hrecursion target P _ _ _ _ _ _ _ _ _ _) + | _ => fail "Cannot handle the recursion principle (too many parameters?) :(" + end + end + end. + +Ltac hrecursion x := hrecursion_ x; simpl; try (clear x). + + diff --git a/Mod2.v b/Mod2.v index b65a225..2f9bc8d 100644 --- a/Mod2.v +++ b/Mod2.v @@ -1,6 +1,6 @@ -Require Import HoTT. Require Export HoTT. +Require Import HitTactics. Module Export modulo. Private Inductive Mod2 : Type0 := @@ -51,44 +51,38 @@ Axiom Mod2_rec_beta_mod : forall (mod' : a = s (s a)) , ap (Mod2_rec P a s mod') mod = mod'. + +Definition Mod2CL : HitRec.class Mod2 _ := + HitRec.Class Mod2 (fun x P a s p => Mod2_ind P a s p x). +Canonical Structure Mod2ty : HitRec.type := HitRec.Pack Mod2 _ Mod2CL. + End modulo. -Definition negate : Mod2 -> Mod2. -Proof. -refine (Mod2_ind _ _ _ _). - Unshelve. - Focus 2. - apply (succ Z). - - Focus 2. - intros. - apply (succ H). - - simpl. - rewrite transport_const. - rewrite <- mod. - reflexivity. -Defined. Theorem modulo2 : forall n : Mod2, n = succ(succ n). Proof. -refine (Mod2_ind _ _ _ _). - Unshelve. - Focus 2. - apply mod. +intro n. +hrecursion n. +- apply mod. +- intros n p. + apply (ap succ p). +- simpl. + etransitivity. + eapply (@transport_paths_FlFr _ _ idmap (fun n => succ (succ n))). + hott_simpl. + apply ap_compose. +Defined. - Focus 2. - intro n. - intro p. - apply (ap succ p). - - simpl. - rewrite @HoTT.Types.Paths.transport_paths_FlFr. - rewrite ap_idmap. - rewrite concat_Vp. - rewrite concat_1p. - rewrite ap_compose. - reflexivity. +Definition negate : Mod2 -> Mod2. +Proof. +intro x. +hrecursion x. +- apply Z. +- intros. apply (succ H). +- simpl. + etransitivity. + eapply transport_const. + eapply modulo2. Defined. Definition plus : Mod2 -> Mod2 -> Mod2. diff --git a/_CoqProject b/_CoqProject index bba943f..8c51bd5 100644 --- a/_CoqProject +++ b/_CoqProject @@ -1,5 +1,6 @@ -R . "" COQC = hoqc COQDEP = hoqdep +HitTactics.v Mod2.v FinSets.v Expressions.v