include "logic/connectives.ma".
include "properties/relations.ma".
+include "hints_declaration.ma".
+
+(*
+notation "hvbox(a break = \sub \ID b)" non associative with precedence 45
+for @{ 'eqID $a $b }.
+
+notation > "hvbox(a break =_\ID b)" non associative with precedence 45
+for @{ cic:/matita/logic/equality/eq.ind#xpointer(1/1) ? $a $b }.
+
+interpretation "ID eq" 'eqID x y = (cic:/matita/logic/equality/eq.ind#xpointer(1/1) ? x y).
+*)
nrecord setoid : Type[1] ≝
- { carr:> Type;
- eq: carr → carr → CProp;
- refl: reflexive … eq;
- sym: symmetric … eq;
- trans: transitive … eq
+ { carr:> Type[0];
+ eq: equivalence_relation carr
}.
-ndefinition proofs: CProp → setoid.
-#P; napply (mk_setoid …);
-##[ napply P;
-##| #x; #y; napply True;
-##|##*: nwhd; nrepeat (#_); napply I;
-##]
-nqed.
+interpretation "setoid eq" 'eq t x y = (eq_rel ? (eq t) x y).
+
+notation > "hvbox(a break =_0 b)" non associative with precedence 45
+for @{ eq_rel ? (eq ?) $a $b }.
-nrecord function_space (A,B: setoid): Type ≝
- { f:1> A → B;
- f_ok: ∀a,a':A. proofs (eq … a a') → proofs (eq … (f a) (f a'))
+interpretation "setoid symmetry" 'invert r = (sym ???? r).
+notation ".= r" with precedence 50 for @{'trans $r}.
+interpretation "trans" 'trans r = (trans ????? r).
+
+nrecord unary_morphism (A,B: setoid) : Type[0] ≝
+ { fun1:1> A → B;
+ prop1: ∀a,a'. eq ? a a' → eq ? (fun1 a) (fun1 a')
}.
-notation "hbox(a break ⇒ b)" right associative with precedence 20 for @{ 'Imply $a $b }.
-
-ndefinition function_space_setoid: setoid → setoid → setoid.
- #A; #B; napply (mk_setoid …);
-##[ napply (function_space A B);
-##| #f; #f1; napply (∀a:A. proofs (eq … (f a) (f1 a)));
-##| nwhd; #x; #a;
- napply (f_ok … x …); (* QUI!! *)
-(* unfold carr; unfold proofs; simplify;
- apply (refl A)
- | simplify;
- intros;
- unfold carr; unfold proofs; simplify;
- apply (sym B);
- apply (f a)
- | simplify;
- intros;
- unfold carr; unfold proofs; simplify;
- apply (trans B ? (y a));
- [ apply (f a)
- | apply (f1 a)]]
-qed.
-
-nrecord isomorphism (A,B: setoid): Type ≝
- { map1:> function_space_setoid A B;
- map2:> function_space_setoid B A;
- inv1: ∀a:A. proofs (eq ? (map2 (map1 a)) a);
- inv2: ∀b:B. proofs (eq ? (map1 (map2 b)) b)
+nrecord binary_morphism (A,B,C:setoid) : Type[0] ≝
+ { fun2:2> A → B → C;
+ prop2: ∀a,a',b,b'. eq ? a a' → eq ? b b' → eq ? (fun2 a b) (fun2 a' b')
}.
-interpretation "isomorphism" 'iff x y = (isomorphism x y).
+notation "† c" with precedence 90 for @{'prop1 $c }.
+notation "l ‡ r" with precedence 90 for @{'prop2 $l $r }.
+notation "#" with precedence 90 for @{'refl}.
+interpretation "prop1" 'prop1 c = (prop1 ????? c).
+interpretation "prop2" 'prop2 l r = (prop2 ???????? l r).
+interpretation "refl" 'refl = (refl ???).
+
+ndefinition binary_morph_setoid : setoid → setoid → setoid → setoid.
+#S1; #S2; #T; @ (binary_morphism S1 S2 T); @;
+##[ #f; #g; napply (∀x,y. f x y = g x y);
+##| #f; #x; #y; napply #;
+##| #f; #g; #H; #x; #y; napply ((H x y)^-1);
+##| #f; #g; #h; #H1; #H2; #x; #y; napply (trans … (H1 …) (H2 …)); ##]
+nqed.
+
+ndefinition unary_morph_setoid : setoid → setoid → setoid.
+#S1; #S2; @ (unary_morphism S1 S2); @;
+##[ #f; #g; napply (∀x. f x = g x);
+##| #f; #x; napply #;
+##| #f; #g; #H; #x; napply ((H x)^-1);
+##| #f; #g; #h; #H1; #H2; #x; napply (trans … (H1 …) (H2 …)); ##]
+nqed.
(*
-record dependent_product (A:setoid) (B: A ⇒ setoids): Type ≝
- { dp:> ∀a:A.carr (B a);
- dp_ok: ∀a,a':A. ∀p:proofs1 (eq1 ? a a'). proofs1 (eq1 ? (dp a) (map2 ?? (f1_ok ?? B ?? p) (dp a')))
- }.*)
+unification hint 0
+ (∀o1,o2. (λx,y:Type[0].True) (carr (unary_morph_setoid o1 o2)) (unary_morphism o1 o2)).
+*)
+
+ndefinition composition ≝
+ λo1,o2,o3:Type[0].λf:o2 → o3.λg: o1 → o2.λx.f (g x).
- *)
\ No newline at end of file
+interpretation "function composition" 'compose f g = (composition ??? f g).
+
+ndefinition comp_unary_morphisms:
+ ∀o1,o2,o3:setoid.
+ unary_morphism o2 o3 → unary_morphism o1 o2 →
+ unary_morphism o1 o3.
+#o1; #o2; #o3; #f; #g; @ (f ∘ g);
+ #a; #a'; #e; nnormalize; napply (.= †(†e)); napply #.
+nqed.
+
+unification hint 0 ≔ o1,o2,o3:setoid,f:unary_morphism o2 o3,g:unary_morphism o1 o2;
+ R ≟ (mk_unary_morphism ?? (composition … f g)
+ (prop1 ?? (comp_unary_morphisms o1 o2 o3 f g)))
+ (* -------------------------------------------------------------------- *) ⊢
+ fun1 ?? R ≡ (composition … f g).
+
+ndefinition comp_binary_morphisms:
+ ∀o1,o2,o3.
+ binary_morphism (unary_morph_setoid o2 o3) (unary_morph_setoid o1 o2)
+ (unary_morph_setoid o1 o3).
+#o1; #o2; #o3; @
+ [ #f; #g; napply (comp_unary_morphisms … f g) (*CSC: why not ∘?*)
+ | #a; #a'; #b; #b'; #ea; #eb; #x; nnormalize;
+ napply (.= †(eb x)); napply ea.
+nqed.
projects / helm.git / blobdiff