+
+
+alias symbol "nleq" = "Excess base excess".
+lemma subst_excess_base_in_semi_lattice:
+ ∀sl:semi_lattice.
+ ∀eb:excess_base.
+ ∀p:exc_carr sl = exc_carr eb.
+ (∀y1,x1:eb. (?(ap_apart sl)) y1 x1 → y1 ≰ x1 ∨ x1 ≰ y1) →
+ (∀y2,x2:eb.y2 ≰ x2 ∨ x2 ≰ y2 → (?(ap_apart sl)) y2 x2) →
+ (∀x3,y3:eb.(le eb) x3 y3 → (?(eq sl)) x3 ((?(sl_meet sl)) x3 y3)) →
+ (∀x4,y4:eb.(le eb) ((?(sl_meet sl)) x4 y4) y4) →
+ semi_lattice.
+[2:apply Prop|3,7,9,10:apply Type|4:apply (exc_carr eb)|1,5,6,8,11:intro f; cases p; apply f;]
+intros (sl eb H H1 H2 H3 H4);
+apply (subst_excess sl);
+ [apply (subst_excess_base_in_excess sl eb H H1 H2);
+ |apply subst_excess_base_in_excess_preserves_apartness;
+ |change in ⊢ (%→%→?) with ((λx.ap_carr x) (subst_excess_base_in_excess (sl_exc sl) eb H H1 H2)); simplify;
+ intros 3 (x y LE);
+ generalize in match (H3 ?? LE);
+ generalize in match H1 as H1;generalize in match H2 as H2;
+ generalize in match x as x; generalize in match y as y;
+ cases FALSE;
+ (*
+ (reduce in H ⊢ %; cases H; simplify; intros; assumption);
+
+
+ cases (subst_excess_base_in_excess_preserves_apartness (sl_exc sl) eb H H1 H2); simplify;
+ change in x:(%) with (exc_carr eb);
+ change in y:(%) with (exc_carr eb);
+ generalize in match OK; generalize in match x as x; generalize in match y as y;
+ cases H; simplify; (* funge, ma devo fare 2 rewrite in un colpo solo *)
+ *)
+ |cases FALSE;
+ ]
+qed.
+
+record lattice_ : Type ≝ {
+ latt_mcarr:> semi_lattice;
+ latt_jcarr_: semi_lattice;
+ W1:?; W2:?; W3:?; W4:?; W5:?;
+ latt_with1: latt_jcarr_ = subst_excess_base_in_semi_lattice latt_jcarr_
+ (excess_base_OF_semi_lattice latt_mcarr) W1 W2 W3 W4 W5
+}.
+
+lemma latt_jcarr : lattice_ → semi_lattice.
+intro l; apply (subst_excess_base_in_semi_lattice (latt_jcarr_ l) (excess_base_OF_semi_lattice (latt_mcarr l)) (W1 l) (W2 l) (W3 l) (W4 l) (W5 l));
+qed.
+
+coercion cic:/matita/lattice/latt_jcarr.con.
+
+interpretation "Lattice meet" 'and a b =
+ (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_mcarr.con _) a b).
+
+interpretation "Lattice join" 'or a b =
+ (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_jcarr.con _) a b).
+
+record lattice : Type ≝ {
+ latt_carr:> lattice_;
+ absorbjm: ∀f,g:latt_carr. (f ∨ (f ∧ g)) ≈ f;
+ absorbmj: ∀f,g:latt_carr. (f ∧ (f ∨ g)) ≈ f
+}.
+
+notation "'meet'" non associative with precedence 50 for @{'meet}.
+notation "'meet_refl'" non associative with precedence 50 for @{'meet_refl}.
+notation "'meet_comm'" non associative with precedence 50 for @{'meet_comm}.
+notation "'meet_assoc'" non associative with precedence 50 for @{'meet_assoc}.
+notation "'strong_extm'" non associative with precedence 50 for @{'strong_extm}.
+notation "'le_to_eqm'" non associative with precedence 50 for @{'le_to_eqm}.
+notation "'lem'" non associative with precedence 50 for @{'lem}.
+notation "'join'" non associative with precedence 50 for @{'join}.
+notation "'join_refl'" non associative with precedence 50 for @{'join_refl}.
+notation "'join_comm'" non associative with precedence 50 for @{'join_comm}.
+notation "'join_assoc'" non associative with precedence 50 for @{'join_assoc}.
+notation "'strong_extj'" non associative with precedence 50 for @{'strong_extj}.
+notation "'le_to_eqj'" non associative with precedence 50 for @{'le_to_eqj}.
+notation "'lej'" non associative with precedence 50 for @{'lej}.
+
+interpretation "Lattice meet" 'meet = (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_refl" 'meet_refl = (cic:/matita/lattice/sl_meet_refl.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_comm" 'meet_comm = (cic:/matita/lattice/sl_meet_comm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice meet_assoc" 'meet_assoc = (cic:/matita/lattice/sl_meet_assoc.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice strong_extm" 'strong_extm = (cic:/matita/lattice/sl_strong_extm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice le_to_eqm" 'le_to_eqm = (cic:/matita/lattice/sl_le_to_eqm.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice lem" 'lem = (cic:/matita/lattice/sl_lem.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice join" 'join = (cic:/matita/lattice/sl_meet.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_refl" 'join_refl = (cic:/matita/lattice/sl_meet_refl.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_comm" 'join_comm = (cic:/matita/lattice/sl_meet_comm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice join_assoc" 'join_assoc = (cic:/matita/lattice/sl_meet_assoc.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice strong_extm" 'strong_extj = (cic:/matita/lattice/sl_strong_extm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice le_to_eqj" 'le_to_eqj = (cic:/matita/lattice/sl_le_to_eqm.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice lej" 'lej = (cic:/matita/lattice/sl_lem.con (cic:/matita/lattice/latt_jcarr.con _)).
+
+notation "'feq_jl'" non associative with precedence 50 for @{'feq_jl}.
+notation "'feq_jr'" non associative with precedence 50 for @{'feq_jr}.
+notation "'feq_ml'" non associative with precedence 50 for @{'feq_ml}.
+notation "'feq_mr'" non associative with precedence 50 for @{'feq_mr}.
+interpretation "Lattice feq_jl" 'feq_jl = (cic:/matita/lattice/sl_feq_ml.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice feq_jr" 'feq_jr = (cic:/matita/lattice/sl_feq_mr.con (cic:/matita/lattice/latt_jcarr.con _)).
+interpretation "Lattice feq_ml" 'feq_ml = (cic:/matita/lattice/sl_feq_ml.con (cic:/matita/lattice/latt_mcarr.con _)).
+interpretation "Lattice feq_mr" 'feq_mr = (cic:/matita/lattice/sl_feq_mr.con (cic:/matita/lattice/latt_mcarr.con _)).
+
+
+interpretation "Lattive meet le" 'leq a b =
+ (cic:/matita/excess/le.con (cic:/matita/lattice/excess_OF_lattice1.con _) a b).
+
+interpretation "Lattive join le (aka ge)" 'geq a b =
+ (cic:/matita/excess/le.con (cic:/matita/lattice/excess_OF_lattice.con _) a b).
+
+(* these coercions help unification, handmaking a bit of conversion
+ over an open term
+*)
+lemma le_to_ge: ∀l:lattice.∀a,b:l.a ≤ b → b ≥ a.
+intros(l a b H); apply H;
+qed.
+
+lemma ge_to_le: ∀l:lattice.∀a,b:l.b ≥ a → a ≤ b.
+intros(l a b H); apply H;
+qed.