Re: Ant: Re: Ant: Re: [Caml-list] Avoiding shared data

[Thomas Fischbacher <Thomas.Fischbacher@Physik.Uni-Muenchen.DE>]

On Mon, 3 Oct 2005, skaller wrote:

> > I hope that one day functional language compilers will
> > do that optimization for you - convert a
> > non-tail-recursive code into a tail-recursive one. Do
> > you know of some progress in that direction?
> 
> Isn't that just CPS? 

He presumably wanted to see a different thing, e.g. 
automatically transforming


let rec fac1 x =
  if x = 0
  then 1
  else x*(fac1 (x-1))
;;

into

let fac2 x =
  let rec walk so_far todo =
    if todo = 0
    then so_far
    else walk (todo*so_far) (todo-1)
  in walk 1 x
;;


My impression is that it may indeed be possible to do something like this 
for simple applications, but that the cases that can be covered 
automatically presumably are so limited that an experienced programmer 
will usually want to attack them by going to a higher form of abstraction 
and not waste time on such things anyway.

I think that Olin Shivers indeed does have a valid point in pointing out 
that writing loops in tail-recursive style has major disadvantages. 
However, my impression still is that as soon as someone thinks in terms of 
"I have to write a loop for this", chances are good that he may improve 
his design by going back one step and ask the question "what do I want to 
use that loop for?". In quite many situations, it is possible to express 
one's thoughts more directly via other means, such as Array.map, 
fold_left, etc. 

What I (as a pedestrian) especially do not like about loops is that it is
much easier to make off-by-one errors than with any form of recursion 
which contains a base-case/recursive-case analysis.


Unfortunately, the OCaml native code compiler apparently is not yet smart 
enough to optimize code written in such a higher-order style well enough 
so that it can compete with imperative or tail-recursive code in 
time-critical applications. (Though quite many applications in fact are 
not.) At present, one can expect to lose about a factor of ~3 in
performance.

Example:

===>
let timing_apply f x =
  let t0 = Unix.gettimeofday() in
  let f_x = f x in
  let t1 = Unix.gettimeofday() in
  (f_x,t1-.t0)
;;

let my_array_fold_left f init arr =
  let len = Array.length arr in
  let rec walk so_far pos =
    if pos=len
    then so_far
    else walk (f so_far arr.(pos)) (1+pos)
  in walk init 0
;;


let test m n =
  let arr =
    Array.init m
      (fun j -> Array.init n (fun k -> j*k+k))
  in
  let scratchpad = ref 0 in
  (* -- *)
  let rec frobenius1 mx =
    Array.fold_left
      (fun so_far row ->
	Array.fold_left
	  (fun so_far entry ->
	    so_far+entry*entry)
	  so_far row)
      0 mx
  in
  let frobenius2 mx =
    my_array_fold_left
      (fun so_far row ->
	my_array_fold_left
	  (fun so_far entry ->
	    so_far+entry*entry)
	  so_far row)
      0 mx
  in
  let frobenius3 mx =
    begin
      scratchpad := 0;
      for i=0 to (Array.length mx)-1 do
	let row = mx.(i) in
	for j=0 to (Array.length row)-1 do
	  scratchpad:= !scratchpad + row.(j)*row.(j);
	done;
      done;
      !scratchpad
    end
  in
  let frobenius4 mx =
    let nr_rows = Array.length mx in
    let rec walk_rows so_far nr_row =
      if nr_row = nr_rows
      then so_far
      else
	let row = mx.(nr_row) in
	let len_row = Array.length row in
	let rec walk_cols so_far nr_col =
	  if nr_col = len_row
	  then so_far
	  else walk_cols (so_far+row.(nr_col)*row.(nr_col)) (1+nr_col)
	in 
	walk_rows (walk_cols so_far 0) (1+nr_row)
    in
    walk_rows 0 0
  in
  let frobenius5 mx =
    let nr_rows = Array.length mx in
    let rec walk_rows so_far nr_row =
      if nr_row = nr_rows
      then so_far
      else
	let row = mx.(nr_row) in
	let len_row = Array.length row in
	let rec walk_cols row so_far nr_col =
	  if nr_col = len_row
	  then so_far
	  else walk_cols row (so_far+row.(nr_col)*row.(nr_col)) (1+nr_col)
	in 
	walk_rows (walk_cols row so_far 0) (1+nr_row)
    in
    walk_rows 0 0
  in
  let compute_n_times n f x =
    let rec walk k =
      if k = n then f x
      else
	let () = ignore(f x) in
	walk (k+1)
    in walk 1
  in
  Array.map
    (fun f -> timing_apply (compute_n_times 1000 f) arr)
    [|frobenius1;frobenius2;frobenius3;frobenius4;frobenius5|]
;;

let result = test 1000 3 in
Array.iteri (fun nr (_,t) -> Printf.printf "%d: %f\n" (1+nr) t) result
;;
<===

ocamlc:

1: 0.987257
2: 1.196910
3: 0.709074
4: 0.858948
5: 0.984935

ocamlopt:

1: 0.066404
2: 0.075691
3: 0.025450
4: 0.025756
5: 0.023472

-- 
regards,               tf@cip.physik.uni-muenchen.de              (o_
 Thomas Fischbacher -  http://www.cip.physik.uni-muenchen.de/~tf  //\
(lambda (n) ((lambda (p q r) (p p q r)) (lambda (g x y)           V_/_
(if (= x 0) y (g g (- x 1) (* x y)))) n 1))                  (Debian GNU)