```
(** This file is a copy-paste from Caml's list library,
with the exception of functions iter and iter2
(specialization of fold_left and fold_left2 which have
no interest in a purely functional language),
and functions memq, mem_assq, assq, remove_assq
which are defined in terms of physical equality
(whose behaviour is not defined in a theoretical
semantics of purely functional language).
Moreover, the definition of function append is taken
from module Pervasive. *)
let rec length_aux len = function
[] -> len
| a::l -> length_aux (len + 1) l
let length l = length_aux 0 l
let hd = function
[] -> failwith "hd"
| a::l -> a
let tl = function
[] -> failwith "tl"
| a::l -> l
let nth l n =
if n < 0 then invalid_arg "List.nth" else
let rec nth_aux l n =
match l with
| [] -> failwith "nth"
| a::l -> if n = 0 then a else nth_aux l (n-1)
in nth_aux l n
let rec append l1 l2 =
match l1 with
[] -> l2
| a :: l -> a :: (append l l2)
let rec rev_append l1 l2 =
match l1 with
[] -> l2
| a :: l -> rev_append l (a :: l2)
let rev l = rev_append l []
let rec flatten = function
[] -> []
| l::r -> l @ flatten r
let concat = flatten
let rec map f = function
[] -> []
| a::l -> let r = f a in r :: map f l
let rev_map f l =
let rec rmap_f accu = function
| [] -> accu
| a::l -> rmap_f (f a :: accu) l
in
rmap_f [] l
let rec fold_left f accu l =
match l with
[] -> accu
| a::l -> fold_left f (f accu a) l
let rec fold_right f l accu =
match l with
[] -> accu
| a::l -> f a (fold_right f l accu)
let rec map2 f l1 l2 =
match (l1, l2) with
([], []) -> []
| (a1::l1, a2::l2) -> let r = f a1 a2 in r :: map2 f l1 l2
| (_, _) -> invalid_arg "List.map2"
let rev_map2 f l1 l2 =
let rec rmap2_f accu l1 l2 =
match (l1, l2) with
| ([], []) -> accu
| (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2
| (_, _) -> invalid_arg "List.rev_map2"
in
rmap2_f [] l1 l2
let rec fold_left2 f accu l1 l2 =
match (l1, l2) with
([], []) -> accu
| (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2) l1 l2
| (_, _) -> invalid_arg "List.fold_left2"
let rec fold_right2 f l1 l2 accu =
match (l1, l2) with
([], []) -> accu
| (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu)
| (_, _) -> invalid_arg "List.fold_right2"
let rec for_all p = function
[] -> true
| a::l -> p a && for_all p l
let rec exists_ p = function
[] -> false
| a::l -> p a || exists_ p l
let rec for_all2 p l1 l2 =
match (l1, l2) with
([], []) -> true
| (a1::l1, a2::l2) -> p a1 a2 && for_all2 p l1 l2
| (_, _) -> invalid_arg "List.for_all2"
let rec exists2_ p l1 l2 =
match (l1, l2) with
([], []) -> false
| (a1::l1, a2::l2) -> p a1 a2 || exists2_ p l1 l2
| (_, _) -> invalid_arg "List.exists2"
let rec mem x = function
[] -> false
| a::l -> compare a x = 0 || mem x l
let rec assoc x = function
[] -> raise Not_found
| (a,b)::l -> if compare a x = 0 then b else assoc x l
let rec mem_assoc x = function
| [] -> false
| (a, b) :: l -> compare a x = 0 || mem_assoc x l
let rec remove_assoc x = function
| [] -> []
| (a, b as pair) :: l ->
if compare a x = 0 then l else pair :: remove_assoc x l
let rec find p = function
| [] -> raise Not_found
| x :: l -> if p x then x else find p l
let find_all p =
let rec my_find accu = function
| [] -> rev accu
| x :: l -> if p x then my_find (x :: accu) l else my_find accu l in
my_find []
let filter = find_all
let partition p l =
let rec part yes no = function
| [] -> (rev yes, rev no)
| x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in
part [] [] l
let rec split = function
[] -> ([], [])
| (x,y)::l ->
let (rx, ry) = split l in (x::rx, y::ry)
let rec combine l1 l2 =
match (l1, l2) with
([], []) -> []
| (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2
| (_, _) -> invalid_arg "List.combine"
let rec merge cmp l1 l2 =
match l1, l2 with
| [], l2 -> l2
| l1, [] -> l1
| h1 :: t1, h2 :: t2 ->
if cmp h1 h2 <= 0
then h1 :: merge cmp t1 l2
else h2 :: merge cmp l1 t2
let rec chop k l =
if k = 0 then l else begin
match l with
| x::t -> chop (k-1) t
| _ -> assert false
end
let merge_sort cmp l =
let rec rev_merge l1 l2 accu =
match l1, l2 with
| [], l2 -> rev_append l2 accu
| l1, [] -> rev_append l1 accu
| h1::t1, h2::t2 ->
if cmp h1 h2 <= 0
then rev_merge t1 l2 (h1::accu)
else rev_merge l1 t2 (h2::accu)
in
let rec rev_merge_rev l1 l2 accu =
match l1, l2 with
| [], l2 -> rev_append l2 accu
| l1, [] -> rev_append l1 accu
| h1::t1, h2::t2 ->
if cmp h1 h2 > 0
then rev_merge_rev t1 l2 (h1::accu)
else rev_merge_rev l1 t2 (h2::accu)
in
let rec sort n l =
match n, l with
| 2, x1 :: x2 :: _ ->
if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1]
| 3, x1 :: x2 :: x3 :: _ ->
if cmp x1 x2 <= 0 then begin
if cmp x2 x3 <= 0 then [x1; x2; x3]
else if cmp x1 x3 <= 0 then [x1; x3; x2]
else [x3; x1; x2]
end else begin
if cmp x1 x3 <= 0 then [x2; x1; x3]
else if cmp x2 x3 <= 0 then [x2; x3; x1]
else [x3; x2; x1]
end
| n, l ->
let n1 = n asr 1 in
let n2 = n - n1 in
let l2 = chop n1 l in
let s1 = rev_sort n1 l in
let s2 = rev_sort n2 l2 in
rev_merge_rev s1 s2 []
and rev_sort n l =
match n, l with
| 2, x1 :: x2 :: _ ->
if cmp x1 x2 > 0 then [x1; x2] else [x2; x1]
| 3, x1 :: x2 :: x3 :: _ ->
if cmp x1 x2 > 0 then begin
if cmp x2 x3 > 0 then [x1; x2; x3]
else if cmp x1 x3 > 0 then [x1; x3; x2]
else [x3; x1; x2]
end else begin
if cmp x1 x3 > 0 then [x2; x1; x3]
else if cmp x2 x3 > 0 then [x2; x3; x1]
else [x3; x2; x1]
end
| n, l ->
let n1 = n asr 1 in
let n2 = n - n1 in
let l2 = chop n1 l in
let s1 = sort n1 l in
let s2 = sort n2 l2 in
rev_merge s1 s2 []
in
let len = length l in
if len < 2 then l else sort len l
```