Commit 20204945 by MARCHE Claude

List, Option, BinTree : test for emptiness in programs

parent 71f138c5
 ... ... @@ -50,12 +50,9 @@ module BraunHeaps requires { heap t && 0 < size t } ensures { is_minimum (minimum t) t } variant { t } = match t with | Empty -> absurd | Node l _ r -> if not is_empty l then root_is_min l; if not is_empty r then root_is_min r end = let Node l _ r = t in if not is_empty l then root_is_min l; if not is_empty r then root_is_min r predicate inv (t: tree elt) = match t with | Empty -> true ... ...
 ... ... @@ -2,14 +2,14 @@ ... ...
No preview for this file type
 ... ... @@ -13,10 +13,6 @@ module M [0 <= y2 <= x2]. The seven other cases can be easily deduced by symmetry. *) constant x2: int constant y2: int axiom first_octant: 0 <= y2 <= x2 (* [best x y] expresses that the point [(x,y)] is the best possible point i.e. the closest to the real line i.e. for all y', we have |y - x*y2/x2| <= |y' - x*y2/x2| ... ... @@ -24,7 +20,7 @@ module M use import int.Abs predicate best (x y: int) = predicate best (x2 y2 x y: int) = forall y': int. abs (x2 * y - x * y2) <= abs (x2 * y' - x * y2) (** Key lemma for Bresenham's proof: if [b] is at distance less or equal ... ... @@ -36,15 +32,16 @@ module M abs (2 * a * b - 2 * c) <= a -> forall b': int. abs (a * b - c) <= abs (a * b' - c) let bresenham () = let y = ref 0 in let bresenham (x2 y2:int) requires { 0 <= y2 <= x2 } = let y = ref 0 in let e = ref (2 * y2 - x2) in for x = 0 to x2 do invariant { !e = 2 * (x + 1) * y2 - (2 * !y + 1) * x2 } invariant { 2 * (y2 - x2) <= !e <= 2 * y2 } (* here we would plot (x, y), so we assert this is the best possible row y for column x *) assert { best x !y }; assert { best x2 y2 x !y }; if !e < 0 then e := !e + 2 * y2 else begin ... ...
 ... ... @@ -2,44 +2,36 @@ ... ...
No preview for this file type
 ... ... @@ -13,20 +13,20 @@ module BubbleSort let bubble_sort (a: array int) ensures { permut_all (old a) a } ensures { permut_all (old a) a } ensures { sorted a } = 'Init: = label Init in for i = length a - 1 downto 1 do invariant { permut_all (at a 'Init) a } invariant { permut_all (a at Init) a } invariant { sorted_sub a i (length a) } invariant { forall k1 k2: int. 0 <= k1 <= i < k2 < length a -> a[k1] <= a[k2] invariant { forall k1 k2: int. 0 <= k1 <= i < k2 < length a -> a[k1] <= a[k2] } for j = 0 to i - 1 do invariant { permut_all (at a 'Init) a } invariant { permut_all (a at Init) a } invariant { sorted_sub a i (length a) } invariant { forall k1 k2: int. 0 <= k1 <= i < k2 < length a -> a[k1] <= a[k2] invariant { forall k1 k2: int. 0 <= k1 <= i < k2 < length a -> a[k1] <= a[k2] } invariant { forall k. 0 <= k <= j -> a[k] <= a[j] } if a[j] > a[j+1] then swap a j (j+1); ... ... @@ -35,7 +35,7 @@ module BubbleSort let test1 () = let a = make 3 0 in a[0] <- 7; a[1] <- 3; a[2] <- 1; a[0] <- 7; a[1] <- 3; a[2] <- 1; bubble_sort a; a ... ...
This diff is collapsed.
No preview for this file type
 ... ... @@ -20,10 +20,10 @@ module CoincidenceCount use import set.FsetComprehension function setof (a: array 'a) : set 'a = map (get a) (interval 0 (length a)) map (fun x -> a[x]) (interval 0 (length a)) function drop (a: array 'a) (n: int) : set 'a = map (get a) (interval n (length a)) map (fun x -> a[x]) (interval n (length a)) lemma drop_left: forall a: array 'a, n: int. 0 <= n < length a -> ... ...
 ... ... @@ -2,94 +2,104 @@ ... ...
No preview for this file type
 ... ... @@ -74,7 +74,7 @@ module Conjugate invariant { 0 <= !partc < a.length } invariant { forall j: int. a[!partc] <= j < b.length -> numofgt a b[j] j } variant { a.length - !partc } 'L: label L in let ghost start = !partc in let edge = a[!partc] in incr partc; ... ... @@ -85,7 +85,7 @@ module Conjugate incr partc done; for i = a[!partc] to edge - 1 do invariant { forall j: int. edge <= j < b.length -> b[j] = (at b 'L)[j] } invariant { forall j: int. edge <= j < b.length -> b[j] = (b at L)[j] } invariant { forall j: int. a[!partc] <= j < i -> b[j] = !partc } b[i] <- !partc done ... ...
 ... ... @@ -2,101 +2,19 @@ ... ...
No preview for this file type
 ... ... @@ -23,8 +23,8 @@ module Spec use export array.IntArraySorted (* values of the array are in the range 0..k-1 *) constant k: int axiom k_positive: 0 < k val constant k: int ensures { 0 < result } predicate k_values (a: array int) = forall i: int. 0 <= i < length a -> 0 <= a[i] < k ... ... @@ -33,10 +33,10 @@ module Spec - [numeq a v l u] is the number of values in a[l..u[ equal to v - [numlt a v l u] is the number of values in a[l..u[ less than v *) function numeq (a: array int) (v i j : int) : int = N.numof (\ k. a[k] = v) i j N.numof (fun k -> a[k] = v) i j function numlt (a: array int) (v i j : int) : int = N.numof (\ k. a[k] < v) i j N.numof (fun k -> a[k] < v) i j (* an ovious lemma relates numeq and numlt *) let rec lemma eqlt (a: array int) (v: int) (l u: int) ... ... @@ -64,7 +64,7 @@ module CountingSort let counting_sort (a: array int) (b: array int) requires { k_values a /\ length a = length b } ensures { sorted b /\ permut a b } = let c = make k 0 in = let c = Array.make k 0 in for i = 0 to length a - 1 do invariant { forall v: int. 0 <= v < k -> c[v] = numeq a v 0 i } let v = a[i] in ... ... @@ -101,8 +101,7 @@ module InPlaceCountingSort let in_place_counting_sort (a: array int) requires { k_values a } ensures { sorted a /\ permut (old a) a } = 'L: let c = make k 0 in = let c = make k 0 in for i = 0 to length a - 1 do invariant { forall v: int. 0 <= v < k -> c[v] = numeq a v 0 i } let v = a[i] in ... ... @@ -110,17 +109,17 @@ module InPlaceCountingSort done; let j = ref 0 in for v = 0 to k-1 do invariant { !j = numlt (at a 'L) v 0 (length a) } invariant { !j = numlt (old a) v 0 (length a) } invariant { sorted_sub a 0 !j } invariant { forall e: int. 0 <= e < !j -> 0 <= a[e] < v } invariant { forall f: int. 0 <= f < v -> numeq a f 0 !j = numeq (at a 'L) f 0 (length a) } 0 <= f < v -> numeq a f 0 !j = numeq (old a) f 0 (length a) } for i = 1 to c[v] do invariant { !j -i+1 = numlt (at a 'L) v 0 (length a) } invariant { !j -i+1 = numlt (old a) v 0 (length a) } invariant { sorted_sub a 0 !j } invariant { forall e: int. 0 <= e < !j -> 0 <= a[e] <= v } invariant { forall f: int. 0 <= f < v -> numeq a f 0 !j = numeq (at a 'L) f 0 (length a) } 0 <= f < v -> numeq a f 0 !j = numeq (old a) f 0 (length a) } invariant { numeq a v 0 !j = i-1 } a[!j] <- v; incr j; ... ...
This diff is collapsed.
No preview for this file type
 ... ... @@ -60,14 +60,13 @@ module TestCursor let sum (t: t) (c: cursor) : int requires { coherent t c } requires { c.i = 0 } ensures { result = sum 0 (length c.seq) (get c.seq) } ensures { result = sum (get c.seq) 0 (length c.seq) } = let s = ref 0 in 'I: while has_next t c do invariant { coherent t c } invariant { 0 <= c.i <= length c.seq } invariant { !s = sum 0 c.i (get c.seq) } invariant { !s = sum (get c.seq) 0 c.i } variant { length c.seq - c.i } let x = next t c in s += x ... ... @@ -107,7 +106,7 @@ module IntListCursor (* : IterableList *) requires { coherent t c } ensures { result <-> c.to_do <> Nil } = c.to_do <> Nil not is_nil c.to_do let next (t: t) (c: cursor) : elt requires { c.to_do <> Nil } ... ...
This diff is collapsed.
No preview for this file type
 ... ... @@ -5,8 +5,9 @@ theory Tree type tree 'a = Empty | Node (tree 'a) 'a (tree 'a) let function is_empty (t:tree 'a) : bool = match t with Empty -> true | Node _ _ _ -> false end let predicate is_empty (t:tree 'a) ensures { result <-> t = Empty } = match t with Empty -> true | Node _ _ _ -> false end end ... ... @@ -51,10 +52,8 @@ theory Height "height of a tree" use import int.MinMax let rec function height (t: tree 'a) : int = match t with | Empty -> 0 | Node l _ r -> 1 + max (height l) (height r) | Empty -> 0 | Node l _ r -> 1 + max (height l) (height r) end lemma height_nonneg: ... ... @@ -68,7 +67,7 @@ theory Inorder "inorder traversal" use import list.List use import list.Append function inorder (t: tree 'a) : list 'a = match t with let rec function inorder (t: tree 'a) : list 'a = match t with | Empty -> Nil | Node l x r -> inorder l ++ Cons x (inorder r) end ... ... @@ -81,7 +80,7 @@ theory Preorder "preorder traversal" use import list.List use import list.Append function preorder (t: tree 'a) : list 'a = match t with let rec function preorder (t: tree 'a) : list 'a = match t with | Empty -> Nil | Node l x r -> Cons x (preorder l ++ preorder r) end ... ... @@ -109,31 +108,32 @@ theory Zipper "Huet's zipper" | Left (zipper 'a) 'a (tree 'a) | Right (tree 'a) 'a (zipper 'a) function zip (t: tree 'a) (z: zipper 'a) : tree 'a = match z with let rec function zip (t: tree 'a) (z: zipper 'a) : tree 'a = match z with | Top -> t | Left z x r -> zip (Node t x r) z | Right l x z -> zip (Node l x t) z end end (* navigating in a tree using a zipper *) type pointed 'a = (tree 'a, zipper 'a) function start (t: tree 'a) : pointed 'a = (t, Top) let function start (t: tree 'a) : pointed 'a = (t, Top) function up (p: pointed 'a) : pointed 'a = match p with let function up (p: pointed 'a) : pointed 'a = match p with | _, Top -> p (* do nothing *) | l, Left z x r | r, Right l x z -> (Node l x r, z) end function top (p: pointed 'a) : tree 'a = let t, z = p in zip t z let function top (p: pointed 'a) : tree 'a = let t, z = p in zip t z function down_left (p: pointed 'a) : pointed 'a = match p with let function down_left (p: pointed 'a) : pointed 'a = match p with | Empty, _ -> p (* do nothing *) | Node l x r, z -> (l, Left z x r) end function down_right (p: pointed 'a) : pointed 'a = match p with let function down_right (p: pointed 'a) : pointed 'a = match p with | Empty, _ -> p (* do nothing *) | Node l x r, z -> (r, Right l x z) end ... ...
 ... ... @@ -7,6 +7,11 @@ theory List type list 'a = Nil | Cons 'a (list 'a) let predicate is_nil (l:list 'a) ensures { result <-> l = Nil } = match l with Nil -> true | Cons _ _ -> false end end (** {2 Length of a list} *) ... ...
 ... ... @@ -4,4 +4,9 @@ theory Option type option 'a = None | Some 'a let predicate is_none (o: option 'a) ensures { result <-> o = None } = match o with None -> true | Some _ -> false end end