Definition extend_strictly_partial_WO: forall (WO:partial_WO)
(a:T), ~ In (pwo_S WO) a -> partial_WO.
refine (fun WO a H => let S' := Add (pwo_S WO) a in
let R' := fun x y:T => pwo_R WO x y \/ (In (pwo_S WO) x /\ y = a) in
Build_partial_WO S' R' _ _).
intros.
case H0.
intros.
split.
left.
pose proof (pwo_R_lives_on_S WO x y).
tauto.
left.
pose proof (pwo_R_lives_on_S WO x y).
tauto.
intros.
destruct H1.
split.
left.
assumption.
right.
rewrite H2.
auto with sets.
constructor.
red.
intros.
assert (forall x:{y:T | In (pwo_S WO) y}, In S' (proj1_sig x)).
intro.
destruct x.
left.
simpl.
assumption.
assert (forall x:{y:T | In (pwo_S WO) y},
Acc (restriction_relation R' S') (exist _ (proj1_sig x) (H0 x))).
intro.
pose proof (wo_well_founded (pwo_wo WO) x).
induction H1.
constructor.
intros.
destruct x.
destruct y.
unfold restriction_relation in H3.
simpl in H3.
assert (In (pwo_S WO) x0).
case H3.
intro.
pose proof (pwo_R_lives_on_S WO x0 x).
tauto.
tauto.
assert (pwo_R WO x0 x).
case H3.
trivial.
intro.
destruct H5.
contradict H.
rewrite <- H6.
assumption.
pose proof (H2 (exist _ x0 H4)).
simpl in H6.
assert (i0 = (H0 (exist (In (pwo_S WO)) x0 H4))).
apply proof_irrelevance.
rewrite <- H7 in H6.
apply H6.
red.
simpl.
assumption.
destruct a0.
case i.
intros.
pose proof (H1 (exist _ x0 i0)).
simpl in H2.
assert (H0 (exist (In (pwo_S WO)) x0 i0) =
Union_introl T (pwo_S WO) (Singleton a) x0 i0).
apply proof_irrelevance.
rewrite <- H3.
assumption.
intros.
generalize i0.
destruct i0.
intro.
constructor.
intros.
unfold restriction_relation in H2.
destruct y.
simpl in H2.
case H2.
intro.
contradict H.
pose proof (pwo_R_lives_on_S WO x0 a).
tauto.
intros.
destruct H3.
pose proof (H1 (exist _ x0 H3)).
simpl in H5.
assert (H0 (exist (In (pwo_S WO)) x0 H3) = i1).
apply proof_irrelevance.
rewrite H6 in H5.
assumption.
red.
intros.
destruct x.
destruct y.
unfold restriction_relation.
simpl.
case i.
case i0.
intros.
case (wo_total_strict_order (pwo_wo WO)
(exist _ x2 i2) (exist _ x1 i1)).
intro.
red in H0.
simpl in H0.
left.
constructor 1.
assumption.
intro.
case H0.
right; left.
apply subset_eq_compatT.
injection H1.
trivial.
right; right.
red in H1.
simpl in H1.
constructor 1.
assumption.
intros.
left.
destruct i1.
constructor 2.
tauto.
case i0.
intros.
right; right.
destruct i2.
constructor 2.
tauto.
right; left.
apply subset_eq_compatT.
destruct i1.
destruct i2.
trivial.
Defined.

(* Specifications: *)
Lemma extend_strictly_partial_WO_correct: forall (WO:partial_WO)
(x:T) (ni:~ In (pwo_S WO) x),
partial_WO_ord WO (extend_strictly_partial_WO WO x ni).
Lemma premaximal_partial_WO_is_full: forall WO:partial_WO,
premaximal partial_WO_ord WO -> pwo_S WO = Full_set.
Theorem well_orderable: exists R:relation T, well_order R.
End WellOrderConstruction.