Hint Resolve val_defined_add_1 val_defined_add_2 : val_defined.
Hint Extern 0 (val_erasure (Vint _) (Vint _)) => reflexivity : val_erasure.
Hint Resolve val_erasure_ror val_erasure_shru val_erasure_shr
val_erasure_shl val_erasure_xor val_erasure_or val_erasure_and
val_erasure_mulhs val_erasure_mulhu val_erasure_sub
val_erasure_neg val_erasure_singleofint val_erasure_singleoffloat
val_erasure_intofsingle val_erasure_floatofint val_erasure_intoffloat
val_erasure_floatofsingle val_erasure_singleoffloat val_erasure_sign_ext
val_erasure_zero_ext val_erasure_negative val_erasure_notint
val_erasure_sub_overflow val_erasure_encode_val
val_erasure_hiword val_erasure_loword
val_erasure_add val_erasure_add_result isPointer_isDefined
val_erasure_mul_result val_erasure_mul
val_erasure_addf val_erasure_subf val_erasure_mulf
val_erasure_divf val_erasure_negf val_erasure_absf
val_erasure_addfs val_erasure_subfs val_erasure_mulfs
val_erasure_divfs val_erasure_negfs val_erasure_absfs
val_erasure_offset_ptr val_erasure_longofintu val_erasure_longofint
val_erasure_longoffloat val_erasure_longofsingle val_erasure_singleoflong
val_erasure_floatoflong val_erasure_longofwords
val_erasure_negl val_erasure_addl val_erasure_subl val_erasure_subl_overflow
val_erasure_mull val_erasure_mullhs val_erasure_mullhu val_erasure_shrl
val_erasure_andl val_erasure_orl val_erasure_xorl val_erasure_notl val_erasure_shll
val_erasure_shrlu val_erasure_rorl val_erasure_negativel : val_erasure.
Hint Immediate val_erasure_refl : val_erasure.
End ValErasure.
(** ** Erasure of Traces*)
Module TraceErasure.
Inductive mem_event_erasure : mem_event -> mem_event -> Prop :=
| WriteErasure: forall b ofs mvals mvals',
memval_erasure_list mvals mvals' ->
mem_event_erasure (Write b ofs mvals) (Write b ofs mvals')
| ReadErasure: forall b ofs sz mvals mvals',
memval_erasure_list mvals mvals' ->
mem_event_erasure (Read b ofs sz mvals) (Read b ofs sz mvals')
| AllocErasure: forall b ofs sz,
mem_event_erasure (Alloc b ofs sz) (Alloc b ofs sz)
| FreeErasure: forall ls,
mem_event_erasure (Free ls) (Free ls).
Inductive mem_event_list_erasure: list mem_event -> list mem_event -> Prop :=
| nilMemEvent: mem_event_list_erasure nil nil
| consMemEvent: forall mev mev' ls ls'
(Hev_erasure: mem_event_erasure mev mev')
(Hls_erasure: mem_event_list_erasure ls ls'),
mem_event_list_erasure (mev :: ls) (mev' :: ls').
(** Removing the footprints from a [sync_event] *)
Definition eraseSyncEvent ev :=
match ev with
| Events.release addr _ => Events.release addr None
| Events.acquire addr _ => Events.acquire addr None
| Events.spawn addr _ _ => Events.spawn addr None None
| _ => ev
end.
Inductive event_erasure : Events.machine_event -> Events.machine_event -> Prop :=
| InternalErasure: forall tid mev mev',
mem_event_erasure mev mev' ->
event_erasure (Events.internal tid mev) (Events.internal tid mev')
| ExternalErasure: forall tid ev,
event_erasure (Events.external tid ev)
(Events.external tid (eraseSyncEvent ev)).
Inductive trace_erasure : list Events.machine_event ->
list Events.machine_event -> Prop :=
| NilErasure: trace_erasure nil nil
| ConsErasure: forall ev ev' tr tr'
(Hev_erasure: event_erasure ev ev')
(Htr_erasure: trace_erasure tr tr'),
trace_erasure (ev :: tr) (ev' :: tr').

(* Specifications: *)
Lemma mem_event_list_erasure_cat:
forall tr1 tr1' tr2 tr2',
mem_event_list_erasure tr1 tr1' ->
mem_event_list_erasure tr2 tr2' ->
mem_event_list_erasure (tr1 ++ tr2) (tr1' ++ tr2').
Lemma trace_erasure_cat:
forall tr1 tr1' tr2 tr2',
trace_erasure tr1 tr1' ->
trace_erasure tr2 tr2' ->
trace_erasure (tr1 ++ tr2) (tr1' ++ tr2').
Lemma trace_erasure_map:
forall ev ev' tid,
mem_event_list_erasure ev ev' ->
trace_erasure (map [eta Events.internal tid] ev)
(map [eta Events.internal tid] ev').