Mefresa.Dec.WellFormednessDecidability
Lemma not_in_l_pairs_dec:
forall id a li, decidable (not_in_l_pairs id a li).
Proof.
intros.
induction li.
left; apply NotInPair_Nil; auto.
assert ((((a0 ->id)%int == id) &&
((a0 ->visibility)%int == a)%vis = false) \/
((a0 ->id)%int == id) &&
((a0 ->visibility)%int == a)%vis = true).
destruct (((a0 ->id)%int == id) && ((a0 ->visibility)%int == a)%vis); intuition.
destruct IHli; destruct H.
Case "1/4".
left.
apply NotInPairStep with (int:=a0) (r:=li); auto.
Case "2/4".
right.
intro.
inversion H1; inversion H2; subst.
congruence.
Case "3/4".
right.
intro.
inversion H1; inversion H2; subst. congruence.
Case "4/4".
right.
intro.
inversion H1; inversion H2; subst; congruence.
Qed.
Hint Resolve not_in_l_pairs_dec.
The careful reader may wonder about the employed proof strategy.
Indeed, since we demonstrated not_in_l_pairs_bool_correctness,
proving not_in_l_pairs's decidability can be achieved in a trivial
manner:
Lemma not_in_l_pairs_dec':
forall id a li, decidable (not_in_l_pairs id a li).
Proof.
intros.
unfold decidable.
rewrite <- not_in_l_pairs_bool_correctness .
destruct not_in_l_pairs_bool; intuition.
Qed.
In any case, for the sake of diversity and fun, we followed an approach
without using the fact that we demonstrated the predicate equivalent
to its computational counterpart.
In the following we employ one of the two approaches as we
think more convenient.
Lemma unique_pairs_dec:
forall li, decidable (unique_pairs li).
Proof.
intros.
induction li.
Case "List is nil".
left.
apply UniquePairs_Base; auto.
Case "List is not nil".
assert (decidable (not_in_l_pairs (a->id%int) (a->visibility%int) li)).
auto.
destruct H; destruct IHli.
SCase "1/4".
left. eapply UniquePairs_Step; eauto.
SCase "2/4".
right.
intro.
clear -H0 H1.
inversion H1; inversion H; subst. clear H.
congruence.
SCase "3/4".
right.
intro.
clear -H H1.
inversion H1; inversion H0; subst. clear H0.
congruence.
SCase "4/4".
right.
intro.
inversion H1; inversion H2; subst.
congruence.
Qed.
Hint Resolve unique_pairs_dec.
Theorem well_formed_interfaces_dec:
forall li, decidable (well_formed_interfaces li).
Proof.
intros.
destruct li.
Case "Interfaces are nil".
left;auto.
Case "Interfaces are not nil".
destruct unique_pairs_dec with (li:=i::li).
SCase "Unique Pairs".
left.
induction (i::li); auto.
eapply WellFormedInterfaces_Step;auto.
apply IHl.
inversion H; inversion H0; subst; auto.
SCase "No Unique Pairs".
right.
intro.
unfold not in H.
apply H.
inversion H0; auto.
inversion H1.
Qed.
Hint Resolve well_formed_interfaces_dec.
Lemma valid_binding_dec:
forall b lc li, decidable (valid_binding b lc li).
Proof.
intros.
unfold decidable.
rewrite <- valid_bindings_correctness.
destruct valid_binding_bool; auto.
Qed.
Hint Resolve valid_binding_dec.
Theorem well_formed_bindings_dec:
forall lb lc li, decidable (well_formed_bindings lb lc li).
Proof.
intros.
unfold decidable.
rewrite <- dec_bindings_correctness.
destruct dec_bindings; auto.
Qed.
Hint Resolve well_formed_bindings_dec.
Lemma not_in_dec:
forall id l, decidable (not_in_l id l).
Proof.
induction l.
Case "List is nil".
left; auto.
Case "List is not nil".
destruct ident_dec with (id1:=a->id%comp) (id2:=id).
SCase "Ids are Equal".
right.
intro.
inversion H; inversion H0; subst.
assert (a0->id%comp <> (a0->id%comp)).
auto.
congruence.
SCase "Ids are Not Equal".
destruct IHl.
SSCase "Not In".
left; eapply NotInStep;auto.
SSCase "~ Not In".
right.
intro.
unfold not in H.
apply H.
inversion H0; inversion H1; subst; auto.
Qed.
Lemma unique_ids_dec:
forall lc, unique_ids lc \/ ~ unique_ids lc.
Proof.
induction lc.
Case "Components are nil".
left; auto.
Case "Components are not nil".
destruct not_in_dec with (id:=a->id%comp) (l:=lc);
destruct IHlc.
SCase "Not in, Unique Ids (1/4)".
left.
eapply Unique_Step; auto.
SCase "Not in, ~ Unique Ids (2/4)".
right.
intro.
unfold not in H0.
apply H0.
inversion H1; inversion H2; subst; auto.
SCase "~ Not In, Unique Ids (3/4)".
right.
intro.
unfold not in H.
apply H.
inversion H1; inversion H2; subst; auto.
SCase "~ Not In, ~ Unique Ids".
right.
intro.
unfold not in H0.
apply H0.
inversion H1; inversion H2; subst; auto.
Qed.
Into Components
Lemma well_formed_component_nil_dec :
decidable (forall c', In c' nil -> well_formed_component c').
Proof.
left; intros.
inversion H.
Qed.
Now let us prove the same for the case that the component
belongs to a non-empty list, and we have decidability
on the well-formedness of the head element, and also
on all elements of the tail.
Lemma well_formed_component_cons_dec c
(Hc : decidable (well_formed_component c))
lc
(Hlc : decidable (forall c', In c' lc -> well_formed_component c'))
: decidable (forall c', In c' (cons c lc) -> well_formed_component c').
Proof.
simpl.
destruct Hc as [Hc|Hc]; [ |clear Hlc].
Case "Head Component is Well Formed". Focus.
destruct Hlc as [Hlc|Hlc]; [ |clear Hc].
left; intros c' [Heq|HIn]; subst; auto.
right; intros Habs; apply Hlc; clear Hlc.
intros c' Hc'; apply Habs; right; auto.
Case "Head Component is not Well Formed".
right; intros Habs; apply Hc; clear Hc.
apply Habs; left; auto.
Qed.
Lemma well_formed_component_lc_dec (Hp : forall c, decidable (well_formed_component c))
: forall lc, decidable (forall c, In c lc -> well_formed_component c).
Proof.
exact (fix well_formed_component_lc_dec lc :=
match lc as lc return decidable (forall c', In c' lc -> well_formed_component c') with
| nil => well_formed_component_nil_dec
| cons c lc => well_formed_component_cons_dec c (Hp c) lc (well_formed_component_lc_dec lc)
end).
Defined.
Finally, we are in a position to prove out theorem of interest.
Theorem well_formed_component_dec:
forall c, decidable (well_formed_component c).
Proof.
fix 1; intros [i p ic cl lc li lb].
assert (IHp_dec := well_formed_component_lc_dec well_formed_component_dec lc);
clear well_formed_component_dec.
Guarded.
destruct IHp_dec;
destruct (well_formed_bindings_dec lb lc li);
destruct (well_formed_interfaces_dec li);
destruct (unique_ids_dec lc);
[ left; apply WellFormedComponent; simpl; intros; auto | ..];
(right; intro Hwf; inversion Hwf; simpl in *; congruence).
Qed.
Naturally, as our notion of state is in fact a component
with some imposed restrictions, its well_formedness can also
be easily proved.
Lemma path_dec:
forall p p':path, {p=p'} + {p<>p'}.
Proof.
decide equality.
Qed.
Lemma control_level_dec:
forall c c':controlLevel, {c=c'} + {c<>c'}.
Proof.
decide equality.
Qed.
Lemma interface_dec:
forall i i':interface, {i=i'} + {i<>i'}.
Proof.
repeat decide equality.
Qed.
Lemma interfaces_dec:
forall li li':list interface, {li=li'} + {li<>li'}.
Proof.
repeat decide equality.
Qed.
Theorem well_formed_dec:
forall s, decidable (well_formed s).
Proof.
intros.
destruct s; simpl.
destruct (ident_dec i (Ident "Root"));
destruct (path_dec p root);
destruct (implementationClass_dec i0 "null");
destruct (control_level_dec c Configuration);
destruct (interfaces_dec l0 nil);
destruct (well_formed_component_dec
(Component (Ident "Root") root "null" Configuration l nil l1));
subst;
[ left; intuition
| right; intro;
destruct H0 as (H1, (H2, (H3, (H4, (H5, H6)))));
apply H; auto
| .. ];
right; intro;
destruct H0 as (H1, (H2, (H3, (H4, (H5, H6)))));
congruence.
Qed.
Being able to decide whether a component is indeed a
well_formed_component or not was already demonstrated by our
theorem well_formed_component_dec.
However, we now want a function that returns true when
the given component is a well_formed_component and
false otherwise. Naturally, we want the ensurance that
this function is correct, i.e. sound and complete w.r.t
the well_formed_component predicate.
Let us start by defining such function.
Fixpoint dec_component (c :component) : bool :=
match c with
| Component i p ic cl lc li lb =>
(dec_unique_ids lc) && (dec_interfaces li) && (dec_bindings lb lc li) &&
((fix dec_component_lc (ssc: list component) {struct ssc} : bool :=
match ssc with
| nil => true
| cc :: r => (dec_component cc) && dec_component_lc r
end) lc)
end.
Definition eq c : Prop := dec_component c = true <-> well_formed_component c.
For our interests, we shall want to prove dec_component
as being equivalent to our well_formed_component predicate
as demonstrated by the eq predicate.
For this, we shall follow the same approach employed
for proving the decidability of well_formed_component.
Lemma nil_eq: forall c, In c nil -> eq c.
Proof.
intros.
inversion H.
Qed.
Lemma cons_eq c (Hc : eq c) lc (Hlc : forall c', In c' lc -> eq c'):
forall c', In c' (cons c lc) -> eq c'.
Proof.
intros.
destruct H; subst; auto.
Qed.
Lemma lc_eq (Hp: forall c, eq c) :
forall lc, (forall c', In c' lc -> eq c').
Proof.
exact (fix lc_eq lc :=
match lc as lc return (forall c', In c' lc -> eq c') with
| nil => nil_eq
| cons c lc => cons_eq c (Hp c) lc (lc_eq lc)
end).
Defined.
Note again that lc_eq requires to be concluded by Defined
rather than Qed.
Moreover, we shall define the auxiliary lemma boolean_function_fact
to help us proving our main theorem.
Require Import Coq.Bool.Bool.
Lemma boolean_function_fact:
forall lc, (fix dec_component_lc (ssc : list component) : bool :=
match ssc with
| nil => true
| cc :: r => dec_component cc && dec_component_lc r
end) lc = true ->
(forall c, In c lc -> dec_component c = true).
Proof.
induction lc; intros .
inversion H0.
destruct H0; subst.
clear -H.
rewrite andb_true_iff in H.
destruct H; auto.
apply IHlc; auto.
clear -H.
rewrite andb_true_iff in H.
destruct H; auto.
Qed.
Theorem dec_component_correctness:
forall c,
dec_component c = true <-> well_formed_component c.
Proof.
fix 1; intros [i p ic cl lc li lb].
assert (IHp_dec := lc_eq dec_component_correctness lc);
clear dec_component_correctness.
Guarded.
split; intro.
Case "Function Entails Predicate".
unfold eq in IHp_dec.
simpl in H.
repeat rewrite andb_true_iff in H.
destruct H as ((H1, H2), H3).
destruct H1.
apply dec_unique_ids_correctness in H.
apply dec_interfaces_correctness in H0.
apply dec_bindings_correctness in H2.
apply WellFormedComponent; simpl; auto.
intros.
clear -H3 IHp_dec H1.
apply IHp_dec; auto.
apply boolean_function_fact with (lc:=lc); auto.
Case "Predicate Entails Function".
unfold eq in IHp_dec.
simpl.
repeat rewrite andb_true_iff.
inversion H; simpl in * |-.
repeat split.
apply dec_unique_ids_correctness; auto.
apply dec_interfaces_correctness; auto.
apply dec_bindings_correctness; auto.
clear H1 H2 H3 H.
induction lc; auto.
assert (well_formed_component a).
apply H0; left; auto.
rewrite andb_true_iff.
split.
apply IHp_dec; auto.
left; auto.
apply IHlc; intros.
apply IHp_dec. right; auto.
apply H0. right; auto.
Qed.
Indeed, proving dec_component_correctness follows the same approach
as in well_formed_component_dec. This gives us strong confidence on the
behaviour of our dec_component function.
As expected, its extraction to an OCaml certified program would
be achieved as follows:
Recursive Extraction dec_component.
It should come as no surprise that doing the same
for states reuses most of the above machinery.
Definition dec_state (s : state) : bool :=
match s with
| Component id p ic cl lc li lb =>
(id == (Ident "Root")) && (p == root)%path && (ic=="null")%iclass &&
(cl == Configuration)%ctlvl && (li == nil)%l_int &&
(dec_component (Component (Ident "Root") root "null" Configuration lc nil lb))
end.
Lemma controlLevel_equality_bool2Prop:
forall cl cl' : controlLevel, (cl == cl')%ctlvl = true -> cl = cl'.
Proof.
intros.
destruct cl; destruct cl'; auto;
unfold beq_controlLevel in H; congruence.
Qed.
Hint Resolve controlLevel_equality_bool2Prop.
Lemma list_interface_equality_bool2Prop:
forall li li' : list interface, (li == li')%l_int = true -> li = li'.
Proof.
induction li; induction li'; intros;
simpl in *; try congruence.
clear IHli'.
assert (a = a0).
apply interface_eq_reflection.
destruct ((a == a0)%int); auto.
subst.
apply f_equal.
apply IHli.
destruct ((li == li')%l_int); auto.
destruct ((a0 == a0)%int ); simpl in H; congruence.
Qed.
Hint Resolve list_interface_equality_bool2Prop.
Theorem dec_state_correctness:
forall s,
dec_state s = true <-> well_formed s.
Proof.
intros.
split; intro.
Case "Function Entails Predicate". Focus.
destruct s; simpl.
unfold dec_state in H.
repeat rewrite andb_true_iff in H.
destruct H as (((((H1, H2), H3), H4), H5), H6).
split; eauto.
split; eauto.
split; eauto.
apply implementationClass_eq_reflection; auto.
split; eauto.
split ; [eauto | ..].
apply dec_component_correctness; auto.
Case "Predicate Entails Function".
destruct s; simpl in * |-.
destruct H as (H1, (H2, (H3, (H4, (H5, H6))))).
unfold dec_state; subst.
replace ((Ident "Root" == Ident "Root") && (root == root)%path && ("null" == "null")%iclass &&
(Configuration == Configuration)%ctlvl && (nil == nil)%l_int)
with true; auto.
rewrite andb_true_iff.
split; [auto | apply dec_component_correctness; auto].
Qed.
Definition well_formed_bool := dec_state.