From Coq Require Import List.
Import List.ListNotations.
Open Scope list_scope.
From Coq Require Import Permutation.
From Coq Require Import Setoid.
From Coq Require Import Morphisms.
From Velus Require Import Common.
From Velus Require Import CommonProgram.
From Velus Require Import Environment.
From Velus Require Import FunctionalEnvironment.
From Velus Require Import Operators.
From Velus Require Import Clocks.
From Velus Require Import CoreExpr.CESyntax.
From Velus Require Import VelusMemory.
From Velus Require Import Stc.StcSyntax.
From Velus Require Import Stc.StcOrdered.
From Velus Require Import IndexedStreams.
From Velus Require Import CoreExpr.CESemantics.
Module Type STCSEMANTICS
(
Import Ids :
IDS)
(
Import Op :
OPERATORS)
(
Import OpAux :
OPERATORS_AUX Ids Op)
(
Import Cks :
CLOCKS Ids Op OpAux)
(
Import CESyn :
CESYNTAX Ids Op OpAux Cks)
(
Import Syn :
STCSYNTAX Ids Op OpAux Cks CESyn)
(
Import Ord :
STCORDERED Ids Op OpAux Cks CESyn Syn)
(
Import Str :
INDEXEDSTREAMS Ids Op OpAux Cks)
(
Import CESem :
CESEMANTICS Ids Op OpAux Cks CESyn Str).
Definition state :=
memory value.
Definition state_closed_states (
states :
list ident) (
S:
state) :
Prop :=
forall x,
find_val x S <>
None ->
In x states.
Inductive state_closed {
prefs} : @
program prefs ->
ident ->
state ->
Prop :=
state_closed_intro:
forall P f S s P',
find_system f P =
Some (
s,
P') ->
state_closed_states (
map fst (
s.(
s_lasts) ++
s.(
s_nexts)))
S ->
(
forall i S',
find_inst i S =
Some S' ->
exists g,
In (
i,
g) (
s_subs s)
/\
state_closed P'
g S') ->
state_closed P f S.
Definition state_closed_insts {
prefs} (
P: @
program prefs) (
subs:
list (
ident *
ident)) (
S:
state) :
Prop :=
forall i Si,
find_inst i S =
Some Si ->
exists g,
In (
i,
g)
subs
/\
state_closed P g Si.
Definition reset_states {
prefs} (
s: @
system prefs) (
S0:
state) :
Prop :=
forall x c t ck,
In (
x, (
c,
t,
ck)) (
s.(
s_lasts) ++
s.(
s_nexts)) ->
find_val x S0 =
Some (
sem_const c).
Inductive initial_state {
prefs} : (@
program prefs) ->
ident ->
state ->
Prop :=
initial_state_intro:
forall P f S0 s P',
find_system f P =
Some (
s,
P') ->
reset_states s S0 ->
(
forall i g,
In (
i,
g)
s.(
s_subs) ->
exists Si0,
find_inst i S0 =
Some Si0
/\
initial_state P'
g Si0) ->
initial_state P f S0.
Section Semantics.
Context {
prefs :
PS.t}.
Variable P: @
program prefs.
Inductive sem_trconstr:
bool ->
env ->
state ->
state ->
state ->
trconstr ->
Prop :=
|
STcDef:
forall base R S I S'
x v ck ce,
sem_arhs_instant base R ck ce v ->
sem_var_instant R (
Var x)
v ->
sem_trconstr base R S I S' (
TcDef ck x ce)
|
STcResetState:
forall base R S I S'
x ckr ty c0 r c,
find_val x S =
Some c ->
sem_clock_instant base (
var_env R)
ckr r ->
(
if r then find_val x I =
Some (
sem_const c0)
else True) ->
sem_trconstr base R S I S' (
TcReset ckr (
ResState x ty c0))
|
STcResetInst:
forall base R S I S'
ckr f i r Ii,
find_inst i I =
Some Ii ->
sem_clock_instant base (
var_env R)
ckr r ->
(
if r then initial_state P f Ii else True) ->
sem_trconstr base R S I S' (
TcReset ckr (
ResInst i f))
|
STcUpdateLast:
forall base R S I S'
x ck e ckrs c v',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_val x S =
Some c) ->
find_val x I =
Some c ->
sem_caexp_instant base R ck e v' ->
sem_var_instant R (
Last x) (
match v'
with present _ =>
present c |
absent =>
absent end) ->
sem_var_instant R (
Var x)
v' ->
find_val x S' =
Some (
match v'
with present c' =>
c' |
absent =>
c end) ->
sem_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdLast x e))
|
STcUpdateNext:
forall base R S I S'
x ck e ckrs c v',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_val x S =
Some c) ->
find_val x I =
Some c ->
sem_aexp_instant base R ck e v' ->
sem_var_instant R (
Var x) (
match v'
with present _ =>
present c |
absent =>
absent end) ->
find_val x S' =
Some (
match v'
with present c' =>
c' |
absent =>
c end) ->
sem_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdNext x e))
|
STcUpdateInst:
forall base R S I S'
ys ck ckrs f i es xs Ii os Si',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_inst i S ⌈≋⌉
Some Ii) ->
find_inst i I =
Some Ii ->
sem_exps_instant base R es xs ->
sem_clock_instant base (
var_env R)
ck (
clock_of_instant xs) ->
sem_system f Ii xs os Si' ->
sem_vars_instant R ys os ->
find_inst i S' =
Some Si' ->
sem_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdInst i ys f es))
with sem_system:
ident ->
state ->
list svalue ->
list svalue ->
state ->
Prop :=
SSystem:
forall f s P'
S I S'
R xs ys,
find_system f P =
Some (
s,
P') ->
sem_vars_instant R (
map fst s.(
s_in))
xs ->
sem_vars_instant R (
map fst s.(
s_out))
ys ->
sem_clocked_vars_instant (
clock_of_instant xs)
R (
map (
fun '(
x, (
_,
ck)) => (
x, (
ck,
false)))
s.(
s_in)) ->
Forall (
sem_trconstr (
clock_of_instant xs)
R S I S')
s.(
s_tcs) ->
state_closed P f S ->
state_closed P f I ->
state_closed P f S' ->
sem_system f S xs ys S'.
End Semantics.
Global Hint Constructors sem_trconstr sem_system state_closed :
stcsem.
Section sem_system_mult.
Context {
prefs :
PS.t}.
Variable P: @
program prefs.
Variable P_trconstr:
bool ->
env ->
state ->
state ->
state ->
trconstr ->
Prop.
Variable P_system:
ident ->
state ->
list svalue ->
list svalue ->
state ->
Prop.
Hypothesis TcDefCase:
forall base R S I S'
x v ck ce,
sem_arhs_instant base R ck ce v ->
sem_var_instant R (
Var x)
v ->
P_trconstr base R S I S' (
TcDef ck x ce).
Hypothesis TcResetStateCase:
forall base R S I S'
x ckr ty c0 r c,
find_val x S =
Some c ->
sem_clock_instant base (
var_env R)
ckr r ->
(
if r then find_val x I =
Some (
sem_const c0)
else True) ->
P_trconstr base R S I S' (
TcReset ckr (
ResState x ty c0)).
Hypothesis TcUpdateLastCase:
forall base R S I S'
x ck e ckrs c v',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_val x S =
Some c) ->
find_val x I =
Some c ->
sem_caexp_instant base R ck e v' ->
sem_var_instant R (
Last x) (
match v'
with present _ =>
present c |
absent =>
absent end) ->
sem_var_instant R (
Var x)
v' ->
find_val x S' =
Some (
match v'
with present c' =>
c' |
absent =>
c end) ->
P_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdLast x e)).
Hypothesis TcUpdateNextCase:
forall base R S I S'
x ck e ckrs c v',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_val x S =
Some c) ->
find_val x I =
Some c ->
sem_aexp_instant base R ck e v' ->
sem_var_instant R (
Var x) (
match v'
with present _ =>
present c |
absent =>
absent end) ->
find_val x S' =
Some (
match v'
with present c' =>
c' |
absent =>
c end) ->
P_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdNext x e)).
Hypothesis TcResetInstCase:
forall base R S I S'
ck f i r Ii,
sem_clock_instant base (
var_env R)
ck r ->
find_inst i I =
Some Ii ->
(
if r then initial_state P f Ii else True) ->
P_trconstr base R S I S' (
TcReset ck (
ResInst i f)).
Hypothesis TcUpdateInstCase:
forall base R S I S'
ys ck ckrs f i es xs Ii os Si',
(
Forall (
fun ckr =>
sem_clock_instant base (
var_env R)
ckr false)
ckrs ->
find_inst i S ⌈≋⌉
Some Ii) ->
find_inst i I =
Some Ii ->
sem_exps_instant base R es xs ->
sem_clock_instant base (
var_env R)
ck (
clock_of_instant xs) ->
sem_system P f Ii xs os Si' ->
sem_vars_instant R ys os ->
find_inst i S' =
Some Si' ->
P_system f Ii xs os Si' ->
P_trconstr base R S I S' (
TcUpdate ck ckrs (
UpdInst i ys f es)).
Hypothesis SystemCase:
forall f s P'
R S I S'
xs ys,
find_system f P =
Some (
s,
P') ->
sem_vars_instant R (
map fst s.(
s_in))
xs ->
sem_vars_instant R (
map fst s.(
s_out))
ys ->
sem_clocked_vars_instant (
clock_of_instant xs)
R (
map (
fun '(
x, (
_,
ck)) => (
x, (
ck,
false)))
s.(
s_in)) ->
Forall (
sem_trconstr P (
clock_of_instant xs)
R S I S')
s.(
s_tcs) ->
state_closed P f S ->
state_closed P f I ->
state_closed P f S' ->
Forall (
P_trconstr (
clock_of_instant xs)
R S I S')
s.(
s_tcs) ->
P_system f S xs ys S'.
Fixpoint sem_trconstr_mult
(
base:
bool) (
R:
env) (
S:
state) (
I:
state) (
S':
state) (
e:
trconstr)
(
Sem:
sem_trconstr P base R S I S'
e) {
struct Sem}
:
P_trconstr base R S I S'
e
with sem_system_mult
(
f:
ident) (
S:
state) (
xs ys:
list svalue) (
S':
state)
(
Sem:
sem_system P f S xs ys S') {
struct Sem}
:
P_system f S xs ys S'.
Proof.
-
destruct Sem;
eauto.
-
destruct Sem.
eapply SystemCase;
eauto.
match goal with H:
Forall _ _ |-
_ =>
induction H;
auto end.
Qed.
End sem_system_mult.
CoInductive loop {
prefs}: (@
program prefs) ->
ident ->
stream (
list svalue) ->
stream (
list svalue) ->
state ->
nat ->
Prop :=
loop_intro:
forall P f xss yss Sn Sn'
n,
sem_system P f Sn (
xss n) (
yss n)
Sn' ->
loop P f xss yss Sn' (
S n) ->
loop P f xss yss Sn n.
Section LoopCoind.
Context {
prefs :
PS.t}.
Variable R: (@
program prefs) ->
ident ->
stream (
list svalue) ->
stream (
list svalue) ->
state ->
nat ->
Prop.
Hypothesis Loop:
forall P f xss yss Sn n,
R P f xss yss Sn n ->
exists Sn',
sem_system P f Sn (
xss n) (
yss n)
Sn'
/\
R P f xss yss Sn' (
S n).
Lemma loop_coind:
forall P f xss yss S n,
R P f xss yss S n ->
loop P f xss yss S n.
Proof.
cofix COFIX;
intros *
HR.
apply Loop in HR as (?&?&?).
econstructor;
eauto.
Qed.
End LoopCoind.
Add Parametric Morphism {
prefs}
system : (@
reset_states prefs system)
with signature equal_memory ==>
Basics.impl
as reset_states_equal_memory.
Proof.
intros * E Rst ???? Hin.
rewrite <-E; apply Rst in Hin; auto.
Qed.
Add Parametric Morphism {
prefs}
P f : (@
initial_state prefs P f)
with signature equal_memory ==>
Basics.impl
as initial_state_equal_memory.
Proof.
intros *
E Init.
revert dependent P;
revert dependent f;
revert dependent y.
induction x as [?
IH]
using memory_ind';
intros.
inversion_clear Init as [???????
Spec].
econstructor;
eauto.
-
now rewrite <-
E.
-
intros *
Hin.
apply Spec in Hin as (?&
Sub &?).
pose (
Sub' :=
Sub).
apply orel_eq in Sub'.
setoid_rewrite (@
eq_subrelation _ equal_memory)
in Sub';
auto with memory.
setoid_rewrite E in Sub'.
apply orel_find_inst_Some in Sub'
as (
v' &
Hv' & ->).
symmetry in Hv'.
eauto.
Qed.
Add Parametric Morphism states : (
state_closed_states states)
with signature equal_memory ==>
Basics.impl
as state_closed_states_equal_memory.
Proof.
Add Parametric Morphism {
prefs}
P b : (@
state_closed prefs P b)
with signature equal_memory ==>
Basics.impl
as state_closed_equal_memory.
Proof.
intros m m'
E Closed;
revert dependent m';
revert dependent b;
revert P ;
induction m as [?
IH]
using memory_ind';
intros.
inversion_clear Closed as [???????
Insts].
econstructor;
eauto.
-
now setoid_rewrite <-
E.
-
intros *
Sub.
apply orel_eq in Sub.
setoid_rewrite (@
eq_subrelation _ equal_memory)
in Sub;
auto with memory.
setoid_rewrite <-
E in Sub.
apply orel_find_inst_Some in Sub as (
S &
HS &
Sub').
specialize (
Insts _ _ Sub')
as (
b' & ? & ?).
eauto.
Qed.
Add Parametric Morphism {
prefs}
P : (@
state_closed_insts prefs P)
with signature @
Permutation (
ident *
ident) ==>
eq ==>
Basics.impl
as state_closed_insts_Permutation.
Proof.
intros * E ? Closed ?? Find; apply Closed in Find as (g&?&?).
exists g; split; auto.
now rewrite <-E.
Qed.
Add Parametric Morphism {
prefs}
P f: (@
sem_system prefs P f)
with signature equal_memory ==>
eq ==>
eq ==>
equal_memory ==>
Basics.impl
as sem_system_equal_memory.
Proof.
intros S1 S2 ???
S1'
S2' **
Sem.
eapply sem_system_mult with
(
P_system :=
fun f S1 xs ys S1' =>
forall S2 S2',
S1 ≋
S2 ->
S1' ≋
S2' ->
sem_system P f S2 xs ys S2')
(
P_trconstr :=
fun base R S1 I1 S1'
tc =>
forall S2 S2'
I2,
S1 ≋
S2 ->
I1 ≋
I2 ->
S1' ≋
S2' ->
sem_trconstr P base R S2 I2 S2'
tc)
in Sem;
eauto.
-
intros * ??? *
E EI E'.
econstructor;
eauto.
-
intros * ??? *
E EI E'.
econstructor;
eauto.
+
rewrite <-
E;
eauto.
+
destruct r;
try rewrite <-
EI;
eauto.
-
intros * ?????? *
E EI E'.
econstructor;
eauto.
+
rewrite <-
E;
eauto.
+
rewrite <-
EI;
eauto.
+
rewrite <-
E';
eauto.
-
intros * ????? *
E EI E'.
econstructor;
eauto.
+
rewrite <-
E;
eauto.
+
rewrite <-
EI;
eauto.
+
rewrite <-
E';
eauto.
-
intros * ?
Find ? *
E EI E'.
apply orel_eq in Find;
setoid_rewrite (@
eq_subrelation _ equal_memory)
in Find;
auto with memory.
rewrite EI in Find.
apply Env.orel_find_Some in Find as (
Is' &
Eq &
Find').
destruct r.
+
econstructor;
eauto;
simpl.
rewrite Eq;
eauto.
+
econstructor;
eauto;
simpl.
-
intros * ?
Find ?
Spec ??
Sub Ind *
E EI E'.
apply orel_eq in Find;
setoid_rewrite (@
eq_subrelation _ equal_memory)
in Find;
auto with memory.
rewrite EI in Find.
apply Env.orel_find_Some in Find as (? &
Eq & ?).
apply orel_eq in Sub;
setoid_rewrite (@
eq_subrelation _ equal_memory)
in Sub;
auto with memory.
rewrite E'
in Sub.
apply orel_find_inst_Some in Sub as (? &
Eq' & ?).
symmetry in Eq,
Eq'.
econstructor;
eauto.
rewrite <-
E, <-
Eq;
eauto.
-
intros * ????????? *
E E'.
eapply SSystem with (
I :=
I);
eauto.
+
induction (
s_tcs s);
auto;
repeat match goal with H:
Forall ?
P (
_ ::
_) |-
_ =>
inv H end.
constructor;
auto.
assert (
I ≋
I)
by reflexivity;
auto.
+
now rewrite <-
E.
+
now rewrite <-
E'.
Qed.
Add Parametric Morphism : (
state_closed_states)
with signature (@
Permutation ident) ==>
eq ==>
Basics.impl
as state_closed_states_permutation.
Proof.
Add Parametric Morphism {
prefs}
P b xss yss : (@
loop prefs P b xss yss)
with signature equal_memory ==>
eq ==>
Basics.impl
as loop_equal_memory.
Proof.
cofix COFIX.
intros * E n Loop.
inv Loop.
econstructor; eauto.
intros; rewrite <-E; auto.
Qed.
Lemma initial_state_other {
prefs}:
forall S0 s (
P :
list (@
system prefs))
enums externs f,
s_name s <>
f ->
(
initial_state (
Program enums externs P)
f S0 <->
initial_state (
Program enums externs (
s ::
P))
f S0).
Proof.
Fact reset_states_add_inst {
prefs}:
forall (
s: @
system prefs)
S0 i Si0,
reset_states s S0 ->
reset_states s (
add_inst i Si0 S0).
Proof.
Fact state_closed_states_add:
forall states S x v,
state_closed_states states S ->
state_closed_states (
x::
states) (
add_val x v S).
Proof.
Fact state_closed_states_add_inst:
forall states S i Si,
state_closed_states states S ->
state_closed_states states (
add_inst i Si S).
Proof.
Lemma state_closed_insts_InMembers {
prefs}:
forall (
P: @
program prefs)
subs S s Ss,
state_closed_insts P subs S ->
find_inst s S =
Some Ss ->
InMembers s subs.
Proof.
intros *
Closed Sub;
apply Closed in Sub as (?&?&?).
eapply In_InMembers;
eauto.
Qed.
Lemma state_closed_other {
prefs}:
forall S s (
P:
list (@
system prefs))
f enums externs,
s_name s <>
f ->
(
state_closed (
Program enums externs P)
f S <->
state_closed (
Program enums externs (
s ::
P))
f S).
Proof.
Lemma state_closed_find_system_other {
prefs}:
forall S i (
P: @
program prefs)
P'
f s g,
Ordered_systems P ->
find_system f P =
Some (
s,
P') ->
In (
i,
g)
s.(
s_subs) ->
state_closed P g S ->
state_closed P'
g S.
Proof.
intros ?? [] *
Ord Find Hin Closed;
inversion_clear Closed as [?????
Find'].
econstructor;
eauto.
assert (
types0 =
types P')
as Enums
by (
apply find_unit_equiv_program in Find;
specialize (
Find nil);
inv Find;
auto).
assert (
externs0 =
externs P')
as Externs
by (
apply find_unit_equiv_program in Find;
specialize (
Find nil);
inv Find;
auto).
apply find_unit_spec in Find as (?&?&
E &?);
simpl in E;
subst.
apply Ordered_systems_split in Ord.
eapply Forall_forall in Ord as (
FindNone &
Neq &?&?&?);
eauto;
simpl in *.
setoid_rewrite find_unit_app in Find';
simpl in *;
eauto.
setoid_rewrite FindNone in Find'.
eapply find_unit_cons in Find'
as [[]|[]];
simpl in *;
eauto;
auto;
contradiction.
Qed.
Lemma state_closed_insts_find_system_other {
prefs}:
forall I (
s: @
system prefs)
P P'
f,
Ordered_systems P ->
find_system f P =
Some (
s,
P') ->
state_closed_insts P s.(
s_subs)
I ->
state_closed_insts P'
s.(
s_subs)
I.
Proof.
Lemma state_closed_insts_cons {
prefs}:
forall I (
s: @
system prefs)
P enums externs,
Ordered_systems (
Program enums externs (
s ::
P)) ->
state_closed_insts (
Program enums externs P)
s.(
s_subs)
I ->
state_closed_insts (
Program enums externs (
s ::
P))
s.(
s_subs)
I.
Proof.
intros *
Ord Closed;
inversion_clear Ord as [|?? [
Spec ?]].
intros ??
Find;
apply Closed in Find as (
g &
Hin &?).
exists g;
split;
auto.
apply state_closed_other;
auto.
apply in_map with (
f :=
snd)
in Hin.
apply Spec in Hin;
intuition.
Qed.
Lemma sem_system_cons {
prefs}:
forall (
P:
list (@
system prefs))
enums externs s f xs S S'
ys,
Ordered_systems (
Program enums externs (
s ::
P)) ->
sem_system (
Program enums externs (
s ::
P))
f xs S S'
ys ->
s.(
s_name) <>
f ->
sem_system (
Program enums externs P)
f xs S S'
ys.
Proof.
Lemma sem_system_cons2 {
prefs}:
forall (
s: @
system prefs)
P enums externs f xs S S'
ys,
Ordered_systems (
Program enums externs (
s ::
P)) ->
sem_system (
Program enums externs P)
f xs S S'
ys ->
sem_system (
Program enums externs (
s ::
P))
f xs S S'
ys.
Proof.
Global Hint Resolve sem_system_cons sem_system_cons2 :
stcsem.
Lemma sem_trconstrs_cons {
prefs}:
forall (
P:
list (@
system prefs))
enums externs bk H S I S'
tcs s,
Ordered_systems (
Program enums externs (
s ::
P)) ->
~
Is_system_in s.(
s_name)
tcs ->
(
Forall (
sem_trconstr (
Program enums externs P)
bk H S I S')
tcs <->
Forall (
sem_trconstr (
Program enums externs (
s ::
P))
bk H S I S')
tcs).
Proof.
intros *
Hord Hnini.
induction tcs as [|
tc tcs IH]; [
now constructor|].
apply not_Is_system_in_cons in Hnini as [
Hnini Hninis].
split;
intros Hsem;
apply Forall_cons2 in Hsem as [
Htc Htcs];
apply IH in Htcs;
auto;
constructor;
auto.
-
destruct Htc;
eauto with stcsem.
+
econstructor;
eauto.
destruct r;
eauto.
apply initial_state_other;
auto.
intro E;
apply Hnini;
rewrite E;
constructor.
-
destruct Htc;
eauto with stcsem.
+
econstructor;
eauto.
destruct r;
auto.
rewrite initial_state_other;
eauto.
intro E;
apply Hnini;
rewrite E;
constructor.
+
econstructor;
eauto.
eapply sem_system_cons;
eauto.
intro E;
apply Hnini;
rewrite E;
constructor.
Qed.
Lemma reset_states_det {
prefs}:
forall (
P: @
program prefs)
f S S'
s P',
state_closed P f S ->
state_closed P f S' ->
find_system f P =
Some (
s,
P') ->
reset_states s S ->
reset_states s S' ->
Env.Equal (
values S) (
values S').
Proof.
Lemma initial_state_det {
prefs}:
forall S S' (
P: @
program prefs)
f,
state_closed P f S ->
state_closed P f S' ->
initial_state P f S ->
initial_state P f S' ->
S ≋
S'.
Proof.
induction S as [?
IH]
using memory_ind'.
inversion_clear 1
as [???????
Insts2];
inversion_clear 1
as [???????
Insts2'];
inversion_clear 1
as [???????
Insts1];
inversion_clear 1
as [???????
Insts1'].
repeat match goal with
H:
find_system ?
b ?
P =
_,
H':
find_system ?
b ?
P =
_ |-
_ =>
rewrite H in H';
inv H'
end.
constructor.
-
eapply reset_states_det;
eauto with stcsem.
-
unfold find_inst in *.
split.
+
setoid_rewrite Env.In_find.
split;
intros (?&
Find).
*
apply Insts2 in Find as (?&
Hin &?).
apply Insts1'
in Hin as (?&?&?);
eauto.
*
apply Insts2'
in Find as (?&
Hin &?).
apply Insts1 in Hin as (?&?&?);
eauto.
+
setoid_rewrite Env.Props.P.F.find_mapsto_iff.
intros *
Find Find'.
pose proof Find as Find1;
pose proof Find'
as Find1'.
apply Insts2 in Find as (?&
Hin &?);
apply Insts2'
in Find'
as (?&
Hin' &?).
pose proof Hin;
pose proof Hin'.
apply Insts1 in Hin as (?&
Find2 &?);
apply Insts1'
in Hin'
as (?&
Find2' & ?).
rewrite Find2 in Find1;
inv Find1;
rewrite Find2'
in Find1';
inv Find1'.
assert (
x =
x0)
as E
by (
eapply NoDupMembers_det;
eauto;
apply s_nodup_subs).
eapply IH;
subst;
eauto.
Qed.
Definition last_reset_clocks_have_sem b R tcs :=
forall x ckrs,
Last_with_reset_in x ckrs tcs ->
Forall (
fun ckr =>
exists r,
sem_clock_instant b R ckr r)
ckrs.
Lemma last_reset_clocks_have_sem_cons:
forall b R tc tcs,
last_reset_clocks_have_sem b R (
tc::
tcs) ->
last_reset_clocks_have_sem b R tcs.
Proof.
Corollary last_reset_clocks_have_sem_app:
forall b R tcs tcs',
last_reset_clocks_have_sem b R (
tcs' ++
tcs) ->
last_reset_clocks_have_sem b R tcs.
Proof.
Lemma sem_trconstrs_last_reset_clocks' {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs tcs',
Forall (
sem_trconstr P b R S I S') (
tcs' ++
tcs) ->
last_consistency (
tcs' ++
tcs) ->
last_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
Corollary sem_trconstrs_last_reset_clocks {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs,
Forall (
sem_trconstr P b R S I S')
tcs ->
last_consistency tcs ->
last_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
intros.
eapply sem_trconstrs_last_reset_clocks' with (tcs':=[]); simpl; eauto.
Qed.
Definition next_reset_clocks_have_sem b R tcs :=
forall x ckrs,
Next_with_reset_in x ckrs tcs ->
Forall (
fun ckr =>
exists r,
sem_clock_instant b R ckr r)
ckrs.
Lemma next_reset_clocks_have_sem_cons:
forall b R tc tcs,
next_reset_clocks_have_sem b R (
tc::
tcs) ->
next_reset_clocks_have_sem b R tcs.
Proof.
Corollary next_reset_clocks_have_sem_app:
forall b R tcs tcs',
next_reset_clocks_have_sem b R (
tcs' ++
tcs) ->
next_reset_clocks_have_sem b R tcs.
Proof.
Lemma sem_trconstrs_next_reset_clocks' {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs tcs',
Forall (
sem_trconstr P b R S I S') (
tcs' ++
tcs) ->
next_consistency (
tcs' ++
tcs) ->
next_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
Corollary sem_trconstrs_next_reset_clocks {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs,
Forall (
sem_trconstr P b R S I S')
tcs ->
next_consistency tcs ->
next_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
intros.
eapply sem_trconstrs_next_reset_clocks' with (tcs':=[]); simpl; eauto.
Qed.
Definition inst_reset_clocks_have_sem b R tcs :=
forall i ckrs,
Inst_with_reset_in i ckrs tcs ->
Forall (
fun ckr =>
exists r,
sem_clock_instant b R ckr r)
ckrs.
Lemma inst_reset_clocks_have_sem_cons:
forall b R tc tcs,
inst_reset_clocks_have_sem b R (
tc::
tcs) ->
inst_reset_clocks_have_sem b R tcs.
Proof.
Corollary inst_reset_clocks_have_sem_app:
forall b R tcs tcs',
inst_reset_clocks_have_sem b R (
tcs' ++
tcs) ->
inst_reset_clocks_have_sem b R tcs.
Proof.
Lemma sem_trconstrs_inst_reset_clocks' {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs tcs',
Forall (
sem_trconstr P b R S I S') (
tcs' ++
tcs) ->
inst_consistency (
tcs' ++
tcs) ->
inst_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
Corollary sem_trconstrs_inst_reset_clocks {
prefs}:
forall S I S' (
P: @
program prefs)
R b tcs,
Forall (
sem_trconstr P b R S I S')
tcs ->
inst_consistency tcs ->
inst_reset_clocks_have_sem b (
var_env R)
tcs.
Proof.
intros.
eapply sem_trconstrs_inst_reset_clocks' with (tcs':=[]); simpl; eauto.
Qed.
Lemma sem_trconstrs_absent_states {
prefs}:
forall S I S' (
P: @
program prefs)
tcs R,
(
forall f xs S ys S',
sem_system P f S xs ys S' ->
absent_list xs ->
S' ≋
S) ->
state_closed_states (
map fst (
lasts_of tcs ++
nexts_of tcs))
S ->
state_closed_states (
map fst (
lasts_of tcs ++
nexts_of tcs))
S' ->
state_closed_insts P (
insts_of tcs)
S ->
state_closed_insts P (
insts_of tcs)
S' ->
last_reset_clocks_have_sem false (
var_env R)
tcs ->
next_reset_clocks_have_sem false (
var_env R)
tcs ->
inst_reset_clocks_have_sem false (
var_env R)
tcs ->
Forall (
sem_trconstr P false R S I S')
tcs ->
S' ≋
S.
Proof.
intros *
IH States States'
Insts Insts'
LResets NResets IResets Htcs.
constructor.
-
clear Insts Insts'
IResets.
intros x.
unfold state_closed_states,
find_val in *.
specialize (
States x);
specialize (
States'
x).
assert (
In x (
map fst (
lasts_of tcs ++
nexts_of tcs)) ->
Env.find x (
values S') =
Env.find x (
values S))
as In.
{
intros *
Hin.
clear States States'.
rewrite map_app,
in_app_iff in Hin.
destruct Hin as [
Hin|
Hin].
-
clear NResets.
induction tcs as [|[|? []|?? []]];
simpl in Hin;
try contradiction;
assert (
Resets':=
LResets);
apply last_reset_clocks_have_sem_cons in Resets';
inversion_clear Htcs as [|??
Htc];
auto.
destruct Hin;
auto;
subst.
inversion_clear Htc as [| | |???????????
ClockR Find Exp _ _ Find'| |];
unfold find_val in *.
inversion Exp as [????
Clock|];
[
contradict Clock;
apply not_subrate_clock|];
subst.
rewrite Find',
ClockR;
try congruence.
eapply Forall_impl; [|
eapply LResets]. 2:
left;
auto with stcsyntax.
intros ? (?&
Clock).
assert (
Clock':=
Clock).
apply not_subrate_clock_impl in Clock;
subst;
auto.
-
clear LResets.
induction tcs as [|[|? []|?? []]];
simpl in Hin;
try contradiction;
assert (
Resets':=
NResets);
apply next_reset_clocks_have_sem_cons in Resets';
inversion_clear Htcs as [|??
Htc];
auto.
destruct Hin;
auto;
subst.
inversion_clear Htc as [| | | |???????????
ClockR Find Exp _ Find'|];
unfold find_val in *.
inversion Exp as [????
Clock|];
[
contradict Clock;
apply not_subrate_clock|];
subst.
rewrite Find',
ClockR;
try congruence.
eapply Forall_impl; [|
eapply NResets]. 2:
left;
auto with stcsyntax.
intros ? (?&
Clock).
assert (
Clock':=
Clock).
apply not_subrate_clock_impl in Clock;
subst;
auto.
}
destruct (
Env.find x (
values S))
eqn:
Find;
destruct (
Env.find x (
values S'))
eqn:
Find';
auto.
all:
eapply In.
+
apply States.
congruence.
+
apply States.
congruence.
+
apply States'.
congruence.
-
clear States States'
LResets NResets.
constructor.
+
setoid_rewrite Env.In_find.
unfold state_closed_insts in *.
intro s;
split;
intros (?&
Find).
*{
apply Insts'
in Find as (
b &
Hin &?).
apply insts_of_In'
in Hin as (?&?&
cks &?&
Hin).
pose proof Htcs as Htcs'.
eapply Forall_forall in Htcs;
eauto.
inversion_clear Htcs as [| | | | |???????????????
ClockR].
destruct (
find_inst s S)
eqn:
Hfind;
eauto.
assert (
None ⌈≋⌉
Some Ii)
as contra. 2:
inv contra.
apply ClockR.
eapply Forall_impl; [|
eapply IResets]. 2:
eapply Exists_exists;
eexists;
split;
eauto with stcsyntax.
intros ? (?&
Clock).
assert (
Clock':=
Clock).
apply not_subrate_clock_impl in Clock;
subst;
auto.
}
*
apply Insts in Find as (
b &
Hin &?).
apply insts_of_In'
in Hin as (?&?&?&?&
Hin).
eapply Forall_forall in Htcs;
eauto.
inv Htcs;
eauto.
+
setoid_rewrite Env.Props.P.F.find_mapsto_iff.
intros s e e'
Find'
Find.
pose proof Find as Hin.
apply Insts in Hin as (
b &
Hin &?).
apply insts_of_In'
in Hin as (?&?&
rst &?&
Hin).
pose proof Htcs as Htcs'.
eapply Forall_forall in Htcs;
eauto.
inversion_clear Htcs as [| | | | |???????????????
ClockR FindI'
Exps Clk SemSystem ?
Find1'].
unfold find_inst in *;
rewrite Find1'
in Find';
inv Find'.
assert (
absent_list xs)
by (
eapply clock_of_instant_false,
not_subrate_clock_impl;
eauto).
apply IH in SemSystem;
auto.
assert (
Env.find s (
instances S) ⌈≋⌉
Some Ii)
as FindI.
{
apply ClockR.
eapply Forall_impl; [|
eapply IResets]. 2:
eapply Exists_exists;
eexists;
split;
eauto with stcsyntax.
intros ? (?&
Clock).
assert (
Clock':=
Clock).
apply not_subrate_clock_impl in Clock;
subst;
auto.
}
clear ClockR.
rewrite SemSystem.
rewrite Find in FindI.
inv FindI.
symmetry;
auto.
Qed.
Lemma sem_trconstrs_absent_vars {
prefs}:
forall tcs S I S' (
P: @
program prefs)
R x,
(
forall f xs S ys S',
sem_system P f S xs ys S' ->
absent_list xs ->
absent_list ys) ->
In x (
variables tcs) ->
Forall (
sem_trconstr P false R S I S')
tcs ->
sem_var_instant R (
Var x)
absent.
Proof.
Lemma sem_system_absent {
prefs}:
forall (
P: @
program prefs)
f xs S ys S',
Ordered_systems P ->
sem_system P f S xs ys S' ->
absent_list xs ->
absent_list ys /\
S' ≋
S.
Proof.
Lemma state_closed_states_empty:
forall states,
state_closed_states states (
empty_memory _).
Proof.
Lemma state_closed_empty {
prefs}:
forall (
P: @
program prefs)
f s P',
find_system f P =
Some (
s,
P') ->
state_closed P f (
empty_memory _).
Proof.
Lemma reset_or_not_reset_dec :
forall b R ckrs,
Forall (
fun ckr =>
exists r,
sem_clock_instant b R ckr r)
ckrs ->
Forall (
fun ckr =>
sem_clock_instant b R ckr false)
ckrs \/
Exists (
fun ckr =>
sem_clock_instant b R ckr true)
ckrs.
Proof.
intros * Hf.
induction Hf as [|??([|]&?)]; auto.
destruct IHHf; auto.
Qed.
Lemma sem_system_find_val {
prefs}:
forall (
P: @
program prefs)
f S xs ys S'
x s P',
sem_system P f S xs ys S' ->
find_system f P =
Some (
s,
P') ->
In x (
map fst (
s_lasts s ++
s_nexts s)) ->
find_val x S <>
None.
Proof.
Lemma sem_system_find_valI {
prefs}:
forall (
P: @
program prefs) (
s: @
system prefs)
b R S I S'
x v,
Forall (
sem_trconstr P b R S I S') (
s_tcs s) ->
In x (
map fst (
s_lasts s)) ->
sem_var_instant R (
Last x) (
present v) ->
find_val x I =
Some v.
Proof.
End STCSEMANTICS.
Module StcSemanticsFun
(
Ids :
IDS)
(
Op :
OPERATORS)
(
OpAux :
OPERATORS_AUX Ids Op)
(
Cks :
CLOCKS Ids Op OpAux)
(
CESyn :
CESYNTAX Ids Op OpAux Cks)
(
Syn :
STCSYNTAX Ids Op OpAux Cks CESyn)
(
Ord :
STCORDERED Ids Op OpAux Cks CESyn Syn)
(
Str :
INDEXEDSTREAMS Ids Op OpAux Cks)
(
CESem :
CESEMANTICS Ids Op OpAux Cks CESyn Str)
<:
STCSEMANTICS Ids Op OpAux Cks CESyn Syn Ord Str CESem.
Include STCSEMANTICS Ids Op OpAux Cks CESyn Syn Ord Str CESem.
End StcSemanticsFun.