xref: /dports/lang/ocaml/ocaml-4.05.0/testsuite/tests/misc/sorts.ml

(* Test bench for sorting algorithms. *)


(*
  ocamlopt -noassert sorts.ml -cclib -lunix
*)

open Printf;;

(*
  Criteria:
  0. stack overhead: at most log n.
  1. stable or not.
  2. space overhead.
  3. speed.
*)

(************************************************************************)
(* auxiliary functions *)

let rec exp2 n = if n <= 0 then 1 else 2 * exp2 (n-1);;
let id x = x;;
let postl x y = Array.of_list y;;
let posta x y = x;;

let mkconst n = Array.make n 0;;
let chkconst _ n a = (a = mkconst n);;

let mksorted n =
  let a = Array.make n 0 in
  for i = 0 to n - 1 do
    a.(i) <- i;
  done;
  a
;;
let chksorted _ n a = (a = mksorted n);;

let mkrev n =
  let a = Array.make n 0 in
  for i = 0 to n - 1 do
    a.(i) <- n - 1 - i;
  done;
  a
;;
let chkrev _ n a = (a = mksorted n);;

let seed = ref 0;;
let random_reinit () = Random.init !seed;;

let random_get_state () =
  let a = Array.make 55 0 in
  for i = 0 to 54 do a.(i) <- Random.bits (); done;
  Random.full_init a;
  a
;;
let random_set_state a = Random.full_init a;;

let chkgen mke cmp rstate n a =
  let marks = Array.make n (-1) in
  let skipmarks l =
    if marks.(l) = -1 then l else begin
      let m = ref marks.(l) in
      while marks.(!m) <> -1 do incr m; done;
      marks.(l) <- !m;
      !m
    end
  in
  let linear e l =
    let l = skipmarks l in
    let rec loop l =
      if cmp a.(l) e > 0 then raise Exit
      else if e = a.(l) then marks.(l) <- l+1
      else loop (l+1)
    in loop l
  in
  let rec dicho e l r =
    if l = r then linear e l
    else begin
      assert (l < r);
      let m = (l + r) / 2 in
      if cmp a.(m) e >= 0 then dicho e l m else dicho e (m + 1) r
    end
  in
  try
    for i = 0 to n-2 do if cmp a.(i) a.(i+1) > 0 then raise Exit; done;
    random_set_state rstate;
    for i = 0 to n-1 do dicho (mke i) 0 (Array.length a - 1); done;
    true
  with Exit | Invalid_argument _ -> false;
;;

let mkrand_dup n =
  let a = Array.make n 0 in
  for i = 0 to (n-1) do a.(i) <- Random.int n; done;
  a
;;

let chkrand_dup rstate n a =
  chkgen (fun i -> Random.int n) compare rstate n a
;;

let mkrand_nodup n =
  let a = Array.make n 0 in
  for i = 0 to (n-1) do a.(i) <- Random.bits (); done;
  a
;;

let chkrand_nodup rstate n a =
  chkgen (fun i -> Random.bits ()) compare rstate n a
;;

let mkfloats n =
  let a = Array.make n 0.0 in
  for i = 0 to (n-1) do a.(i) <- Random.float 1.0; done;
  a
;;

let chkfloats rstate n a =
  chkgen (fun i -> Random.float 1.0) compare rstate n a
;;

type record = {
  s1 : bytes;
  s2 : bytes;
  i1 : int;
  i2 : int;
};;

let rand_string () =
  let len = Random.int 10 in
  let s = String.create len in
  for i = 0 to len-1 do
    s.[i] <- Char.chr (Random.int 256);
  done;
  s
;;

let mkrec1 b i = {
  s1 = rand_string ();
  s2 = rand_string ();
  i1 = Random.int b;
  i2 = i;
};;

let mkrecs b n = Array.init n (mkrec1 b);;

let mkrec1_rev b i = {
  s1 = rand_string ();
  s2 = rand_string ();
  i1 = - i;
  i2 = i;
};;

let mkrecs_rev n = Array.init n (mkrec1_rev 0);;

let cmpstr r1 r2 =
  let c1 = compare r1.s1 r2.s1 in
  if c1 = 0 then compare r1.s2 r2.s2 else c1
;;
let lestr r1 r2 =
  let c1 = compare r1.s1 r2.s1 in
  if c1 = 0 then r1.s2 <= r2.s2 else (c1 < 0)
;;
let chkstr b rstate n a = chkgen (mkrec1 b) cmpstr rstate n a;;

let cmpint r1 r2 = compare r1.i1 r2.i1;;
let leint r1 r2 = r1.i1 <= r2.i1;;
let chkint b rstate n a = chkgen (mkrec1 b) cmpint rstate n a;;

let cmplex r1 r2 =
  let c1 = compare r1.i1 r2.i1 in
  if c1 = 0 then compare r1.i2 r2.i2 else c1
;;
let lelex r1 r2 =
  let c1 = compare r1.i1 r2.i1 in
  if c1 = 0 then r1.i2 <= r2.i2 else (c1 < 0)
;;
let chklex b rstate n a = chkgen (mkrec1 b) cmplex rstate n a;;

(************************************************************************)

let lens = [
  0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 28;
  100; 127; 128; 129; 193; 506;
  1000; 1025; 1535; 2323;
];;

type ('a, 'b, 'c, 'd) aux = {
  prepf : ('a -> 'a -> int) -> ('a -> 'a -> bool) -> 'b;
  prepd : 'a array -> 'c;
  postd : 'a array -> 'd -> 'a array;
};;

let ll = { prepf = (fun x y -> y); prepd = Array.to_list; postd = postl };;
let lc = { prepf = (fun x y -> x); prepd = Array.to_list; postd = postl };;
let al = { prepf = (fun x y -> y); prepd = id; postd = posta };;
let ac = { prepf = (fun x y -> x); prepd = id; postd = posta };;

type 'a outcome = Value of 'a | Exception of exn;;

let numfailed = ref 0;;

let test1 name f prepdata postdata cmp desc mk chk =
  random_reinit ();
  printf "  %s with %s" name desc;
  let i = ref 0 in
  List.iter (fun n ->
      if !i = 0 then printf "\n    "; incr i; if !i > 11 then i := 0;
      printf "%5d" n; flush stdout;
      let rstate = random_get_state () in
      let a = mk n in
      let input = prepdata a in
      let output = try Value (f cmp input) with e -> Exception e in
      printf "."; flush stdout;
      begin match output with
      | Value v ->
         if not (chk rstate n (postdata a v))
         then (incr numfailed; printf "\n*** FAIL\n")
      | Exception e ->
         incr numfailed; printf "\n*** %s\n" (Printexc.to_string e)
      end;
      flush stdout;
    ) lens;
  printf "\n";
;;

let test name stable f1 f2 aux1 aux2 =
  printf "Testing %s...\n" name;
  let t a b c d = test1 name f1 aux1.prepd aux1.postd a b c d in
  let cmp = aux1.prepf compare (<=) in
  t cmp "constant ints" mkconst chkconst;
  t cmp "sorted ints" mksorted chksorted;
  t cmp "reverse-sorted ints" mkrev chkrev;
  t cmp "random ints (many dups)" mkrand_dup chkrand_dup;
  t cmp "random ints (few dups)" mkrand_nodup chkrand_nodup;
(*
  let t a b c d = test1 name f3 aux3.prepd aux3.postd a b c d in
  t cmp "random floats" mkfloats chkfloats;
*)
  let t a b c d = test1 name f2 aux2.prepd aux2.postd a b c d in
  let cmp = aux2.prepf cmpstr lestr in
  t cmp "records (str)" (mkrecs 1) (chkstr 1);
  let cmp = aux2.prepf cmpint leint in
  List.iter (fun m -> t cmp (sprintf "records (int[%d])" m) (mkrecs m)
                        (chkint m)
            ) [1; 10; 100; 1000];
  if stable then
    List.iter (fun m -> t cmp (sprintf "records (int[%d]) [stable]" m)
                          (mkrecs m) (chklex m)
              ) [1; 10; 100; 1000];
;;

(************************************************************************)

(* Warning: rpt_timer cannot be used for the array sorts because
   the sorting functions have effects.
*)

let rpt_timer1 repeat f x =
  Gc.compact ();
  ignore (f x);
  let st = Sys.time () in
  for i = 1 to repeat do ignore (f x); done;
  let en = Sys.time () in
  en -. st
;;

let rpt_timer f x =
  let repeat = ref 1 in
  let t = ref (rpt_timer1 !repeat f x) in
  while !t < 0.2 do
    repeat := 10 * !repeat;
    t := rpt_timer1 !repeat f x;
  done;
  if !t < 2.0 then begin
    repeat := (int_of_float (10. *. (float !repeat) /. !t) + 1);
    t := rpt_timer1 !repeat f x;
  end;
  !t /. (float !repeat)
;;

let timer f x =
  let st = Sys.time () in
  ignore (f x);
  let en = Sys.time () in
  (en -. st)
;;

let table1 limit f mkarg =
  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n" "n" "t1" "t2" "t3" "t4" "t5";
  let sz = ref 49151 in
  while !sz < int_of_float (2. ** float limit) do
    begin try
      printf "  %10d  " !sz; flush stdout;
      for i = 0 to 4 do
        let arg = mkarg !sz in
        let t = timer f arg in
        printf " %.2e   " t; flush stdout;
      done;
      printf "\n";
    with e -> printf "*** %s\n" (Printexc.to_string e);
    end;
    flush stdout;
    sz := 2 * !sz + 1;
  done;
;;

let table2 limit f mkarg =
  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n"
         " n" "t" "t/n" "t/nlogn" "t/nlog^2n" "t/n^2";
  let sz = ref 49151 in
  while float !sz < 2. ** float limit do
    begin try
      printf "  %10d   " !sz; flush stdout;
      Gc.compact ();
      let arg = mkarg !sz in
      let t = timer f arg in
      let n = float !sz in
      let logn = log (float !sz) /. log 2. in
      printf "%.2e   %.2e   %.2e   %.2e   %.2e\n"
             t (t/.n) (t/.n/.logn) (t/.n/.logn/.logn) (t/.n/.n);
    with e -> printf "*** %s\n" (Printexc.to_string e);
    end;
    flush stdout;
    sz := 2 * !sz + 1;
  done;
;;

let table3 limit f mkarg =
  printf "  %10s  %9s  %9s  %9s  %9s  %9s\n" "n" "t1" "t2" "t3" "t4" "t5";
  let sz = ref 2 in
  while float !sz < 2. ** float limit do
    begin try
      printf "  %10d  " !sz; flush stdout;
      for i = 0 to 4 do
        let arg = mkarg !sz in
        let t = rpt_timer f arg in
        printf " %.2e   " t; flush stdout;
      done;
      printf "\n";
    with e -> printf "*** %s\n" (Printexc.to_string e);
    end;
    flush stdout;
    sz := 2 * !sz + 1;
  done;
;;

(************************************************************************)

(* benchmarks:
   1a. random records, sorted with two keys
   1b. random integers
   1c. random floats

   2a. integers, constant
   2b. integers, already sorted
   2c. integers, reverse sorted

   only for short lists:
   3a. random records, sorted with two keys
   3b. random integers
   3c. random floats
*)
let bench1a limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random records [10]:\n" name;
  let cmp = aux.prepf cmplex lelex in
  table1 limit (f cmp) (fun n -> aux.prepd (mkrecs 10 n));
;;

let bench1b limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random integers:\n" name;
  let cmp = aux.prepf (-) (<=) in
  table1 limit (f cmp) (fun n -> aux.prepd (mkrand_nodup n));
;;

let bench1c limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random floats:\n" name;
  let cmp = aux.prepf compare (<=) in
  table1 limit (f cmp) (fun n -> aux.prepd (mkfloats n));
;;

let bench2 limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  printf "\n%s with constant integers:\n" name;
  let cmp = aux.prepf compare (<=) in
  table2 limit (f cmp) (fun n -> aux.prepd (mkconst n));

  printf "\n%s with sorted integers:\n" name;
  let cmp = aux.prepf compare (<=) in
  table2 limit (f cmp) (fun n -> aux.prepd (mksorted n));

  printf "\n%s with reverse-sorted integers:\n" name;
  let cmp = aux.prepf compare (<=) in
  table2 limit (f cmp) (fun n -> aux.prepd (mkrev n));
;;

let bench3a limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random records [10]:\n" name;
  let cmp = aux.prepf cmplex lelex in
  table3 limit (f cmp) (fun n -> aux.prepd (mkrecs 10 n));
;;

let bench3b limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random integers:\n" name;
  let cmp = aux.prepf (-) (<=) in
  table3 limit (f cmp) (fun n -> aux.prepd (mkrand_nodup n));
;;

let bench3c limit name f aux =

  (* Don't do benchmarks with assertions enabled. *)
  assert (not true);

  random_reinit ();

  printf "\n%s with random floats:\n" name;
  let cmp = aux.prepf compare (<=) in
  table3 limit (f cmp) (fun n -> aux.prepd (mkfloats n));
;;

(************************************************************************)
(* merge sort on lists *)

(* FIXME to do: cutoff
         to do: cascade pattern-matchings (delete pairs)
         to do: intermediary closure for merge
*)
let (@@) = List.rev_append;;

let lmerge_1a cmp l =
  let rec init accu = function
    | [] -> accu
    | e::rest -> init ([e] :: accu) rest
  in
  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
                                           accu,accu2 are rev *)
    match l1, l2 with
    | []    , _      -> mergepairs ((l2 @@ accu)::accu2) rest
    | _     , []     -> mergepairs ((l1 @@ accu)::accu2) rest
    | h1::t1, h2::t2 -> if cmp h1 h2 <= 0
                        then merge rest accu2 (h1::accu) t1 l2
                        else merge rest accu2 (h2::accu) l1 t2
  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
                                           l1,l2,rest are rev *)
    match l1, l2 with
    | []    , _      -> mergepairs_rev ((l2 @@ accu)::accu2) rest
    | _     , []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
    | h1::t1, h2::t2 -> if cmp h2 h1 <= 0
                        then merge_rev rest accu2 (h1::accu) t1 l2
                        else merge_rev rest accu2 (h2::accu) l1 t2
  and mergepairs accu = function       (* accu is rev, arg is forward *)
    | [] -> mergeall_rev accu
    | [l] -> mergeall_rev ((List.rev l)::accu)
    | l1::l2::rest -> merge rest accu [] l1 l2
  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
    | [] -> mergeall accu
    | [l] -> mergeall ((List.rev l)::accu)
    | l1::l2::rest -> merge_rev rest accu [] l1 l2
  and mergeall = function              (* arg is forward *)
    | [] -> []
    | [l] -> l
    | llist -> mergepairs [] llist
  and mergeall_rev = function          (* arg is rev *)
    | [] -> []
    | [l] -> List.rev l
    | llist -> mergepairs_rev [] llist
  in
  mergeall_rev (init [] l)
;;

let lmerge_1b cmp l =
  let rec init accu = function
    | [] -> accu
    | [e] -> [e] :: accu
    | e1::e2::rest ->
        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
  in
  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
                                           accu,accu2 are rev *)
    match l1, l2 with
    | []    , _      -> mergepairs ((l2 @@ accu)::accu2) rest
    | _     , []     -> mergepairs ((l1 @@ accu)::accu2) rest
    | h1::t1, h2::t2 -> if cmp h1 h2 <= 0
                        then merge rest accu2 (h1::accu) t1 l2
                        else merge rest accu2 (h2::accu) l1 t2
  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
                                           l1,l2,rest are rev *)
    match l1, l2 with
    | []    , _      -> mergepairs_rev ((l2 @@ accu)::accu2) rest
    | _     , []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
    | h1::t1, h2::t2 -> if cmp h2 h1 <= 0
                        then merge_rev rest accu2 (h1::accu) t1 l2
                        else merge_rev rest accu2 (h2::accu) l1 t2
  and mergepairs accu = function       (* accu is rev, arg is forward *)
    | [] -> mergeall_rev accu
    | [l] -> mergeall_rev ((List.rev l)::accu)
    | l1::l2::rest -> merge rest accu [] l1 l2
  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
    | [] -> mergeall accu
    | [l] -> mergeall ((List.rev l)::accu)
    | l1::l2::rest -> merge_rev rest accu [] l1 l2
  and mergeall = function              (* arg is forward *)
    | [] -> []
    | [l] -> l
    | llist -> mergepairs [] llist
  and mergeall_rev = function          (* arg is rev *)
    | [] -> []
    | [l] -> List.rev l
    | llist -> mergepairs_rev [] llist
  in
  mergeall_rev (init [] l)
;;

let lmerge_1c cmp l =
  let rec init accu = function
    | [] -> accu
    | [e] -> [e] :: accu
    | e1::e2::rest ->
        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
  in
  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
                                           accu,accu2 are rev *)
    match l1 with
    | [] -> mergepairs ((l2 @@ accu)::accu2) rest
    | h1::t1 ->
       match l2 with
       | []     -> mergepairs ((l1 @@ accu)::accu2) rest
       | h2::t2 -> if cmp h1 h2 <= 0
                   then merge rest accu2 (h1::accu) t1 l2
                   else merge rest accu2 (h2::accu) l1 t2
  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
                                           l1,l2,rest are rev *)
    match l1 with
    | [] -> mergepairs_rev ((l2 @@ accu)::accu2) rest
    | h1::t1 ->
       match l2 with
       | []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
       | h2::t2 -> if cmp h2 h1 <= 0
                   then merge_rev rest accu2 (h1::accu) t1 l2
                   else merge_rev rest accu2 (h2::accu) l1 t2
  and mergepairs accu = function       (* accu is rev, arg is forward *)
    | [] -> mergeall_rev accu
    | [l] -> mergeall_rev ((List.rev l)::accu)
    | l1::l2::rest -> merge rest accu [] l1 l2
  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
    | [] -> mergeall accu
    | [l] -> mergeall ((List.rev l)::accu)
    | l1::l2::rest -> merge_rev rest accu [] l1 l2
  and mergeall = function              (* arg is forward *)
    | [] -> []
    | [l] -> l
    | llist -> mergepairs [] llist
  and mergeall_rev = function          (* arg is rev *)
    | [] -> []
    | [l] -> List.rev l
    | llist -> mergepairs_rev [] llist
  in
  mergeall_rev (init [] l)
;;

let lmerge_1d cmp l =
  let rec init accu = function
    | [] -> accu
    | [e] -> [e] :: accu
    | e1::e2::rest ->
        init ((if cmp e1 e2 <= 0 then [e2;e1] else [e1;e2])::accu) rest
  in
  let rec merge rest accu2 accu l1 l2 = (* l1,l2,rest are forward;
                                           accu,accu2 are rev *)
    let merge_rest_accu2 accu l1 l2 =
      match l1 with
      | [] -> mergepairs ((l2 @@ accu)::accu2) rest
      | h1::t1 ->
         match l2 with
         | []     -> mergepairs ((l1 @@ accu)::accu2) rest
         | h2::t2 -> if cmp h1 h2 <= 0
                     then merge rest accu2 (h1::accu) t1 l2
                     else merge rest accu2 (h2::accu) l1 t2
    in merge_rest_accu2 accu l1 l2
  and merge_rev rest accu2 accu l1 l2 = (* accu, accu2 are forward;
                                           l1,l2,rest are rev *)
    let merge_rev_rest_accu2 accu l1 l2 =
      match l1 with
      | [] -> mergepairs_rev ((l2 @@ accu)::accu2) rest
      | h1::t1 ->
         match l2 with
         | []     -> mergepairs_rev ((l1 @@ accu)::accu2) rest
         | h2::t2 -> if cmp h2 h1 <= 0
                     then merge_rev rest accu2 (h1::accu) t1 l2
                     else merge_rev rest accu2 (h2::accu) l1 t2
    in merge_rev_rest_accu2 accu l1 l2
  and mergepairs accu = function       (* accu is rev, arg is forward *)
    | [] -> mergeall_rev accu
    | [l] -> mergeall_rev ((List.rev l)::accu)
    | l1::l2::rest -> merge rest accu [] l1 l2
  and mergepairs_rev accu = function   (* accu is forward, arg is rev *)
    | [] -> mergeall accu
    | [l] -> mergeall ((List.rev l)::accu)
    | l1::l2::rest -> merge_rev rest accu [] l1 l2
  and mergeall = function              (* arg is forward *)
    | [] -> []
    | [l] -> l
    | llist -> mergepairs [] llist
  and mergeall_rev = function          (* arg is rev *)
    | [] -> []
    | [l] -> List.rev l
    | llist -> mergepairs_rev [] llist
  in
  mergeall_rev (init [] l)
;;

(************************************************************************)
(* merge sort on lists, user-contributed (NOT STABLE) *)

(* BEGIN code contributed by Yann Coscoy *)

  let rec rev_merge_append order l1 l2 acc =
    match l1 with
      [] ->  List.rev_append l2 acc
    | h1 :: t1 ->
        match l2 with
          [] -> List.rev_append l1 acc
        | h2 :: t2 ->
            if order h1 h2
            then  rev_merge_append order t1 l2 (h1::acc)
            else  rev_merge_append order l1 t2 (h2::acc)

  let rev_merge order l1 l2 = rev_merge_append order l1 l2 []

  let rec rev_merge_append' order l1 l2 acc =
    match l1 with
    | [] ->  List.rev_append l2 acc
    | h1 :: t1 ->
        match l2 with
          | [] -> List.rev_append l1 acc
          | h2 :: t2 ->
              if order h2 h1
              then  rev_merge_append' order t1 l2 (h1::acc)
              else  rev_merge_append' order l1 t2 (h2::acc)

  let rev_merge' order l1 l2 = rev_merge_append' order l1 l2 []

  let lmerge_3 order l =
    let rec initlist l acc = match l with
      | e1::e2::rest ->
          initlist rest
           ((if order e1 e2 then [e1;e2] else [e2;e1])::acc)
      | [e] -> [e]::acc
      | [] -> acc
    in
    let rec merge2 ll acc  = match ll with
      | [] -> acc
      | [l] -> [List.rev l]@acc
      | l1::l2::rest ->
          merge2 rest (rev_merge order l1 l2::acc)
    in
    let rec merge2' ll acc  = match ll with
      | [] -> acc
      | [l] -> [List.rev l]@acc
      | l1::l2::rest ->
          merge2' rest (rev_merge' order l1 l2::acc)
    in
    let rec mergeall rev = function
      | [] -> []
      | [l] -> if rev then List.rev l else l
      | llist ->
          mergeall
          (not rev) ((if rev then merge2' else merge2) llist [])
    in
    mergeall false (initlist l [])

(* END code contributed by Yann Coscoy *)

(************************************************************************)
(* merge sort on short lists, Francois Pottier *)

(* BEGIN code contributed by Francois Pottier *)

  (* [chop k l] returns the list [l] deprived of its [k] first
     elements. The length of the list [l] must be [k] at least. *)

  let rec chop k l =
    match k, l with
    | 0, _ -> l
    | _, x :: l -> chop (k-1) l
    | _, _ -> assert false
  ;;

  let rec merge order l1 l2 =
    match l1 with
      [] -> l2
    | h1 :: t1 ->
        match l2 with
          [] -> l1
        | h2 :: t2 ->
            if order h1 h2
            then h1 :: merge order t1 l2
            else h2 :: merge order l1 t2
  ;;

  let rec lmerge_4a order l =
    match l with
    | []
    | [ _ ] -> l
    | _ ->
        let rec sort k l = (* k > 1 *)
          match k, l with
          | 2, x1 :: x2 :: _ ->
              if order x1 x2 then [ x1; x2 ] else [ x2; x1 ]
          | 3, x1 :: x2 :: x3 :: _ ->
              if order x1 x2 then
                if order x2 x3 then
                  [ x1 ; x2 ; x3 ]
                else
                  if order x1 x3 then [ x1 ; x3 ; x2 ] else [ x3; x1; x2 ]
              else
                if order x1 x3 then
                  [ x2; x1; x3 ]
                else
                  if order x2 x3 then [ x2; x3; x1 ] else [ x3; x2; x1 ]
          | _, _ ->
              let k1 = k / 2 in
              let k2 = k - k1 in
              merge order (sort k1 l) (sort k2 (chop k1 l))
        in
        sort (List.length l) l
  ;;
(* END code contributed by Francois Pottier *)

(************************************************************************)
(* merge sort on short lists, Francois Pottier,
   adapted to new-style interface *)

(* BEGIN code contributed by Francois Pottier *)

  (* [chop k l] returns the list [l] deprived of its [k] first
     elements. The length of the list [l] must be [k] at least. *)

  let rec chop k l =
    match k, l with
    | 0, _ -> l
    | _, x :: l -> chop (k-1) l
    | _, _ -> assert false
  ;;

  let rec merge order l1 l2 =
    match l1 with
      [] -> l2
    | h1 :: t1 ->
        match l2 with
          [] -> l1
        | h2 :: t2 ->
            if order h1 h2 <= 0
            then h1 :: merge order t1 l2
            else h2 :: merge order l1 t2
  ;;

  let rec lmerge_4b order l =
    match l with
    | []
    | [ _ ] -> l
    | _ ->
        let rec sort k l = (* k > 1 *)
          match k, l with
          | 2, x1 :: x2 :: _ ->
              if order x1 x2 <= 0 then [ x1; x2 ] else [ x2; x1 ]
          | 3, x1 :: x2 :: x3 :: _ ->
              if order x1 x2 <= 0 then
                if order x2 x3 <= 0 then
                  [ x1 ; x2 ; x3 ]
                else
                  if order x1 x3 <= 0 then [ x1 ; x3 ; x2 ] else [ x3; x1; x2 ]
              else
                if order x1 x3 <= 0 then
                  [ x2; x1; x3 ]
                else
                  if order x2 x3 <= 0 then [ x2; x3; x1 ] else [ x3; x2; x1 ]
          | _, _ ->
              let k1 = k / 2 in
              let k2 = k - k1 in
              merge order (sort k1 l) (sort k2 (chop k1 l))
        in
        sort (List.length l) l
  ;;
(* END code contributed by Francois Pottier *)

(************************************************************************)
(* merge sort on short lists a la Pottier, modified merge *)

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 lmerge_4c cmp l =
  let rec merge1 h1 t1 l2 =
    match l2 with
    | [] -> h1 :: t1
    | h2 :: t2 ->
        if cmp h1 h2 <= 0
        then h1 :: (merge2 t1 h2 t2)
        else h2 :: (merge1 h1 t1 t2)
  and merge2 l1 h2 t2 =
    match l1 with
    | [] -> h2 :: t2
    | h1 :: t1 ->
        if cmp h1 h2 <= 0
        then h1 :: (merge2 t1 h2 t2)
        else h2 :: (merge1 h1 t1 t2)
  in
  let merge l1 = function
    | [] -> l1
    | h2 :: t2 -> merge2 l1 h2 t2
  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
       merge (sort n1 l) (sort n2 (chop n1 l))
  in
  let len = List.length l in
  if len < 2 then l else sort len l
;;

(************************************************************************)
(* merge sort on short lists a la Pottier, logarithmic stack space *)

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 lmerge_4d cmp l =
  let rec rev_merge l1 l2 accu =
    match l1, l2 with
    | [], l2 -> l2 @@ accu
    | l1, [] -> 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 -> l2 @@ accu
    | l1, [] -> 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
       rev_merge_rev (rev_sort n1 l) (rev_sort n2 (chop n1 l)) []
  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
       rev_merge (sort n1 l) (sort n2 (chop n1 l)) []
  in
  let len = List.length l in
  if len < 2 then l else sort len l
;;


(************************************************************************)
(* merge sort on short lists a la Pottier, logarithmic stack space,
   in place: input list is freed as the output is being computed. *)

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 lmerge_4e cmp l =
  let rec rev_merge l1 l2 accu =
    match l1, l2 with
    | [], l2 -> l2 @@ accu
    | l1, [] -> 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 -> l2 @@ accu
    | l1, [] -> 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 = List.length l in
  if len < 2 then l else sort len l
;;

(************************************************************************)
(* chop-free version of Pottier's code, binary version *)

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 lmerge_5a cmp l =
  let rem = ref l in
  let rec sort_prefix n =
    if n <= 1 then begin
      match !rem with
      | [] -> []
      | [x] as l -> rem := []; l
      | x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
    end else if !rem = [] then []
    else begin
      let l1 = sort_prefix (n-1) in
      let l2 = sort_prefix (n-1) in
      merge cmp l1 l2
    end
  in
  let len = ref (List.length l) in
  let i = ref 0 in
  while !len > 0 do incr i; len := !len lsr 1; done;
  sort_prefix !i
;;

(************************************************************************)
(* chop-free version of Pottier's code, dichotomic version,
   ground cases 1 & 2 *)

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 lmerge_5b cmp l =
  let rem = ref l in
  let rec sort_prefix n =
    match n, !rem with
    | 1, x::t -> rem := t; [x]
    | 2, x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
    | n, _ ->
       let n1 = n/2 in
       let n2 = n - n1 in
       let l1 = sort_prefix n1 in
       let l2 = sort_prefix n2 in
       merge cmp l1 l2
  in
  let len = List.length l in
  if len <= 1 then l else sort_prefix len
;;

(************************************************************************)
(* chop-free version of Pottier's code, dichotomic version,
   ground cases 2 & 3 *)

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 lmerge_5c cmp l =
  let rem = ref l in
  let rec sort_prefix n =
    match n, !rem with
    | 2, x::y::t -> rem := t; if cmp x y <= 0 then [x;y] else [y;x]
    | 3, x::y::z::t ->
       rem := t;
       if cmp x y <= 0 then
         if cmp y z <= 0 then [x; y; z]
         else if cmp x z <= 0 then [x; z; y]
         else [z; x; y]
       else
         if cmp x z <= 0 then [y; x; z]
         else if cmp y z <= 0 then [y; z; x]
         else [z; y; x]
    | n, _ ->
       let n1 = n/2 in
       let n2 = n - n1 in
       let l1 = sort_prefix n1 in
       let l2 = sort_prefix n2 in
       merge cmp l1 l2
  in
  let len = List.length l in
  if len <= 1 then l else sort_prefix len
;;

(************************************************************************)
(* chop-free, ref-free version of Pottier's code, dichotomic version,
   ground cases 2 & 3, modified merge *)

let lmerge_5d cmp l =
  let rec merge1 h1 t1 l2 =
    match l2 with
    | [] -> h1::t1
    | h2 :: t2 ->
        if cmp h1 h2 <= 0
        then h1 :: merge2 t1 h2 t2
        else h2 :: merge1 h1 t1 t2
  and merge2 l1 h2 t2 =
    match l1 with
    | [] -> h2::t2
    | h1 :: t1 ->
        if cmp h1 h2 <= 0
        then h1 :: merge2 t1 h2 t2
        else h2 :: merge1 h1 t1 t2
  in
  let rec sort_prefix n l =
    match n, l with
    | 2, x::y::t -> ((if cmp x y <= 0 then [x;y] else [y;x]), t)
    | 3, x::y::z::t ->
       ((if cmp x y <= 0 then
           if cmp y z <= 0 then [x; y; z]
           else if cmp x z <= 0 then [x; z; y]
           else [z; x; y]
         else
           if cmp x z <= 0 then [y; x; z]
           else if cmp y z <= 0 then [y; z; x]
           else [z; y; x]),
        t)
    | n, _ ->
       let n1 = n/2 in
       let n2 = n - n1 in
       let (l1, rest1) = sort_prefix n1 l in
       match sort_prefix n2 rest1 with
       | (h2::t2, rest2) -> ((merge2 l1 h2 t2), rest2)
       | _ -> assert false
  in
  let len = List.length l in
  if len <= 1 then l else fst (sort_prefix len l)
;;

(************************************************************************)
(* merge sort on arrays, merge with tail-rec function *)

let amerge_1a cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let rec sortto srcofs dst dstofs len =
    assert (len > 0);
    if len = 1 then dst.(dstofs) <- a.(srcofs)
    else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= 1 then ()
  else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let amerge_1b cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let rec sortto srcofs dst dstofs len =
    assert (len > 0);
    if len = 1 then dst.(dstofs) <- a.(srcofs)
    else if len = 2 then begin
      if cmp a.(srcofs) a.(srcofs+1) <= 0 then begin
        dst.(dstofs) <- a.(srcofs);
        dst.(dstofs+1) <- a.(srcofs+1);
      end else begin
        dst.(dstofs) <- a.(srcofs+1);
        dst.(dstofs+1) <- a.(srcofs);
      end;
    end else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= 1 then ()
  else if l = 2 then begin
    if cmp a.(0) a.(1) > 0 then begin
      let e = a.(0) in
      a.(0) <- a.(1);
      a.(1) <- e;
    end;
  end else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 3;;
let amerge_1c cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 4;;
let amerge_1d cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 5;;
let amerge_1e cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 6;;
let amerge_1f cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 7;;
let amerge_1g cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 8;;
let amerge_1h cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 9;;
let amerge_1i cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 10;;
let amerge_1j cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let src1r = src1ofs + src1len and src2r = src2ofs + src2len in
    let rec loop i1 s1 i2 s2 d =
      if cmp s1 s2 <= 0 then begin
        dst.(d) <- s1;
        let i1 = i1 + 1 in
        if i1 < src1r then
          loop i1 a.(i1) i2 s2 (d + 1)
        else
          Array.blit src2 i2 dst (d + 1) (src2r - i2)
      end else begin
        dst.(d) <- s2;
        let i2 = i2 + 1 in
        if i2 < src2r then
          loop i1 s1 i2 src2.(i2) (d + 1)
        else
          Array.blit a i1 dst (d + 1) (src1r - i1)
      end
    in loop src1ofs a.(src1ofs) src2ofs src2.(src2ofs) dstofs;
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len - 1 do
      let e = a.(srcofs + i) in
      let j = ref (dstofs + i - 1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs + l1) dst (dstofs + l1) l2;
      sortto srcofs a (srcofs + l2) l1;
      merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs;
    end;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

(* FIXME try: *)
(* list->array->list direct and array->list->array direct *)
(* overhead = 1/3, 1/4, etc. *)
(* overhead = sqrt (n) *)
(* overhead = n/3 up to 30k, 30k up to 900M, sqrt (n) beyond *)

(************************************************************************)
(* merge sort on arrays, merge with loop *)

(* cutoff = 1 *)
let amerge_3a cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let rec sortto srcofs dst dstofs len =
    assert (len > 0);
    if len = 1 then dst.(dstofs) <- a.(srcofs) else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= 1 then () else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let amerge_3b cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let rec sortto srcofs dst dstofs len =
    assert (len > 0);
    if len = 1 then dst.(dstofs) <- a.(srcofs)
    else if len = 2 then begin
      if cmp a.(srcofs) a.(srcofs+1) <= 0 then begin
        dst.(dstofs) <- a.(srcofs);
        dst.(dstofs+1) <- a.(srcofs+1);
      end else begin
        dst.(dstofs) <- a.(srcofs+1);
        dst.(dstofs+1) <- a.(srcofs);
      end
    end else begin
      let l1 = len / 2 in
      let l2 = len - l1 in
      sortto (srcofs+l1) dst (dstofs+l1) l2;
      sortto srcofs a (srcofs+l2) l1;
      merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
    end
  in
  let l = Array.length a in
  if l <= 1 then ()
  else if l = 2 then begin
    if cmp a.(0) a.(1) > 0 then begin
      let e = a.(0) in
      a.(0) <- a.(1);
      a.(1) <- e;
    end;
  end else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 3;;
let amerge_3c cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 4;;
let amerge_3d cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 5;;
let amerge_3e cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 6;;
let amerge_3f cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 7;;
let amerge_3g cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 8;;
let amerge_3h cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 9;;
let amerge_3i cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

let cutoff = 10;;
let amerge_3j cmp a =
  let merge src1ofs src1len src2 src2ofs src2len dst dstofs =
    let i1 = ref src1ofs
    and i2 = ref src2ofs
    and d = ref dstofs
    and src1r = src1ofs + src1len
    and src2r = src2ofs + src2len
    in
    while !i1 < src1r && !i2 < src2r do
      let s1 = a.(!i1) and s2 = src2.(!i2) in
      if cmp s1 s2 <= 0 then begin
        dst.(!d) <- s1;
        incr i1;
      end else begin
        dst.(!d) <- s2;
        incr i2;
      end;
      incr d;
    done;
    if !i1 < src1r then
      Array.blit a !i1 dst !d (src1r - !i1)
    else
      Array.blit src2 !i2 dst !d (src2r - !i2)
  in
  let isortto srcofs dst dstofs len =
    for i = 0 to len-1 do
      let e = a.(srcofs+i) in
      let j = ref (dstofs+i-1) in
      while (!j >= dstofs && cmp dst.(!j) e > 0) do
        dst.(!j + 1) <- dst.(!j);
        decr j;
      done;
      dst.(!j + 1) <- e;
    done;
  in
  let rec sortto srcofs dst dstofs len =
    if len <= cutoff then isortto srcofs dst dstofs len else
    let l1 = len / 2 in
    let l2 = len - l1 in
    sortto (srcofs+l1) dst (dstofs+l1) l2;
    sortto srcofs a (srcofs+l2) l1;
    merge (srcofs+l2) l1 dst (dstofs+l1) l2 dst dstofs;
  in
  let l = Array.length a in
  if l <= cutoff then isortto 0 a 0 l else begin
    let l1 = l / 2 in
    let l2 = l - l1 in
    let t = Array.make l2 a.(0) in
    sortto l1 t 0 l2;
    sortto 0 a l2 l1;
    merge l2 l1 t 0 l2 a 0;
  end;
;;

(* FIXME try bottom-up merge on arrays? *)

(************************************************************************)
(* Shell sort on arrays *)

let ashell_1 cmp a =
  let l = Array.length a in
  let step = ref 1 in
  while !step < l do step := !step * 3 + 1; done;
  step := !step / 3;
  while !step > 0 do
    for j = !step to l-1 do
      let e = a.(j) in
      let k = ref (j - !step) in
      let k1 = ref j in
      while !k >= 0 && cmp a.(!k) e > 0 do
        a.(!k1) <- a.(!k);
        k1 := !k;
        k := !k - !step;
      done;
      a.(!k1) <- e;
    done;
    step := !step / 3;
  done;
;;

let ashell_2 cmp a =
  let l = Array.length a in
  let step = ref 1 in
  while !step < l do step := !step * 3 + 1; done;
  step := !step / 3;
  while !step > 0 do
    for j = !step to l-1 do
      let e = a.(j) in
      let k = ref (j - !step) in
      while !k >= 0 && cmp a.(!k) e > 0 do
        a.(!k + !step) <- a.(!k);
        k := !k - !step;
      done;
      a.(!k + !step) <- e;
    done;
    step := !step / 3;
  done;
;;

let ashell_3 cmp a =
  let l = Array.length a in
  let step = ref 1 in
  while !step < l do step := !step * 3 + 1; done;
  step := !step / 3;
  while !step > 0 do
    for i = 0 to !step - 1 do
      let j = ref (i + !step) in
      while !j < l do
        let e = ref a.(!j) in
        let k = ref (!j - !step) in
        if cmp !e a.(i) < 0 then begin
          let x = !e in e := a.(i); a.(i) <- x;
        end;
        while cmp a.(!k) !e > 0 do
          a.(!k + !step) <- a.(!k);
          k := !k - !step;
        done;
        a.(!k + !step) <- !e;
        j := !j + !step;
      done;
    done;
    step := !step / 3;
  done;
;;

let force = Lazy.force;;

type iilist = Cons of int * iilist Lazy.t;;

let rec mult n (Cons (x,l)) = Cons (n*x, lazy (mult n (force l)))

let rec merge (Cons (x1, t1) as l1) (Cons (x2, t2) as l2) =
  if x1 = x2 then Cons (x1, lazy (merge (force t1) (force t2)))
  else if x1 < x2 then Cons (x1, lazy (merge (force t1) l2))
  else Cons (x2, lazy (merge l1 (force t2)))
;;

let rec scale = Cons (1, lazy (merge (mult 2 scale) (mult 3 scale)));;

let ashell_4 cmp a =
  let l = Array.length a in
  let rec loop1 accu (Cons (x, t)) =
    if x > l then accu else loop1 (x::accu) (force t)
  in
  let sc = loop1 [] scale in
  let rec loop2 = function
    | [] -> ()
    | step::t ->
      for i = 0 to step - 1 do
        let j = ref (i + step) in
        while !j < l do
          let e = a.(!j) in
          let k = ref (!j - step) in
          while !k >= 0 && cmp a.(!k) e > 0 do
            a.(!k + step) <- a.(!k);
            k := !k - step;
          done;
          a.(!k + step) <- e;
          j := !j + step;
        done;
      done;
      loop2 t;
  in
  loop2 sc;
;;

(************************************************************************)
(* Quicksort on arrays *)
let cutoff = 1;;
let aquick_1a cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 2;;
let aquick_1b cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 3;;
let aquick_1c cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 4;;
let aquick_1d cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 5;;
let aquick_1e cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 6;;
let aquick_1f cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 7;;
let aquick_1g cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref (r - 1) in
    while !p2 <= !p3 do
      let e = a.(!p3) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
      end else if c < 0 then begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        a.(!p3) <- a.(!p2);
        a.(!p2) <- e;
        incr p2;
      end;
    done;
    incr p3;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 1 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 1;;
let aquick_2a cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 2;;
let aquick_2b cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 3;;
let aquick_2c cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 4;;
let aquick_2d cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 5;;
let aquick_2e cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 6;;
let aquick_2f cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 7;;
let aquick_2g cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end else begin
        incr p2;
      end;
    done;
    let len1 = !p1 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p1; qsort !p3 r)
        else (qsort !p3 r; qsort l !p1)
      end else qsort l !p1
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 1;;
let aquick_3a cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 2;;
let aquick_3b cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 3;;
let aquick_3c cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 4;;
let aquick_3d cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 5;;
let aquick_3e cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 6;;
let aquick_3f cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 7;;
let aquick_3g cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 8;;
let aquick_3h cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 9;;
let aquick_3i cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

let cutoff = 10;;
let aquick_3j cmp a =
  let rec qsort l r =     (* ASSUMES r - l >= 2 *)
    let m = (l + r) / 2 in
    let al = a.(l) and am = a.(m) and ar = a.(r - 1) in
    let pivot = if cmp al am <= 0 then
                  if cmp am ar <= 0 then am
                  else if cmp al ar <= 0 then ar
                  else al
                else
                  if cmp al ar <= 0 then al
                  else if cmp am ar <= 0 then ar
                  else am
    in
    let p1 = ref l and p2 = ref l and p3 = ref r in
    while !p2 < !p3 do
      let e = a.(!p2) in
      let c = cmp e pivot in
      if c > 0 then begin
        decr p3;
        a.(!p2) <- a.(!p3);
        a.(!p3) <- e;
      end else if c < 0 then begin
        incr p2;
      end else begin
        a.(!p2) <- a.(!p1);
        a.(!p1) <- e;
        incr p1;
        incr p2;
      end
    done;
    while !p1 > l do
      decr p1;
      decr p2;
      let e = a.(!p1) in a.(!p1) <- a.(!p2); a.(!p2) <- e;
    done;
    let len1 = !p2 - l and len2 = r - !p3 in
    if len1 > cutoff then
      if len2 > cutoff then begin
        if len1 < len2
        then (qsort l !p2; qsort !p3 r)
        else (qsort !p3 r; qsort l !p2)
      end else qsort l !p2
    else if len2 > cutoff then qsort !p3 r;
  in
  let l = Array.length a in
  if l > 1 then begin
    qsort 0 l;
    let mini = ref 0 in
    for i = 0 to (min l cutoff) - 1 do
      if cmp a.(i) a.(!mini) < 0 then mini := i;
    done;
    let e = a.(0) in a.(0) <- a.(!mini); a.(!mini) <- e;
    for i = 1 to l - 1 do
      let e = a.(i) in
      let j = ref (i - 1) in
      while cmp a.(!j) e > 0 do
        a.(!j + 1) <- a.(!j);
        decr j;
      done;
      a.(!j + 1) <- e;
    done;
  end;
;;

(************************************************************************)
(* Heap sort on arrays (top-down, ternary) *)

let aheap_1 cmp a =
  let l = ref (Array.length a) in
  let l3 = ref ((!l + 1) / 3) in   (* l3 is the first element without sons *)
  let maxson i =                   (* ASSUMES i < !l3 *)
    let i31 = i+i+i+1 in
    let x = ref i31 in
    if i31+2 < !l then begin
      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
      !x
    end else begin
      if i31+1 < !l && cmp a.(i31) a.(i31+1) < 0
      then i31+1
      else i31
    end
  in
  let rec trickledown i e =    (* ASSUMES i < !l3 *)
    let j = maxson i in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      if j < !l3 then trickledown j e else a.(j) <- e;
    end else begin
      a.(i) <- e;
    end;
  in
  for i = !l3 - 1 downto 0 do trickledown i a.(i); done;
  let m = ref (!l + 1 - 3 * !l3) in
  while !l > 2 do
    decr l;
    if !m = 0 then (m := 2; decr l3) else decr m;
    let e = a.(!l) in
    a.(!l) <- a.(0);
    trickledown 0 e;
  done;
  if !l > 1 then begin let e = a.(1) in a.(1) <- a.(0); a.(0) <- e; end;
;;

(************************************************************************)
(* Heap sort on arrays (top-down, binary) *)

(* FIXME try partial application of trickledown (merge with down) *)
(* FIXME try to expand maxson in trickledown; delete the exception. *)

let aheap_2 cmp a =
  let maxson l i e =
    let i21 = i + i + 1 in
    if i21 + 1 < l && cmp a.(i21) a.(i21+1) < 0
    then i21 + 1
    else if i21 < l then i21 else (a.(i) <- e; raise Exit)
  in
  let rec trickledown l i e =
    let j = maxson l i e in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      trickledown l j e;
    end else begin
      a.(i) <- e;
    end;
  in
  let down l i e = try trickledown l i e with Exit -> () in
  let l = Array.length a in
  for i = l / 2 -1 downto 0 do down l i a.(i); done;
  for i = l - 1 downto 1 do
    let e = a.(i) in
    a.(i) <- a.(0);
    down i 0 e;
  done;
;;

(************************************************************************)
(* Heap sort on arrays (bottom-up, ternary) *)

exception Bottom of int;;

let aheap_3 cmp a =
  let maxson l i =
    let i31 = i+i+i+1 in
    let x = ref i31 in
    if i31+2 < l then begin
      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
      !x
    end else
      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
      then i31+1
      else if i31 < l then i31 else raise (Bottom i)
  in
  let rec trickledown l i e =
    let j = maxson l i in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      trickledown l j e;
    end else begin
      a.(i) <- e;
    end;
  in
  let rec trickle l i e = try trickledown l i e with Bottom i -> a.(i) <- e in
  let rec bubbledown l i =
    let j = maxson l i in
    a.(i) <- a.(j);
    bubbledown l j;
  in
  let bubble l i = try bubbledown l i with Bottom i -> i in
  let rec trickleup i e =
    let father = (i - 1) / 3 in
    assert (i <> father);
    if cmp a.(father) e < 0 then begin
      a.(i) <- a.(father);
      if father > 0 then trickleup father e else a.(0) <- e;
    end else begin
      a.(i) <- e;
    end;
  in
  let l = Array.length a in
  for i = (l + 1) / 3 - 1 downto 0 do trickle l i a.(i); done;
  for i = l - 1 downto 2 do
    let e = a.(i) in
    a.(i) <- a.(0);
    trickleup (bubble i 0) e;
  done;
  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
;;

(************************************************************************)
(* Heap sort on arrays (bottom-up, binary) *)

let aheap_4 cmp a =
  let maxson l i =
    let i21 = i + i + 1 in
    if i21 + 1 < l && cmp a.(i21) a.(i21 + 1) < 0
    then i21 + 1
    else if i21 < l then i21 else raise (Bottom i)
  in
  let rec trickledown l i e =
    let j = maxson l i in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      trickledown l j e;
    end else begin
      a.(i) <- e;
    end;
  in
  let trickle l i e = try trickledown l i e with Bottom i -> a.(i) <- e in
  let rec bubbledown l i =
    let j = maxson l i in
    a.(i) <- a.(j);
    bubbledown l j;
  in
  let bubble l i = try bubbledown l i with Bottom i -> i in
  let rec trickleup i e =
    let father = (i - 1) / 2 in
    assert (i <> father);
    if cmp a.(father) e < 0 then begin
      a.(i) <- a.(father);
      if father > 0 then trickleup father e else a.(0) <- e;
    end else begin
      a.(i) <- e;
    end;
  in
  let l = Array.length a in
  for i = l / 2 - 1 downto 0 do trickle l i a.(i); done;
  for i = l - 1 downto 2 do
    let e = a.(i) in
    a.(i) <- a.(0);
    trickleup (bubble i 0) e;
  done;
  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
;;

(************************************************************************)
(* heap sort, top-down, ternary, recursive final loop *)

let aheap_5 cmp a =
  let maxson l i =                 (* ASSUMES i < (l+1)/3 *)
    let i31 = i+i+i+1 in
    let x = ref i31 in
    if i31+2 < l then begin
      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
      !x
    end else begin
      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
      then i31+1
      else i31
    end
  in
  let rec trickledown l l3 i e =    (* ASSUMES i < l3 *)
    let j = maxson l i in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      if j < l3 then trickledown l l3 j e else a.(j) <- e;
    end else begin
      a.(i) <- e;
    end;
  in
  let l = Array.length a in
  let l3 = (l + 1) / 3 in
  for i = l3 - 1 downto 0 do trickledown l l3 i a.(i); done;
  let rec loop0 l l3 =
    let e = a.(l) in
    a.(l) <- a.(0);
    trickledown l l3 0 e;
    loop2 (l-1) (l3-1);
  and loop1 l l3 =
    let e = a.(l) in
    a.(l) <- a.(0);
    trickledown l l3 0 e;
    loop0 (l-1) l3;
  and loop2 l l3 =
    if l > 1 then begin
      let e = a.(l) in
      a.(l) <- a.(0);
      trickledown l l3 0 e;
      loop1 (l-1) l3;
    end else begin
      let e = a.(1) in a.(1) <- a.(0); a.(0) <- e;
    end;
  in
  if l > 1 then
    match l + 1 - 3 * l3 with
    | 0 -> loop2 (l-1) (l3-1);
    | 1 -> loop0 (l-1) l3;
    | 2 -> loop1 (l-1) l3;
    | _ -> assert false;
;;

(************************************************************************)
(* heap sort, top-down, ternary, with exception *)

let aheap_6 cmp a =
  let maxson e l i =
    let i31 = i + i + i + 1 in
    let x = ref i31 in
    if i31+2 < l then begin
      if cmp a.(i31) a.(i31+1) < 0 then x := i31+1;
      if cmp a.(!x) a.(i31+2) < 0 then x := i31+2;
      !x
    end else begin
      if i31+1 < l && cmp a.(i31) a.(i31+1) < 0
      then i31+1
      else if i31 < l then i31 else (a.(i) <- e; raise Exit)
    end
  in
  let rec trickledown e l i =
    let j = maxson e l i in
    if cmp a.(j) e > 0 then begin
      a.(i) <- a.(j);
      trickledown e l j;
    end else begin
      a.(i) <- e;
    end;
  in
  let down e l i = try trickledown e l i with Exit -> (); in
  let l = Array.length a in
  for i = (l + 1) / 3 - 1 downto 0 do down a.(i) l i; done;
  for i = l - 1 downto 2 do
    let e = a.(i) in
    a.(i) <- a.(0);
    down e i 0;
  done;
  if l > 1 then (let e = a.(1) in a.(1) <- a.(0); a.(0) <- e);
;;

(* FIXME try cutoff for heapsort *)

(************************************************************************)
(* Insertion sort with dichotomic search *)

let ainsertion_1 cmp a =
  let rec dicho l r e =
    if l = r then l else begin
      let m = (l + r) / 2 in
      if cmp a.(m) e <= 0
      then dicho (m+1) r e
      else dicho l m e
    end
  in
  for i = 1 to Array.length a - 1 do
    let e = a.(i) in
    let j = dicho 0 i e in
    Array.blit a j a (j + 1) (i - j);
    a.(j) <- e;
  done;
;;

(************************************************************************)
(* merge sort on lists via arrays *)

let array_to_list_in_place a =
  let l = Array.length a in
  let rec loop accu n p =
    if p <= 0 then accu else begin
      if p = n then begin
        Obj.truncate (Obj.repr a) p;
        loop (a.(p-1) :: accu) (n-1000) (p-1)
      end else begin
        loop (a.(p-1) :: accu) n (p-1)
      end
    end
  in
  loop [] l l
;;

let array_of_list l len =
  match l with
  | [] -> [| |]
  | h::t ->
      let a = Array.make len h in
      let rec loop i l =
        match l with
        | [] -> ()
        | h::t -> a.(i) <- h; loop (i+1) t
      in
      loop 1 t;
      a
;;

let lmerge_0a cmp l =
  let a = Array.of_list l in
  amerge_1e cmp a;
  array_to_list_in_place a
;;

let lmerge_0b cmp l =
  let len = List.length l in
  if len > 256 then Gc.minor ();
  let a = array_of_list l len in
  amerge_1e cmp a;
  array_to_list_in_place a
;;

let lshell_0 cmp l =
  let a = Array.of_list l in
  ashell_2 cmp a;
  array_to_list_in_place a
;;

let lquick_0 cmp l =
  let a = Array.of_list l in
  aquick_3f cmp a;
  array_to_list_in_place a
;;

(************************************************************************)
(* merge sort on arrays via lists *)

let amerge_0 cmp a =    (* cutoff is not yet used *)
  let l = lmerge_4e cmp (Array.to_list a) in
  let rec loop i = function
  | [] -> ()
  | h::t -> a.(i) <- h; loop (i + 1) t
  in
  loop 0 l
;;

(************************************************************************)

let lold = [
  "Sort.list", Sort.list, true;
  "lmerge_3", lmerge_3, false;
  "lmerge_4a", lmerge_4a, true;
];;

let lnew = [
  "List.stable_sort", List.stable_sort, true;

  "lmerge_0a", lmerge_0a, true;
  "lmerge_0b", lmerge_0b, true;
  "lshell_0", lshell_0, false;
  "lquick_0", lquick_0, false;

  "lmerge_1a", lmerge_1a, true;
  "lmerge_1b", lmerge_1b, true;
  "lmerge_1c", lmerge_1c, true;
  "lmerge_1d", lmerge_1d, true;

  "lmerge_4b", lmerge_4b, true;
  "lmerge_4c", lmerge_4c, true;
  "lmerge_4d", lmerge_4d, true;
  "lmerge_4e", lmerge_4e, true;

  "lmerge_5a", lmerge_5a, true;
  "lmerge_5b", lmerge_5b, true;
  "lmerge_5c", lmerge_5c, true;
  "lmerge_5d", lmerge_5d, true;
];;
let anew = [
  "Array.stable_sort", Array.stable_sort, true;
  "Array.sort", Array.sort, false;

  "amerge_0", amerge_0, true;

  "amerge_1a", amerge_1a, true;
  "amerge_1b", amerge_1b, true;
  "amerge_1c", amerge_1c, true;
  "amerge_1d", amerge_1d, true;
  "amerge_1e", amerge_1e, true;
  "amerge_1f", amerge_1f, true;
  "amerge_1g", amerge_1g, true;
  "amerge_1h", amerge_1h, true;
  "amerge_1i", amerge_1i, true;
  "amerge_1j", amerge_1j, true;

  "amerge_3a", amerge_3a, true;
  "amerge_3b", amerge_3b, true;
  "amerge_3c", amerge_3c, true;
  "amerge_3d", amerge_3d, true;
  "amerge_3e", amerge_3e, true;
  "amerge_3f", amerge_3f, true;
  "amerge_3g", amerge_3g, true;
  "amerge_3h", amerge_3h, true;
  "amerge_3i", amerge_3i, true;
  "amerge_3j", amerge_3j, true;

  "ashell_1", ashell_1, false;
  "ashell_2", ashell_2, false;
  "ashell_3", ashell_3, false;
  "ashell_4", ashell_4, false;

  "aquick_1a", aquick_1a, false;
  "aquick_1b", aquick_1b, false;
  "aquick_1c", aquick_1c, false;
  "aquick_1d", aquick_1d, false;
  "aquick_1e", aquick_1e, false;
  "aquick_1f", aquick_1f, false;
  "aquick_1g", aquick_1g, false;

  "aquick_2a", aquick_2a, false;
  "aquick_2b", aquick_2b, false;
  "aquick_2c", aquick_2c, false;
  "aquick_2d", aquick_2d, false;
  "aquick_2e", aquick_2e, false;
  "aquick_2f", aquick_2f, false;
  "aquick_2g", aquick_2g, false;

  "aquick_3a", aquick_3a, false;
  "aquick_3b", aquick_3b, false;
  "aquick_3c", aquick_3c, false;
  "aquick_3d", aquick_3d, false;
  "aquick_3e", aquick_3e, false;
  "aquick_3f", aquick_3f, false;
  "aquick_3g", aquick_3g, false;
  "aquick_3h", aquick_3h, false;
  "aquick_3i", aquick_3i, false;
  "aquick_3j", aquick_3j, false;

  "aheap_1", aheap_1, false;
  "aheap_2", aheap_2, false;
  "aheap_3", aheap_3, false;
  "aheap_4", aheap_4, false;
  "aheap_5", aheap_5, false;
  "aheap_6", aheap_6, false;

  "ainsertion_1", ainsertion_1, true;
];;

(************************************************************************)
(* main program *)

type mode = Test_std | Test | Bench1 | Bench2 | Bench3;;

let size = ref 22
and mem = ref 0
and mode = ref Test_std
and only = ref []
;;

let usage = "Usage: sorts [-size <table size>] [-mem <memory size>]\n\
          \032            [-seed <random seed>] [-test|-bench]"
;;

let options = [
  "-size", Arg.Int ((:=) size), "   Maximum size for benchmarks (default 22)";
  "-meg",Arg.Int ((:=) mem),"    How many megabytes to preallocate (default 0)";
  "-seed", Arg.Int ((:=) seed), "   PRNG seed (default 0)";
  "-teststd", Arg.Unit (fun () -> mode := Test_std), "   Test stdlib (default)";
  "-test", Arg.Unit (fun () -> mode := Test), "   Select test mode";
  "-bench1", Arg.Unit (fun () -> mode := Bench1), "  Select bench mode 1";
  "-bench2", Arg.Unit (fun () -> mode := Bench2), "  Select bench mode 2";
  "-bench3", Arg.Unit (fun () -> mode := Bench3), "  Select bench mode 3";
  "-fn", Arg.String (fun x -> only := x :: !only),
                         " <function>  Test/Bench this function (default all)";
];;
let anonymous x = raise (Arg.Bad ("unrecognised option "^x));;

let main () =
  Arg.parse options anonymous usage;

  Printf.printf "Command line arguments are:";
  for i = 1 to Array.length Sys.argv - 1 do
    Printf.printf " %s" Sys.argv.(i);
  done;
  Printf.printf "\n";

  ignore (String.create (1048576 * !mem));
  Gc.full_major ();
(*
  let a2l = Array.to_list in
  let l2ak x y = Array.of_list x in
  let id = fun x -> x in
  let fst x y = x in
  let snd x y = y in
*)
  let benchonly f x y z t =
    match !only with
    | [] -> f x y z t
    | l -> if List.mem y l then f x y z t
  in
  let testonly x1 x2 x3 x4 x5 x6 =
    match !only with
    | [] -> test x1 x2 x3 x4 x5 x6
    | l -> if List.mem x1 l then test x1 x2 x3 x4 x5 x6
  in

  match !mode with
  | Test_std -> begin
      testonly "List.sort" false List.sort List.sort lc lc;
      testonly "List.stable_sort" true List.stable_sort List.stable_sort lc lc;
      testonly "Array.sort" false Array.sort Array.sort ac ac;
      testonly "Array.stable_sort" true Array.stable_sort Array.stable_sort
               ac ac;
      printf "Number of tests failed: %d\n" !numfailed;
    end;
  | Test -> begin
      for i = 0 to List.length lold - 1 do
        let (name, f1, stable) = List.nth lold i in
        let (_, f2, _) = List.nth lold i in
        testonly name stable f1 f2 ll ll;
      done;
      testonly "Sort.array" false Sort.array Sort.array al al;
      for i = 0 to List.length lnew - 1 do
        let (name, f1, stable) = List.nth lnew i in
        let (_, f2, _) = List.nth lnew i in
        testonly name stable f1 f2 lc lc;
      done;
      for i = 0 to List.length anew - 1 do
        let (name, f1, stable) = List.nth anew i in
        let (_, f2, _) = List.nth anew i in
        testonly name stable f1 f2 ac ac;
      done;
      printf "Number of tests failed: %d\n" !numfailed;
    end;
  | Bench1 -> begin
      let ba = fun x y z -> benchonly bench1a !size x y z
      and bb = fun x y z -> benchonly bench1b !size x y z
      and bc = fun x y z -> benchonly bench1c !size x y z
      in
      for i = 0 to List.length lold - 1 do
        let (name, f, stable) = List.nth lold i in ba name f ll;
        let (name, f, stable) = List.nth lold i in bb name f ll;
        let (name, f, stable) = List.nth lold i in bc name f ll;
      done;
      ba "Sort.array" Sort.array al;
      bb "Sort.array" Sort.array al;
      bc "Sort.array" Sort.array al;
      for i = 0 to List.length lnew - 1 do
        let (name, f, stable) = List.nth lnew i in ba name f lc;
        let (name, f, stable) = List.nth lnew i in bb name f lc;
        let (name, f, stable) = List.nth lnew i in bc name f lc;
      done;
      for i = 0 to List.length anew - 1 do
        let (name, f, stable) = List.nth anew i in ba name f ac;
        let (name, f, stable) = List.nth anew i in bb name f ac;
        let (name, f, stable) = List.nth anew i in bc name f ac;
      done;
    end;
  | Bench2 -> begin
      let b = fun x y z -> benchonly bench2 !size x y z in
      for i = 0 to List.length lold - 1 do
        let (name, f, stable) = List.nth lold i in b name f ll;
      done;
      b "Sort.array" Sort.array al;
      for i = 0 to List.length lnew - 1 do
        let (name, f, stable) = List.nth lnew i in b name f lc;
      done;
      for i = 0 to List.length anew - 1 do
        let (name, f, stable) = List.nth anew i in b name f ac;
      done;
    end;
  | Bench3 -> begin
      let ba = fun x y z -> benchonly bench3a !size x y z
      and bb = fun x y z -> benchonly bench3b !size x y z
      and bc = fun x y z -> benchonly bench3c !size x y z
      in
      for i = 0 to List.length lold - 1 do
        let (name, f, stable) = List.nth lold i in ba name f ll;
        let (name, f, stable) = List.nth lold i in bb name f ll;
        let (name, f, stable) = List.nth lold i in bc name f ll;
      done;
      for i = 0 to List.length lnew - 1 do
        let (name, f, stable) = List.nth lnew i in ba name f lc;
        let (name, f, stable) = List.nth lnew i in bb name f lc;
        let (name, f, stable) = List.nth lnew i in bc name f lc;
      done;
    end;
;;

if not !Sys.interactive then Printexc.catch main ();;