intros n1 x1 l Hx; induction l as [|y l IH]; simpl; Vfold n; Grm0.
intros Hv Hr; destruct l as [|b l1]; auto.
rewrite meet_join_distrl with (k1 := 1%nat) (k2 := length (b:: l1)); auto.
rewrite Hr, IH; Grm0.
intros u Hu; apply Hv; auto with datatypes.
rewrite <-cbl1_hom1_equiv; apply Hv; auto with datatypes.
apply joinl_hom1; intros u Hu.
rewrite <-cbl1_hom1_equiv; apply Hv; auto with datatypes.
assert (dual_aux_rec: forall n x l, hom n 1 x -> is_vector_space n l ->
'@x ∧ joinl n l = 0  \/ (exists y, In y l /\ '@x ∧ y <> 0)).
intros n1 x1 l H1 H2.
case (list_dec _ (fun y => '@x1 ∧ y = 0) l); auto.
intros y; case (eqE_spec _ (fn n1) ('@x1 ∧ y) 0); auto.
generalize x; clear x.
induction k as [|k IH]; auto.
intros x Hn Hx; rewrite (grade0E _ _ Hx); Grm0.
apply grade0.
intros x Hn; rewrite !gradeE; intros (Hx, ([|a l], (H1l,H2l)));
subst; try discriminate; split; auto.
exists nil; split; Grm0.
assert (Hn1: 0 < n)
by (destruct n; auto with arith; contradict Hn; auto with arith).
assert (Ha: hom n 1 a); auto with datatypes.
case (eqE_spec _ (fn n) (joinl n (a :: l)) 0); intros Hal.
rewrite Hal; exists nil; split; Grm0; intros y [].
case (homE _  _ (length (a::l)) _ Hx).
apply joinl_hom1; auto.
2: intros HH; rewrite HH; exists nil; Grm0.
2: split; auto; intros y [].
intros HH; injection HH; clear HH; intros Hk.
assert (F1: exists l1, is_vector_space n l1 /\
'@(joinl n (a::l)) = '@a ∧ joinl n l1).
destruct l.
exists (base n 1).
split.
intros u Hu; constructor; auto.
rewrite joinl_all, meet_allr; auto with arith.
assert (F1: grade n k  (joinl n (v::l))).
rewrite gradeE; split.
rewrite Hk; apply joinl_hom1; auto with datatypes.
exists (v::l); split; auto with datatypes.
assert (F2: k < n); auto with arith.
generalize (IH _ F2 F1); rewrite gradeE; intros (_,(l1,(H1l1,H2l1))).
exists l1; split.
intros u Hu; red; rewrite cbl1_hom1_equiv; auto with datatypes.
rewrite joinlS, dual_join, H1l1; auto.
intros HH; discriminate.
case F1; intros l1 (H1l1,H2l1).
rewrite H2l1.
case (dual_aux_rec n a l1); auto with datatypes.
intros HH; rewrite HH.
exists nil; split; auto; intros y [].
intros (b, (H1b,H2b)).
assert (Hb: hom n 1 b) by
(rewrite <-cbl1_hom1_equiv; apply H1l1; auto with datatypes).
case (is_vector_space_swap n b l1); auto.
intros l2 (H1l2,H2l2); rewrite H2l2.
destruct l2 as [|c l2].
assert (F2: hom n 0 '@(joinl n (a :: l))).
rewrite H2l1, H2l2; simpl.
replace 0%nat with ((n - 1) + 1 - n)%nat; auto.
rewrite Plus.plus_comm, <-Minus.le_plus_minus, <-Minus.minus_n_n; auto.
case (homE n n k.+1 (joinl n (a :: l))); auto.
rewrite dual_invoE with (1 := Hx).
pattern n at 2; replace n with (n - 0)%nat; auto.
rewrite <-Minus.minus_n_O; auto.
intros; subst n; contradict Hn; auto with arith.
intros H1a; case Hal; auto.
assert (Hc: hom n 1 c) by
(rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes).
pose (f := fun x => 'C['@a ∧ x]).
exists (((- (1)) ^ length (c :: l2) * f b) .* (c + (-(1) * f c * (f b)^-1) .* b) ::
map (fun x => x + (-(1) * f x * (f b)^-1) .* b) l2).
split.
assert (F2: forall y, hom n 1 y -> '@a ∧ y = ['C['@a ∧ y]]).
intros y Hy; apply hom0E.
replace 0%nat with ((n - 1) + 1 - n)%nat; auto.
rewrite Plus.plus_comm, <-Minus.le_plus_minus, <-Minus.minus_n_n; auto.
replace (joinl n (b :: c :: l2)) with
(joinl n (b::(c + (-(1) * f c * f b ^-1) .* b)::
map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2)).
rewrite joinlS; auto.
2: intros HH; discriminate.
rewrite (meet_join_distrl n 1 (length (c::l2))); auto.
rewrite addE_com, dual_aux; Grm0.
rewrite (F2 b); auto.
rewrite joinkl, !joinl_scal, !scal_multE; auto.
intros y Hy; case in_inv with (1 := Hy).
intros; subst; auto.
red; apply VectorSpace.cbl_add.
apply H1l2; auto with datatypes.
apply VectorSpace.cbl_scal; apply H1l2; auto with datatypes.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
red; apply VectorSpace.cbl_add.
apply H1l2; auto with datatypes.
apply VectorSpace.cbl_scal.
apply H1l2; auto with datatypes.
intros y Hy; case in_inv with (1 := Hy).
intros HH; subst.
rewrite meet_addr, !meet_scalr.
rewrite (F2 c), (F2 b); auto.
unfold f; rewrite !scalk, addk, !multK_assoc; auto.
rewrite invKr, multK1r; Krm1.
rewrite oppKr; auto.
intros HH; case H2b; rewrite F2, HH; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
rewrite  meet_addr, !meet_scalr.
rewrite (F2 u), (F2 b); auto.
unfold f; rewrite !scalk, addk, !multK_assoc; auto.
rewrite invKr, multK1r; Krm1.
rewrite oppKr; auto.
intros HH; case H2b; rewrite F2, HH; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
replace (length (c::l2)) with
(length (c + (-(1) * f c * f b ^-1) .* b
:: map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2)).
apply joinl_hom1.
intros y Hy; case in_inv with (1 := Hy).
intros HH; subst; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
apply add_hom; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
simpl; rewrite map_length; auto.
rewrite joinlS.
apply sym_equal; rewrite joinlS.
change (c + (-(1) * f c * f b ^-1) .* b
:: map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) l2) with
(map (fun x : vect n => x + (-(1) * f x * f b ^-1) .* b) (c::l2)).
apply joinl_addmult with (f:= fun b x: vect n => (-(1) * f x * f b ^-1)%f); auto.
simpl; intros i [[]|Hi]; auto.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
intros HH; discriminate.
intros HH; discriminate.
intros y Hy; case in_inv with (1 := Hy).
intros; subst; auto.
rewrite in_map_iff; intros (u, (H1u,H2u)); subst.
apply add_hom.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
apply scal_hom.
rewrite <-cbl1_hom1_equiv; apply H1l2; auto with datatypes.
Qed.

(* Specifications: *)
Lemma grade_meet n k1 k2 x y : n < k1 + k2 ->
grade n k1 x -> grade n k2 y -> grade n (k1 + k2 - n) (x ∧ y).