Next draft of soundness theorem

coq/Infra/ExpressionAbbrevs.v

@@ -211,9 +211,9 @@ Qed.
 Definition toRTMap (tMap:FloverMap.t mType) : expr R -> option mType :=
   let elements := FloverMap.elements (elt:=mType) tMap in
   fun (e:expr R) =>
-    olet p := find (fun p => match R_orderedExps.compare  e (toRExp (fst p)) with
+    olet p := findA (fun p => match R_orderedExps.compare e (toRExp p) with
                    | Eq => true |_ => false end) elements in
-        Some (snd p).
+        Some p.
 
 Definition updDefVars  (e:expr R) (m:mType) Gamma :=
   fun eNew =>
@@ -248,32 +248,77 @@ Proof.
     apply IHl; auto.
 Qed.
 
-Lemma toRTMap_some tMap e m:
+Lemma findA_swap (A B:Type) (f1:A -> bool) f2 (l: list (A*B)) r:
+  (forall k, f1 k = f2 k) ->
+  findA f1 l = Some r ->
+  findA f2 l = Some r.
+Proof.
+  induction l; intros f_eq find1; simpl in *; try congruence.
+  destruct a.
+  destruct (f1 a) eqn:?.
+  - rewrite <- f_eq; rewrite Heqb0; congruence.
+  - rewrite <- f_eq; rewrite Heqb0.
+    apply IHl; auto.
+Qed.
+
+Lemma findA_swap2 (A B:Type) (f1:A -> bool) f2 (l: list (A*B)):
+  (forall k, f1 k = f2 k) ->
+  findA f1 l = findA f2 l.
+Proof.
+  induction l; intros f_eq; simpl in *; try congruence.
+  destruct a.
+  destruct (f1 a) eqn:?.
+  - rewrite <- f_eq; rewrite Heqb0; congruence.
+  - rewrite <- f_eq; rewrite Heqb0.
+    apply IHl; auto.
+Qed.
+
+Lemma toRTMap_some tMap e e2 m:
+  e2 = toRExp e ->
   FloverMap.find e tMap = Some m ->
-  toRTMap tMap (toRExp e) = Some m.
+  toRTMap tMap e2 = Some m.
 Proof.
-  intros find_Q.
+  intros ? find_Q; subst.
   rewrite  FloverMapFacts.P.F.elements_o in find_Q.
   unfold toRTMap.
   unfold optionBind.
-  apply findA_find in find_Q as [key [find_Q k_eq]].
-  unfold FloverMapFacts.P.F.eqb in k_eq.
-  cut (find
-      (fun p : expr Q * mType =>
-       match R_orderedExps.compare (toRExp e) (toRExp (fst p)) with
-       | Eq => true
-       | _ => false
-       end) (FloverMap.elements (elt:=mType) tMap) = Some (key, m)).
-  - intros find_R. rewrite find_R. auto.
-  - eapply find_swap with (f1 := fun p => match Q_orderedExps.exprCompare e (fst p) with
-                                       |Eq => true |_ => false end).
-    + intros. rewrite <- QcompareExp_RcompareExp; auto.
-    + eapply find_swap; eauto.
-      intros; simpl.
-      destruct (Q_orderedExps.exprCompare e (fst k)) eqn:q_comp.
-      all: unfold FloverMapFacts.P.F.eqb.
-      all: unfold FloverMapFacts.P.F.eq_dec.
-      all: rewrite q_comp; auto.
+  erewrite <- findA_swap2 with (f1 := FloverMapFacts.P.F.eqb e).
+  - rewrite find_Q; auto.
+  - unfold R_orderedExps.compare.
+    intros.
+    rewrite <- QcompareExp_RcompareExp.
+    unfold FloverMapFacts.P.F.eqb, FloverMapFacts.P.F.eq_dec.
+    destruct (Q_orderedExps.exprCompare e k) eqn:q_comp; auto.
+Qed.
+
+Lemma toRTMap_find_map tMap e m:
+  toRTMap tMap (toRExp e) = Some m ->
+  FloverMap.find e tMap = Some m.
+Proof.
+  intros RTMap_def.
+  unfold toRTMap, optionBind in *.
+  Flover_compute.
+  inversion RTMap_def; subst.
+  rewrite FloverMapFacts.P.F.elements_o.
+  erewrite <- findA_swap2 with
+      (f1 := fun p => match R_orderedExps.compare (toRExp e) (toRExp p) with
+             |Eq => true |_ => false end); try auto.
+  intros. unfold R_orderedExps.compare; rewrite <- QcompareExp_RcompareExp.
+  unfold FloverMapFacts.P.F.eqb, FloverMapFacts.P.F.eq_dec.
+  destruct (Q_orderedExps.exprCompare e k) eqn:q_comp; auto.
+Qed.
+
+Lemma toRTMap_some_cases tMap e1 e2 m1 m2:
+  toRTMap (FloverMap.add e1 m1 tMap) (toRExp e2) = Some m2 ->
+  (R_orderedExps.exprCompare (toRExp e1) (toRExp e2) = Eq /\ m1 = m2) \/ toRTMap tMap (toRExp e2) = Some m2.
+Proof.
+  intros map_def.
+  apply toRTMap_find_map in map_def.
+  rewrite FloverMapFacts.P.F.add_o in map_def.
+  destruct (FloverMap.E.eq_dec e1 e2) eqn:?.
+  - left. inversion map_def; split; try auto.
+    rewrite <- QcompareExp_RcompareExp; auto.
+  - right. eauto using toRTMap_some.
 Qed.
 
 (**