Load loadpath.
Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype.
Require Import prelude heaps rels hprop domains secmod seclog ordtype finmap datatypes
               min.
Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(* KVMaps (hashable and otherwise) *)

Lemma defPtUnl {T:Type} x (y z : T) h : def (x :-> y :+ h) -> def (x :-> z :+ h).
Proof.
have H1: x :-> z :+ empty = upd (x :-> y :+ empty) x (dyn z) by rewrite updPtUn.
move=>H2; rewrite 2!unh0 in H1; rewrite {}H1 defUnUl=>//.
by case:(defUnl H2); rewrite defPt=>H3; rewrite domPt in_simpl; apply/andP.
Qed.

Lemma defPtUnr {T:Type} x (y z : T) h : def (h :+ x :-> y) -> def (h :+ x :-> z).
Proof. by rewrite unC=>H1; rewrite unC; apply:(defPtUnl z H1). Qed.

(*****************) 
(*  Hash Tables  *)
(*****************)

Module HashTab.
Record Sig (K : ordType) (V : eqType) (n : nat) (hash : K -> 'I_n) : Type := 
  Make {T :> Type; 
        sshape : d T -> d {finMap K -> V} -> Pred (d heap); 
        shape : T -> {finMap K -> V} -> Pred heap;
        shape_fun : forall t s h1 h2, shape t s h1 -> shape t s h2 -> h1 = h2;
        sshape_refl : forall xx ff ii, 
            sshape xx ff ii -> shape xx.1 ff.1 ii.1 /\ shape xx.2 ff.2 ii.2;
        sshape_refl1 : forall x f i, shape x f i -> sshape (x, x) (f, f) (i, i);
        sshape_refl2 : forall x1 x2 f1 f2 i1 i2, 
          shape x1 f1 i1 -> shape x2 f2 i2 -> sshape (x1, x2) (f1, f2) (i1, i2);
        pre_kvmap := fun x i => exists f, exists j, exists h,
                                  i = j :+ h /\ j \In shape x f;
        new : STsec [:::] T 
          (fun i => True,
           fun yy ii mm => 
             exists jj, mm = jj :++ ii /\ sshape yy (nil K V, nil K V) jj /\
               (ii.1 =~ ii.2 -> yy.1 = yy.2 /\ jj.1 = jj.2));
        insert (x : T) : STsec [::: K; V] unit
          (fun k v => pre_kvmap x,
           fun kk vv yy ii mm =>
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               exists jj', mm = jj' :++ hh /\ 
                 jj' \In sshape (x, x) (ins kk.1 vv.1 ff.1, ins kk.2 vv.2 ff.2));
        remove (x : T) : STsec [::: K] unit
          (fun k => pre_kvmap x,
           fun kk yy ii mm =>
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               exists jj', mm = jj' :++ hh /\ 
                 jj' \In sshape (x, x) (rem kk.1 ff.1, rem kk.2 ff.2)); 
        lookup (x : T) : STsec [::: K] (option V)
          (fun k => pre_kvmap x,
           fun kk yy ii mm => 
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               mm = ii /\ yy.1 = fnd kk.1 ff.1 /\ yy.2 = fnd kk.2 ff.2);
        minkey (x : T) : STsec [::: 'I_n] (option K)
          (fun ix => pre_kvmap x,
           fun iix yy ii mm => 
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               mm = ii /\ 
               yy.1 = min (filter (fun k => hash k == iix.1) (supp ff.1)) /\
               yy.2 = min (filter (fun k => hash k == iix.2) (supp ff.2)));
        bnd_new : 
          forall (B : Type) (e1 e2 : ST [::: T] B) i1 i2 (r : d B -> d heap -> Prop),
            (forall j1 j2 t1 t2,
              verify2 (j1 :+ i1) (j2 :+ i2) (e1 @0 [t1]) (e2 @0 [t2])
            (fun y m =>
              (sshape (t1, t2) (nil K V, nil K V) (j1, j2) /\
                (i1 =~ i2 -> t1 = t2 /\ j1 = j2)) ->
              r y m)) ->
            verify2 i1 i2 (new @0 tt;; e1) (new @0 tt;; e2) r; 
        bnd_insert : 
          forall (B : Type) (e1 e2 : ST [::: unit] B) (t : T) k1 k2 v1 v2
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop),
            def (j1 :+ h1) -> def (j2 :+ h2) -> sshape (t, t) (f1, f2) (j1, j2) ->
            (forall j1' j2',
              def (j1' :+ h1) -> def (j2' :+ h2) -> 
              sshape (t, t) (ins k1 v1 f1, ins k2 v2 f2) (j1', j2') ->    
              verify2 (j1' :+ h1) (j2' :+ h2) (e1 @0 [tt]) (e2 @0 [tt]) r) ->
            verify2 (j1 :+ h1) (j2 :+ h2) 
            (insert t @0 [k1, v1];; e1) (insert t @0 [k2, v2];; e2) r; 
        bnd_insertL : 
          forall B (e1 : ST [::: unit] B) e2 (t : T) k1 v1
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop),
            sshape (t, t) (f1, f2) (j1, j2) -> def (j1 :+ h1) -> def (j2 :+ h2) ->
            (forall j1',
              def (j1' :+ h1) -> 
              sshape (t, t) (ins k1 v1 f1, f2) (j1', j2) ->    
              verify2 (j1' :+ h1) (j2 :+ h2) (e1 @0 [tt]) e2 r) ->
            verify2 (j1 :+ h1) (j2 :+ h2) (insert t @0 [k1, v1];; e1) e2 r;
        val_lookupV (t : T) j h f k (r : option V -> heap -> Prop) :
          shape t f j -> (def (j :+ h) -> r (fnd k f) (j :+ h)) -> 
          verify (j :+ h) (lookup t @0 [k]) r
  }.  
End HashTab.

(******************) 
(* Key-Value maps *)
(******************)

Module KVmap. 
Record Sig (K : ordType) (V : eqType) : Type := 
  Make {T :> Type; 
        sshape : d T -> d {finMap K -> V} -> Pred (d heap); 
        shape : T -> {finMap K -> V} -> Pred heap;
        shape_fun : forall t s h1 h2, shape t s h1 -> shape t s h2 -> h1 = h2;
        sshape_refl : forall xx ff ii, 
            sshape xx ff ii -> shape xx.1 ff.1 ii.1 /\ shape xx.2 ff.2 ii.2;
        sshape_refl1 : forall x f i, shape x f i -> sshape (x, x) (f, f) (i, i);
        sshape_refl2 : forall x1 x2 f1 f2 i1 i2, 
          shape x1 f1 i1 -> shape x2 f2 i2 -> sshape (x1, x2) (f1, f2) (i1, i2);
        pre_kvmap := fun x i => exists f, exists j, exists h,
                                  i = j :+ h /\ j \In shape x f;
        new : STsec [:::] T 
          (fun i => True,
           fun yy ii mm => 
             exists jj, mm = jj :++ ii /\ sshape yy (nil K V, nil K V) jj /\
               (ii.1 =~ ii.2 -> yy.1 = yy.2 /\ jj.1 = jj.2));
        insert (x : T) : STsec [::: K; V] unit
          (fun k v => pre_kvmap x,
           fun kk vv yy ii mm =>
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               exists jj', mm = jj' :++ hh /\ 
                 jj' \In sshape (x, x) (ins kk.1 vv.1 ff.1, ins kk.2 vv.2 ff.2));
        remove (x : T) : STsec [::: K] unit
          (fun k => pre_kvmap x,
           fun kk yy ii mm =>
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               exists jj', mm = jj' :++ hh /\ 
                 jj' \In sshape (x, x) (rem kk.1 ff.1, rem kk.2 ff.2)); 
        lookup (x : T) : STsec [::: K] (option V)
          (fun k => pre_kvmap x,
           fun kk yy ii mm => 
             forall ff jj hh, ii = jj :++ hh -> jj \In sshape (x, x) ff ->
               mm = ii /\ yy.1 = fnd kk.1 ff.1 /\ yy.2 = fnd kk.2 ff.2);
        bnd_new : 
          forall (B : Type) (e1 e2 : ST [::: T] B) i1 i2 (r : d B -> d heap -> Prop),
            (forall j1 j2 t1 t2,
              verify2 (j1 :+ i1) (j2 :+ i2) (e1 @0 [t1]) (e2 @0 [t2])
            (fun y m =>
              (sshape (t1, t2) (nil K V, nil K V) (j1, j2) /\
                (i1 =~ i2 -> t1 = t2 /\ j1 = j2)) ->
              r y m)) ->
            verify2 i1 i2 (new @0 tt;; e1) (new @0 tt;; e2) r; 
        bnd_insert : 
          forall (B : Type) (e1 e2 : ST [::: unit] B) (t : T) k1 k2 v1 v2
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop),
            def (j1 :+ h1) -> def (j2 :+ h2) -> sshape (t, t) (f1, f2) (j1, j2) ->
            (forall j1' j2',
              def (j1' :+ h1) -> def (j2' :+ h2) -> 
              sshape (t, t) (ins k1 v1 f1, ins k2 v2 f2) (j1', j2') ->    
              verify2 (j1' :+ h1) (j2' :+ h2) (e1 @0 [tt]) (e2 @0 [tt]) r) ->
            verify2 (j1 :+ h1) (j2 :+ h2) 
            (insert t @0 [k1, v1];; e1) (insert t @0 [k2, v2];; e2) r; 
        bnd_insertL : 
          forall B (e1 : ST [::: unit] B) e2 (t : T) k1 v1
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop),
            sshape (t, t) (f1, f2) (j1, j2) -> def (j1 :+ h1) -> def (j2 :+ h2) ->
            (forall j1',
              def (j1' :+ h1) -> 
              sshape (t, t) (ins k1 v1 f1, f2) (j1', j2) ->    
              verify2 (j1' :+ h1) (j2 :+ h2) (e1 @0 [tt]) e2 r) ->
            verify2 (j1 :+ h1) (j2 :+ h2) (insert t @0 [k1, v1];; e1) e2 r;
        val_lookupV (t : T) j h f k (r : option V -> heap -> Prop) :
          shape t f j -> (def (j :+ h) -> r (fnd k f) (j :+ h)) -> 
          verify (j :+ h) (lookup t @0 [k]) r
  }.  
End KVmap.  

(************************************************************************)
(* Hash Table implemented as a pointer to a finitely-supported function *)
(************************************************************************)

Module AssocList. Section AssocList.
Variables (K : ordType) (V : eqType)
          (n : nat) (hash : K -> 'I_n).
Notation fmap := (finMap K V).
Notation nil := (nil K V).
Definition kvmap := ptr.

Definition sshape (xx : d kvmap) (ff : d fmap) (ii : d heap) := 
  ii.1 = xx.1 :-> ff.1 /\ ii.2 = xx.2 :-> ff.2.

Definition shape (x : kvmap) (f : fmap) (i : heap) := sshape (x, x) (f, f) (i, i).

Lemma shape_fun x f i1 i2 : shape x f i1 -> shape x f i2 -> i1 = i2.
Proof. by rewrite /shape /sshape /= => [[-> _]] [-> _]. Qed.

Lemma shapeK t s1 s2 j1 j2 h1 h2 :
  shape t s1 j1 -> shape t s2 j2 -> def (j1 :+ h1) -> j1 :+ h1 = j2 :+ h2 -> 
  s1 = s2 /\ j1 = j2.
Proof. by move=> [[/= -> ->]] [[/= -> ->]]=> D; heap_cancel=>// _ _ ->. Qed.

Lemma sshape_refl xx ff ii :
  sshape xx ff ii -> shape xx.1 ff.1 ii.1 /\ shape xx.2 ff.2 ii.2.
Proof. by move=> [[/= -> ->]]. Qed.

Lemma sshape_refl1 x f i : shape x f i -> sshape (x, x) (f, f) (i, i).
Proof. by []. Qed.

Lemma sshape_refl2 x1 x2 f1 f2 i1 i2 :
  shape x1 f1 i1 -> shape x2 f2 i2 -> sshape (x1, x2) (f1, f2) (i1, i2).
Proof. by rewrite /sshape; move=> [/= -> ->] [/= -> ->]. Qed.
 
Program Definition new : 
  STsec [:::] kvmap 
    (fun i => True,
     fun yy ii mm => 
       exists jj, mm = jj :++ ii /\ sshape yy (nil, nil) jj /\
         (ii.1 =~ ii.2 -> yy.1 = yy.2 /\ jj.1 = jj.2)) :=
  Do (lalloc @ [nil]).
Next Obligation.
split=>//= a1 a2 i1 i2 _ _ _ _; vauto=> l1 l2 _ _ A _.
rewrite /plus2 //=; exists (l1 :-> nil, l2 :-> nil); split=>//. 
by split=>// B; move: (A B)=> [[->]][[D]].
Qed.

Definition pre_kvmap x := fun i => exists f, exists j, exists h,
                            i = j :+ h /\ shape x f j.

Program Definition free :
  STsec [::: kvmap] unit 
    (pre_kvmap,
     fun xx yy ii mm => 
       forall ff jj hh, ii = jj :++ hh -> sshape xx ff jj -> 
         mm = hh) := 
  Do (dealloc @ (fun x => [x])).
Next Obligation.
rewrite !gh; split=>//= [a i [f][j][h][->][/= -> ->] D | ].
by apply: sval_dealloc.
move=> a1 a2 i1 i2 [[[[[]]]]] f1 f2 [j1 j2] [h1 h2] /= [/= [/= -> ->] [/= -> ->]].
move=> [f1'][j1'][h1'][[A1 [[/= C _]]]] [f2'][j2'][h2'][[A2 [[/= D _]]]] F G.
rewrite C in A1; rewrite D in A2. 
by case: (cancel F A1) (cancel G A2)=> -> _ -> [-> [_ ->]]; vauto.
Qed.

Definition post_insert x :=
  fun kk vv (yy : d unit) ii mm =>
    forall ff jj hh, ii = jj :++ hh -> sshape (x, x) ff jj ->
      exists jj', mm = jj' :++ hh /\ 
        sshape (x, x) (ins kk.1 vv.1 ff.1, ins kk.2 vv.2 ff.2) jj'.

Program Definition insert (x : kvmap) :
  STsec [::: K; V] unit (fun k v => pre_kvmap x, post_insert x) :=
  Do (read fmap @ (fun k v => [x]);;
      write @ (fun m k v => [x, ins k v m])).
Next Obligation.
rewrite !gh; split=>//= [a i [f][j][h][->][/= -> ->] | ]. 
by sauto; apply: sbnd_read.
move=> a1 a2 i1 i2 [[[[[]]]]] f1 f2 [j1 j2] [h1 h2] /= [/= [/= -> ->] [/= -> ->]].
move=> [f1'][j1'][h1'][[A1 [[/= C _]]]] [f2'][j2'][h2'][[A2 [[/= D _]]]] F G.
rewrite C D in A1 A2. 
case: (cancel F A1) (cancel G A2)=> -> _ -> [-> [_ ->]]; vauto=> _ _.
set u1 := x :-> ins a1.1 _ _; set u2 := x :-> ins a2.1 _ _; exists (u1, u2).
by rewrite /plus2 /=.
Qed.

Definition post_remove x :=
  fun kk (yy : d unit) ii mm =>
    forall ff jj hh, ii = jj :++ hh -> sshape (x, x) ff jj ->
      exists jj', mm = jj' :++ hh /\ 
        sshape (x, x) (rem kk.1 ff.1, rem kk.2 ff.2) jj'.

Program Definition remove (x : kvmap) : 
  STsec [::: K] unit (fun k => pre_kvmap x, post_remove x) :=
  Do (read fmap @ (fun k => [x]);;
      write @ (fun m k => [x, rem k m])).
Next Obligation.
rewrite !gh; split=>//= [a i [f][j][h][->][/= -> ->] | ]. 
by sauto; apply: sbnd_read.
move=> a1 a2 i1 i2 [[[[[]]]]] f1 f2 [j1 j2] [h1 h2] /= [/= [/= -> ->] [/= -> ->]].
move=> [f1'][j1'][h1'][[A1 [[/= C _]]]] [f2'][j2'][h2'][[A2 [[/= D _]]]] F G.
rewrite C D in A1 A2.
case: (cancel F A1) (cancel G A2)=> -> _ -> [-> [_ ->]]; vauto=> _ _.
set u1 := x :-> rem a1.1 _; set u2 := x :-> rem a2.1 _; exists (u1, u2).
by rewrite /plus2 /=.
Qed.

Definition post_lookup (x : kvmap) :=
  fun kk yy ii mm => 
    forall ff jj hh, ii = jj :++ hh -> sshape (x, x) ff jj ->
      mm = ii /\ yy.1 = fnd kk.1 ff.1 /\ yy.2 = fnd kk.2 ff.2.
  
Program Definition lookup (x : kvmap) : 
  STsec [::: K] (option V) (fun k => pre_kvmap x, post_lookup x) :=
  Do (read fmap @ (fun k => [x]);;
      ret @ (fun v k => [fnd k v])).
Next Obligation.
split=>//= [a i [f][j][h][->][/= -> ->] | ]; first by sauto; apply: sbnd_read.
move=> a1 a2 i1 i2. 
move=> [f1'][j1'][h1'][[A1 [[/= C _]]]] [f2'][j2'][h2'][[A2 [[/= D _]]]] F G.
rewrite C D in A1 A2; rewrite A1 A2; vauto=> _ _ _; rewrite A1 A2 in F G.
move=>ff jj hh; rewrite /plus2 /= => [[/= H I]] [[/= J L]].
by rewrite J L in H I; case: (cancel F H) (cancel G I)=> -> _ _ [-> [_ _]].
Qed.

Program Definition minkey (x : kvmap) : 
  STsec [::: 'I_n] (option K)
  (fun ix => pre_kvmap x,
   fun iix yy ii mm => 
     forall ff jj hh, ii = jj :++ hh -> sshape (x, x) ff jj ->
       mm = ii /\ 
       yy.1 = min (filter (fun k => hash k == iix.1) (supp ff.1)) /\
       yy.2 = min (filter (fun k => hash k == iix.2) (supp ff.2))) :=
  Do (read fmap @ (fun ix => [x]);;
      ret @ (fun f ix => [min (filter (fun k => hash k == ix) (supp f))])).
Next Obligation.
rewrite !gh; split=>[a i[f][j][k][[/=->]][/=->->]|]; first by sauto.
by move=>a1 a2 i1 i2[[[[[]]]]]f1 f2[j1 j2][k1 k2][[/=->->]][/=->->]H1 H2 D1 D2; vauto.
Qed.

Lemma bnd_new B (e1 e2 : ST [::: kvmap] B) i1 i2 (r : d B -> d heap -> Prop) :
  (forall j1 j2 t1 t2,
    verify2 (j1 :+ i1) (j2 :+ i2) (e1 @0 [t1]) (e2 @0 [t2])
    (fun y m =>
      (sshape (t1, t2) (nil, nil) (j1, j2) /\
        (i1 =~ i2 -> t1 = t2 /\ j1 = j2)) ->
      r y m)) ->
  verify2 i1 i2 (new @0 tt;; e1) (new @0 tt;; e2) r.
Proof.
move=>H; apply: bnd_do=>//=. 
move=> t1 t2 m1 m2 [[j1 j2]][[/= -> ->]] J D1 D2 b1 b2 h1 h2 L M.
by apply: (H j1 j2 t1 t2)=>//. 
Qed.

Lemma bnd_insert B (e1 e2 : ST [::: unit] B) (t : kvmap) k1 k2 v1 v2
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop) :
  def (j1 :+ h1) -> def (j2 :+ h2) -> sshape (t, t) (f1, f2) (j1, j2) ->
  (forall j1' j2',
    def (j1' :+ h1) -> def (j2' :+ h2) -> 
    sshape (t, t) (ins k1 v1 f1, ins k2 v2 f2) (j1', j2') ->    
    verify2 (j1' :+ h1) (j2' :+ h2) (e1 @0 [tt]) (e2 @0 [tt]) r) ->
  verify2 (j1 :+ h1) (j2 :+ h2) 
      (insert t @0 [k1, v1];; e1) (insert t @0 [k2, v2];; e2) r.
Proof.
move=> D1 D2 [/= C D] H; move: D1 D2; rewrite C D=> D1 D2; apply: bnd_do=>//=. 
split=>// _; by repeat eexists; eauto.
rewrite /post_insert; move=> y1 y2 m1 m2 /= L. 
case: (L (f1, f2) (t :-> f1, t :-> f2) (h1, h2)); rewrite /plus2 //.
move=> [j1' j2'][[/= -> ->]] M; case: y1 K; case: y2=> N; apply: (H _ _ _ _ M).
by case:M=>/=->_; apply:(defPtUnl _ D1).
by case:M=>/=_->; apply:(defPtUnl _ D2). 
Qed.

Lemma bnd_insertL B (e1 : ST [::: unit] B) e2 (t : kvmap) k1 v1
                  j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop) :
  sshape (t, t) (f1, f2) (j1, j2) -> def (j1 :+ h1) -> def (j2 :+ h2) ->
  (forall j1',
    def (j1' :+ h1) -> 
    sshape (t, t) (ins k1 v1 f1, f2) (j1', j2) ->    
    verify2 (j1' :+ h1) (j2 :+ h2) (e1 @0 [tt]) e2 r) ->
  verify2 (j1 :+ h1) (j2 :+ h2) (insert t @0 [k1, v1];; e1) e2 r.
Proof.
move=>[/=->->]H1 H2 H3; apply:bnd_doL=>/=y; first by repeat eexists; eauto.
move=>m; case/(_ (f1, f1) (t :-> f1, t :-> f1) (h1, h1))=>//. 
by move=>[? w1][[_ ->]][[/=_ ->]]; case:y; apply:H3=>//; apply:(defPtUnl _ H1).
Qed.

Lemma bnd_remove B (e1 e2 : ST [::: unit] B) (t : kvmap) k1 k2
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop) :
  def (j1 :+ h1) -> def (j2 :+ h2) -> sshape (t, t) (f1, f2) (j1, j2) ->
  (forall j1' j2',
    def (j1' :+ h1) -> def (j2' :+ h2) -> 
    sshape (t, t) (rem k1 f1, rem k2 f2) (j1', j2') ->    
    verify2 (j1' :+ h1) (j2' :+ h2) (e1 @0 [tt]) (e2 @0 [tt]) r) ->
  verify2 (j1 :+ h1) (j2 :+ h2) 
      (remove t @0 [k1];; e1) (remove t @0 [k2];; e2) r.
Proof.
move=> D1 D2 [/= C D] H; move: D1 D2; rewrite C D=> D1 D2; apply: bnd_do=>//=.
split=>// _; by repeat eexists; eauto.
rewrite /post_insert; move=> y1 y2 m1 m2 /= L. 
case: (L (f1, f2) (t :-> f1, t :-> f2) (h1, h2)); rewrite /plus2 //.
move=> [j1' j2'][[/= -> ->]] M; case: y1 L; case: y2=> N; apply: (H _ _ _ _ M).
by case:M=>/=->_; apply:(defPtUnl _ D1).
by case:M=>/=_->; apply:(defPtUnl _ D2).
Qed.

Lemma bnd_lookup B (e1 e2 : ST [::: option V] B) (t : kvmap) k1 k2 
                 j1 j2 h1 h2 f1 f2 (r : d B -> d heap -> Prop) :
  sshape (t, t) (f1, f2) (j1, j2) ->
  verify2 (j1 :+ h1) (j2 :+ h2) (e1 @0 [fnd k1 f1]) (e2 @0 [fnd k2 f2]) r ->
  verify2 (j1 :+ h1) (j2 :+ h2) (lookup t @0 [k1];; e1) (lookup t @0 [k2];; e2) r.
Proof.
move=> [/= -> ->] H; apply: bnd_do=>//=.
split=>// _; by repeat eexists; eauto.
move=>y1 y2 m1 m2 J; set u1 := t:-> _ in J; set u2 := t :-> _ in J.
case: (J (f1, f2) (u1, u2) (h1, h2)); first by rewrite /plus2 /=. by split. 
by move=>[/=-> ->][/=-> ->]. 
Qed.

Lemma val_lookupV (t : kvmap) j h f k (r : option V -> heap -> Prop) :
  shape t f j -> (def (j :+ h) -> r (fnd k f) (j :+ h)) -> 
  verify (j :+ h) (lookup t @0 [k]) r.
Proof.
move=> [/= -> ->] A H; apply: val_doV=>//=; first by repeat eexists; eauto.
move=> y m J; set u := t :-> _ in J.
case: (J (f, f) (u, u) (h, h)); first by rewrite /plus2 /=. by split.
by move=>[/=-> _][/= -> _] D; apply: (A D).
Qed.

Definition AssocList := 
  KVmap.Make shape_fun sshape_refl sshape_refl1 sshape_refl2 
             remove bnd_new bnd_insert bnd_insertL val_lookupV.

Definition HashableAssocList :=
  HashTab.Make shape_fun sshape_refl sshape_refl1 sshape_refl2 
               remove minkey bnd_new bnd_insert bnd_insertL val_lookupV.
  
End AssocList. End AssocList.

Module M := AssocList.

Module D := DataType.

Module KVMapModel. Section KVMapModel.
Variables (K : ordType) (V : eqType) (x : ptr).
Notation fmap := (finMap K V).
Notation nil := (nil K V).

Inductive op : Type := Insert | Remove | Lookup.

(* finmaps up to extensional equality *)

Definition finSet (s1 : finMap K V) := 
  {s2 : finMap K V & forall k, fnd k s1 = fnd k s2}.

Lemma eq_ext (s : finMap K V) k : fnd k s = fnd k s. 
Proof. by apply: erefl. Qed.

Implicit Arguments existT [A P x].

Definition mkfinSet (s : finMap K V) : finSet s := existT (eq_ext s).

Definition T := {s1 : finMap K V & finSet s1}.

Definition mkT (s : finMap K V) : T := existT (mkfinSet s).

Definition init := mkT nil.

Notation map t := (projT1 (projT2 t)).

Lemma mapT_ext (s : T) k : fnd k (projT1 s) = fnd k (map s).
Proof. apply: (projT2 (projT2 s)). Qed.

Definition shape (t : T) := @M.shape K V x (map t).

Lemma shape_fun s h1 h2 : shape s h1 -> shape s h2 -> h1 = h2.
Proof. 
rewrite /shape /M.shape /M.sshape /= => [[-> _]][[-> _]].
by case: s=> f1 [f2 A] /=; move: (fmapP A)=> <-.
Qed.

Definition args_of (op : op) := 
  match op with 
  | Insert => [::: K; V]
  | Remove | Lookup => [::: K]
  end.

Definition res_of (op : op) : Type := 
  match op with 
  | Lookup => option V
  | Insert | Remove => unit
  end.

Definition trans (op : op) (t : T) : args (args_of op) -> T * res_of op := 
  match op as op' return args (args_of op') -> T * res_of op' with
  | Insert => fun av => (mkT (ins av.1 av.2.1 (map t)), tt)
  | Remove => fun av => (mkT (rem av.1 (map t)), tt)
  | Lookup => fun av => (t, fnd av.1 (map t))
  end.

Definition spec_of op : spec (args_of op) (res_of op) := 
  match op as op' return spec (args_of op') (res_of op') with
  | Insert => (fun k v => M.pre_kvmap K V x, M.post_insert x)
  | Remove => (fun k => M.pre_kvmap K V x, M.post_remove V x)
  | Lookup => (fun k => M.pre_kvmap K V x, M.post_lookup x)
  end.

Lemma shape_inv aalpha op av1 av2 yy ii mm :
  spec2 (spec_of op) av1 av2 yy ii mm ->
  shape aalpha.1 ii.1 -> shape aalpha.2 ii.2 ->
  shape (@trans op aalpha.1 av1).1 mm.1 /\
  shape (@trans op aalpha.2 av2).1 mm.2.
Proof.
elim: op yy av1 av2; rewrite /shape =>/= yy av1 av2 A [/= [B _]][/= [C _]].
case: (A (map aalpha.1, map aalpha.2) ii (empty, empty)). 
by rewrite /plus2 /= 2!unh0; case ii. split; first by rewrite B. by rewrite C.
by move=> mm'; rewrite /plus2 /= 2!unh0 => [[->]] [[/= -> ->]].
case: (A (map aalpha.1, map aalpha.2) ii (empty, empty)). 
by rewrite /plus2 /= 2!unh0; case ii. split; first by rewrite B. by rewrite C.
by move=> mm'; rewrite /plus2 /= 2!unh0 => [[->]] [[/= -> ->]].
split; case: (A (map aalpha.1, map aalpha.2) ii (empty, empty))=>//.
by rewrite /plus2 /= 2!unh0; case ii. by move=>->.
by rewrite /plus2 /= 2!unh0; case ii. by move=>->.
Qed.

Definition DataType := D.Datatype init shape_inv.

Lemma UR : D.UR DataType. Proof. by apply: shape_fun. Qed.

Lemma SHI : D.SHI DataType. Proof. apply: D.UR_SHI UR. Qed.

End KVMapModel. End KVMapModel.

(* a model of kvmaps that treats the kvmaps interface as opaque.  since kvmaps require that 
   the shape predicate be a function, any implementation of the interface, including hashmaps,
   is uniquely represented, as proved below. *)

Module KVMapModelOpaque. Section KVMapModel.
Variables (K : ordType) (V : eqType) (s : KVmap.Sig K V).
Notation fmap := (finMap K V).
Notation nil := (nil K V).
Notation Map := (KVmap.T s).
Notation T := (finMap K V).

Variable map : Map.

Inductive op : Type := Insert | Remove | Lookup.

Definition shape := KVmap.shape map.

Lemma shape_fun f h1 h2 : shape f h1 -> shape f h2 -> h1 = h2.
Proof. by apply: KVmap.shape_fun. Qed.

Definition args_of (op : op) := 
  match op with Insert => [::: K; V]
  | Remove | Lookup => [::: K]
  end.

Definition res_of (op : op) : Type := 
  match op with Lookup => option V
  | Insert | Remove => unit
  end.

Definition trans (op : op) (t : T) : args (args_of op) -> T * res_of op := 
  match op as op' return args (args_of op') -> T * res_of op' with
  | Insert => fun av => (ins av.1 av.2.1 t, tt)
  | Remove => fun av => (rem av.1 t, tt)
  | Lookup => fun av => (t, fnd av.1 t)
  end.

Definition spec_of op : spec (args_of op) (res_of op) := 
  match op as op' return spec (args_of op') (res_of op') with
  | Insert => (fun k v => KVmap.pre_kvmap map, 
               fun kk vv yy ii mm => 
                 forall ff jj hh, ii = jj :++ hh -> 
                   jj \In KVmap.sshape (map, map) ff ->
                   exists jj', mm = jj' :++ hh /\ 
                     jj' \In KVmap.sshape (map, map) 
                               (ins kk.1 vv.1 ff.1, ins kk.2 vv.2 ff.2))
  | Remove => (fun k => KVmap.pre_kvmap map, 
               fun kk yy ii mm =>
                 forall ff jj hh, ii = jj :++ hh -> 
                   jj \In KVmap.sshape (map, map) ff ->
                   exists jj', mm = jj' :++ hh /\ 
                     jj' \In KVmap.sshape (map, map) 
                               (rem kk.1 ff.1, rem kk.2 ff.2))
  | Lookup => (fun k => KVmap.pre_kvmap map, 
               fun kk yy ii mm => 
                 forall ff jj hh, ii = jj :++ hh -> 
                   jj \In KVmap.sshape (map, map) ff ->
                   mm = ii /\ yy.1 = fnd kk.1 ff.1 /\ yy.2 = fnd kk.2 ff.2)
  end.

Lemma shape_inv aalpha op av1 av2 yy ii mm :
  spec2 (spec_of op) av1 av2 yy ii mm ->
  shape aalpha.1 ii.1 -> shape aalpha.2 ii.2 ->
  shape (@trans op aalpha.1 av1).1 mm.1 /\
  shape (@trans op aalpha.2 av2).1 mm.2.
Proof.
elim: op yy av1 av2; rewrite /shape =>/= yy av1 av2 A B C. 
case: (A aalpha ii (empty, empty)); first by rewrite /plus2 /= 2!unh0; case ii.
case: ii A B C=> ii1 ii2; case: aalpha =>/= a1 a2 A B C. 
by apply: (KVmap.sshape_refl2 B C).
move=> [j1 j2][[/= ->]] /=; case/KVmap.sshape_refl =>/= D E.
by rewrite 2!unh0; split.
case: (A aalpha ii (empty, empty)); first by rewrite /plus2 /= 2!unh0; case ii.
case: ii A B C=> ii1 ii2; case: aalpha =>/= a1 a2 A B C. 
by apply: (KVmap.sshape_refl2 B C).
move=> [j1 j2][[/= ->]] /=; case/KVmap.sshape_refl =>/= D E.
by rewrite 2!unh0; split.
case: (A aalpha ii (empty, empty)); first by rewrite /plus2 /= 2!unh0; case ii.
case: ii A B C=> ii1 ii2; case: aalpha =>/= a1 a2 A B C. 
by apply: (KVmap.sshape_refl2 B C).
by move=>-> [D E]; split.
Qed.

Definition DataType := D.Datatype nil shape_inv.

Lemma UR : D.UR DataType. Proof. by apply: shape_fun. Qed.

Lemma SHI : D.SHI DataType. Proof. apply: D.UR_SHI UR. Qed.

End KVMapModel. End KVMapModelOpaque.




