Proof with simpl; auto; try congruence; try solve [
apply listd_pure_atomd_pureu with (s0 := y);
[ | exists x; apply join_comm; auto ]; apply IHsigma; auto].
revert s; induction sigma... intros s [x [y [A [B C]]]].
remember a as b; destruct b. destruct e...
rewrite listd_app, (@listd_unfold_inter _ state); split...
generalize (nl_lseg_in_sound _ _ _ _ _ _ B C A); intro D.
clear - D. set (l := lseg_in_dom_atoms v sigma) in D |- *. induction l...
solve [destruct D as [D E]; split; [ left; auto | ]; apply IHl; auto].
destruct e... remember (lseg_in_dom_atoms v sigma) as l. destruct l...
rewrite listd_app; split... unfold normalize_atoms.
rewrite (@listd_sort_uniq_un _ state) with (cmp := pure_atom_cmp).
2: apply pure_atom_cmp_eq.
generalize (ll_lseg_in_sound _ _ _ _ _ _ B C A); rewrite <- Heql.
intro D. simpl in D. destruct D as [D E]. destruct D as [D | D].
left. rewrite <- order_eqv_sound...
destruct D. right; left. rewrite <- order_eqv_sound... inversion H.
rewrite (@listd_unfold_inter _ state); split...
generalize (ll_lseg_in_sound _ _ _ _ _ _ B C A); rewrite <- Heql.
simpl; intros [D E]. clear - E.
induction l... simpl in E; destruct E as [E F].
split... unfold normalize_atoms. rewrite (@listd_sort_uniq_un _ state).
2: apply pure_atom_cmp_eq.
destruct E as [E | E]. left; rewrite <- order_eqv_sound...
destruct E; [ right; left; rewrite <- order_eqv_sound; auto | inversion H].
Qed.

(* Specifications: *)
Lemma do_well_sound sigma s :
space_denote sigma s ->
listd (fun atms => listd pure_atom_denote un FF atms) inter TT
(do_well sigma) s.