Universe Set_u.
Universe Set_V.
Constraint Set_u < Set_V.
Create HintDb aczel_hints.
Inductive Tree : Type@{Set_V} :=
| mkNode (cs : Type@{Set_u}) (ts : forall c : cs, Tree) : Tree.
Fixpoint eqTree (lhs : Tree) (rhs : Tree) : Prop :=
match lhs, rhs with
| mkNode cs1 ts1, mkNode cs2 ts2 => (forall c1 : cs1, exists c2 : cs2, eqTree (ts1 c1) (ts2 c2)) /\ (forall c2 : cs2, exists c1 : cs1, eqTree (ts1 c1) (ts2 c2))
end.
#[global]
Instance eqTree_Reflexive
: Reflexive eqTree.
#[global] Hint Resolve member_intro : aczel_hints.
Definition isSubsetOf x y : Prop :=
forall z, z \in x -> z \in y.
#[local] Infix "\subseteq" := isSubsetOf : type_scope.
#[global] Hint Unfold isSubsetOf : aczel_hints.
#[global]
Instance isSubsetOf_PreOrder
: PreOrder isSubsetOf.
#[global]
Instance isSubsetOf_PartialOrder
: PartialOrder eqProp isSubsetOf.
#[global]
Add Parametric Morphism
: isSubsetOf with signature (eqProp ==> eqProp ==> iff)
as isSubsetOf_compatWith_eqProp.
Proof with eauto with *.
intros x1 y1 EQ1 x2 y2 EQ2. transitivity (x1 \subseteq y2); unfold "\subseteq"; split; intros SUBSET z H_in.
- rewrite <- EQ2...
- rewrite -> EQ2...
- rewrite <- EQ1 in H_in...
- rewrite -> EQ1 in H_in...
Qed.
(** Section SET_CONSTRUCTIONS. *)
#[local] Opaque eqProp.
Definition filterc (x : Tree) (P : children x -> Prop) : Tree :=
mkNode (@sig (children x) P) (fun c => childnodes x (proj1_sig c)).
#[global] Hint Rewrite filterc_spec : simplication_hints.
Definition filter (P : Tree -> Prop) (x : Tree) : Tree :=
filterc x (fun c => P (childnodes x c)).
#[global] Hint Rewrite filter_spec : simplication_hints.
#[global]
Instance filter_eqPropCompatible1 P
(COMPAT : isCompatibleWith_eqProp P)
: eqPropCompatible1 (filter P).
Definition power (x : Tree) : Tree :=
mkNode (children x -> Prop) (filterc x).
#[global] Hint Rewrite power_spec : simplication_hints.
#[global]
Instance power_eqPropCompatible1
: eqPropCompatible1 power.
Definition indexed_union (I : Type@{Set_u}) (x_i : I -> Tree) : Tree :=
mkNode { i : I & children (x_i i) } (fun c => childnodes (x_i (projT1 c)) (projT2 c)).
#[global] Hint Rewrite indexed_union_spec : simplication_hints.
#[global]
Instance indexed_union_eqPropCompatible1 I
: eqPropCompatible1 (indexed_union I).
Definition unions (x : Tree) : Tree :=
indexed_union (children x) (childnodes x).
#[global] Hint Rewrite unions_spec : simplication_hints.
#[global]
Instance unions_eqPropCompatible1
: eqPropCompatible1 unions.
Definition empty : Tree :=
mkNode Empty_set (@Empty_set_rect (fun _ => Tree)).
#[global] Hint Rewrite empty_spec : simplication_hints.
Definition upair (x1 : Tree) (x2 : Tree) : Tree :=
mkNode bool (fun b => if b then x1 else x2).
#[global] Hint Rewrite upair_spec : simplication_hints.
#[global]
Instance upair_eqPropCompatible2
: eqPropCompatible2 upair.
#[global]
Instance upair_comm
: isCommutative upair.
Definition union (x1 : Tree) (x2 : Tree) : Tree :=
unions (upair x1 x2).
#[global] Hint Rewrite union_spec : simplication_hints.
#[global]
Instance union_eqPropCompatible2
: eqPropCompatible2 union.
Definition intersection (x : Tree) (y : Tree) : Tree :=
filter (fun z => z \in x) y.
#[global] Hint Rewrite intersection_spec : simplication_hints.
#[global]
Instance intersection_eqPropCompatible2
: eqPropCompatible2 intersection.
Definition singlton (x : Tree) : Tree :=
upair x x.
#[global] Hint Rewrite singlton_spec : simplication_hints.
#[global]
Instance singlton_eqPropCompatible1
: eqPropCompatible1 singlton.
Definition pair (x : Tree) (y : Tree) : Tree :=
upair (singlton x) (upair x y).
#[global]
Instance pair_eqPropCompatible2
: eqPropCompatible2 pair.
Definition fst (t : Tree) : Tree :=
unions (filter (fun x => singlton x \in t) (unions t)).
#[global]
Instance fst_eqPropCompatible1
: eqPropCompatible1 fst.
Definition snd (t : Tree) : Tree :=
unions (filter (fun y => pair (fst t) y == t) (unions t)).
#[global]
Instance snd_eqPropCompatible1
: eqPropCompatible1 snd.
Definition Cartesian_product (X : Tree) (Y : Tree) : Tree :=
filter (fun z => exists x, x \in X /\ exists y, y \in Y /\ z == pair x y) (power (power (union X Y))).

Lemma Cartesian_product_spec X Y
: forall z, z \in Cartesian_product X Y <-> (exists x, x \in X /\ exists y, y \in Y /\ z == pair x y).