Section SM.
Variable A:Type.
Variable EqDec_A : EqDec A.
Variable B:Type.
Variable JB: Join B.
Variable paB : Perm_alg B.
Variable saB : Sep_alg B.
Definition map := fpm A (lifted Share.Join_ba * B).
Instance Join_map : Join map := Join_fpm _.
Instance pa_map : Perm_alg map := Perm_fpm _ _.
Instance sa_map : Sep_alg map := Sep_fpm _ _.
Instance ca_map {CA: Canc_alg B} : Canc_alg map := Canc_fpm _.
Instance da_map {DA: Disj_alg B} : Disj_alg map := @Disj_fpm _ _ _ _ _ _.
Definition map_share (a:A) (m:map) : share :=
match lookup_fpm m a with
| Some (sh,_) => lifted_obj sh
| None => Share.bot
end.
Definition map_val (a:A) (m:map) : option B :=
match lookup_fpm m a with
| Some (_,b) => Some b
| None => None
end.
Definition empty_map : map := empty_fpm _ _.
Definition map_upd (a:A) (b:B) (m:map) : option map :=
match lookup_fpm m a with
| Some (sh,_) =>
if eq_dec (lifted_obj sh) fullshare
then Some (insert_fpm _ a (sh,b) m)
else None
| None => None
end.
Proof with auto.
split; intros.
hnf in H. specialize ( H a).
unfold map_val, map_share, lookup_fpm.
destruct (proj1_sig m1 a) as [[sh1 a1] | ];
destruct (proj1_sig m2 a) as [[sh2 a2] | ];
destruct (proj1_sig m3 a) as [[sh3 a3] | ]; inv H; try solve [inv H0]; simpl; auto.
destruct H3; simpl in *; auto.
split. apply join_lifted; auto. constructor; auto.
split; apply join_unit2; auto.
split; apply join_unit1; auto.
split; apply join_unit1; auto.
split; apply join_unit1; auto.
intro a. specialize ( H a). destruct H.
unfold map_val, map_share, lookup_fpm in *.
destruct (proj1_sig m1 a) as [[sh1 a1] | ];
destruct (proj1_sig m2 a) as [[sh2 a2] | ];
destruct (proj1_sig m3 a) as [[sh3 a3] | ]; inv H0; try solve [inv H1]; auto.
constructor. split; auto.
apply join_unit2_e in H; auto. apply join_unit2; auto.
repeat f_equal. destruct sh1; destruct sh3; simpl in *; subst.
rewrite (proof_irr n n0); auto.
apply join_unit1_e in H; auto. apply join_unit1; auto.
repeat f_equal. destruct sh2; destruct sh3; simpl in *; subst.
rewrite (proof_irr n n0); auto.
constructor. constructor.
Qed.

Lemma map_identity_unique {CAB: Disj_alg B}: forall m1 m2:map,
identity m1 -> identity m2 -> m1 = m2.