Section typed_heaps.
Inductive htype:=
|char
|short1
|short2.
Inductive ht_ord: htype -> htype -> Prop :=
|htype_refl x: ht_ord x x
|htype_sht1 : ht_ord char short1
|htype_sht2 : ht_ord char short2.
Instance ht_preorder: PreOrder ht_ord.
Notation THeap':= (nat -> option htype).
Definition THvalid (TH:THeap'):=
forall n, TH n = Some short1 <->
TH (S n) = Some short2.
Record THeap: Type :=
{ theap:> nat -> option htype;
th_wf1: THvalid theap}.
Instance THeap_Join': Join THeap' :=
@fun_Join _ _ (@option_Join _ (trivial_Join)).
Inductive THeap_Join: Join THeap :=
| th_join (h1 h2 h3: THeap): THeap_Join' h1 h2 h3 ->
THeap_Join h1 h2 h3.
Instance THeap_SA': @SeparationAlgebra _ THeap_Join':=
@fun_SA _ _ _ (@option_SA _ _ (trivial_SA)).
Instance THeap_SA: @SeparationAlgebra THeap THeap_Join.
Inductive THeap_order': THeap' -> THeap' -> Prop:=
| THeap_ord (h1 h2:THeap'):
(forall (n:nat) (c:htype), h2 n = Some c ->
exists (c':htype), h1 n = Some c' /\
ht_ord c' c) ->
THeap_order' h2 h1.
Definition THeap_order (h1 h2: THeap): Prop:=
THeap_order' h1 h2.
Instance THeap_preorder': PreOrder THeap_order'.
constructor.
- hnf; intros.
constructor; intros.
exists c; split; auto; constructor.
- hnf; intros.
inversion H;
inversion H0; subst.
constructor; intros.
apply H1 in H2; destruct H2 as [c0 [HH1 HH2]].
apply H4 in HH1; destruct HH1 as [c' [HH3 HH4]].
exists c'; split; auto.
transitivity c0; auto.
Qed.

Lemma THeap_preorder: PreOrder THeap_order.