Section MATCH.
Variable bc: block_classification.
(** * Abstracting the result of conditions (type [option bool]) *)
Inductive abool :=
| Bnone               (**r always [None] (undefined) *)
| Just (b: bool)      (**r always [Some b] (defined and known to be [b]) *)
| Maybe (b: bool)     (**r either [None] or [Some b] (known to be [b] if defined) *)
| Btop.               (**r unknown, all results are possible *)
Inductive cmatch: option bool -> abool -> Prop :=
| cmatch_none: cmatch None Bnone
| cmatch_just: forall b, cmatch (Some b) (Just b)
| cmatch_maybe_none: forall b, cmatch None (Maybe b)
| cmatch_maybe_some: forall b, cmatch (Some b) (Maybe b)
| cmatch_top: forall ob, cmatch ob Btop.
Hint Constructors cmatch : va.
Definition club (x y: abool) : abool :=
match x, y with
| Bnone, Bnone => Bnone
| Bnone, (Just b | Maybe b) => Maybe b
| (Just b | Maybe b), Bnone => Maybe b
| Just b1, Just b2 => if eqb b1 b2 then x else Btop
| Maybe b1, Maybe b2 => if eqb b1 b2 then x else Btop
| Maybe b1, Just b2 => if eqb b1 b2 then x else Btop
| Just b1, Maybe b2 => if eqb b1 b2 then y else Btop
| _, _ => Btop
end.
Definition cnot (x: abool) : abool :=
match x with
| Just b => Just (negb b)
| Maybe b => Maybe (negb b)
| _ => x
end.
(** * Abstracting pointers *)
Inductive aptr : Type :=
| Pbot                         (**r bottom (empty set of pointers) *)
| Gl (id: ident) (ofs: ptrofs) (**r pointer into the block for global variable [id] at offset [ofs] *)
| Glo (id: ident)              (**r pointer anywhere into the block for global [id] *)
| Glob                         (**r pointer into any global variable *)
| Stk (ofs: ptrofs)            (**r pointer into the current stack frame at offset [ofs] *)
| Stack                        (**r pointer anywhere into the current stack frame *)
| Nonstack                     (**r pointer anywhere but into the current stack frame *)
| Ptop.                        (**r any valid pointer *)
Definition eq_aptr: forall (p1 p2: aptr), {p1=p2} + {p1<>p2}.
Definition plub (p q: aptr) : aptr :=
match p, q with
| Pbot, _ => q
| _, Pbot => p
| Gl id1 ofs1, Gl id2 ofs2 =>
if ident_eq id1 id2 then if Ptrofs.eq_dec ofs1 ofs2 then p else Glo id1 else Glob
| Gl id1 ofs1, Glo id2 =>
if ident_eq id1 id2 then q else Glob
| Glo id1, Gl id2 ofs2 =>
if ident_eq id1 id2 then p else Glob
| Glo id1, Glo id2 =>
if ident_eq id1 id2 then p else Glob
| (Gl _ _ | Glo _ | Glob), Glob => Glob
| Glob, (Gl _ _ | Glo _) => Glob
| (Gl _ _ | Glo _ | Glob | Nonstack), Nonstack =>
Nonstack
| Nonstack, (Gl _ _ | Glo _ | Glob) =>
Nonstack
| Stk ofs1, Stk ofs2 =>
if Ptrofs.eq_dec ofs1 ofs2 then p else Stack
| (Stk _ | Stack), Stack =>
Stack
| Stack, Stk _ =>
Stack
| _, _ => Ptop
end.
Definition pincl (p q: aptr) : bool :=
match p, q with
| Pbot, _ => true
| Gl id1 ofs1, Gl id2 ofs2 => peq id1 id2 && Ptrofs.eq_dec ofs1 ofs2
| Gl id1 ofs1, Glo id2 => peq id1 id2
| Glo id1, Glo id2 => peq id1 id2
| (Gl _ _ | Glo _ | Glob), Glob => true
| (Gl _ _ | Glo _ | Glob | Nonstack), Nonstack => true
| Stk ofs1, Stk ofs2 => Ptrofs.eq_dec ofs1 ofs2
| Stk ofs1, Stack => true
| Stack, Stack => true
| _, Ptop => true
| _, _ => false
end.
Definition padd (p: aptr) (n: ptrofs) : aptr :=
match p with
| Gl id ofs => Gl id (Ptrofs.add ofs n)
| Stk ofs => Stk (Ptrofs.add ofs n)
| _ => p
end.
Definition psub (p: aptr) (n: ptrofs) : aptr :=
match p with
| Gl id ofs => Gl id (Ptrofs.sub ofs n)
| Stk ofs => Stk (Ptrofs.sub ofs n)
| _ => p
end.
Definition poffset (p: aptr) : aptr :=
match p with
| Gl id ofs => Glo id
| Stk ofs => Stack
| _ => p
end.
Definition cmp_different_blocks (c: comparison) : abool :=
match c with
| Ceq => Maybe false
| Cne => Maybe true
| _   => Bnone
end.
Definition pcmp (c: comparison) (p1 p2: aptr) : abool :=
match p1, p2 with
| Pbot, _ | _, Pbot => Bnone
| Gl id1 ofs1, Gl id2 ofs2 =>
if peq id1 id2 then Maybe (Ptrofs.cmpu c ofs1 ofs2)
else cmp_different_blocks c
| Gl id1 ofs1, Glo id2 =>
if peq id1 id2 then Btop else cmp_different_blocks c
| Glo id1, Gl id2 ofs2 =>
if peq id1 id2 then Btop else cmp_different_blocks c
| Glo id1, Glo id2 =>
if peq id1 id2 then Btop else cmp_different_blocks c
| Stk ofs1, Stk ofs2 => Maybe (Ptrofs.cmpu c ofs1 ofs2)
| (Gl _ _ | Glo _ | Glob | Nonstack), (Stk _ | Stack) => cmp_different_blocks c
| (Stk _ | Stack), (Gl _ _ | Glo _ | Glob | Nonstack) => cmp_different_blocks c
| _, _ => Btop
end.

Lemma pcmp_sound:
forall valid c b1 ofs1 p1 b2 ofs2 p2,
pmatch b1 ofs1 p1 -> pmatch b2 ofs2 p2 ->
cmatch (Val.cmpu_bool valid c (Vptr b1 ofs1) (Vptr b2 ofs2)) (pcmp c p1 p2).