[Shootout-list] fannkuch (OCaml)

[ChriS]

----Next_Part(Fri_Mar__4_10_54_58_2005_450)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hi,

Here is a new version (shorter and faster) of the fannkuch benchmark
for Ocaml.

ChriS

----Next_Part(Fri_Mar__4_10_54_58_2005_450)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="fannkuch.ml"

(* fannkuch.ml

   ocamlopt -dtypes -o fannkuch.com -inline 3 -unsafe fannkuch.ml
*)

(* Monomorphic version for speed *)
let int_max (x : int) y = if x < y then y else x

let pfannkuchen n =
  let a = Array.init n (fun i -> i)
  and b = Array.make n 0 in
  let rec reverse i j =
    let t = b.(i) and i' = i + 1 and j' = j - 1 in
    b.(i) <- b.(j);  b.(j) <- t;  if i' < j' then reverse i' j' in
  let rec count_flips c =
    let b0 = b.(0) in
    if b0 = 0 then c else (reverse 0 b0; count_flips(c+1)) in
  let maxc = ref 0 in
  let f () =
    for i = 0 to n - 1 do b.(i) <- a.(i) done;
    maxc := int_max (count_flips 0) !maxc in
  (* Generate the n! permutations *)
  let swap i j = let t = a.(i) in a.(i) <- a.(j); a.(j) <- t in
  let rec go = function
    | 0 -> f()
    | 1 -> f(); swap 0 1; f()
    | n ->
	let n' = n - 1 in
	for c = 0 to n do ge n'; swap 0 n; done
  and ge = function
    | 0 -> f()
    | 1 -> f(); swap 0 1; f()
    | n ->
	let n' = n - 1 in
	for c = 0 to n do go n'; swap c n; done  in
  let n = Array.length a in
  if n mod 2 = 0 then ge(n - 1) else go(n - 1);
  !maxc

let () =
  let n = try int_of_string Sys.argv.(1) with _ -> 1 in
  Printf.printf "Pfannkuchen(%i) = %i\n" n (pfannkuchen n)

----Next_Part(Fri_Mar__4_10_54_58_2005_450)----