Commit 15d07791 authored by Martin Clochard's avatar Martin Clochard

examples/in_progress: 2wp_gen, cont'd

parent 58f09fef
(* Basic arrow definitions *)
module Fun
use export HighOrd
predicate ext (f g:'a -> 'b) = forall x. f x = g x
predicate equalizer (a:'a -> bool) (f g:'a -> 'b) =
forall x. a x -> f x = g x
function compose (g:'b -> 'c) (f:'a -> 'b) : 'a -> 'c = \x. g (f x)
function rcompose (f:'a -> 'b) (g:'b -> 'c) : 'a -> 'c = compose g f
function id : 'a -> 'a = \x.x
function const (x:'b) : 'a -> 'b = \_.x
function fst (x:('a,'b)) : 'a = let (x,_) = x in x
function snd (x:('a,'b)) : 'b = let (_,x) = x in x
function flip (f:'a -> 'b -> 'c) : 'b -> 'a -> 'c = \x y. f y x
function update (f:'a -> 'b) (x:'a) (y:'b) : 'a -> 'b =
\z. if z = x then y else f z
function ([<-]) (f:'a -> 'b) (x:'a) (y:'b) : 'a -> 'b = update f x y
end
(* Proof done via cloning+replacing axioms by goals *)
(* Functional extensionality. *)
module FunExt "W:non_conservative_extension:N" (* => FunProofs *)
use export Fun
axiom extensionality : forall f g:'a -> 'b. ext f g -> f = g
let extensional (f g:'a -> 'b) : unit
requires { ext f g }
ensures { f = g }
= ()
end
(* Evident category properties of functions. *)
module FunCategory "W:non_conservative_extension:N" (* => FunProofs *)
use export Fun
axiom assoc : forall f:'a -> 'b,g,h:'c -> 'd.
compose (compose h g) f = compose h (compose g f)
axiom neutral : forall f:'a -> 'b. compose f id = f = compose id f
end
(* Proofs of above Fun modules *)
module FunProofs
use import Fun
predicate hack (f g h:'a -> 'b) = f = g = h
lemma ext : forall f g:'a -> 'b.
ext f g -> f = g by hack f (\x. (\y.y) (f x)) g
lemma assoc : forall f:'a -> 'b,g,h:'c -> 'd.
ext (compose (compose h g) f) (compose h (compose g f))
lemma neutral : forall f:'a -> 'b.
ext (compose f id) f /\ ext (compose id f) f
clone FunExt with goal extensionality
clone FunCategory with goal assoc, goal neutral
end
(* Basic definition on sets-as-arrows *)
module Set
use import Fun
type set 'a = 'a -> bool
predicate subset (a b:set 'a) = forall x. a x -> b x
predicate sext (a b:set 'a) = forall x. a x <-> b x
lemma sext_is_ext : forall a b:set 'a. sext a b -> ext a b
function neg (s:set 'a) : set 'a = \x. not (s x)
function union (a b:set 'a) : set 'a = \x. a x \/ b x
function inter (a b:set 'a) : set 'a = \x. a x /\ b x
function diff (a b:set 'a) : set 'a = inter a (neg b)
constant all : set 'a = \_. true
constant none : set 'a = \_. false
function sing (x:'a) : set 'a = (=) x
function add (s:set 'a) (x:'a) : set 'a = \y. s y \/ x = y
function remove (s:set 'a) (x:'a) : set 'a = \y. s y /\ y <> x
end
(* Basic definition on relations-as-arrows *)
module Rel
use import Fun
type rel 'a 'b = 'a -> 'b -> bool
type erel 'a = rel 'a 'a
predicate rext (r1 r2:rel 'a 'b) = forall x y. r1 x y <-> r2 x y
predicate reflexive (r:erel 'a) = forall x. r x x
predicate symetric (r:erel 'a) = forall x y. r x y -> r y x
predicate transitive (r:erel 'a) = forall x y z. r x y /\ r y z -> r x z
predicate antisymetric (r:erel 'a) = forall x y. r x y /\ r y x -> x = y
predicate total (r:erel 'a) = forall x y. r x y \/ r y x
predicate preorder (r:erel 'a) = reflexive r /\ transitive r
predicate order (r:erel 'a) = preorder r /\ antisymetric r
predicate equivalence (r:erel 'a) = preorder r /\ symetric r
inductive acc_on (erel 'a) ('a -> bool) 'a =
| Acc : forall r s,x:'a.
s x /\ (forall y. s y /\ r y x -> acc_on r s y) -> acc_on r s x
predicate wf_on (r:erel 'a) (s:'a -> bool) = forall x. s x -> acc_on r s x
constant id : rel 'a 'a = (=)
function of_func (f:'a -> 'b) : rel 'a 'b = \x y. y = f x
function compose (r1:rel 'a 'b) (r2:rel 'b 'c) : rel 'a 'c =
\x z. exists y. r1 x y /\ r2 y z
function reverse (r:rel 'a 'b) : rel 'b 'a = flip r
end
(* Relational extensionality. *)
module RelExt "W:non_conservative_extension:N" (* => RelProofs *)
use export Rel
axiom extensionality : forall r1 r2:rel 'a 'b. rext r1 r2 -> r1 = r2
end
(* Evident category properties of relations. *)
module RelCategory "W:non_conservative_extension:N" (* => RelProofs *)
use export Rel
axiom assoc : forall r1:rel 'a 'b,r2,r3:rel 'c 'd.
compose r1 (compose r2 r3) = compose (compose r1 r2) r3
axiom reverse_antimorphism : forall r1:rel 'a 'b,r2:rel 'b 'c.
compose (reverse r2) (reverse r1) = reverse (compose r1 r2)
axiom reverse_antimorphism_id : reverse id = (id:erel 'a)
axiom reverse_involution : forall r:rel 'a 'b. reverse (reverse r) = r
axiom neutral : forall r:rel 'a 'b.
compose r id = r = compose id r
end
(* Relation product. *)
module RelProduct
use export Rel
predicate rprod (r1:rel 'a 'b) (r2:rel 'c 'd) (x:('a,'c)) (y:('b,'d)) =
let (xa,xc) = x in let (yb,yd) = y in r1 xa yb /\ r2 xc yd
end
(* Elements related to a set. *)
module RelSet
use import Set
use export Rel
predicate related (r:rel 'a 'b) (s:set 'a) (y:'b) = exists x. s x /\ r x y
predicate i_related (r:rel 'a 'b) (s:set 'b) (x:'a) = exists y. s y /\ r x y
end
module RelProofs
use import FunExt
use import Rel
lemma extensionality : forall r1 r2:rel 'a 'b. rext r1 r2 -> r1 = r2
by ext r1 r2 by forall x. ext (r1 x) (r2 x)
predicate (==) (x y:rel 'a 'b) = rext x y
meta rewrite_def predicate (==)
meta rewrite_def predicate rext
meta rewrite_def function compose
lemma assoc : forall r1:rel 'a 'b,r2,r3:rel 'c 'd.
compose r1 (compose r2 r3) == compose (compose r1 r2) r3
lemma reverse_antimorphism : forall r1:rel 'a 'b,r2:rel 'b 'c.
compose (reverse r2) (reverse r1) == reverse (compose r1 r2)
lemma reverse_antimorphism_id : reverse id == (id:erel 'a)
lemma reverse_involution : forall r:rel 'a 'b. reverse (reverse r) == r
lemma neutral : forall r:rel 'a 'b.
compose r id == r == compose id r
clone RelExt with goal extensionality
clone RelCategory with goal assoc,
goal reverse_antimorphism,
goal reverse_antimorphism_id,
goal reverse_involution,
goal neutral
end
module SubsetOrder "W:non_conservative_extension:N" (* => SetProofs *)
use export Set
use import Rel
axiom subset_order : order (subset:erel (set 'a))
end
module SetProofs
use import FunExt
use import Set
lemma anti_subset : forall s1 s2:set 'a.
subset s1 s2 /\ subset s2 s1 -> sext s1 s2
clone SubsetOrder with goal subset_order
end
module Image
use import Fun
use import Set
predicate image (f:'a -> 'b) (s:set 'a) (y:'b) = exists x. s x /\ f x = y
predicate preimage (f:'a -> 'b) (s:set 'b) (x:'a) = s (f x)
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="Alt-Ergo" version="1.00.prv" timelimit="5" steplimit="1" memlimit="1000"/>
<file name="../base.mlw">
<theory name="Fun" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="FunExt" sum="74d4af5538daa9eb9ddee6284a05e5bf">
<goal name="WP_parameter extensional" expl="VC for extensional">
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
</theory>
<theory name="FunCategory" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="FunProofs" sum="2c63808db73c38978a321086af9d0cfd">
<goal name="ext">
<transf name="split_goal_wp">
<goal name="ext.1" expl="1.">
<transf name="inline_goal">
<goal name="ext.1.1" expl="1.">
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
</transf>
</goal>
<goal name="ext.2" expl="2.">
<proof prover="0"><result status="valid" time="0.00" steps="3"/></proof>
</goal>
</transf>
</goal>
<goal name="assoc">
<proof prover="0"><result status="valid" time="0.00" steps="4"/></proof>
</goal>
<goal name="neutral">
<proof prover="0"><result status="valid" time="0.00" steps="9"/></proof>
</goal>
<goal name="FunExt.extensionality">
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
<goal name="FunCategory.assoc">
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
<goal name="FunCategory.neutral">
<proof prover="0"><result status="valid" time="0.01" steps="10"/></proof>
</goal>
</theory>
<theory name="Set" sum="8dc39e2ae96fd0498b0d50bb47f235eb">
<goal name="sext_is_ext">
<proof prover="0"><result status="valid" time="0.00" steps="4"/></proof>
</goal>
</theory>
<theory name="Rel" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="RelExt" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="RelCategory" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="RelProduct" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="RelSet" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="RelProofs" sum="7b018da73dc68e6d1c67c464fa4c1b3a">
<goal name="extensionality">
<transf name="split_goal_wp">
<goal name="extensionality.1" expl="1.">
<proof prover="0"><result status="valid" time="0.01" steps="4"/></proof>
</goal>
<goal name="extensionality.2" expl="2.">
<proof prover="0"><result status="valid" time="0.01" steps="4"/></proof>
</goal>
<goal name="extensionality.3" expl="3.">
<proof prover="0"><result status="valid" time="0.00" steps="3"/></proof>
</goal>
</transf>
</goal>
<goal name="assoc">
<transf name="compute_specified">
<goal name="assoc.1" expl="1.">
<proof prover="0"><result status="valid" time="0.01" steps="12"/></proof>
</goal>
</transf>
</goal>
<goal name="reverse_antimorphism">
<proof prover="0"><result status="valid" time="0.01" steps="27"/></proof>
</goal>
<goal name="reverse_antimorphism_id">
<proof prover="0"><result status="valid" time="0.01" steps="9"/></proof>
</goal>
<goal name="reverse_involution">
<proof prover="0"><result status="valid" time="0.01" steps="5"/></proof>
</goal>
<goal name="neutral">
<transf name="compute_specified">
<goal name="neutral.1" expl="1.">
<proof prover="0"><result status="valid" time="0.00" steps="14"/></proof>
</goal>
</transf>
</goal>
<goal name="RelExt.extensionality">
<proof prover="0"><result status="valid" time="0.01" steps="2"/></proof>
</goal>
<goal name="RelCategory.assoc">
<proof prover="0"><result status="valid" time="0.01" steps="2"/></proof>
</goal>
<goal name="RelCategory.reverse_antimorphism">
<proof prover="0"><result status="valid" time="0.01" steps="2"/></proof>
</goal>
<goal name="RelCategory.reverse_antimorphism_id">
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
<goal name="RelCategory.reverse_involution">
<proof prover="0"><result status="valid" time="0.01" steps="2"/></proof>
</goal>
<goal name="RelCategory.neutral">
<proof prover="0"><result status="valid" time="0.01" steps="11"/></proof>
</goal>
</theory>
<theory name="SubsetOrder" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
<theory name="SetProofs" sum="0be5aa0fe01aa313571b5c5ef55cb77b">
<goal name="anti_subset">
<proof prover="0"><result status="valid" time="0.00" steps="7"/></proof>
</goal>
<goal name="SubsetOrder.subset_order">
<proof prover="0"><result status="valid" time="0.02" steps="65"/></proof>
</goal>
</theory>
<theory name="Image" sum="d41d8cd98f00b204e9800998ecf8427e">
</theory>
</file>
</why3session>
module Choice
use import HighOrd
use import fn.Fun
use import option.Option
constant default : 'a
constant witness : 'a
function choice ('a -> bool) : 'a
axiom choice_def : forall p,x:'a. p x -> p (choice p)
......
......@@ -2,14 +2,14 @@
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<prover id="1" name="Alt-Ergo" version="1.00.prv" timelimit="5" steplimit="1" memlimit="1000"/>
<prover id="0" name="Alt-Ergo" version="1.00.prv" timelimit="5" steplimit="1" memlimit="1000"/>
<file name="../choice.mlw">
<theory name="Choice" sum="10c4efd79629e9417231ac2d78d9aa7b">
<theory name="Choice" sum="7c1ca533a0ae37f3bd6e59347ceef0bd">
<goal name="WP_parameter choose" expl="VC for choose">
<proof prover="1"><result status="valid" time="0.00" steps="3"/></proof>
<proof prover="0"><result status="valid" time="0.00" steps="3"/></proof>
</goal>
<goal name="WP_parameter choose_if" expl="VC for choose_if">
<proof prover="1"><result status="valid" time="0.00" steps="2"/></proof>
<proof prover="0"><result status="valid" time="0.00" steps="2"/></proof>
</goal>
</theory>
</file>
......
module Fun use export base.FunExt end
module Category use export base.FunCategory end
module Image use export base.Image 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">
<file name="../fn.mlw" expanded="true">
<theory name="Fun" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Category" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
This source diff could not be displayed because it is too large. You can view the blob instead.
This diff is collapsed.
module Rel use export base.RelExt end
module Category use export base.RelCategory end
module Prod use export base.RelProduct end
module RelSet use export base.RelSet end
\ No newline at end of file
<?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">
<file name="../ho_rel.mlw" expanded="true">
<theory name="Rel" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Category" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Prod" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="RelSet" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
module Set use export base.Set end
module SubsetOrder use export base.SubsetOrder end
\ No newline at end of file
<?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">
<file name="../ho_set.mlw" expanded="true">
<theory name="Set" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="SubsetOrder" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment