Module KSa := KnotFullSa(TyFSA)(K)(KL).
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.
Instance ag_rmap : ageable rmap := K.ageable_knot.
Instance Age_rmap: Age_alg rmap := KSa.asa_knot.
Inductive preds : Type :=
SomeP : forall A : TypeTree,
(forall ts: list Type, dependent_type_functor_rec ts A (pred rmap)) -> preds.
Definition NoneP := SomeP (ConstType unit) (fun _ => tt).
Inductive resource : Type :=
| NO: forall sh: Share.t, ~ readable_share sh -> resource
| YES: forall sh: Share.t, readable_share sh -> kind -> preds -> resource
| PURE: kind -> preds -> resource.
Definition resource2res (r: resource): res (pred rmap) :=
match r with
| NO sh nsh => NO' (pred rmap) sh nsh
| YES sh rsh k (SomeP A l) => YES' (pred rmap) sh rsh 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' sh nsh => NO sh nsh
| YES' sh rsh k (existT A l) => YES sh rsh k (SomeP A l)
| PURE' k (existT A l) => PURE k (SomeP A l)
end.
Definition ghost : Type := list (option ({g: Ghost & {a: @G g | ghost.valid a}} * preds)%type).
Definition pred2p (p: preds) : fpreds (pred rmap) :=
match p with SomeP A P => existT _ A P end.
Definition p2pred (p: fpreds (pred rmap)) : preds :=
match p with existT A P => SomeP A P end.
Definition ghost2g (r: ghost): SM.ghost (pred rmap) :=
map (option_map (fun '(a, b) => (a, pred2p b))) r.
Definition g2ghost (r: SM.ghost (pred rmap)) : ghost :=
map (option_map (fun '(a, b) => (a, p2pred b))) r.
Inductive res_join : resource -> resource -> resource -> Prop :=
| res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3
(RJ: join sh1 sh2 sh3),
res_join (NO sh1 nsh1) (NO sh2 nsh2) (NO sh3 nsh3)
| res_join_NO2 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (YES sh1 rsh1 k p) (NO sh2 nsh2) (YES sh3 rsh3 k p)
| res_join_NO3 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (NO sh1 nsh1) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
| res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (YES sh1 rsh1 k p) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
| res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
Instance Join_resource: Join resource := res_join.
Instance Perm_resource: Perm_alg resource.
Instance Sep_resource: Sep_alg resource.
Instance pa_gej : @Perm_alg _ ghost_elem_join.
Instance Perm_ghost : Perm_alg ghost.
Instance Sep_ghost : Sep_alg ghost.
Definition rmap' := ((address->resource) * ghost)%type.
Definition preds_fmap (f g:(pred rmap)->(pred rmap)) (x:preds) : preds :=
match x with SomeP A ls => SomeP A (fmap (fpi _) f g ls) end.
Definition resource_fmap (f g:pred rmap -> pred rmap) (x:resource) : resource :=
match x with
| NO sh nsh => NO sh nsh
| YES sh rsh k p => YES sh rsh k (preds_fmap f g p)
| PURE k p => PURE k (preds_fmap f g p)
end.
Definition ghost_fmap (f g:pred rmap -> pred rmap)(x:ghost) : ghost :=
map (option_map (fun '(a, b) => (a, preds_fmap f g b))) x.
Definition rmap_fmap (f g:(pred rmap)->(pred rmap)) (x:rmap') : rmap' :=
(resource_fmap f g oo fst x, ghost_fmap f g (snd x)).
Definition rmap'2pre_rmap (f: rmap') : f_pre_rmap (pred rmap) :=
(fun x : address => resource2res (fst f x), ghost2g (snd f)).
Definition pre_rmap2rmap' (f: f_pre_rmap (pred rmap)) : rmap' :=
(fun l : address => res2resource (fst f l), g2ghost (snd f)).
Definition squash (n_rm:nat * rmap') : rmap :=
match n_rm with (n,rm) => K.squash (n, rmap'2pre_rmap rm) end.
Definition unsquash (phi:rmap) : (nat * rmap') :=
match K.unsquash phi with (n,rm) => (n, pre_rmap2rmap' rm) end.
Definition rmap_level (phi:rmap) : nat := fst (unsquash phi).
Definition resource_at (phi:rmap) : address -> resource := fst (snd (unsquash phi)).
Infix "@" := resource_at (at level 50, no associativity).
Definition ghost_of (phi:rmap) : ghost := snd (snd (unsquash phi)).
Program Definition approx (n:nat) (p: (pred rmap)) : (pred rmap) :=
fun w => level w < n /\ p w.
Next Obligation.
destruct H0.
split.
apply age_level in H.
simpl in *. omega.
apply pred_hereditary with a; auto.
Qed.

Lemma unsquash_squash : forall n rm, (unsquash (squash (n,rm))) = (n,rmap_fmap (approx n) (approx n) rm).