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.
Definition pdisjoint (p1: aptr) (sz1: Z) (p2: aptr) (sz2: Z) : bool :=
match p1, p2 with
| Pbot, _ => true
| _, Pbot => true
| Gl id1 ofs1, Gl id2 ofs2 =>
if peq id1 id2
then zle (Ptrofs.unsigned ofs1 + sz1) (Ptrofs.unsigned ofs2)
|| zle (Ptrofs.unsigned ofs2 + sz2) (Ptrofs.unsigned ofs1)
else true
| Gl id1 ofs1, Glo id2 => negb(peq id1 id2)
| Glo id1, Gl id2 ofs2 => negb(peq id1 id2)
| Glo id1, Glo id2 => negb(peq id1 id2)
| Stk ofs1, Stk ofs2 =>
zle (Ptrofs.unsigned ofs1 + sz1) (Ptrofs.unsigned ofs2)
|| zle (Ptrofs.unsigned ofs2 + sz2) (Ptrofs.unsigned ofs1)
| (Gl _ _ | Glo _ | Glob | Nonstack), (Stk _ | Stack) => true
| (Stk _ | Stack), (Gl _ _ | Glo _ | Glob | Nonstack) => true
| _, _ => false
end.
(** * Abstracting values *)
Inductive aval : Type :=
| Vbot                     (**r bottom (empty set of values) *)
| I (n: int)               (**r exactly [Vint n] *)
| Uns (p: aptr) (n: Z)     (**r a [n]-bit unsigned integer, or [Vundef] *)
| Sgn (p: aptr) (n: Z)     (**r a [n]-bit signed integer, or [Vundef] *)
| L (n: int64)             (**r exactly [Vlong n] *)
| F (f: float)             (**r exactly [Vfloat f] *)
| FS (f: float32)          (**r exactly [Vsingle f] *)
| Ptr (p: aptr)            (**r a pointer from the set [p], or [Vundef] *)
| Ifptr (p: aptr).         (**r a pointer from the set [p], or a number, or [Vundef] *)
(** The "top" of the value domain is defined as any pointer, or any number, or [Vundef]. *)
Definition Vtop := Ifptr Ptop.
(** The [p] parameter (an abstract pointer) to [Uns] and [Sgn] helps keeping track of pointers that leak through arithmetic operations such as shifts. See the section "Tracking leakage of pointers" below. In strict analysis mode, [p] is always [Pbot]. *)
Definition eq_aval: forall (v1 v2: aval), {v1=v2} + {v1<>v2}.

Lemma vmatch_top: forall v x, vmatch v x -> vmatch v Vtop.