Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
9d1ea986
Commit
9d1ea986
authored
Apr 01, 2014
by
Jean-Christophe Filliâtre
Browse files
completed proof of OCaml's mergesort
parent
2d72ce3d
Changes
2
Expand all
Hide whitespace changes
Inline
Side-by-side
examples/mergesort_list.mlw
View file @
9d1ea986
(** Sorting
a
list
of integer
s using mergesort
(**
{1
Sorting lists using mergesort
}
Author: Jean-Christophe Filliâtre (CNRS)
*)
...
...
@@ -113,6 +113,19 @@ end
(** {2 OCaml's List.sort}
There are several ideas here:
- instead of splitting the list in two, sort takes the length of
the prefix to be sorted; hence there is nothing to do to get the
first half and the second half is obtained with chop (which does
not allocate at all)
- all functions are tail recursive. To avoid the extra cost of
List.rev, sort is duplicated in two versions that respectively
sort in order and in reverse order ([sort] and [sort_rev]) and
merge is duplicated as well ([rev_merge] and [rev_merge_rev]).
Note: this is a stable sort, but stability is not proved here.
*)
module OCamlMergesort
...
...
@@ -176,6 +189,18 @@ module OCamlMergesort
forall n: int, x: 'a, l: list 'a. n > 0 ->
prefix n (Cons x l) = Cons x (prefix (n-1) l)
let rec lemma prefix_length (n: int) (l: list 'a)
requires { 0 <= n <= length l } ensures { length (prefix n l) = n }
variant { n } =
if n > 0 then match l with Nil -> () | Cons _ r -> prefix_length (n-1) r end
let rec lemma prefix_append (n: int) (l1 l2: list 'a)
requires { length l1 <= n <= length l1 + length l2 }
ensures { prefix n (l1 ++ l2) =
prefix (length l1) l1 ++ prefix (n - length l1) l2 }
variant { l1 }
= match l1 with Nil -> () | Cons _ t -> prefix_append (n-1) t l2 end
let rec chop (n: int) (l: list 'a) : list 'a
requires { 0 <= n <= length l }
ensures { l = prefix n l ++ result }
...
...
@@ -187,10 +212,73 @@ module OCamlMergesort
| Nil -> absurd
end
val sort (n: int) (l: list elt) : list elt
(** [sort n l] sorts [prefix n l]
and [rev_sort n l] sorts [prefix n l] in reverse order. *)
use import mach.int.Int
let rec sort (n: int) (l: list elt) : list elt
requires { 2 <= n <= length l }
ensures { sorted result }
ensures { permut result (prefix n l) }
variant { n }
=
if n = 2 then match l with
| Cons x1 (Cons x2 _) ->
if le x1 x2 then Cons x1 (Cons x2 Nil) else Cons x2 (Cons x1 Nil)
| _ -> absurd
end else if n = 3 then match l with
| Cons x1 (Cons x2 (Cons x3 _)) ->
if le x1 x2 then
if le x2 x3 then Cons x1 (Cons x2 (Cons x3 Nil))
else if le x1 x3 then Cons x1 (Cons x3 (Cons x2 Nil))
else Cons x3 (Cons x1 (Cons x2 Nil))
else
if le x1 x3 then Cons x2 (Cons x1 (Cons x3 Nil))
else if le x2 x3 then Cons x2 (Cons x3 (Cons x1 Nil))
else Cons x3 (Cons x2 (Cons x1 Nil))
| _ -> absurd
end else begin
let n1 = n / 2 in
let n2 = n - n1 in
let l2 = chop n1 l in
assert { prefix n1 l ++ prefix n2 l2 = prefix n l };
let s1 = rev_sort n1 l in
let s2 = rev_sort n2 l2 in
rev_merge_rev s1 s2 Nil
end
with rev_sort (n: int) (l: list elt) : list elt
requires { 2 <= n <= length l }
ensures { sorted (reverse result) }
ensures { permut result (prefix n l) }
variant { n }
=
if n = 2 then match l with
| Cons x1 (Cons x2 _) ->
if not (le x1 x2) then Cons x1 (Cons x2 Nil)
else Cons x2 (Cons x1 Nil)
| _ -> absurd
end else if n = 3 then match l with
| Cons x1 (Cons x2 (Cons x3 _)) ->
if not (le x1 x2) then
if not (le x2 x3) then Cons x1 (Cons x2 (Cons x3 Nil))
else if not (le x1 x3) then Cons x1 (Cons x3 (Cons x2 Nil))
else Cons x3 (Cons x1 (Cons x2 Nil))
else
if not (le x1 x3) then Cons x2 (Cons x1 (Cons x3 Nil))
else if not (le x2 x3) then Cons x2 (Cons x3 (Cons x1 Nil))
else Cons x3 (Cons x2 (Cons x1 Nil))
| _ -> absurd
end else begin
let n1 = n / 2 in
let n2 = n - n1 in
let l2 = chop n1 l in
assert { prefix n1 l ++ prefix n2 l2 = prefix n l };
let s1 = sort n1 l in
let s2 = sort n2 l2 in
rev_merge s1 s2 Nil
end
lemma permut_prefix: forall l: list elt. permut (prefix (length l) l) l
...
...
examples/mergesort_list/why3session.xml
View file @
9d1ea986
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment