Section IO_safety.
Context `{Config : ThreadsConfigurationOps}.
Variable (prog : Clight.program).
Definition ext_link := ext_link_prog prog.
Definition sys_getc_wrap_spec (abd : RData) : option (RData * val * trace) :=
match sys_getc_spec abd with
| Some abd' => Some (abd', get_sys_ret abd', trace_of_ostrace (strip_common_prefix IOEvent_eq abd.(io_log) abd'.(io_log)))
| None => None
end.
Definition sys_putc_wrap_spec (cv : val) (abd : RData) : option (RData * val * trace) :=
(* Make sure argument is set *)
match cv, get_sys_arg1 abd with
| Vint c, Vint c' =>
if eq_dec.eq_dec c c' then
match sys_putc_spec abd with
| Some abd' => Some (abd', get_sys_ret abd', trace_of_ostrace (strip_common_prefix IOEvent_eq abd.(io_log) abd'.(io_log)))
| None => None
end
else None
| _, _ => None
end.
Definition IO_ext_sem e (args : list val) s :=
if oi_eq_dec (Some (ext_link "putchar"%string, funsig2signature ([(1%positive, tint)], tint) cc_default))
(ef_id_sig ext_link e) then
match args with
| c :: nil =>
match sys_putc_wrap_spec c s with
| Some (s', ret, t') => Some (s', Some ret, t')
| None => None
end
| _ => None end else
if oi_eq_dec  (Some (ext_link "getchar"%string, funsig2signature ([], tint) cc_default))
(ef_id_sig ext_link e) then
match sys_getc_wrap_spec s with
| Some (s', ret, t') => Some (s', Some ret, t')
| None => None
end
else Some (s, None, TEnd).
Variable (R_mem : block -> Z).
(* Because putchar and getchar don't use memory, these functions don't either. *)
Definition IO_inj_mem (e : external_function) (args : list val) (m : mem) t s :=
valid_trace s /\ t = trace_of_ostrace s.(io_log).
Definition OS_mem (e : external_function) (args : list val) m (s : RData) : mem := m.
(* In general, this could look like: if oi_eq_dec (Some (ext_link "putchars"%string, ...) (ef_id_sig ext_link e) then match args with | (Vptr b ofs) :: len :: nil => flatmem_to_mem R_mem s.(HP) m b ofs (ofs + len) | _ => m end else ... *)
Instance IO_Espec : OracleKind := IO_Espec ext_link.
(* relate to OS's external events *)
Notation ge := (globalenv prog).
Inductive OS_safeN_trace : nat -> @trace io_events.IO_event unit -> Ensemble (@trace io_events.IO_event unit * RData) -> OK_ty -> RData -> CC_core -> mem -> Prop :=
| OS_safeN_trace_0: forall t z s c m, OS_safeN_trace O t (Singleton _ (TEnd, s)) z s c m
| OS_safeN_trace_step:
forall n t traces z s c m c' m',
cl_step ge c m c' m' ->
OS_safeN_trace n t traces z s c' m' ->
OS_safeN_trace (S n) t traces z s c m
| OS_safeN_trace_external:
forall n t traces z s0 c m e args,
cl_at_external c = Some (e,args) ->
(forall s s' ret m' t' n'
(Hargsty : Val.has_type_list args (sig_args (ef_sig e)))
(Hretty : step_lemmas.has_opttyp ret (sig_res (ef_sig e))),
IO_inj_mem e args m t s ->
IO_ext_sem e args s = Some (s', ret, t') ->
m' = OS_mem e args m s' ->
(n' <= n)%nat ->
valid_trace s' /\ exists traces' z' c', consume_trace z z' t' /\
cl_after_external ret c = Some c' /\
OS_safeN_trace n' (app_trace t t') traces' z' s' c' m' /\
(forall t'' sf, In _ traces' (t'', sf) -> In _ traces (app_trace t' t'', sf))) ->
(forall t1, In _ traces t1 ->
exists s s' ret m' t' n', Val.has_type_list args (sig_args (ef_sig e)) /\
step_lemmas.has_opttyp ret (sig_res (ef_sig e)) /\
IO_inj_mem e args m t s /\ IO_ext_sem e args s = Some (s', ret, t') /\ m' = OS_mem e args m s' /\
(n' <= n)%nat /\ valid_trace s' /\ exists traces' z' c', consume_trace z z' t' /\
cl_after_external ret c = Some c' /\ OS_safeN_trace n' (app_trace t t') traces' z' s' c' m' /\
exists t'' sf, In _ traces' (t'', sf) /\ t1 = (app_trace t' t'', sf)) ->
OS_safeN_trace (S n) t traces z s0 c m.
Local Ltac inj :=
repeat match goal with
| H: _ = _ |- _ => assert_succeeds (injection H); inv H
end.
Local Ltac destruct_spec Hspec :=
repeat match type of Hspec with
| match ?x with _ => _ end = _ => destruct x eqn:?; subst; inj; try discriminate
end.

Lemma app_trace_strip : forall t1 t2, common_prefix IOEvent_eq t1 t2 = t1 ->
app_trace (trace_of_ostrace t1) (trace_of_ostrace (strip_common_prefix IOEvent_eq t1 t2)) = trace_of_ostrace t2.