X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2Fnlibrary%2Fsets%2Fsetoids.ma;h=dac7b1375ac3f93fcafcfea033b5d39db1a69170;hb=e1cbf489bba32a8109f3373f43f9e3cfe2e0171f;hp=40982a660438b3479e40d5502aba581041d2ec47;hpb=70893c71a58e7788b9ec2256dd96f3d75818b61a;p=helm.git

diff --git a/helm/software/matita/nlibrary/sets/setoids.ma b/helm/software/matita/nlibrary/sets/setoids.ma
index 40982a660..dac7b1375 100644
--- a/helm/software/matita/nlibrary/sets/setoids.ma
+++ b/helm/software/matita/nlibrary/sets/setoids.ma
@@ -14,64 +14,95 @@
 
 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.