Commit 34ca0de3 by Martin Clochard

### in_progress(example): 2wp_gen

parent 00d95af9
 module Choice use import HighOrd use import option.Option constant default : 'a function choice ('a -> bool) : 'a axiom choice_def : forall p,x:'a. p x -> p (choice p) let choose (p:'a -> bool) : 'a requires { exists x. p x } ensures { p result } = choice p let choose_if (p:'a -> bool) : option 'a returns { None -> forall x. not p x | Some u -> p u } = let u = choice p in if p u then Some u else None end

This diff is collapsed.
This diff is collapsed.
 module Order use import HighOrd predicate reflexive (o:'a -> 'a -> bool) = forall x. o x x predicate antisymetric (o:'a -> 'a -> bool) = forall x y. o x y /\ o y x -> x = y predicate transitive (o:'a -> 'a -> bool) = forall x y z. o x y /\ o y z -> o x z predicate total (o:'a -> 'a -> bool) = forall x y. o x y \/ o y x predicate preorder (o:'a -> 'a -> bool) = reflexive o /\ transitive o predicate order (o:'a -> 'a -> bool) = reflexive o /\ antisymetric o /\ transitive o predicate lower (o:'a -> 'a -> bool) (x y:'a) = o x y /\ not o y x predicate upper_bound (o:'a -> 'a -> bool) (s:'a -> bool) (u:'a) = forall x. s x -> o x u predicate lower_bound (o:'a -> 'a -> bool) (s:'a -> bool) (l:'a) = forall x. s x -> o l x predicate maximum (o:'a -> 'a -> bool) (s:'a -> bool) (u:'a) = upper_bound o s u /\ s u lemma maximum_unique : forall o s,u1 u2:'a. antisymetric o /\ maximum o s u1 /\ maximum o s u2 -> u1 = u2 predicate minimum (o:'a -> 'a -> bool) (s:'a -> bool) (u:'a) = lower_bound o s u /\ s u lemma minimum_unique : forall o s,l1 l2:'a. antisymetric o /\ minimum o s l1 /\ minimum o s l2 -> l1 = l2 predicate supremum (o:'a -> 'a -> bool) (s:'a -> bool) (x:'a) = minimum o (upper_bound o s) x predicate infimum (o:'a -> 'a -> bool) (s:'a -> bool) (x:'a) = maximum o (lower_bound o s) x predicate maximal (o:'a -> 'a -> bool) (x:'a) = forall y. o x y -> o y x predicate minimal (o:'a -> 'a -> bool) (x:'a) = forall y. o y x -> o x y end (* Monotonicity & inflationary functions. *) module Mono use import HighOrd predicate monotone (o1:'a -> 'a -> bool) (f:'a -> 'b) (o2:'b -> 'b -> bool) = forall x y. o1 x y -> o2 (f x) (f y) predicate inflationary (o:'a -> 'a -> bool) (f:'a -> 'a) = forall x. o x (f x) end module Chain use import HighOrd use import Order (* chain for a relation = subset on which the relation is half-total. *) predicate chain (o:'a -> 'a -> bool) (s:'a -> bool) = forall x y. s x /\ s y -> o x y \/ o y x (* a relation is chain-bounded if any chain has an upper bound for this relation. *) predicate chain_bounded (o:'a -> 'a -> bool) = forall s. chain o s -> exists y. upper_bound o s y (* chain-complete = chain-bounded + minimal upper bound. Note: in particular, it has a minimum element. *) predicate chain_complete (o:'a -> 'a -> bool) = forall s. chain o s -> exists y. supremum o s y end (* Well-foundedness. *) module Wf use import Order inductive acc ('a -> 'a -> bool) 'a = | Acc : forall r,x:'a. (forall y. r y x -> acc r y) -> acc r x predicate wf (o:'a -> 'a -> bool) = forall x. acc o x predicate well_order (o:'a -> 'a -> bool) = order o /\ total o /\ wf (lower o) end

 (* Definition and lemmas about the transfinite sequence generated by an inflationary function on a chain-complete order. *) module IterateCommon use import order.Order use import order.Chain (* Transfinite reachability in chain-complete orders. *) inductive tr_reach ('a -> 'a -> bool) ('a -> 'a) (_ _:'a) = | Reach_base : forall o f,x:'a. tr_reach o f x x | Reach_succ : forall o f,x y:'a. tr_reach o f x y -> tr_reach o f x (f y) | Reach_chain : forall o f x c,y:'a. chain o c /\ c x /\ (forall y. c y -> tr_reach o f x y) /\ supremum o c y -> tr_reach o f x y predicate restricted_lower (o:'a -> 'a -> bool) (f:'a -> 'a) (x y z:'a) = tr_reach o f x y /\ o y z /\ not o z y predicate separator (o:'a -> 'a -> bool) (f:'a -> 'a) (base x:'a) = o x base \/ o (f base) x end (* Proof of iterate axioms in IterateProof module. *) module Iterates use import order.Order use import order.Chain use import order.Mono use import order.Wf use export IterateCommon namespace import Dummy type d end (* tr_reach is a chain, and there are no tr_reach element between any z and its 'sucessor' f z. *) axiom tr_reach_separated : forall o f,x y z:'a. order o /\ inflationary o f /\ tr_reach o f x y /\ tr_reach o f x z -> separator o f z y /\ forall _:d. true (* For chain-complete orders, there is a maximum tr_reach element, which is a fixpoint of the growth function (the fixpoint part is the Bourbaki-Witt theorem) *) function fixpoint_above (o:'a -> 'a -> bool) (f:'a -> 'a) 'a : 'a axiom tr_reach_maximum : forall o f,x:'a. order o /\ inflationary o f /\ chain_complete o -> f (fixpoint_above o f x) = fixpoint_above o f x /\ maximum o (tr_reach o f x) (fixpoint_above o f x) /\ forall _:d. true axiom tr_reach_fixpoint : forall o f,x y:'a. order o /\ inflationary o f /\ f y = y /\ tr_reach o f x y -> maximum o (tr_reach o f x) y /\ forall _:d. true (* transifinite reachability relation is compatible with the base order. *) axiom tr_reach_compare : forall o f,x y:'a. preorder o /\ inflationary o f /\ tr_reach o f x y -> o x y /\ forall _:d. true (* transfinite reachability relation is transitive. *) axiom tr_reach_transitive : forall o f,x y z:'a. preorder o /\ inflationary o f -> tr_reach o f x y /\ ("induction" tr_reach o f y z) -> tr_reach o f x z /\ forall _:d. true (* the set of reachable states from a given one is well-founded for the base order relation. *) axiom tr_reach_wf : forall o f,x:'a. order o /\ inflationary o f -> wf (restricted_lower o f x) /\ forall _:d. true end module IterateProof use import order.Order use import order.Mono use import order.Chain use import order.Wf use import choice.Choice use import IterateCommon lemma tr_reach_compare : forall o f,x y:'a. preorder o /\ inflationary o f -> ("induction" tr_reach o f x y) -> o x y predicate near_all_separator (o:'a -> 'a -> bool) (f:'a -> 'a) (u a:'a) = tr_reach o f u a /\ forall c b. tr_reach o f u c /\ tr_reach o f u b /\ o c a /\ not o a c -> separator o f c b (* Any element <= a is a separator. *) predicate all_separator (o:'a -> 'a -> bool) (f:'a -> 'a) (u a:'a) = tr_reach o f u a /\ forall c b. tr_reach o f u c /\ tr_reach o f u b /\ o c a -> separator o f c b lemma separation : forall o f,u base:'a. order o /\ inflationary o f /\ near_all_separator o f u base -> (forall o1 f1 u1 x. o1 = o /\ f1 = f /\ u1 = u -> ("induction" tr_reach o1 f1 u1 x) -> separator o f base x) lemma all_separation : forall o,f,u:'a. order o /\ inflationary o f -> (forall o1 f1 u1 x. o1 = o /\ f1 = f /\ u1 = u -> ("induction" tr_reach o1 f1 u1 x) -> all_separator o f u x) by (forall a. all_separator o f u a -> near_all_separator o f u (f a) by forall c b. o c (f a) /\ not o (f a) c /\ tr_reach o f u c /\ tr_reach o f u b -> separator o f c b by separator o f a c) /\ forall ch a. ch u /\ (forall y. ch y -> all_separator o f u y) /\ chain o ch /\ supremum o ch a -> near_all_separator o f u a by forall c b. o c a /\ not o a c /\ tr_reach o f u c /\ tr_reach o f u b -> separator o f c b by exists x. ch x /\ not o x c so separator o f x c function fixpoint_above (o:'a -> 'a -> bool) (f:'a -> 'a) (u:'a) : 'a = choice (supremum o (tr_reach o f u)) lemma fixpoint_max_proof : forall o f,u:'a. order o /\ chain_complete o /\ inflationary o f -> (forall x y. tr_reach o f u x /\ tr_reach o f u y -> separator o f x y && (o x y \/ o y x)) && chain o (tr_reach o f u) && let y = fixpoint_above o f u in maximum o (tr_reach o f u) y && f y = y lemma fixpoint_is_max_proof : forall o f,x y:'a. order o /\ inflationary o f /\ tr_reach o f x y /\ f y = y -> maximum o (tr_reach o f x) y by forall o1 f1 x1 y1. o1 = o /\ f1 = f /\ x1 = x -> "induction" tr_reach o1 f1 x1 y1 -> o y1 y predicate add (c:'a -> bool) (u x:'a) = c x \/ u = x lemma add_chain : forall o f x y c,z:'a. preorder o /\ inflationary o f /\ c y /\ chain o c /\ (forall t. c t -> tr_reach o f x t) /\ supremum o c z /\ tr_reach o f x y -> tr_reach o f x z by supremum o (add c x) z predicate all_acc (o:'a -> 'a -> bool) (f:'a -> 'a) (x:'a) (y:'a) = forall z. o z y /\ tr_reach o f x z -> acc (restricted_lower o f x) z lemma accessibility : forall o f,x:'a. order o /\ inflationary o f -> (forall y. tr_reach o f x y -> acc (restricted_lower o f x) y) by (forall o1 f1 x1 y. o1 = o /\ f1 = f /\ x1 = x -> ("induction" tr_reach o1 f1 x1 y) -> all_acc o f x y) by (forall y. all_acc o f x y /\ tr_reach o f x y -> all_acc o f x (f y) by acc (restricted_lower o f x) (f y) by forall z2. restricted_lower o f x z2 (f y) -> acc (restricted_lower o f x) z2 by separator o f y z2) /\ (forall ch y. supremum o ch y /\ (forall z. ch z -> tr_reach o f x z /\ all_acc o f x z) -> all_acc o f x y by acc (restricted_lower o f x) y by forall z. restricted_lower o f x z y -> acc (restricted_lower o f x) z by exists a. ch a /\ not o a z so separator o f a z so o z a) clone Iterates with type Dummy.d = unit, function fixpoint_above = fixpoint_above, goal tr_reach_separated, goal tr_reach_maximum, goal tr_reach_fixpoint, goal tr_reach_compare, goal tr_reach_transitive, goal tr_reach_wf end module ChainExtensionCommon use import Iterates use import order.Order use import order.Chain predicate subchain (o:'a -> 'a -> bool) (a b:'a -> bool) = (forall x. a x -> b x) /\ (forall x y. a x /\ b y /\ not a y -> o x y) function subchain_completion (chh:('a -> bool) -> bool) : 'a -> bool = \x. exists s. chh s /\ s x predicate ub_builder (o:'a -> 'a -> bool) (f:('a -> bool) -> 'a) = forall ch. chain o ch -> upper_bound o ch (f ch) predicate extends_ch (o:'a -> 'a -> bool) (f:('a -> bool) -> 'a) (ch:'a -> bool) (x:'a) = ch x \/ (chain o ch /\ x = f ch) predicate reach_ch (o:'a -> 'a -> bool) (f:('a -> bool) -> 'a) (x y:'a -> bool) = tr_reach (subchain o) (extends_ch o f) x y end (* Special shape of iterates: chain extension. This module contain the machinery to build chain iterates. Proofs in ChainExtensionProof. *) module ChainExtension use import order.Order use import order.Chain use import order.Mono use export ChainExtensionCommon namespace import Dummy type d end (* subchain ordering is a chain-complete order for transitive relations. *) axiom subchain_order : forall o:'a -> 'a -> bool. transitive o -> order (subchain o) /\ forall _:d. true axiom subchain_complete : forall o:'a -> 'a -> bool,ch. chain (subchain o) ch -> supremum (subchain o) ch (subchain_completion ch) /\ forall _:d. true axiom subchain_completion_chain : forall o:'a -> 'a -> bool,ch. chain (subchain o) ch /\ (forall x. ch x -> chain o x) -> chain o (subchain_completion ch) /\ forall _:d. true axiom extends_inflationary : forall o:'a -> 'a -> bool,f. ub_builder o f -> inflationary (subchain o) (extends_ch o f) /\ forall _:d. true axiom extends_preserve_chain : forall o:'a -> 'a -> bool,f ch. ub_builder o f /\ chain o ch /\ reflexive o -> chain o (extends_ch o f ch) /\ forall _:d. true axiom reach_only_chains : forall o:'a -> 'a -> bool,f ch1 ch2. ub_builder o f /\ chain o ch1 /\ reach_ch o f ch1 ch2 /\ reflexive o -> chain o ch2 /\ forall _:d. true end module ChainExtensionProof use import order.Order use import order.Mono use import order.Chain use import order.Wf use import choice.Choice use import Iterates use import ChainExtensionCommon function id : 'a -> 'a = \x. x predicate hack (f g h:'a -> bool) = f = g = h let lemma ext (o:'a -> 'a -> bool) (f g:'a -> bool) : unit requires { subchain o f g /\ subchain o g f } ensures { f = g } = assert { hack f (\x. id (f x)) g } lemma subchain_complete : forall o ch. chain (subchain o) ch -> let sup = subchain_completion ch in supremum (subchain o) ch sup by forall c. ch c -> subchain o c sup by forall x y:'a. c x /\ sup y /\ not c y -> o x y by exists w. ch w /\ w y so subchain o c w lemma subchain_competion_chain : forall o:'a -> 'a -> bool,ch. chain (subchain o) ch /\ (forall x. ch x -> chain o x) -> chain o (subchain_completion ch) lemma extends_preserve_chain : forall o:'a -> 'a -> bool,f ch. ub_builder o f /\ chain o ch /\ reflexive o -> chain o (extends_ch o f ch) lemma reach_only_chains : forall o f,ch1 ch2:'a -> bool. ub_builder o f /\ reflexive o /\ chain o ch1 /\ reach_ch o f ch1 ch2 -> chain o ch2 by forall o1 f1 b1 x. o1 = o /\ f1 = f /\ b1 = ch1 -> ("induction" tr_reach (subchain o1) (extends_ch o1 f1) b1 x) -> chain o1 x clone ChainExtension with type Dummy.d = unit, goal subchain_order, goal subchain_complete, goal subchain_completion_chain, goal extends_inflationary, goal extends_preserve_chain, goal reach_only_chains end