Hacking x 2

_CoqProject

@@ -9,9 +9,12 @@ theories/c_translation/monad.v
 theories/c_translation/proofmode.v
 theories/c_translation/translation.v
 theories/c_translation/derived.v
-theories/heap_lang_vcgen/dval.v
-theories/heap_lang_vcgen/vcgen.v
-theories/heap_lang_vcgen/test.v
+theories/vcgen/dval.v
+theories/vcgen/vcgen.v
+# theories/vcgen/test.v
+# theories/heap_lang_vcgen/dval.v
+# theories/heap_lang_vcgen/vcgen.v
+# theories/heap_lang_vcgen/test.v
 theories/tests/test1.v
 theories/tests/test2.v
 theories/tests/fact.v

theories/heap_lang_vcgen/vcgen.v

@@ -242,8 +242,7 @@ Section vcg.
        case_bool_decide; first done. naive_solver.
   Qed.
 
-  Fixpoint optimize (s : list (nat * dval)) (Φ : wp_expr) : wp_expr := exhale_list s Φ.
-(*
+  Fixpoint optimize (s : list (nat * dval)) (Φ : wp_expr) : wp_expr :=
     match Φ with
     | Base Φ1 => exhale_list s Φ
     | Inhale dl Φ1 =>
@@ -268,8 +267,10 @@ Section vcg.
         IsLoc dv (λ v, optimize s (Φ1 v))
       | _ => Base False
       end
+    | Par P1 P2 P3 => Par (λ Ψ1, optimize s (P1 Ψ1))
+                          (λ Ψ2, optimize s (P2 Ψ2))
+                          (λ v1 v2, optimize s (P3 v1 v2))
     end.
-*)
 
   Lemma vcg_opt_list_sound' (E: list loc) (pl: list (nat * dval)) (Φ: wp_expr) :
       wp_interp E (optimize pl Φ) -∗
@@ -422,4 +423,4 @@ Section vcg.
     iIntros (v) "H". by iDestruct "H" as (dv) "[-> H2]".
   Qed.
 
-End vcg.
\ No newline at end of file
+End vcg.

theories/vcgen/dval.v

+From iris.heap_lang Require Export proofmode notation.
+From iris.bi Require Import big_op.
+
+  Inductive dloc :=
+    | dLoc : nat → dloc
+    | dLocUnknown : loc → dloc.
+
+  Global Instance dloc_decision : EqDecision dloc.
+  Proof. solve_decision. Defined.
+
+  Inductive dbase_lit : Type :=
+    | dLitInt : Z → dbase_lit
+    | dLitBool : bool → dbase_lit
+    | dLitUnit : dbase_lit
+    | dLitLoc : dloc → dbase_lit
+    | dLitUnknown : base_lit → dbase_lit.
+
+  Global Instance dlit_decision : EqDecision dbase_lit.
+  Proof. solve_decision. Defined.
+
+  Inductive dval : Type :=
+    | dLitV : dbase_lit → dval
+    | dValUnknown : val → dval.
+
+  Inductive doption (A : Type) : Type :=
+    | dNone : doption A
+    | dSome : A → doption A
+    | dUnknown : option A → doption A.
+
+  Arguments dNone {_}.
+  Arguments dSome {_} _.
+  Arguments dUnknown {_} _.
+
+  Global Instance doption_fmap : FMap doption := λ A B f m,
+    match m with
+    | dNone => dNone
+    | dSome x => dSome (f x)
+    | dUnknown o => dUnknown (f <$> o)
+    end.
+
+
+  Definition dloc_interp (E : list loc) (dl : dloc) : loc :=
+    match dl with
+    | dLoc i => from_option id inhabitant (E !! i)
+    | dLocUnknown l => l
+    end.
+
+  Definition dbase_lit_interp (E : list loc) (l : dbase_lit) : base_lit :=
+    match l with
+    | dLitInt x => LitInt x
+    | dLitBool b => LitBool b
+    | dLitUnit => LitUnit
+    | dLitLoc dl => LitLoc (dloc_interp E dl)
+    | dLitUnknown l => l
+    end.
+
+  Definition dval_interp (E : list loc) (v : dval) : val :=
+    match v with
+    | dLitV l => LitV (dbase_lit_interp E l)
+    | dValUnknown v => v
+    end.
+
+  Fixpoint doption_interp {A} (mx : doption A) : option A :=
+    match mx with
+    | dNone => None
+    | dSome x => Some x
+    | dUnknown mx => mx
+    end.
+
+  Definition dbin_op_eval_int (op : bin_op) (n1 n2 : Z) : dbase_lit :=
+    match op with
+    | PlusOp => dLitInt (n1 + n2)
+    | MinusOp => dLitInt (n1 - n2)
+    | MultOp => dLitInt (n1 * n2)
+    | QuotOp => dLitInt (n1 `quot` n2)
+    | RemOp => dLitInt (n1 `rem` n2)
+    | AndOp => dLitInt (Z.land n1 n2)
+    | OrOp => dLitInt (Z.lor n1 n2)
+    | XorOp => dLitInt (Z.lxor n1 n2)
+    | ShiftLOp => dLitInt (n1 ≪ n2)
+    | ShiftROp => dLitInt (n1 ≫ n2)
+    | LeOp => dLitBool (bool_decide (n1 ≤ n2))
+    | LtOp => dLitBool (bool_decide (n1 < n2))
+    | EqOp => dLitBool (bool_decide (n1 = n2))
+    end.
+
+  Lemma dbin_op_eval_int_correct E op n1 n2 :
+    bin_op_eval_int op n1 n2 = dbase_lit_interp E (dbin_op_eval_int op n1 n2).
+  Proof. by destruct op. Qed.
+
+  Definition dbin_op_eval_bool
+      (op : bin_op) (b1 b2 : bool) : doption dbase_lit :=
+    match op with
+    | PlusOp | MinusOp | MultOp | QuotOp | RemOp => dNone (* Arithmetic *)
+    | AndOp => dSome (dLitBool (b1 && b2))
+    | OrOp => dSome (dLitBool (b1 || b2))
+    | XorOp => dSome (dLitBool (xorb b1 b2))
+    | ShiftLOp | ShiftROp => dNone (* Shifts *)
+    | LeOp | LtOp => dNone (* InEquality *)
+    | EqOp => dSome (dLitBool (bool_decide (b1 = b2)))
+    end.
+
+  Lemma dbin_op_eval_bool_correct E op b1 b2 w :
+    dbin_op_eval_bool op b1 b2 = dSome w →
+    bin_op_eval_bool op b1 b2 = Some (dbase_lit_interp E w).
+  Proof. destruct op; simpl; try by inversion 1. Qed.
+
+  Definition dbin_op_eval
+             (E : list loc) (op : bin_op) (dv1 dv2 : dval) : doption dval :=
+    match dv1,dv2 with
+    | dValUnknown _, _ | _,dValUnknown _ =>
+       dUnknown
+        (dValUnknown <$> bin_op_eval op (dval_interp E dv1) (dval_interp E dv2))
+    | dLitV l1, dLitV l2 =>
+      if decide (op = EqOp)
+      then dSome $ dLitV $ dLitBool
+                 $ bool_decide (dbase_lit_interp E l1 = dbase_lit_interp E l2)
+      else match l1, l2 with
+           | (dLitInt n1), (dLitInt n2) =>
+             dSome $ dLitV $ dbin_op_eval_int op n1 n2
+           | (dLitBool b1), (dLitBool b2) =>
+             dLitV <$> dbin_op_eval_bool op b1 b2
+           | dLitUnknown _, _ | _, dLitUnknown _ =>
+               dUnknown (dValUnknown <$>
+                  bin_op_eval op (dval_interp E dv1) (dval_interp E dv2))
+           | _, _ => dNone
+           end
+    end.
+
+  Lemma dbin_op_eval_correct E op dv1 dv2 w :
+    doption_interp (dbin_op_eval E op dv1 dv2) = Some w →
+    bin_op_eval op (dval_interp E dv1) (dval_interp E dv2) =
+    Some (dval_interp E w).
+  Proof.
+    destruct dv1 as [dl1 | v1].
+    - destruct dv2 as [dl2 | v2].
+      + unfold bin_op_eval. simpl. case_decide; simplify_eq/=.
+        { inversion 1. rewrite /bin_op_eval /=.  f_equal. simplify_eq /=.
+           do 2 case_bool_decide; simplify_eq /=; eauto. destruct H0. done. }
+        { rewrite /bin_op_eval; intros; destruct dl1, dl2;
+            rewrite /bin_op_eval_int /bin_op_eval_bool; simplify_eq /=; f_equal;
+              try (destruct op; done); simpl.
+          -  rewrite /bin_op_eval in H0; case_decide; first done.
+             destruct b; simplify_eq /=; f_equal.
+          - destruct op; simplify_eq /=; try done.
+          -  case_decide; first done. destruct b0; simplify_eq /=; f_equal.
+             destruct op; simplify_eq /=; try done.
+          -  case_decide; first done. destruct b; simplify_eq /=; f_equal.
+          -  case_decide; first done; destruct b; simplify_eq /=; f_equal;
+              destruct op; simplify_eq /=; try done.
+          -  case_decide; first done; destruct b; simplify_eq /=; f_equal.
+          -  case_decide; first done; destruct b; simplify_eq /=; f_equal.
+          -  case_decide; first done; destruct b,b0; simplify_eq /=; f_equal.
+             destruct op; simplify_eq /=; try done. }
+      + simpl; destruct (bin_op_eval op #(dbase_lit_interp E dl1) v2);
+          try by inversion 1.
+    - simpl; destruct (bin_op_eval op v1 (dval_interp E dv2));
+        try by inversion 1.
+  Qed.
+
+  (** ** LocLookup *)
+  Class LocLookup (E : list loc) (l : loc) (i : nat) :=
+    loc_lookup : E !! i = Some l.
+
+  Global Instance loc_lookup_here l E : LocLookup (l :: E) l 0.
+  Proof. done. Qed.
+
+  Global Instance loc_lookup_there l l' E i :
+    LocLookup E l i → LocLookup (l' :: E) l (S i).
+  Proof. done. Qed.
+
+  (** ** BaseLitQuote *)
+  Class BaseLitQuote (E : list loc) (l : base_lit) (dl : dbase_lit) :=
+    base_lit_quote : l = dbase_lit_interp E dl.  
+
+  (** BaseLitQuote for locs *)
+  Global Instance base_lit_quote_loc E l i :
+    LocLookup E l i → BaseLitQuote E (LitLoc l) (dLitLoc (dLoc i)) | 1.
+  Proof. by rewrite /LocLookup /BaseLitQuote /= => ->. Qed.
+
+  Global Instance base_lit_quote_loc_unknown E l :
+    BaseLitQuote E (LitLoc l) (dLitLoc (dLocUnknown l)) | 10.
+  Proof. done. Qed.
+
+  (** BaseLitQuote for constants *)
+  Global Instance base_lit_quote_int E i :
+    BaseLitQuote E (LitInt i) (dLitInt i).
+  Proof. by rewrite /BaseLitQuote /=. Qed.
+
+  Global Instance base_lit_quote_default E l :
+    BaseLitQuote E l (dLitUnknown l) | 1000.
+  Proof. done. Qed.
+
+  Class IntoDVal (E : list loc) (e : expr) (dv : dval) :=
+    into_dval : e = of_val (dval_interp E dv).
+
+  Global Instance into_dval_loc E l dl :
+    BaseLitQuote E l dl → IntoDVal E (Lit l) (dLitV dl).
+  Proof. by rewrite /BaseLitQuote /IntoDVal=> ->. Qed.
+
+  Global Instance into_dval_default E e v :
+    IntoVal e v → IntoDVal E e (dValUnknown v) | 1000.
+  Proof. by rewrite /IntoVal /IntoDVal=> /of_to_val ->. Qed.