Section Vect.
(* Our Field *)
Variable F: fparams.
Hypothesis FT:
@field_theory (Field.K F) (v0 F) (v1 F) (addK F) (multK F)
(fun x y => (addK F) x (oppK F y)) (oppK F)
(fun x y => (multK F) x (invK F y)) (invK F) (@Logic.eq F).
Add Field Kfth : FT.
(******************************************************************************)
(*   Instanciation of Grassman for n = 3                                      *)
(******************************************************************************)
Definition Pp: params :=  {| dim := 3; K := F |}.
Variable HP : fparamsProp Pp.
SubClass point := Kn Pp.
SubClass vect := Vect Pp.
Definition Vjoin (x y : vect): vect := Vjoin Pp x y.
Notation "x '∨' y" := (Vjoin x y) (at level 40, left associativity).
Definition Vadd (x y : vect): vect := Vadd Pp x y.
Notation "x + y" := (Vadd x y).
Definition Vsub (x y : vect): vect := sub Pp Pp x y.
Notation "x - y" := (Vsub x y).
Definition Vscal (k : F) (x : vect): vect := Vscal Pp k x.
Notation "k .* x" := (Vscal k x).
Definition Vmeet (x y : vect): vect := Vmeet Pp x y.
Notation "x '∧' y" := (Vmeet x y) (at level 45, left associativity).
Definition Vdual (x : vect): vect := Vdual Pp x.
Notation "'@  x" := (Vdual x) (at level 9).
Definition Veq (x y : vect): bool := Veq Pp x y.
Notation "x ?= y" := (Veq x y).
Definition Vgenk (k : F): vect := (Vgenk Pp k).
Notation "0" := (Vgenk 0%f).
Notation "1" := (Vgenk 1%f).
Definition hom (n: nat) (x : vect) := (hom Pp Pp n x).
Notation "'dC[ x ]" := (dconst Pp 3 x).
Notation "'C[ x ]" := (const Pp 3 x).
Notation "'E'" := (all Pp 3: vect).
Coercion p2v (x : point) := (K2G Pp x): vect.
Let scal0l x : 0%f .*  x = 0.
Let join_id: forall (x : point), x ∨ x = 0.
Let add_com x y : x + y = y + x.
(******************************************************************************)
(*   Definition of the bracket operator                                       *)
(******************************************************************************)
Definition bracket x y z : F := 'dC[x ∨ y ∨ z].
Notation "'E'" := (all Pp 3: vect).
Notation "'[ x , y , z ]" := (bracket x y z).
(******************************************************************************)
(* A tactic to prove homogeneity                                              *)
(******************************************************************************)
(* A tactic to normalize one specific bracket *)
Ltac normb a b c :=
generalize (bracket_norm a b c);
intros (Hn1, (Hn2, (Hn3, (Hn4, Hn5))));
rewrite ?Hn1, ?Hn2, ?Hn3, ?Hn4, ?Hn5;
clear Hn1 Hn2 Hn3 Hn4 Hn5.
Definition fbracket a b c:= '[a, b, c].
(* A tactic to globally normalize brackets *)
Ltac normbs :=
repeat match goal with |- context['[p2v ?a,p2v ?b,p2v ?c]] =>
generalize (fbracket_norm a b c);
intros (Hn1, (Hn2, (Hn3, (Hn4, (Hn5, Hn6)))));
rewrite ?Hn1, ?Hn2, ?Hn3, ?Hn4, ?Hn5, ?Hn6;
clear Hn1 Hn2 Hn3 Hn4 Hn5 Hn6
end; unfold fbracket.
(******************************************************************************)
(*   Some distributivity rules                                                *)
(******************************************************************************)
rewrite expand_meetl.
rewrite sub_add, meet_addl.
rewrite !meet_scall.
pattern (x2 ∧ x5 ∨ x6) at 1; rewrite <- join1l.
rewrite bracket_swapr, bracket_swapl; Krm1.
rewrite <-join_scall, <-bracket_defl.
pattern (x1 ∧ x5 ∨ x6) at 1; rewrite <- join1l.
rewrite bracket_swapr, bracket_swapl; Krm1.
rewrite <-join_scall, <-bracket_defl; auto.
Qed.

Lemma join_meet3r (a b c d e f: point) :
((a ∨ b) ∧ (c ∨ d)) ∨ (e ∨ f) = ((a ∨ b) ∧ (c ∨ d) ∧ (e ∨ f)) ∨ E.