Commit fb0b65dc authored by Andrei Paskevich's avatar Andrei Paskevich

examples: replace unused lambda-binders with underscores

parent e43c3352
......@@ -4,44 +4,44 @@
(** {2 Association with respect to an equivalence relation} *)
module Assoc
(** Abstract type for objects identified by keys. *)
clone import key_type.KeyType as K
(** Abstract equivalence relation. *)
clone import relations.Equivalence as Eq with type t = key
use import list.List
use import list.Mem
use import list.Append
use import option.Option
use import HighOrd
(** Existence of an element identified by key [k] in list [l]. *)
predicate appear (k:key) (l:list (t 'a)) =
exists x. mem x l /\ Eq.rel k x.key
lemma appear_append : forall k:key,l r:list (t 'a).
appear k (l++r) <-> appear k l \/ appear k r
(** Unique occurence of every key *)
predicate unique (l:list (t 'a)) = match l with
| Nil -> true
| Cons x q -> not appear x.key q /\ unique q
end
(** Functional update with equivalence classes. *)
function equiv_update (f:key -> 'b) (k:key) (b:'b) : key -> 'b =
\k2. if Eq.rel k k2 then b else f k2
function const_none : 'a -> option 'b = \x.None
function const_none : 'a -> option 'b = \_.None
(** Association list viewed as a partial mapping *)
function model (l:list (t 'a)) : key -> option (t 'a) =
match l with
| Nil -> const_none
| Cons d q -> equiv_update (model q) d.key (Some d)
end
(** A key is bound iff it occurs in the association lists.
Equivalently, [appear] describe the domain of the partial mapping. *)
let rec lemma model_domain (k:key) (l:list (t 'a)) : unit
......@@ -50,14 +50,14 @@ module Assoc
ensures { not appear k l <-> model l k = None }
variant { l }
= match l with Cons _ q -> model_domain k q | _ -> () end
(** A key is bound to a value with an equivalent key. *)
let rec lemma model_key (k:key) (l:list (t 'a)) : unit
ensures { match model l k with None -> true
| Some d -> Eq.rel k d.key end }
variant { l }
= match l with Cons _ q -> model_key k q | _ -> () end
(** Congruence lemma. *)
let rec lemma model_congruence (k1 k2:key) (l:list (t 'a)) : unit
requires { Eq.rel k1 k2 }
......@@ -67,7 +67,7 @@ module Assoc
| Cons _ q -> model_congruence 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 (k:key) (l:list (t 'a)) : unit
......@@ -75,12 +75,12 @@ module Assoc
ensures { forall d. mem d l -> model l d.key = Some d }
variant { l }
= match l with Cons _ q -> model_unique k q | _ -> () end
(** Singleton association list. *)
let lemma model_singleton (k:key) (d:t 'a) : unit
ensures { model (Cons d Nil) k = if rel k d.key then Some d else None }
= ()
(** Link between disjoint concatenation and disjoint union of
partial mappings. *)
let rec lemma model_concat (k:key) (l r:list (t 'a)) : unit
......@@ -97,19 +97,19 @@ module Assoc
| Nil -> ()
| Cons _ q -> model_concat k q r
end
end
(** {2 Sorted association lists} *)
module AssocSorted
use import list.List
use import list.Append
use import list.Mem
use import option.Option
(** It is an instance of association lists. *)
clone import key_type.KeyType as K
clone import preorder.Full as O with type t = key
......@@ -126,14 +126,14 @@ module AssocSorted
function K.key = K.key,
predicate O.rel = O.lt,
goal O.Trans
(** Sorted lists have unicity property. *)
let rec lemma increasing_unique (l:list (t 'a)) : unit
requires { S.increasing l }
ensures { unique l }
variant { l }
= match l with Cons _ q -> increasing_unique q | _ -> () end
(** Description of the partial mapping corresponding to the concatenation
of increasing lists separated by a known key in the middle. *)
let lemma model_cut (k:key) (l r:list (t 'a)) : unit
......@@ -165,7 +165,7 @@ module AssocSorted
end && false };
assert { forall k2. eq k k2 -> model (l++r) k2 <> None ->
(not appear k2 l /\ not appear k2 r) && false }
(** Description of the partial mapping corresponding to a list
split around a midpoint. *)
let lemma model_split (d:t 'a) (l r:list (t 'a)) : unit
......@@ -179,6 +179,6 @@ module AssocSorted
ensures { forall k2. lt k2 d.key -> model (l++Cons d r) k2 = model l k2 }
ensures { forall k2. le d.key k2 -> model l k2 = None }
= ()
end
This diff is collapsed.
(** {1 Values equiped with keys}
Author: Martin Clochard
This file describe types for values equiped with keys, a priori in the
purpose of identification. It is mostly intended to factor the
representations for sets/map-like structures, as it can be used
......@@ -10,19 +10,19 @@
(** {2 Logical type with key} *)
theory KeyType
type t 'a
type key
function key (t 'a) : key
end
(** {2 Program type with key} *)
module ProgramKeyType
clone export KeyType
val get_key (t:t 'a) : key ensures { key t = result }
end
......@@ -5,29 +5,29 @@
(** {2 Abstract logic monoid} *)
module Monoid
(** Elements of the monoid. *)
type t
(** Neutral element. *)
constant zero : t
(** Composition law. *)
function op (a b:t) : t
(** Monoid properties. *)
axiom assoc : forall a b c:t. op a (op b c) = op (op a b) c
axiom neutral : forall x:t. op x zero = x = op zero x
end
(** {2 Abstract monoid with aggregation} *)
module MonoidSum
use import list.List
use import list.Append
use import HighOrd
clone import Monoid as M
(** Axiomatized definition of the monoidal aggregation of elements
obtained from a list: using infix notation for the monoid law,
[sum f [a_1;a_2;...;a_n]] is [a_1 op a_2 ... op a_n].
......@@ -36,20 +36,20 @@ module MonoidSum
axiom sum_def_nil : forall f:'a -> t. sum f Nil = zero
axiom sum_def_cons : forall f:'a -> t,x,q.
sum f (Cons x q) = op (f x) (sum f q)
(** Consequence of associativity *)
let rec lemma sum_append (f:'a -> t) (l r:list 'a) : unit
ensures { sum f (l ++ r) = op (sum f l) (sum f r) }
variant { l }
= match l with Cons _ q -> sum_append f q r | _ -> () end
end
(** {2 Definition of aggregation} *)
module MonoidSumDef
use import list.List
use import HighOrd
namespace M
type t
constant zero : t
......@@ -62,18 +62,18 @@ module MonoidSumDef
clone export MonoidSum with type M.t = M.t,constant M.zero = M.zero,
function M.op = M.op,function sum = sum,
goal sum_def_nil,goal sum_def_cons
end
(** {2 Computable monoid} *)
module ComputableMonoid
clone export Monoid
(** Abstract routines computing operations in the monoid. *)
val zero () : t ensures { result = zero }
val op (a b:t) : t ensures { result = op a b }
end
......@@ -4,7 +4,7 @@
(** {2 Extended preorder theory} *)
theory Full
(** Standard preorder theory. *)
type t
predicate le t t
......@@ -14,38 +14,38 @@ theory Full
axiom eq_def : forall x y. eq x y <-> le x y /\ le y x
predicate lt t t
axiom lt_def : forall x y. lt x y <-> le x y /\ not le y x
(** Equality is provably an equivalence relation. *)
clone relations.Equivalence as Eq with type t = t,
predicate rel = eq, lemma Trans, lemma Refl, lemma Symm
(** Strict ordering is indeed a strict partial order. *)
clone relations.PartialStrictOrder as Lt with type t = t,
predicate rel = lt, lemma Trans, lemma Asymm
end
(** {2 Total preorder} *)
theory TotalFull
clone export Full
clone export relations.Total with type t = t, predicate rel = le
clone relations.Total as Lt with type t = t,
predicate rel = le, goal Total
lemma lt_def2 : forall x y. lt x y <-> not le y x
end
(** {2 Computable total preorder} *)
module Computable
use import int.Int
clone export TotalFull
(** Comparison is computable. *)
val compare (x y:t) : int
ensures { (result > 0 <-> lt y x) /\
(result < 0 <-> lt x y) /\ (result = 0 <-> eq x y) }
end
......@@ -4,7 +4,7 @@
Author: Martin Clochard *)
module PQueue
use import int.Int
use import avl.SelectionTypes
use import option.Option
......@@ -13,13 +13,13 @@ module PQueue
use import list.Append
use import list.Mem
use import list.Length
(** {2 Implementation parameters} *)
(** Balancing level is kept abstract. *)
constant balancing : int
axiom balancing_positive : balancing > 0
(** The Elements of the priority queue are indexed by totally ordered keys.
Moreover, this order can be effectively decided. *)
namespace D type t 'a end
......@@ -27,15 +27,15 @@ module PQueue
clone export key_type.ProgramKeyType with type t = D.t, type key = K.t
constant default_element : D.t 'a
clone preorder.Computable as CO with type t = K.t
(** {2 Instantiation of the AVL tree module} *)
clone sorted.Increasing as S with type K.t = D.t,
type K.key = K.t,
function K.key = key,
predicate O.rel = CO.le,
goal O.Trans
(** Use the minimum monoid to measure sequence of elements by their
minimum value. We extend it with a minimum element in order to measure
empty sequences. *)
......@@ -80,7 +80,7 @@ module PQueue
else y
end
end
end
(** Elements are measured by their keys. *)
namespace D
......@@ -100,18 +100,18 @@ module PQueue
ensures { result = measure d }
= Some (get_key d)
end
(** In priority queue, we are looking for the minimum element.
No extra information is required to perform such search. *)
type selector = unit
(** We can only select the minimum in a non-empty sequeuence. *)
predicate selection_possible 'e (l:list 'g) = l <> Nil
predicate lower_bound_strict (x:K.t) (l:list (D.t 'a)) =
(forall y. mem y l -> CO.lt x y.key)
(** We are interested in split where the middle element
is the minimum of the sequence. In order to make sure
that the same element is returned at each search, we enforce
......@@ -122,7 +122,7 @@ module PQueue
| Some d -> S.lower_bound d.key e.right /\
lower_bound_strict d.key e.left
end
(** The summary of a sequence is indeed its minimum element. *)
let rec lemma monoid_sum_is_min (l:list (D.t 'a)) : unit
ensures { let x = M.sum D.measure l in
......@@ -132,7 +132,7 @@ module PQueue
end }
variant { l }
= match l with Cons _ q -> monoid_sum_is_min q | _ -> () end
(** The middle element of a selected split is indeed the minimum. *)
let lemma selected_is_min (s:'d) (e:split (D.t 'a)) : unit
requires { selected s e }
......@@ -144,7 +144,7 @@ module PQueue
end
end }
= ()
let selected_part (ghost llis:list (D.t 'a))
(ghost rlis:list (D.t 'a))
(s:unit) (sl:M.t) (d:D.t 'a) (sr:M.t) : part_base unit
......@@ -173,7 +173,7 @@ module PQueue
then Left ()
else Right ()
end
(** Extract the first minimum element of a sequence. *)
function first_minimum_acc (acc:D.t 'a) (l:list (D.t 'a)) : D.t 'a =
match l with
......@@ -182,12 +182,12 @@ module PQueue
then first_minimum_acc acc q
else first_minimum_acc x q
end
function first_minimum (l:list (D.t 'a)) : D.t 'a = match l with
| Nil -> default_element
| Cons x q -> first_minimum_acc x q
end
(** the first_minimum function and the selected predicate both
describe the minimum element. *)
let rec lemma first_minimum_caracterisation (e:split (D.t 'a)) : unit
......@@ -217,7 +217,7 @@ module PQueue
end
| Cons _ q -> aux { e with left = q }
end
(** Full instantiation of the avl module. *)
clone avl.AVL as Sel with type selector = selector,
predicate selection_possible = selection_possible,
......@@ -239,62 +239,62 @@ module PQueue
goal M.sum_def_cons,
val M.zero = M.zero,
val M.op = M.op
(** {2 Adaptation of specification to priority queues} *)
type t 'a = Sel.t 'a
(** Model: a bag of data with a minimum element.
The point of the minimum is that we want the returned minimum element
to be always the same, modulo preorder equivalence is not enough. *)
type m 'a = {
bag : D.t 'a -> int;
minimum : D.t 'a;
card : int;
}
(** Convert a list to a bag. *)
constant empty_bag : 'a -> int = \x:'a. 0
constant empty_bag : 'a -> int = \_:'a. 0
function add_bag (x:'a) (f:'a -> int) : 'a -> int =
\y:'a. if y = x then f y + 1 else f y
function as_bag (l:list 'a) : 'a -> int = match l with
| Nil -> empty_bag
| Cons x q -> add_bag x (as_bag q)
end
(** A few lemmas about the bag representation of a list. *)
let rec lemma as_bag_append (l r:list 'a) : unit
ensures { forall x:'a. as_bag (l++r) x = as_bag l x + as_bag r x }
variant { l }
= match l with Nil -> () | Cons _ q -> as_bag_append q r end
let rec lemma as_bag_bounds (l:list 'a) : unit
ensures { forall x:'a. 0 <= as_bag l x <= length l }
variant { l }
= match l with Nil -> () | Cons _ q -> as_bag_bounds q end
let rec lemma as_bag_membership (d:'a) (l:list 'a) : unit
ensures { as_bag l d > 0 <-> mem d l }
variant { l }
= match l with Nil -> () | Cons _ q -> as_bag_membership d q end
(** Convert the avl tree to logical model. *)
function m (t:t 'a) : m 'a =
{ bag = as_bag t.Sel.m.Sel.lis;
card = length t.Sel.m.Sel.lis;
minimum = first_minimum t.Sel.m.Sel.lis }
let ghost m (t:t 'a) : m 'a
ensures { result = t.m }
= { bag = as_bag t.Sel.m.Sel.lis;
card = length t.Sel.m.Sel.lis;
minimum = first_minimum t.Sel.m.Sel.lis }
(** Invariant *)
predicate c (t:t 'a) = Sel.c t
(** Invariant over the logical model. *)
let lemma correction (t:t 'a) : unit
requires { c t }
......@@ -304,20 +304,20 @@ module PQueue
= if t.m.card > 0
then let r0 = Sel.default_split () in
let _ = Sel.split r0 () t in ()
(** Create an empty priority queue. *)
let empty () : t 'a
ensures { forall d:D.t 'a. result.m.bag d = 0 }
ensures { result.m.card = 0 /\ c result }
= Sel.empty ()
(** Create a one-element priority queue. *)
let singleton (d:D.t 'a) : t 'a
ensures { result.m.bag d = 1 /\
forall d2:D.t 'a. d2 <> d -> result.m.bag d2 = 0 }
ensures { result.m.card = 1 /\ c result }
= Sel.singleton d
(** Test emptyness of a priority queue. *)
let is_empty (ghost rd:ref (D.t 'a)) (t:t 'a) : bool
requires { c t }
......@@ -331,21 +331,21 @@ module PQueue
| Cons d _ -> rd := d
end;
res
(** Merge two priority queues. *)
let merge (l r:t 'a) : t 'a
requires { c l /\ c r }
ensures { forall d. result.m.bag d = l.m.bag d + r.m.bag d }
ensures { result.m.card = l.m.card + r.m.card /\ c result }
= Sel.concat l r
(** Additional lemma about bag created from a list
(removal in the middle). *)
let lemma remove_count (l:list 'a) (d:'a) (r:list 'a) : unit
ensures { as_bag (l ++ Cons d r) d = as_bag (l++r) d + 1 }
ensures { forall e. e <> d -> as_bag (l++Cons d r) e = as_bag (l++r) e }
= ()
(** Get and remove minimum element. *)
let extract_min (t:t 'a) : option (D.t 'a,t 'a)
requires { c t }
......@@ -360,7 +360,7 @@ module PQueue
| None -> absurd
| Some d -> Some (d,e)
end
(** Get minimum element. *)
let min (t:t 'a) : D.t 'a
requires { t.m.card >= 1 /\ c t }
......@@ -369,7 +369,7 @@ module PQueue
| None -> absurd
| Some d -> d
end
(** Pop minimum element. *)
let pop_min (t:t 'a) : t 'a
requires { t.m.card >= 1 /\ c t }
......@@ -380,13 +380,13 @@ module PQueue
let res = Sel.remove r0 () t in
assert { match !r0.middle with None -> false | Some _ -> true end };
res
let add (d:D.t 'a) (t:t 'a) : t 'a
requires { c t }
ensures { result.m.bag d = t.m.bag d + 1 /\
(forall d2. d2 <> d -> result.m.bag d2 = t.m.bag d2) }
ensures { result.m.card = t.m.card + 1 /\ c result }
= Sel.cons d t
end
......@@ -4,21 +4,21 @@
Author: Martin Clochard *)
module RAL
(** {2 Instantiation of the AVL tree module} *)
use import int.Int
use import list.List
use import list.NthLengthAppend
use import option.Option
use import avl.SelectionTypes
use import ref.Ref
(** Remaining parameters. A fully concrete implementation would
have to provide an explicit positive integer. *)
constant balancing : int
axiom balancing_positive : balancing > 0
(** Use the integer monoid in order to measure sequence of elements
by their length. *)
namespace M
......@@ -35,7 +35,7 @@ module RAL
let zero () : int ensures { result = 0 } = 0
let op (x y:int) : int ensures { result = x + y } = x + y
end
(** The stored elements are measured by 1. *)
namespace D
type t 'a = 'a
......@@ -53,28 +53,28 @@ module RAL
axiom measure_def : forall x:'b. measure x = 1
let measure (x:'a) : int ensures { result = 1 } = 1
end
(** The monoidal summary of a list is indeed its length. *)
let rec lemma sum_measure_is_length (l:list 'a) : unit
ensures { M.sum D.measure l = length l }
variant { l }
= match l with Cons _ q -> sum_measure_is_length q | _ -> () end
(** Select either an element or the hole before him: the n-th hole is
the position between (n-1)-th element (if any)
and n-th element (if any). *)
type selector = { index : int; hole : bool }
(** Selection is possible iff the index is between the list bounds. *)
predicate selection_possible (s:selector) (l:list 'a) =
0 <= s.index && (if s.hole then s.index <= length l else s.index < length l)
(** Selection predicate: We are exactly at the [index]-th position of the
rebuild list, and there is an element in the middle iff we are
not trying to select a hole. *)
predicate selected (s:selector) (e:split 'a) =
s.index = length e.left /\ (s.hole <-> e.middle = None)
(** Reduction of positional search using the size information. *)
let selected_part (ghost llis:list 'a) (ghost rlis:list 'a)
(s:selector) (sl:int) (d:'a) (sr:int) : part_base selector
......@@ -97,7 +97,7 @@ module RAL
else if s.hole
then Left s
else Here
(** Full instantiation of the AVL module. *)
clone avl.AVL as Sel with type selector = selector,
predicate selection_possible = selection_possible,
......@@ -119,85 +119,85 @@ module RAL
goal M.sum_def_cons,
val M.zero = M.zero,
val M.op = M.op
(** {2 Adaptation of specification to random-access lists}
A priori, the specification expected for random-access lists
is different from the one obtained from the raw instance. *)
(** Adapt the logical model to random-access lists, i.e strip the height
from the accessible information. *)
type t 'a = Sel.t 'a
type m 'a = list 'a
predicate c (r:t 'a) = Sel.c r
function m (r:t 'a) : m 'a = r.Sel.m.Sel.lis
(** Create an empty random-access list. *)
let empty () : t 'a
ensures { result.m = Nil /\ c result }
= Sel.empty ()
(** Create a list with a single element. *)
let singleton (d:'a) : t 'a
ensures { result.m = Cons d Nil /\ c result }
= Sel.singleton d
(** Emptyness test. *)
let is_empty (r:t 'a) : bool
requires { c r }
ensures { result <-> match r.m with Nil -> true | _ -> false end }
= Sel.is_empty r
(** Pattern-matching over the list front. *)
let decompose_front (r:t 'a) : option ('a,t 'a)
requires { c r }
returns { None -> r.m = Nil
| Some (hd,tl) -> r.m = Cons hd tl.m /\ c tl }
= Sel.decompose_front r
(** Pattern-matching over the list back. *)
let decompose_back (r:t 'a) : option (t 'a,'a)
requires { c r }
returns { None -> r.m = Nil
| Some (cotl,cohd) -> r.m = cotl.m ++ Cons cohd Nil /\ c cotl }
= Sel.decompose_back r
(** Get the first element of a non-empty list. *)
let front (ghost li:ref (list 'a)) (r:t 'a) : 'a
requires { r.m <> Nil /\ c r }
ensures { Cons result !li = r.m }
= Sel.front li r
(** Get the last element of a non-empty list. *)
let back (ghost li:ref (list 'a)) (r:t 'a) : 'a
requires { r.m <> Nil /\ c r }
ensures { !li ++ Cons result Nil = r.m }
= Sel.back li r
(** Add an element at the list front. *)
let cons (d:'a) (r:t 'a) : t 'a
requires { c r }
ensures { result.m = Cons d r.m /\ c result }
= Sel.cons d r