Module KSa := KnotHeredSa(TyFSA)(K).
Definition rmap := K.knot.
Instance Join_rmap: Join rmap := KSa.Join_knot.
Instance Perm_rmap : Perm_alg rmap:= KSa.Perm_knot.
Instance Sep_rmap : Sep_alg rmap:= KSa.Sep_knot Sep_pre_rmap.
Instance Canc_rmap : Canc_alg rmap:= KSa.Canc_knot Canc_pre_rmap.
Instance Disj_rmap : Disj_alg rmap:= KSa.Disj_knot Disj_pre_rmap.
Instance ag_rmap : ageable rmap := KSa.K.ag_knot.
Instance Age_rmap: Age_alg rmap := KSa.asa_knot.
Inductive preds : Type :=
SomeP : forall A : list Type, (listprod A -> pred rmap) -> preds.
Definition NoneP := SomeP ((Void:Type)::nil) (fun _ => FF).
Definition hair := preds.
Inductive resource : Type :=
| NO
| YES: pshare -> kind -> preds -> resource
| PURE : kind -> preds -> resource.
Definition resource2res (r: resource): res (pred rmap) :=
match r with
| NO => NO' (pred rmap)
| YES p k (SomeP A l) => YES' (pred rmap) p k (existT _ A l)
| PURE k (SomeP A l) => PURE' (pred rmap) k (existT _ A l)
end.
Definition res2resource (r: res (pred rmap)) : resource :=
match r with
| NO' => NO
| YES' p k (existT A l) => YES p k (SomeP A l)
| PURE' k (existT A l) => PURE k (SomeP A l)
end.
Instance Sep_resource: Sep_alg resource.
Instance Disj_resource: Disj_alg resource.
Definition rmap' := sig valid.
Definition preds_fmap (f:(pred rmap)->(pred rmap)) (x:preds) : preds :=
match x with SomeP A ls => SomeP A (f oo ls) end.
Definition resource_fmap (f:(pred rmap)->(pred rmap)) (x:resource) : resource :=
match x with
| NO => NO
| YES sh k p => YES sh k (preds_fmap f p)
| PURE k p => PURE k (preds_fmap f p)
end.
Definition rmap_fmap (f:(pred rmap)->(pred rmap)) (x:rmap') : rmap' :=
match x with exist m H => exist (fun m => valid m) (resource_fmap f oo m) (valid_res_map f m H) end.
Definition rmap'2pre_rmap (r: rmap') : pre_rmap (pred rmap).
destruct r as [f ?].
unfold pre_rmap.
assert (valid' _ (fun x: address => resource2res (f x))).
unfold valid'. unfold valid, compose in v.
eapply same_valid; try apply v.
intros. simpl.
destruct (f x); simpl; auto. destruct p0; simpl; auto. destruct p; simpl; auto.
eauto.
Defined.
Definition pre_rmap2rmap' (r: pre_rmap (pred rmap)) : rmap'.
destruct r as [f ?].
unfold rmap', valid' in *.
assert (valid (fun l: address => res2resource (f l))).
unfold valid, compose.
replace (fun l : address => res_option (res2resource (f l))) with (fun l : address => SM.res_option (pred rmap) (f l)); auto.
extensionality l. rewrite res_option_rewrite.
unfold compose; simpl. rewrite res2resource2res. auto.
eauto.
Defined.

Lemma pre_rmap2rmap'2pre_rmap :
forall x,  pre_rmap2rmap' (rmap'2pre_rmap x) = x.