avl example continued (WIP)

examples/in_progress/avl/association_list.mlw

+
+(* Association lists. *)
+
+(* Association with respect to an equivalence relation. *)
+module Assoc
+  
+  clone import key_type.KeyType as K
+  clone import relations_params.EquivalenceParam as Eq with type t = key
+  
+  use import list.List
+  use import list.Mem
+  use import option.Option
+  use import HighOrd
+  
+  predicate appear (p:param 'a) (k:key 'a) (l:list (t 'a 'b)) =
+    exists x. mem x l /\ correct_for p k /\ Eq.rel p k (key x)
+  
+  (* Correction. *)
+  predicate correct (p:param 'a) (l:list (t 'a 'b)) = match l with
+    | Nil -> true
+    | Cons x q -> let kx = key x in correct_for p kx /\ correct p q
+    end
+  
+  (* Unique occurence (a desirable property of an association list). *)
+  predicate unique (p:param 'a) (l:list (t 'a 'b)) = match l with
+    | Nil -> true
+    | Cons x q -> not appear p (key x) q /\ unique p q
+    end
+  
+  (* functional update with equivalence classes. *)
+  function param_update (p:param 'a) (f:key 'a -> 'b)
+    (k:key 'a) (b:'b) : key 'a -> 'b = \k2.
+      if Eq.rel p k k2 then b else f k2
+  
+  (* functional model of an association list. *)
+  function model (p:param 'a) (l:list (t 'a 'b)) : key 'a -> option (t 'a 'b) =
+    match l with
+    | Nil -> \x. None
+    | Cons d q -> param_update p (model p q) (key d) (Some d)
+    end
+  
+  (* A key is bound iff it occurs in the association lists. *)
+  let rec lemma model_occurence (p:param 'a) (k:key 'a)
+    (l:list (t 'a 'b)) : unit
+    requires { correct p l }
+    requires { correct_for p k }
+    ensures { appear p k l <-> match model p l k with None -> false
+      | Some _ -> true end }
+    variant { l }
+  = match l with Cons _ q -> model_occurence p k q | _ -> () end
+  
+  (* A key is bound to a value with an equivalent key. *)
+  let rec lemma model_link (p:param 'a) (k:key 'a) (l:list (t 'a 'b)) : unit
+    requires { correct p l }
+    requires { correct_for p k }
+    ensures { match model p l k with None -> true
+      | Some d -> Eq.rel p k (key d) end }
+    variant { l }
+  = match l with Cons _ q -> model_link p k q | _ -> () end
+  
+  (* Two equivalent keys are bound to the same value. *)
+  let rec lemma model_equal (p:param 'a) (k1 k2:key 'a)
+    (l:list (t 'a 'b)) : unit
+    requires { correct p l }
+    requires { correct_for p k1 /\ correct_for p k2 }
+    requires { Eq.rel p k1 k2 }
+    ensures { model p l k1 = model p l k2 }
+    variant { l }
+  = match l with Cons _ q -> model_equal p k1 k2 q | _ -> () end
+  
+  (* If the list satisfies the uniqueness property,
+     then every value occuring in the list is the image of its key. *)
+  let rec lemma model_unique (p:param 'a) (k:key 'a) (l:list (t 'a 'b)) : unit
+    requires { correct p l }
+    requires { unique p l }
+    requires { correct_for p k }
+    ensures { forall d. mem d l -> model p l (key d) = Some d }
+    variant { l }
+  = match l with Cons _ q -> model_unique p k q | _ -> () end
+  
+end
+
+
+(* Sorted (increasing) association list. *)
+
+module AssocSorted
+  
+  use import list.List
+  use import list.Append
+  use import list.Mem
+  use import option.Option
+  
+  clone import key_type.KeyType as K
+  clone import preorder.FullParam as O with type t = key
+  (* The commented out part do not work, unfortunately. *)
+  clone export Assoc with namespace K = K,(*namespace Eq = O.Eq*)
+      type Eq.param = O.order,
+      predicate Eq.correct_for = O.correct_for,
+      predicate Eq.rel = O.eq,
+      (* Duplicates, there is no need to keep them. *)
+      goal Eq.trans,
+      goal Eq.refl,
+      goal Eq.symm
+  clone sorted.Increasing as S with namespace K = K,
+    (*namespace O = O.Lt*)
+    type O.param = O.order,
+    predicate O.correct_for = O.correct_for,
+    predicate O.rel = O.lt,
+    goal O.trans
+  
+  (* Sorted lists are correct association lists with unicity property. *)
+  let rec lemma increasing_unique_and_correct (o:order 'a)
+    (l:list (t 'a 'b)) : unit
+    requires { S.increasing o l }
+    ensures { correct o l }
+    ensures { unique o l }
+    variant { l }
+  = match l with Cons _ q -> increasing_unique_and_correct o q | _ -> () end
+  
+  let lemma absent (o:order 'a) (k:key 'a) (l r:list (t 'a 'b)) : unit
+    requires { correct_for o k }
+    requires { S.increasing o l }
+    requires { S.increasing o r }
+    requires { S.majorate o k l }
+    requires { S.minorate o k r }
+    ensures { model o (l++r) k = None }
+  = assert { S.precede o l r && not appear o k (l++r) &&
+    match model o (l++r) k with None -> true | _ -> false end }
+  
+  let lemma present (o:order 'a) (k:key 'a) (l r:list (t 'a 'b))
+    (d:t 'a 'b) : unit
+    requires { correct_for o k }
+    requires { correct_for o (key d) }
+    requires { S.increasing o l }
+    requires { S.increasing o r }
+    requires { S.majorate o k l }
+    requires { S.minorate o k r }
+    requires { eq o k (key d) }
+    ensures { model o (l++Cons d r) k = Some d }
+  = assert { S.increasing o (l++Cons d r) }
+  
+end
+

examples/in_progress/avl/association_list/why3session.xml

+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE why3session PUBLIC "-//Why3//proof session v2//EN" "http://why3.lri.fr/why3session.dtd">
+<why3session shape_version="4">
+ <prover
+  id="0"
+  name="Alt-Ergo"
+  version="0.95.2"/>
+ <prover
+  id="1"
+  name="CVC4"
+  version="1.3"/>
+ <file
+  name="../association_list.mlw"
+  verified="true"
+  expanded="false">
+  <theory
+   name="Assoc"
+   locfile="../association_list.mlw"
+   loclnum="5" loccnumb="7" loccnume="12"
+   verified="true"
+   expanded="false">
+   <goal
+    name="WP_parameter model_occurence"
+    locfile="../association_list.mlw"
+    loclnum="43" loccnumb="16" loccnume="31"
+    expl="VC for model_occurence"
+    sum="45769d0afeebf6f4a3ba55e1301b497c"
+    proved="true"
+    expanded="false"
+    shape="CCfaNonetaSomewainfix @amodelV0V2V1qaappearV0V1V2ICfaNonetaSomewainfix @amodelV0V3V1qaappearV0V1V3Aacorrect_forV0V1AacorrectV0V3ACfaNilainfix =V4V3aConswVV2aConswVCfaNonetaSomewainfix @amodelV0V2V1qaappearV0V1V2wV2Iacorrect_forV0V1AacorrectV0V2F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for model_occurence"/>
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.03"/>
+    </proof>
+   </goal>
+   <goal
+    name="WP_parameter model_link"
+    locfile="../association_list.mlw"
+    loclnum="53" loccnumb="16" loccnume="26"
+    expl="VC for model_link"
+    sum="9739759d0868921977d8b3a1b49a57ce"
+    proved="true"
+    expanded="false"
+    shape="CCtaNonearelV0V1akeyV4aSomeVainfix @amodelV0V2V1ICtaNonearelV0V1akeyV5aSomeVainfix @amodelV0V3V1Aacorrect_forV0V1AacorrectV0V3ACfaNilainfix =V6V3aConswVV2aConswVCtaNonearelV0V1akeyV7aSomeVainfix @amodelV0V2V1wV2Iacorrect_forV0V1AacorrectV0V2F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for model_link"/>
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.08"/>
+    </proof>
+   </goal>
+   <goal
+    name="WP_parameter model_equal"
+    locfile="../association_list.mlw"
+    loclnum="62" loccnumb="16" loccnume="27"
+    expl="VC for model_equal"
+    sum="aa1254a320c83582e7fc29731c7fa832"
+    proved="true"
+    expanded="false"
+    shape="Cainfix =ainfix @amodelV0V3V1ainfix @amodelV0V3V2Iainfix =ainfix @amodelV0V4V1ainfix @amodelV0V4V2AarelV0V1V2Aacorrect_forV0V2Aacorrect_forV0V1AacorrectV0V4ACfaNilainfix =V5V4aConswVV3aConswVainfix =ainfix @amodelV0V3V1ainfix @amodelV0V3V2wV3IarelV0V1V2Aacorrect_forV0V2Aacorrect_forV0V1AacorrectV0V3F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for model_equal"/>
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.20"/>
+    </proof>
+   </goal>
+   <goal
+    name="WP_parameter model_unique"
+    locfile="../association_list.mlw"
+    loclnum="73" loccnumb="16" loccnume="28"
+    expl="VC for model_unique"
+    sum="47dbff96bc3e568578fa58414a7c422b"
+    proved="true"
+    expanded="false"
+    shape="Cainfix =ainfix @amodelV0V2akeyV4aSomeV4IamemV4V2FIainfix =ainfix @amodelV0V3akeyV5aSomeV5IamemV5V3FAacorrect_forV0V1AauniqueV0V3AacorrectV0V3ACfaNilainfix =V6V3aConswVV2aConswVainfix =ainfix @amodelV0V2akeyV7aSomeV7IamemV7V2FwV2Iacorrect_forV0V1AauniqueV0V2AacorrectV0V2F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for model_unique"/>
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.03"/>
+    </proof>
+   </goal>
+  </theory>
+  <theory
+   name="AssocSorted"
+   locfile="../association_list.mlw"
+   loclnum="86" loccnumb="7" loccnume="18"
+   verified="true"
+   expanded="false">
+   <goal
+    name="refl"
+    locfile="../relations_params.mlw"
+    loclnum="14" loccnumb="8" loccnume="12"
+    sum="1a8956218bada7ab4930cddaeeef3bec"
+    proved="true"
+    expanded="false"
+    shape="aeqV0V1V1Iacorrect_forV0V1F">
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.01"/>
+    </proof>
+   </goal>
+   <goal
+    name="trans"
+    locfile="../relations_params.mlw"
+    loclnum="26" loccnumb="8" loccnume="13"
+    sum="a22194a9f5910222aa5a236bdfc99770"
+    proved="true"
+    expanded="false"
+    shape="aeqV0V1V3IaeqV0V2V3AaeqV0V1V2Iacorrect_forV0V3Aacorrect_forV0V2Aacorrect_forV0V1F">
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.01"/>
+    </proof>
+   </goal>
+   <goal
+    name="symm"
+    locfile="../relations_params.mlw"
+    loclnum="33" loccnumb="8" loccnume="12"
+    sum="1a64b738c70a0907335259ac80c9199d"
+    proved="true"
+    expanded="false"
+    shape="aeqV0V2V1IaeqV0V1V2Iacorrect_forV0V2Aacorrect_forV0V1F">
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.01"/>
+    </proof>
+   </goal>
+   <goal
+    name="trans"
+    locfile="../relations_params.mlw"
+    loclnum="26" loccnumb="8" loccnume="13"
+    sum="57cc4ca5b30f82016e2735ad84387f35"
+    proved="true"
+    expanded="false"
+    shape="altV0V1V3IaltV0V2V3AaltV0V1V2Iacorrect_forV0V3Aacorrect_forV0V2Aacorrect_forV0V1F">
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.01"/>
+    </proof>
+   </goal>
+   <goal
+    name="WP_parameter increasing_unique_and_correct"
+    locfile="../association_list.mlw"
+    loclnum="112" loccnumb="16" loccnume="45"
+    expl="VC for increasing_unique_and_correct"
+    sum="a5b0cd3f3756f501c793764cd9dd80d5"
+    proved="true"
+    expanded="false"
+    shape="CauniqueV0V1AacorrectV0V1IauniqueV0V2AacorrectV0V2AaincreasingV0V2ACfaNilainfix =V3V2aConswVV1aConswVauniqueV0V1AacorrectV0V1wV1IaincreasingV0V1F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for increasing_unique_and_correct"/>
+    <proof
+     prover="0"
+     timelimit="5"
+     memlimit="1000"
+     obsolete="false"
+     archived="false">
+     <result status="valid" time="0.04"/>
+    </proof>
+   </goal>
+   <goal
+    name="WP_parameter absent"
+    locfile="../association_list.mlw"
+    loclnum="120" loccnumb="12" loccnume="18"
+    expl="VC for absent"
+    sum="54118473a904052020bb4488cfbde2e0"
+    proved="true"
+    expanded="false"
+    shape="ainfix =ainfix @amodelV0ainfix ++V2V3V1aNoneACtaNonefwainfix @amodelV0ainfix ++V2V3V1ANaappearV0V1ainfix ++V2V3AaprecedeV0V2V3IaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0V1F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for absent"/>
+    <transf
+     name="split_goal_wp"
+     proved="true"
+     expanded="false">
+     <goal
+      name="WP_parameter absent.1"
+      locfile="../association_list.mlw"
+      loclnum="120" loccnumb="12" loccnume="18"
+      expl="1. assertion"
+      sum="de830a3390d1df6cab38826ff1b947a7"
+      proved="true"
+      expanded="false"
+      shape="assertionCtaNonefwainfix @amodelV0ainfix ++V2V3V1ANaappearV0V1ainfix ++V2V3AaprecedeV0V2V3IaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0V1F">
+      <label
+       name="why3:lemma"/>
+      <label
+       name="expl:VC for absent"/>
+      <proof
+       prover="0"
+       timelimit="5"
+       memlimit="1000"
+       obsolete="false"
+       archived="false">
+       <result status="valid" time="0.15"/>
+      </proof>
+     </goal>
+     <goal
+      name="WP_parameter absent.2"
+      locfile="../association_list.mlw"
+      loclnum="120" loccnumb="12" loccnume="18"
+      expl="2. postcondition"
+      sum="ec0a38edf20083f1351bdac1fd06049a"
+      proved="true"
+      expanded="false"
+      shape="postconditionainfix =ainfix @amodelV0ainfix ++V2V3V1aNoneICtaNonefwainfix @amodelV0ainfix ++V2V3V1ANaappearV0V1ainfix ++V2V3AaprecedeV0V2V3IaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0V1F">
+      <label
+       name="why3:lemma"/>
+      <label
+       name="expl:VC for absent"/>
+      <proof
+       prover="0"
+       timelimit="5"
+       memlimit="1000"
+       obsolete="false"
+       archived="false">
+       <result status="valid" time="0.03"/>
+      </proof>
+     </goal>
+    </transf>
+   </goal>
+   <goal
+    name="WP_parameter present"
+    locfile="../association_list.mlw"
+    loclnum="130" loccnumb="12" loccnume="19"
+    expl="VC for present"
+    sum="704539429ba98492bc30fcb57c9dfb0d"
+    proved="true"
+    expanded="false"
+    shape="ainfix =ainfix @amodelV0ainfix ++V2aConsV4V3V1aSomeV4AaincreasingV0ainfix ++V2aConsV4V3IaeqV0V1akeyV4AaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0akeyV4Aacorrect_forV0V1F">
+    <label
+     name="why3:lemma"/>
+    <label
+     name="expl:VC for present"/>
+    <transf
+     name="split_goal_wp"
+     proved="true"
+     expanded="false">
+     <goal
+      name="WP_parameter present.1"
+      locfile="../association_list.mlw"
+      loclnum="130" loccnumb="12" loccnume="19"
+      expl="1. assertion"
+      sum="5f188f15b8da6a38eafe87b0ec4b9f21"
+      proved="true"
+      expanded="false"
+      shape="assertionaincreasingV0ainfix ++V2aConsV4V3IaeqV0V1akeyV4AaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0akeyV4Aacorrect_forV0V1F">
+      <label
+       name="why3:lemma"/>
+      <label
+       name="expl:VC for present"/>
+      <transf
+       name="split_goal_wp"
+       proved="true"
+       expanded="false">
+       <goal
+        name="WP_parameter present.1.1"
+        locfile="../association_list.mlw"
+        loclnum="130" loccnumb="12" loccnume="19"
+        expl="1. assertion"
+        sum="5f188f15b8da6a38eafe87b0ec4b9f21"
+        proved="true"
+        expanded="false"
+        shape="assertionaincreasingV0ainfix ++V2aConsV4V3IaeqV0V1akeyV4AaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0akeyV4Aacorrect_forV0V1F">
+        <label
+         name="why3:lemma"/>
+        <label
+         name="expl:VC for present"/>
+        <proof
+         prover="1"
+         timelimit="5"
+         memlimit="1000"
+         obsolete="false"
+         archived="false">
+         <result status="valid" time="0.19"/>
+        </proof>
+       </goal>
+      </transf>
+     </goal>
+     <goal
+      name="WP_parameter present.2"
+      locfile="../association_list.mlw"
+      loclnum="130" loccnumb="12" loccnume="19"
+      expl="2. postcondition"
+      sum="c6829da9d9da50fe740850f978d07502"
+      proved="true"
+      expanded="false"
+      shape="postconditionainfix =ainfix @amodelV0ainfix ++V2aConsV4V3V1aSomeV4IaincreasingV0ainfix ++V2aConsV4V3IaeqV0V1akeyV4AaminorateV0V1V3AamajorateV0V1V2AaincreasingV0V3AaincreasingV0V2Aacorrect_forV0akeyV4Aacorrect_forV0V1F">
+      <label
+       name="why3:lemma"/>
+      <label
+       name="expl:VC for present"/>
+      <proof
+       prover="0"
+       timelimit="5"
+       memlimit="1000"
+       obsolete="false"
+       archived="false">
+       <result status="valid" time="0.67"/>
+      </proof>
+     </goal>
+    </transf>
+   </goal>
+  </theory>
+ </file>
+</why3session>

examples/in_progress/avl/key_type.mlw

+
+(* Type with a key. Intended to factor elements/bindings representations
+   in sets/map-like structures.
+   Typical instantiation:
+     - Set elements, t 'a 'b = key 'a, get_key = id:
+       the only information one can retrieve
+       from a key is presence.
+     - Map bindings, t 'a 'b = (key 'a,value 'b),get_key = fst:
+       one can also retrieve a value from a present binding. *)
+theory KeyType
+  
+  type t 'a 'b
+  type key 'a
+  function key (t 'a 'b) : key 'a
+  
+end
+
+(* program version. *)
+module ProgramKeyType
+  
+  clone export program_type.Type2
+  clone program_type.Type1 as Key
+  function key_m (m 'a 'b) : Key.m 'a
+  val key (x:t 'a 'b) : Key.t 'a
+    requires { c x }
+    ensures { Key.c result }
+    ensures { x.m.key_m = result.Key.m }
+  
+end
+

examples/in_progress/avl/key_type/why3session.xml

+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE why3session PUBLIC "-//Why3//proof session v2//EN" "http://why3.lri.fr/why3session.dtd">
+<why3session shape_version="4">
+ <file
+  name="../key_type.mlw"
+  verified="true"
+  expanded="true">
+  <theory
+   name="KeyType"
+   locfile="../key_type.mlw"
+   loclnum="3" loccnumb="7" loccnume="14"
+   verified="true"
+   expanded="true">
+  </theory>
+  <theory
+   name="ProgramKeyType"
+   locfile="../key_type.mlw"
+   loclnum="12" loccnumb="7" loccnume="21"
+   verified="true"
+   expanded="true">
+  </theory>
+ </file>
+</why3session>

examples/in_progress/avl/preorder.mlw

+
+(* Full preorder theory,
+   containing lt and eq as well. *)
+theory FullParam
+  
+  type t 'a
+  type order 'a
+  predicate le (order 'a) (t 'a) (t 'a)
+  clone export relations_params.PreOrderParam with type t = t,
+    type param = order, predicate rel = le
+  predicate eq (order 'a) (t 'a) (t 'a)
+  axiom eq_def : forall o:order 'a,x y:t 'a.
+    correct_for o x /\ correct_for o y ->
+      (eq o x y <-> le o x y /\ le o y x)
+  predicate lt (order 'a) (t 'a) (t 'a)
+  axiom lt_def : forall o:order 'a,x y:t 'a.
+    correct_for o x /\ correct_for o y ->
+      (lt o x y <-> le o x y /\ not le o y x)
+  
+  clone relations_params.EquivalenceParam as Eq with type t = t,
+    type param = order, predicate correct_for = correct_for,
+    predicate rel = eq, lemma trans, lemma refl, lemma symm
+  
+  clone relations_params.PartialStrictOrderParam as Lt with type t = t,
+    type param = order, predicate correct_for = correct_for,
+    predicate rel = lt, lemma trans, lemma asymm
+  
+end
+
+(* Preorder + corresponding computable comparison. *)
+module ComputableParam
+  
+  use import int.Int
+  clone export program_type.Type1
+  clone program_type.Type1 as O
+  clone export FullParam with type t = m, type order = O.m
+  
+  (* Comparison is computable. *)
+  val compare (o:O.t 'a) (x y:t 'a) : int
+    requires { O.c o }
+    requires { correct_for o.O.m x.m /\ c x }
+    requires { correct_for o.O.m y.m /\ c y }
+    ensures { result > 0 <-> lt o.O.m y.m x.m }
+    ensures { result < 0 <-> lt o.O.m x.m y.m }
+    ensures { result = 0 <-> eq o.O.m x.m y.m }
+  
+end
+

examples/in_progress/avl/preorder/why3session.xml

+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE why3session PUBLIC "-//Why3//proof session v2//EN" "http://why3.lri.fr/why3session.dtd">
+<why3session shape_version="4">
+ <prover
+  id="0"
+  name="Alt-Ergo"
+  version="0.95.2"/>
+ <file
+  name="../preorder.mlw"
+  verified="true"