(** A little module for doing naive congruence closure; we don't need anything much fancier because in practice, for spatial entailments, we only discover a few new equalities in each call to the superposition subsystem.  Pure entailments are another matter entirely, but for now we seem to be fine on those (see, eg, test/test.pure.entailments.sf) *)
Load loadpath.
veristar.list_denote veristar.basic veristar.compare.
Section cclosure.
Context (A B : Type).
Variables
(A_cmp : A -> A -> comparison)
(B_cmp : B -> B -> comparison)
(fAB : A -> B).
Notation canons := (list (A*B)).
(*Definition isEq (c : comparison) := match c with Eq => true | _ => false end.*)
Fixpoint lookC (a: A) (cs: canons) : B :=
match cs with nil => fAB a
| (a1, b1)::cs' => if isEq (A_cmp a a1) then b1
else lookC a cs'
end.
Fixpoint rewriteC (b1 b2 : B) (cs: canons) : canons :=
match cs with nil => nil
| (a1, b1')::cs' =>
let new_cs := rewriteC b1 b2 cs' in
if isEq (B_cmp b1 b1') then (a1, b2)::new_cs else (a1, b1')::new_cs end.
Definition mergeC (a1 a2 : A) (cs: canons) : canons :=
match lookC a1 cs, lookC a2 cs with b1, b2 =>
if isEq (B_cmp b1 b2) then cs
else (a1, b2)::(a2, b2)::rewriteC b1 b2 cs end.
(* sanity lemmas *)
(* Lemma lookC_cons a1 b cs : lookC a1 ((a1, b)::cs) = b. *)
End cclosure.
(* Module TestCClosure. Require Import NatOrderedType. Import Nat_as_DT.  Notation lookC := (lookC _ _ eq_dec (fun n => n)). Notation rewriteC := (@rewriteC nat nat eq_dec). Notation mergeC := (mergeC _ _ eq_dec eq_dec (fun n => n)).  Compute mergeC 1 2 nil. Compute mergeC 1 2 (mergeC 3 4 nil). Compute lookC 3 (mergeC 1 2 (mergeC 3 4 (mergeC 5 6 nil))). Compute lookC 3 (mergeC 4 5 (mergeC 3 4 (mergeC 5 6 nil))). Compute lookC 3 (mergeC 1 8 (mergeC 3 4 (mergeC 1 3 (mergeC 1 2 nil)))).  End TestCClosure. *)
Notation expr_get := (lookC _ _ expr_cmp (@id _)).
Notation expr_merge := (mergeC _ _ expr_cmp expr_cmp (@id _)).
(* used internally *)
Local Notation expr_rewriteC := (rewriteC expr _ expr_cmp).
Fixpoint cclose_aux (l : list clause) : list (expr * expr) :=
match l with
| PureClause nil [Eqv s t] _ _ :: l' => expr_merge s t (cclose_aux l')
| _ => nil
end.
Definition cclose (l : list clause) : list clause :=
map (fun p => match p with (e1, e2) => mkPureClause nil [Eqv e1 e2] end)
(cclose_aux l).
(** Correctness proof *)
Module CCSound (VSM : VERISTAR_MODEL).
Definition expr_eqs_denote (l : list (expr * expr)) :=
listd (fun p => match p with (e1, e2) => (e1 === e2) end) inter TT l.

(* Specifications: *)
Lemma expr_get_sound e l s : expr_eqs_denote l s -> (e === expr_get e l) s.
Proof with simpl; auto.