Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit 07b93033 authored by Martin Clochard's avatar Martin Clochard
Browse files

examples/in_progress(wip): 2wp_gen, cont'd

parent c8bbcd4b
(* TODO: complete. *)
module Base
meta compute_max_steps 0x1_000_000
function f (x:('a,'b)) : 'a = let (x,_) = x in x
meta rewrite_def function f
function s (x:('a,'b)) : 'b = let (_,x) = x in x
meta rewrite_def function s
end
(* Decomposition of quantification statements by destructuring
the argument structure. This is intended to be used by compute alone,
so the definitions/lemmas are kept away from the provers sight. *)
module Quant "W:non_conservative_extension:N"
use import HighOrd
type structure
predicate quant_structure bool structure (p:'a -> bool)
val ghost quant_structure_def (_:'a -> bool) : unit
ensures { forall b s,p:'a -> bool.
quant_structure b s p <-> if b then forall y. p y else exists y. p y }
constant def : structure
axiom forall_default : forall p:'a -> bool.
quant_structure true def p <-> forall y. p y
axiom exists_default : forall p:'a -> bool.
quant_structure false def p <-> exists y. p y
meta rewrite prop forall_default
meta rewrite prop exists_default
meta remove_prop prop forall_default
meta remove_prop prop exists_default
function pair structure structure : structure
axiom quant_structure_pair : forall b s1 s2,p:('a,'b) -> bool.
quant_structure b (pair s1 s2) p <->
quant_structure b s1 (\x. quant_structure b s2 (\y. p (x,y)))
meta rewrite prop quant_structure_pair
meta remove_prop prop quant_structure_pair
function cond structure structure : structure
axiom forall_cond : forall s1 s2,p:('a,bool) -> bool.
quant_structure true (cond s1 s2) p <->
quant_structure true s1 (\x. p (x,true)) /\
quant_structure true s2 (\x. p (x,false))
axiom exists_cond : forall s1 s2,p:('a,bool) -> bool.
quant_structure false (cond s1 s2) p <->
quant_structure false s1 (\x. p (x,true)) \/
quant_structure false s2 (\x. p (x,false))
meta rewrite prop forall_cond
meta rewrite prop exists_cond
meta remove_prop prop forall_cond
meta remove_prop prop exists_cond
end
module QuantImpl
use import HighOrd
type structure = int
constant def : int = 0
function pair 'a 'b : int = 0
predicate quant_structure (b:bool) 'b (p:'a -> bool) =
if b then forall x. p x else exists x. p x
let ghost quant_structure_def (_:'b) = ()
clone Quant with type structure = structure,
predicate quant_structure = quant_structure,
val quant_structure_def = quant_structure_def,
function def = def,
goal forall_default,
goal exists_default,
function pair = pair,
goal quant_structure_pair,
function cond = pair,
goal forall_cond,
goal exists_cond
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<prover id="0" name="CVC4" version="1.4" timelimit="5" steplimit="0" memlimit="1000"/>
<prover id="1" name="Alt-Ergo" version="1.01" timelimit="5" steplimit="0" memlimit="1000"/>
<file name="../compute_elts.mlw" expanded="true">
<theory name="Base" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Quant" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="QuantImpl" sum="345cdf6d746cb7346db087793c271275">
<goal name="WP_parameter quant_structure_def" expl="VC for quant_structure_def">
<proof prover="1"><result status="valid" time="0.00" steps="0"/></proof>
</goal>
<goal name="Quant.forall_default">
<proof prover="1"><result status="valid" time="0.00" steps="4"/></proof>
</goal>
<goal name="Quant.exists_default">
<proof prover="1"><result status="valid" time="0.00" steps="5"/></proof>
</goal>
<goal name="Quant.quant_structure_pair">
<proof prover="0"><result status="valid" time="0.18"/></proof>
</goal>
<goal name="Quant.forall_cond">
<proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
<goal name="Quant.exists_cond">
<proof prover="0"><result status="valid" time="0.03"/></proof>
</goal>
<goal name="Quant.WP_parameter Quant quant_structure_def" expl="VC for Quant quant_structure_def">
<proof prover="1"><result status="valid" time="0.02" steps="10"/></proof>
</goal>
</theory>
</file>
</why3session>
......@@ -7,22 +7,27 @@
hence the asymetry. *)
module Game
use import option.Option
use import ho_set.Set
use import order.Chain
use import order.LimUniq
use import ho_rel.Prod
use import ho_rel.RelSet
use import fn.Fun
use import fn.Image
use import transfinite.ChainExtension
type game 'a = {
(* chain-complete progress relation. The game flow respect
that relation, and chain completion is used to get limit
behaviors. *)
(* Progress relation. The game flow respect
that relation, and chain completion (supremum) is used to get limit
behaviors. In case there is no such limit, the angel is
assumed to win (in practice, there should be limits for all
feasible chains) *)
progress : 'a -> 'a -> bool;
(* Transition relation: the angel choose a set of possibility
for the next state, then the demon choose among that
set of possibilities. Another view is that
'a are angel sets and (set 'a) are demon sets. *)
'a are angel states and (set 'a) are demon states. *)
transition : 'a -> set (set 'a);
}
......@@ -38,45 +43,60 @@ module Game
the set of states he has to choose in. *)
type demon 'a = set 'a -> 'a
(* Game well-formed: as stated above, order is quasi chain-complete
and transition respect progression (loosely: there may be
loops) *)
(* Game well-formed: as stated above, transition respect progression
(loosely: there may be loops) *)
predicate game_wf (g:game 'a) =
order g.progress /\ q_chain_complete g.progress /\
order g.progress /\
forall x s y. g.transition x s /\ s y -> g.progress x y
(* Describe a step in the game, as the next element in function
of history. In case the history has no maximum, there is no
current state and we go to the limit. Otherwise, we use the
angel/demon strategies to compute the next state.
of history. In case the history has no supremum, there is no
elements in which we could expect to go.
Otherwise, if the supremum do not belong to che chain, this
corresponds to a valid limit step, and the next element is the
supremum. All other situations are 'regular' situations,
and we use the angel/demon strategies to compute the next state.
In case one of them fails to perform a valid choice, it is
considered losing and the run stops. *)
function step (g:game 'a) (ang:angel 'a) (dmn:demon 'a) (ch:set 'a) : 'a =
function step (g:game 'a) (ang:angel 'a) (dmn:demon 'a)
(ch:set 'a) : option 'a =
let x = sup g.progress ch in
let a = ang x ch in
let d = dmn a in
if ch x /\ g.transition x a /\ a d
then d
else x
if supremum g.progress ch x
then Some (if ch x /\ g.transition x a /\ a d
then d
else x)
else None
(* Two lemmas justifying the correctness of the
construction of history by transfinite chain extension. *)
lemma step_is_ub_builder : forall g:game 'a,ang dmn.
game_wf g -> ub_builder g.progress (step g ang dmn)
by forall ch. let o = g.progress in let f = step g ang dmn in
chain o ch -> upper_bound o ch (f ch)
by let x = sup o ch in
forall y. ch y -> o y (f ch) by supremum o ch x /\ o x (f ch)
chain o ch -> match f ch with
| None -> true
| Some u -> upper_bound o ch u
by let x = sup o ch in
forall y. ch y -> o y u by supremum o ch x /\ o x u
end
lemma start_by_chain : forall g,x:'a. game_wf g ->
chain g.progress ((=) x)
(* The angel win at some point if:
- Either he reached the target set
- Either the demon did an illegal move *)
- Either the demon did an illegal move
- Either he reached a non-existing limit (chain
without supremum). This is asymetric, and was chosen
to make statement about angel ability to win simpler.
In most considered games, this should not make a difference as
all reachable chains will have such limits anyway. *)
predicate supless (o:erel 'a) (ch:set 'a) =
forall x. not supremum o ch x
predicate win_at (g:game 'a) (win:set 'a) (ang:angel 'a) (dmn:demon 'a)
(ch:set 'a) =
exists x. maximum g.progress ch x /\
supless g.progress ch \/ exists x. maximum g.progress ch x /\
(win x \/ let a = ang x ch in g.transition x a /\ not a (dmn a))
(* Angel win against demon for given target set and from x
......@@ -103,27 +123,75 @@ module Game
predicate have_uniform_winning_strat (g:game 'a) (start win:set 'a) =
exists ang. uniform_winning_strat g start win ang
(* Two order are chain-compatible by r if for every non-empty
chains of related pair, the supremum must be a related pair as
well. Technical condition for the simulation theorem. *)
predicate chain_compatible (o1:erel 'a) (r:rel 'a 'b) (o2:erel 'b) =
forall ch inh s1 s2.
(* Technical condition for the simulation theorems: condition for limit
steps. If we carry out a limit in second game that relates to
a run in the first one, then either there is a corresponding related
supremum in the first game, either the second game allows to win
from that limit whatever the winning conditions. *)
predicate limit_compatible (o1:erel 'a) (r:rel 'a 'b) (g2:game 'b) =
let o2 = g2.progress in
forall ch inh s2.
chain (rprod o1 o2) ch /\ ch inh /\ (forall a b. ch (a,b) -> r a b) /\
supremum (rprod o1 o2) ch (s1,s2) -> r s1 s2
supremum o2 (image snd ch) s2 ->
have_winning_strat g2 s2 none
\/ exists s1. supremum o1 (image fst ch) s1 /\ r s1 s2
(* A relation induce a step simulation if every step of game 1
can be mapped to a winning strategy in game 2,
and the chain compatibility condition holds for preserving
the relation at limits. *)
and the limit compatibility condition holds. *)
predicate step_simulate (g1:game 'a) (r:rel 'a 'b) (g2:game 'b) =
chain_compatible g1.progress r g2.progress /\
limit_compatible g1.progress r g2 /\
(forall x y s. g1.transition x s /\ r x y ->
have_winning_strat g2 y (related r s))
(* A relation is said to induce a simulation if we can translate
winning strategies through it. *)
predicate simulate (g1:game 'a) (r:rel 'a 'b) (g2:game 'b) =
forall start win. have_uniform_winning_strat g1 start win ->
have_uniform_winning_strat g2 (related r start) (related r win)
(* Special case for simulation with (=) relation,
as well as an especially simple condition for simulation
to hold. *)
predicate subgame (g1 g2:game 'a) =
g1.progress = g2.progress /\ simulate g1 (=) g2
predicate trivial_subgame (g1 g2:game 'a) =
g1.progress = g2.progress /\
forall x. subset (g1.transition x) (g2.transition x)
end
(* A few properties of strategies on such games. *)
module StratProps "W:non_conservative_extension:N" (* => StratProofs *)
use import Game
(* Quantifier inversion between having a uniform strategy and
having strategies for all. *)
axiom have_uniform_winning_strat_alternate_def :
forall g,start win:'a -> bool. game_wf g ->
(have_uniform_winning_strat g start win <->
(forall x. start x -> have_winning_strat g x win))
(* Local criterion for winning strategy existence. *)
axiom have_winning_strat_local_criterion :
forall g,x:'a,win. game_wf g ->
(have_winning_strat g x win <->
win x \/
exists s. g.transition x s /\ have_uniform_winning_strat g s win)
(* Simulation theorem: a step simulation extends to a real simulation. *)
axiom simulation : forall g1,r:'a -> 'b -> bool,g2.
game_wf g1 /\ game_wf g2 /\ step_simulate g1 r g2 -> simulate g1 r g2
axiom trivial_subgame_indeed : forall g1 g2:game 'a.
game_wf g1 /\ game_wf g2 /\ trivial_subgame g1 g2 -> subgame g1 g2
axiom subgame_other_def : forall g1 g2:game 'a.
subgame g1 g2 <-> g1.progress = g2.progress /\ forall start win.
have_uniform_winning_strat g1 start win ->
have_uniform_winning_strat g2 start win
end
(* Define the extra notion (useful in proofs) of demon reachability.
......@@ -173,8 +241,14 @@ module DmnReach "W:non_conservative_extension:N" (* => DmnReachProofs *)
(forall x. chh x -> dmn_reach g ang b x) ->
dmn_reach g ang b ch
(* demon-reachability is preserved by adding supremums *)
axiom dmn_reach_sup : forall g ang ch,b sp:'a.
game_wf g /\ dmn_reach g ang b ch /\ supremum g.progress ch sp ->
dmn_reach g ang b (add ch sp)
(* A strategy is winning iff there are no losing
demon-reachable chains. *)
demon-reachable chains. This give an alternate definition
of a winning strategy. *)
axiom non_winning_strat_criterion : forall g:game 'a,x win ang ch.
game_wf g /\ dmn_reach g ang x ch /\ lose_at g ang win ch ->
not winning_strat g x win ang
......@@ -195,6 +269,7 @@ end
module DmnReachProofs
use import choice.Choice
use import option.Option
use import Game
use import DmnReachCommon
use import fn.Fun
......@@ -210,6 +285,8 @@ module DmnReachProofs
(ch:set 'a) (dmn:demon 'a) =
reach_ch g.progress (step g ang dmn) ((=) x) ch
(* Define the notion of two demons making the same choices
for some chain. *)
predicate same_choices (g:game 'a) (ang:angel 'a)
(ch:set 'a) (dmn1 dmn2:demon 'a) =
forall ch0 x. subchain g.progress ch0 ch /\ maximum g.progress ch0 x /\
......@@ -238,14 +315,17 @@ module DmnReachProofs
so let ch1 = xt ch0 in
if ch1 = ch0
then false by maximum sb (tr_reach sb xt ((=) b)) ch0
else ch1 = add ch0 (st ch0)
so not ch0 (st ch0) || (false by sext ch0 ch1)
so (if sb ch1 ch then true else
false by separator sb xt ch0 ch so sb ch ch0 so order sb)
so st ch0 = d so ch1 d so ch d
else match st ch0 with
| None -> false
| Some st0 -> ch1 = add ch0 st0
so not ch0 st0 || (false by sext ch0 ch1)
so (if sb ch1 ch then true else
false by separator sb xt ch0 ch so sb ch ch0 so order sb)
so st0 = d so ch1 d so ch d
end
(* If we have a demon that reach some chain, then any demon
that carry the exact same choice on its strict subchain
that carry the exact same choices on its strict subchain
will also reach that chain. *)
lemma dmn_witness_criterion : forall g ang b ch,dmn1 dmn2:demon 'a.
game_wf g /\ dmn_witness g ang b ch dmn1 ->
......@@ -258,23 +338,31 @@ module DmnReachProofs
let xt1 = extends_ch o st1 in
let xt2 = extends_ch o st2 in
if same_choices g ang ch dmn1 dmn2 \/ dmn_witness g ang b ch dmn2
then (forall o1 f1 b1 ch0. o1 = sb /\ f1 = xt1 /\ b1 = ((=) b) ->
("induction" tr_reach o1 f1 b1 ch0) ->
sb ch0 ch -> "stop_split" dmn_witness g ang b ch0 dmn2 /\
same_choices g ang ch0 dmn1 dmn2)
then (* Proof: induction on transfinite reachability. Do both sides
of the equivalence at once. *)
(forall o1 f1 b1 ch0. o1 = sb /\ f1 = xt1 /\ b1 = ((=) b) ->
("induction" tr_reach o1 f1 b1 ch0) ->
sb ch0 ch -> "stop_split" dmn_witness g ang b ch0 dmn2 /\
same_choices g ang ch0 dmn1 dmn2)
by order sb
so dmn_witness g ang b ((=) b) dmn2 /\
so (* Base case, obvious. *)
dmn_witness g ang b ((=) b) dmn2 /\
("stop_split" same_choices g ang ((=) b) dmn1 dmn2
by forall ch0 x. sb ch0 ((=) b) /\ maximum o ch0 x /\
ch0 <> ((=) b) -> false
by if ch0 b then sext ch0 ((=) b) else sext ch0 none)
/\ ("stop_split" forall ch0. dmn_witness g ang b ch0 dmn1 /\
/\ (* Step case. *)
("stop_split" forall ch0. dmn_witness g ang b ch0 dmn1 /\
dmn_witness g ang b ch0 dmn2 /\
same_choices g ang ch0 dmn1 dmn2 /\ sb (xt1 ch0) ch ->
(dmn_witness g ang b (xt1 ch0) dmn2 /\
same_choices g ang (xt1 ch0) dmn1 dmn2)
(* Discard cases where step is trivial. *)
by ("case_split" if xt1 ch0 = ch0 then true else
let x = sup o ch0 in
(* If supremum is not in chain,
then obviously the steps carried out are the same.
Moreover, all possible choices were already feasible. *)
if not ch0 x
then "stop_split"
(sext (xt1 ch0) (xt2 ch0) by st1 ch0 = st2 ch0)
......@@ -289,7 +377,11 @@ module DmnReachProofs
else
let a = ang x ch0 in
if dmn1 a = dmn2 a
then "stop_split"
then (* Otherwise, if the dmn say the same thing
then obviously the steps carried out are again the
same, and moreover the only new possible choice is
done identically *)
"stop_split"
(sext (xt1 ch0) (xt2 ch0) by st1 ch0 = st2 ch0)
so forall ch1 x1. sb ch1 (xt1 ch0) /\
maximum o ch1 x1 /\ ch1 <> xt1 ch0 ->
......@@ -301,31 +393,42 @@ module DmnReachProofs
so dmn_witness g ang b ch1 dmn1
else x1 = x
else "stop_split"
(* Finally, in case the demons disagree,
then first they could not have make the same choices
on the original chain. *)
false
by (not same_choices g ang ch dmn1 dmn2
by sb ch0 ch /\ ch0 <> ch /\ maximum o ch0 x)
so st1 ch0 = dmn1 a
so st2 ch0 = (if a (dmn2 a) then dmn2 a else x)
so not (dmn1 a = x so sext ch0 (xt1 ch0))
so st1 ch0 = Some (dmn1 a)
so st2 ch0 = Some (if a (dmn2 a) then dmn2 a else x)
so not (dmn1 a = x so sext ch0 (xt1 ch0) by match st1 ch0 with
| None -> true | Some _ -> xt1 ch0 = add ch0 x end)
so st1 ch0 <> st2 ch0
so if not dmn_witness g ang b ch dmn2 then true else
"stop_split" false by if xt2 ch0 = ch0
(* But then, the second demon cannot be a witness for
the first chain as any further extension from
that point on will be different from it. *)
so "stop_split" false by if xt2 ch0 = ch0
then false by maximum sb (tr_reach sb xt2 ((=) b)) ch0
so sb ch ch0 so sb ch0 ch
else false by dmn_witness g ang b (xt2 ch0) dmn2
so separator sb xt2 ch0 ch
so sb (xt2 ch0) ch
so xt2 ch0 (st2 ch0) /\ xt1 ch0 (st1 ch0)
so ch (st2 ch0) /\ ch (st1 ch0)
so not (ch0 (st1 ch0) so sext ch0 (xt1 ch0))
so not (ch0 (st2 ch0) so sext ch0 (xt2 ch0))
so not xt2 ch0 (st1 ch0)
so not xt1 ch0 (st2 ch0)
so o (st1 ch0) (st2 ch0) /\ o (st1 ch0) (st2 ch0)
so antisymetric o
) by chain o ch0 so xt1 ch0 = add ch0 (st1 ch0)
so xt2 ch0 = add ch0 (st2 ch0))
/\ ("stop_split"
so match st2 ch0, st1 ch0 with
| None, _ | _, None -> false
| Some st2v, Some st1v -> xt1 ch0 = add ch0 st1v /\
xt2 ch0 = add ch0 st2v
so subset (xt1 ch0) ch /\ subset (xt2 ch0) ch
so ch st2v /\ ch st1v
so not (ch0 st1v so sext ch0 (xt1 ch0))
so not (ch0 st2v so sext ch0 (xt2 ch0))
so not xt2 ch0 st1v
so not xt1 ch0 st2v
so o st1v st2v /\ o st1v st2v
so antisymetric o
end
) by chain o ch0)
/\ (* Limit case. *)
("stop_split"
forall chh y. supremum sb chh y /\ chain sb chh /\ chh ((=) b) /\
(forall x. chh x /\ sb x ch ->
dmn_witness g ang b x dmn2 /\ same_choices g ang x dmn1 dmn2) ->
......@@ -334,7 +437,10 @@ module DmnReachProofs
same_choices g ang y dmn1 dmn2)
by order sb
so (forall x. chh x -> dmn_witness g ang b x dmn2 by sb x ch)
(* dmn_witness falls by mimicking hypothesis. *)
so dmn_witness g ang b y dmn2
(* same_choices come from the fact that all the possible
choices occured in previous chains. *)
so forall ch0 x0. sb ch0 y /\ maximum o ch0 x0 /\ ch0 <> y ->
dmn1 (ang x0 ch0) = dmn2 (ang x0 ch0)
by (exists ch1. chh ch1 /\ sb ch0 ch1 /\ ch0 <> ch1
......@@ -353,6 +459,8 @@ module DmnReachProofs
game_wf g /\ dmn_reach g ang b ch /\ maximum g.progress ch x /\
g.transition x (ang x ch) /\ ang x ch y /\ (ang x ch x -> y = x) ->
let o = g.progress in
(* First part: there exists a demon reaching that chains
and then choosing y. *)
(exists dmn. reach_ch o (step g ang dmn) ((=) b) ch /\
dmn (ang x ch) = y
by exists dmn0. reach_ch o (step g ang dmn0) ((=) b) ch /\
......@@ -364,6 +472,7 @@ module DmnReachProofs
by "case_split" if ang z ch0 <> ang x ch then true else
let y2 = dmn0 (ang z ch0) in y2 = y
by ch y2 so o y2 x so ang x ch y2 so o x y2)
(* Second part: the expected dmn-reachability statement. *)
&& (dmn_reach g ang b (add ch y)
by forall dmn. reach_ch o (step g ang dmn) ((=) b) ch /\
dmn (ang x ch) = y ->
......@@ -382,12 +491,15 @@ module DmnReachProofs
dmn_reach g ang b ch
by let o = g.progress in
let sb = subchain o in
(* Create dmn witness for a chain. *)
let dmn_x = \x. choice (dmn_witness g ang b x) in
(forall x. chh x -> dmn_witness g ang b x (dmn_x x)
by exists dmn. dmn_witness g ang b x dmn)
so ch = bigunion chh
so order sb
so let p0 = \ch0 s. sb ch0 s /\ ch0 <> s /\ chh s in
(* Find a super-chain inside the 'chain chain' of any
strict subchain of the limit chain. *)
let sub_wit = \ch0. choice (p0 ch0) in
("stop_split" forall ch0. sb ch0 ch /\ ch0 <> ch ->
let s = sub_wit ch0 in sb ch0 s /\ ch0 <> s /\ chh s
......@@ -400,13 +512,20 @@ module DmnReachProofs
so exists y. ch0 y /\ not s y
so ch x /\ ch y
so o x y /\ o y x))
so let ch_by = \s ch0. exists x.
so (* Demon: first choose a 'witness chain', strict
subchain of the limit,
that corresponds to the angel choosing the target set (it is unique),
then apply the demon associated to its witness super-chain. *)
let ch_by = \s ch0. exists x.
sb ch0 ch /\ maximum o ch0 x /\ ch0 <> ch /\
ang x ch0 = s in
let dmn_l = \s. let ch0 = choice (ch_by s) in
let db = dmn_x (sub_wit ch0) in
db s in
("stop_split" forall ch1. chh ch1 -> dmn_witness g ang b ch1 dmn_l
(* Go through the definitions to notice that for every chain
in the 'chain chain', the demon we build carry out the same
choices. This relies heavily on the dmn_witness_criterion lemma. *)
by let dmn = dmn_x ch1 in
same_choices g ang ch1 dmn dmn_l
by forall ch0 x. sb ch0 ch1 /\ maximum o ch0 x /\
......@@ -452,21 +571,32 @@ module DmnReachProofs
then exists dmn. reach_ch o (step g ang dmn) ((=) b) ch /\
dmn a0 = x0
else true)
(* Find out a demon that makes loss explicit. *)
so exists dmn. dmn_witness g ang b ch dmn /\
(g.transition x0 a0 -> dmn a0 = x0)
so let st = step g ang dmn in
let xt = extends_ch o st in
st ch = x0 so sext (xt ch) ch
st ch = Some x0 so (sext (xt ch) ch by xt ch = add ch x0)
(* Hence the losing chain is maximal among reachable ones for
this angel-demon pair. *)
so maximum sb (tr_reach sb xt ((=) b)) ch
so not win_against g b win ang dmn
by forall ch0. reach_ch o st ((=) b) ch0 ->
(* Hence by absurd the angel cannot win. Since no
winning state can be ever reached, it would have to fail
the demon or escape from the game states via an unfeasible limit,
which can only happen on the maximum reachable chain. But
that's obviously impossible. *)
if not win_at g win ang dmn ch0 then true else
false by exists x0. maximum o ch0 x0 /\
(win x0 \/ let a = ang x0 ch0 in g.transition x0 a /\ not a (dmn a))
so sb ch0 ch so subset ch0 ch
so not win x0
so st ch0 = x0 so sext (xt ch0) ch0
so maximum sb (tr_reach sb xt ((=) b)) ch0
false by
(supless o ch0 so st ch0 = None so xt ch0 = ch0 so
maximum sb (tr_reach sb xt ((=) b)) ch0
) \/ exists x0. maximum o ch0 x0 /\
(win x0 \/ let a = ang x0 ch0 in g.transition x0 a /\ not a (dmn a))
so sb ch0 ch so subset ch0 ch
so not win x0
so st ch0 = Some x0 so sext (xt ch0) ch0
so maximum sb (tr_reach sb xt ((=) b)) ch0
lemma build_losing_demon : forall g:game 'a,b win ang.
game_wf g /\ not winning_strat g b win ang ->
......@@ -474,69 +604,70 @@ module DmnReachProofs
(forall x. maximum g.progress ch x /\ g.transition x (ang x ch) ->
dmn (ang x ch) = x) /\
lose_at g ang win ch)
(* To build a losing demon, simply notice that any demon against
which the angel do not win will do. *)
by exists dmn. not win_against g b win ang dmn
so let o = g.progress in
let sb = subchain o in
let st = step g ang dmn in
let xt = extends_ch o st in
(* Loss will happen on the maximum reachable chain. *)
let ch = fixpoint_above sb xt ((=) b) in
reach_ch o st ((=) b) ch /\ xt ch = ch
so chain o ch
so ch (st ch)
so let x = sup o ch in supremum o ch x
so not (not ch x so st ch = x)
so maximum o ch x
so (x = st ch by upper_bound o ch (st ch)
so o x (st ch) so o (st ch) x)
so let a = ang x ch in
(if g.transition x a
then a (dmn a) so dmn a = st ch
else true)
so lose_at g ang win ch
by forall u. ch u -> if not win u then true else
false by let ch0 = \x. ch x /\ o x u in
subchain o ch0 ch so subchain o ((=) b) ch
so ch0 b
so subchain o ((=) b) ch0
so reach_ch o st ((=) b) ch0
so maximum o ch0 u
so win_at g win ang dmn ch0
so match st ch with
| None -> false by supless o ch (* Absurd, angel win *)
| Some sth -> xt ch = add ch sth so ch sth
so let x = sup o ch in supremum o ch x
so not (not ch x so sth = x)
so maximum o ch x
so (x = sth by upper_bound o ch sth so o x sth so o sth x)
(* By maximality and the fact that the angel do not win,
we get angel failure or looping behavior. *)
so let a = ang x ch in
(if g.transition x a
then a (dmn a) so dmn a = sth
else true)
so lose_at g ang win ch
(* Finally, if there is a winning state somewhere in
history, the angel won upon reaching that point,
which is absurd. *)
by forall u. ch u -> if not win u then true else