
(* Title:   Inner product
   Author:  Walid Taha
   Date:    Sun Oct 21 16:23:31 EDT 2001 *)

Trx.init_times ()

let n = 100;;

let a = Array.create n 0.0;;

let initA _ =
   for i = 0 to n-1 do
    a.(i) <- float ((i mod 7 + i * 3) mod 97);
   done;;

let libCall _ = (initA ();
                 Array.sort compare a)

let sort =
let module M = 
struct
exception Bottom of int;;
let sort 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 (Array.get a i31) (Array.get a (i31+1)) < 0 then x := i31+1;
      if cmp (Array.get a !x) (Array.get a (i31+2)) < 0 then x := i31+2;
      !x
    end else
      if i31+1 < l && cmp (Array.get a i31) (Array.get 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 (Array.get a j) e > 0 then begin
      Array.set a i (Array.get a j);
      trickledown l j e;
    end else begin
      Array.set a i e;
    end;
  in
  let rec trickle l i e = try trickledown l i e with Bottom i -> Array.set a i e in
  let rec bubbledown l i =
    let j = maxson l i in
    Array.set a i (Array.get 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 (Array.get a father) e < 0 then begin
      Array.set a i (Array.get a father);
      if father > 0 then trickleup father e else Array.set a 0 e;
    end else begin
      Array.set a i e;
    end;
  in
  let l = Array.length a in
  for i = (l + 1) / 3 - 1 downto 0 do trickle l i (Array.get a i); done;
  for i = l - 1 downto 2 do
    let e = (Array.get a i) in
    Array.set a i (Array.get a 0);
    trickleup (bubble i 0) e;
  done;
  if l > 1 then (let e = (Array.get a 1) in Array.set a 1 (Array.get a 0); Array.set a 0 e);
end
in
 M.sort;;

let unstagedCall _ = (initA ();
                      sort compare a)

let sort2 =
.<
let module M = 
struct
exception Bottom of int;;
let sort 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 (Array.get a i31) (Array.get a (i31+1)) < 0 then x := i31+1;
      if cmp (Array.get a !x) (Array.get a (i31+2)) < 0 then x := i31+2;
      !x
    end else
      if i31+1 < l && cmp (Array.get a i31) (Array.get 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 (Array.get a j) e > 0 then begin
      Array.set a i (Array.get a j);
      trickledown l j e;
    end else begin
      Array.set a i e;
    end;
  in
  let rec trickle l i e = try trickledown l i e with Bottom i -> Array.set a i e in
  let rec bubbledown l i =
    let j = maxson l i in
    Array.set a i (Array.get 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 (Array.get a father) e < 0 then begin
      Array.set a i (Array.get a father);
      if father > 0 then trickleup father e else Array.set a 0 e;
    end else begin
      Array.set a i e;
    end;
  in
  let l = Array.length a in
  for i = (l + 1) / 3 - 1 downto 0 do trickle l i (Array.get a i); done;
  for i = l - 1 downto 2 do
    let e = (Array.get a i) in
    Array.set a i (Array.get a 0);
    trickleup (bubble i 0) e;
  done;
  if l > 1 then (let e = (Array.get a 1) in Array.set a 1 (Array.get a 0); Array.set a 0 e);
end
in
 M.sort
>.;;

let stage1Call _ = (sort2)

(* Timing Experiment #use "mex/10.ml";; *)

let lib = 
     Trx.time 1000
        "lib call unstaged"
        (fun () -> libCall ())

let unstaged = 
     Trx.time 1000
        "unstaged"
        (fun () -> unstagedCall ())

let stage1 = 
     Trx.time 100
        "stage 1"
        (fun () -> stage1Call ())

let compilation = 
     Trx.time 10
        "compilation"
        (fun () -> .! stage1)

let stage2 = 
     Trx.time 100000
        "stage 2 (running)"
        (fun () -> compilation ())

let _ = Trx.print_times ()



