(** ordering expressions, atoms and clauses *)
Definition expr_order (t t': expr) := isGe (expr_cmp t t').
Inductive max_expr (t : expr) : pure_atom -> Prop :=
| mexpr_left : forall t', expr_order t t' -> max_expr t (Eqv t t')
| mexpr_right : forall t', expr_order t t' -> max_expr t (Eqv t' t).
Definition order_eqv_pure_atom (a: pure_atom) :=
match a with
| Eqv i j => match expr_cmp i j with Lt => Eqv j i | _ => Eqv i j end
end.
Definition nonreflex_atom a :=
match a with Eqv i j => match expr_cmp i j with Eq => false | _ => true end
end.
Definition normalize_atoms pa :=
rsort_uniq pure_atom_cmp (map order_eqv_pure_atom pa).
Definition mkPureClause (gamma delta: list pure_atom) : clause :=
PureClause gamma delta _ (eq_refl _).
Definition order_eqv_clause (c: clause) :=
match c with
| PureClause pa pa' _ _ =>
mkPureClause (normalize_atoms (filter nonreflex_atom pa)) (normalize_atoms pa')
| PosSpaceClause pa pa' sa' =>
PosSpaceClause (normalize_atoms (filter nonreflex_atom pa))
(normalize_atoms pa') sa'
| NegSpaceClause pa sa pa' =>
NegSpaceClause (normalize_atoms (filter nonreflex_atom pa)) sa
(normalize_atoms pa')
end.
Definition mk_pureL (a: pn_atom) : clause :=
match a with
| Equ x y => mkPureClause nil (order_eqv_pure_atom(Eqv x y)::nil)
| Nequ x y => mkPureClause (order_eqv_pure_atom(Eqv x y)::nil) nil
end.
Fixpoint mk_pureR (al: list pn_atom) : list pure_atom * list pure_atom :=
match al with
| nil => (nil,nil)
| Equ x y :: l' => match mk_pureR l' with (p,n) =>
(order_eqv_pure_atom(Eqv x y)::p, n) end
| Nequ x y :: l' => match mk_pureR l' with (p,n) =>
(p, order_eqv_pure_atom(Eqv x y)::n) end
end.
(** cnf: clausal normal form *)
Definition cnf (en: entailment) : list clause :=
match en with
Entailment (Assertion pureL spaceL) (Assertion pureR spaceR) =>
match mk_pureR pureR with (p,n) =>
map mk_pureL pureL ++ (PosSpaceClause nil nil spaceL :: nil) ++
match spaceL, spaceR with
| nil, nil => mkPureClause p n :: nil
| _, _ => NegSpaceClause p spaceR n :: nil
end
end
end.
(** various comparison functions *)
Definition pure_atom_geq a b := isGeq (pure_atom_cmp a b).
Definition pure_atom_gt a b := match pure_atom_cmp a b with Gt => true | _ => false end.
Definition pure_atom_eq a b := match pure_atom_cmp a b with Eq => true | _ => false end.
Definition expr_lt a b := match expr_cmp a b with Lt => true | _ => false end.
Definition expr_eq a b := match expr_cmp a b with Eq => true | _ => false end.
Definition expr_geq a b := match expr_cmp a b with Lt => false | _ => true end.
Definition norm_pure_atom (a : pure_atom) :=
match a with
| Eqv i j => if expr_lt i j then Eqv j i else Eqv i j
end.
Definition subst_pure (i: var) (t: expr) (a: pure_atom) :=
match a with
| Eqv t1 t2 => Eqv (subst_expr i t t1) (subst_expr i t t2)
end.
Definition subst_pures (i: var) (t: expr) (pa: list pure_atom)
: list pure_atom := map (subst_pure i t) pa.
Definition compare_space_atom (a b : space_atom) : comparison :=
match a , b with
| Next i j , Next i' j' => match expr_cmp i i' with Eq => expr_cmp j j' | c => c end
| Next i j, Lseg i' j' =>
match expr_cmp i i' with
| Lt => Lt
| Eq => Lt
| Gt => Gt
end
| Lseg i j, Next i' j' =>
match expr_cmp i i' with
| Lt => Lt
| Eq => Gt
| Gt => Gt
end
| Lseg i j , Lseg i' j' => match expr_cmp i i' with Eq => expr_cmp j j' | c => c end
end.

(* Specifications: *)
Lemma space_atom_cspec: CompSpec' compare_space_atom.
Proof with (repeat (comp_tac || solve [econstructor; simpl; repeat comp_tac])).