Infinite loop when catching an exception

[Michel Pastor <K4ng@codefx.org>]

[-- Attachment #1: Type: text/plain, Size: 1500 bytes --]

Hi,

I have a problem with a little piece of code but
I attached the whole thing since i cannot reproduce
the "bug" in reduced environement with the same values.
I'm using the num library for doing exact maths.

here extracted from the function line 280
see the code attached, i commented the section with details
try
   let (graph_x, graph_y) = scale_point (!index, yval) in
             fill_circle graph_x graph_y 1;
with Failure _ -> exit 0;

If I try to catch the exception like that the process
wont even go beyond the "try with" block
I tested printing something instead of trying to exit
but nothing is writed to the console and the cpu is at 100%
All I can do is to kill the process.
But if I don't try catch the Failure all works fine.
I don't think doing unsafe things since there is no C code,
no black magic, only some maths.

To test, just launch the attached file with the points file:
    ocamlc nums.cma graphics.cma proj309.ml -o proj309
    ./proj309 points.txt

It should draw a graph from the points in the file
but in my computer it is ending into an infinite-loop
if I uncomment the "try .. with" bloc line 303 and 313.
I don't understand since there is no raised exception
when the bloc is commented and the code works
great without problems without the "try .. with"

Any clues on where is the mess ?

Thanks,
  Michel

PS: I'm using ocaml 3.08.2
PS2: I'm think this language is really very good
        and I only wish It could even become better
        congratulations :)

[-- Attachment #2: points.txt --]
[-- Type: text/plain, Size: 53 bytes --]

3

0.0000   0.0000

1.0000   -1.0000
3.0000   3.0000

[-- Attachment #3: proj309.ml --]
[-- Type: text/plain, Size: 10215 bytes --]

open Num;;
open Scanf;;
open Printf;;
open Graphics;;

(* paramètres du tracé *)
let x_bars_margin = 30
and y_bars_margin = 40
and bars_outter_margin = 40
and scale_adjustement = 20
and bars_width = 3
and bars_color = black
and x_graduations = 10
and y_graduations = 10
and graduations_color = black
and graduations_length = 12
and graduations_width = 2
and labels_color = red
and cross_width = 3
and cross_length = 10
and cross_color = red
and units_minmax_color = green
and units_second_color = cyan
and units_offset = 4
and curve_color = green;;

if Array.length Sys.argv < 2 then
  failwith "usage: proj309 <points file>";;

(* *********** lecture des points du fichier *************** *)
let filename = Sys.argv.(1);;
let data_input = open_in filename;;
let points = ref [];;
try
  let count = fscanf data_input "%d" ref in
    while !count > 0 do
      let line = input_line data_input in
      if String.length line > 1 then (
	sscanf line "%d.%s    %d.%s" (fun x xf y yf ->
	  let ten_num = num_of_int 10 in
	  let xrat = ten_num **/ num_of_int (String.length xf)
	  and yrat = ten_num **/ num_of_int (String.length yf) in
	  let xpoint = ((num_of_int x) */ xrat +/ (num_of_string xf)) // xrat
	  and ypoint = ((num_of_int y) */ yrat +/ (num_of_string yf)) // yrat
	  in
	  points := (xpoint, ypoint)::!points; );
	count := !count - 1;
      );
    done
with Scan_failure msg -> failwith ("Parse error: " ^ msg)
   | End_of_file -> failwith "Unexpected end of file";;
try
  ignore (input_line data_input);
  failwith "It seems that the file contains more data than expected, check line count at beginning";
with End_of_file -> close_in data_input;;
points := List.rev !points;;

let x_min, x_max, y_min, y_max =
  let (xfst, yfst) = List.hd !points in
    ref xfst, ref xfst, ref yfst, ref yfst;;
let set_min_max (x, y) = (
  if (!x_min >/ x) then x_min := x;
  if (!x_max </ x) then x_max := x;
  if (!y_min >/ y) then y_min := y;
  if (!y_max </ y) then y_max := y;
) in
List.iter set_min_max (List.rev !points);;

let string_of_poly poly = 
  let buf = Buffer.create 0
  and first = ref true
  and length = List.length poly in
  let push_mem (p, v) =
    if v <>/ Int 0 || List.length poly = 1 then
      begin
	if !first then
	  first := false
	else
	  Buffer.add_string buf (if sign_num v < 0 then " - " else " + ");
	Buffer.add_string buf (match (p, abs_num v) with
	  (p, v) when p = 0 -> string_of_num v
	| (p, v) when v = Int 1 -> "x^" ^ string_of_int p
	| (p, v) when p = 1 -> string_of_num v ^ "x"
	| (p, v) -> string_of_num v ^ "x^" ^ string_of_int p);
      end
in
begin
  List.iter push_mem poly;
  "(" ^ Buffer.contents buf ^ ")";
end;;

(* power_fact(p1, p2) = p1 * p2 *)
let power_fact leftop rightop =
  let output = ref [] in
  let mul ((p1, v1), (p2, v2)) =
    let p = p1 + p2 and value = v1 */ v2 in
    if value <>/ Int 0 then
      try
	let ve = List.assoc p !output in
	  begin
	    output := List.remove_assoc p !output;
	    output := (p, value +/ ve)::!output;
	  end
      with Not_found -> output := (p, value)::!output
in
begin
  List.iter (fun lvalue -> List.iter (fun rvalue -> mul (lvalue, rvalue)) rightop) leftop;
  if List.length !output = 0 then [(0, Int 0)] else !output
end;;

(* power_add(p1, p2) = p1 + p2 *)
let power_add leftop rightop =
  let output = ref [] in
  let add ((p1, v1) as value) =
    try
      let v2 = List.assoc p1 !output in
        begin
	  output := List.remove_assoc p1 !output;
	  let value = v1 +/ v2 in
	    if value <>/ Int 0 then
	  output := (p1, value)::!output;
	end
    with Not_found -> output := value::!output
in
begin
  List.iter add leftop;
  List.iter add rightop;
  if List.length !output = 0 then [(0, Int 0)] else !output
end;;

let lagrange_factors refpoints =
  let p = ref [(0, Int 0)]
  and x x = fst (List.nth refpoints x)
  and f x = snd (List.nth refpoints x)
  and n = List.length refpoints - 1
in
begin
  for i = 0 to n do
    let s = ref [(0, f i)] in
    for j = 0 to n do
      if i <> j then
        let xi = x i and xj = x j in
	let arg = xi -/ xj in
	try
	  s := power_fact !s [(1, Int 1 // arg); (0, minus_num xj // arg)]
	with Failure _ ->
	  failwith ("Seem that is not possible, you have x = " ^ string_of_num xi)
    done;
    p := power_add !p !s
  done;
  !p;
end;;

let poly_apply poly x =
  let value (p, v) = v */ x **/ num_of_int p in
snd (List.fold_left (fun op1 op2 -> (0, (value op1) +/ (value op2))) (0, Int 0) poly);;

(* *********************** affichage *********************** *)


let poly = lagrange_factors !points;;
print_endline (string_of_poly poly);;

open_graph "";;
set_window_title "Interpolation";;

(* automatic adjustements *)
if scale_adjustement > 0 then
let adjustement = (!y_max -/ !y_min) // num_of_int scale_adjustement in
  begin
    y_min := !y_min -/ adjustement;
    y_max := !y_max +/ adjustement;
  end;;
let y_bars_margin =
  let label1 = string_of_num ((!y_max -/ !y_min) // num_of_int y_graduations +/ !y_min)
  and label2, label3 = string_of_num !y_min, string_of_num !y_max in
  let l1_size, l2_size, l3_size = fst (text_size label1), fst (text_size label2), fst (text_size label3)in
max y_bars_margin (max (max l1_size l2_size) l3_size + fst (text_size "  "));;

let window_width, window_height = size_x (), size_y ();;
let x_interval, y_interval = (window_width - bars_outter_margin - y_bars_margin) / x_graduations,
			     (window_height - bars_outter_margin - x_bars_margin) / y_graduations;;
let graph_x_min, graph_x_max = y_bars_margin, y_bars_margin + x_graduations * x_interval
and graph_y_min, graph_y_max = x_bars_margin, x_bars_margin + y_graduations * y_interval;;
let graph_width, graph_height = graph_x_max - graph_x_min, graph_y_max - graph_y_min;;

let scale_point (x, y) =
  let scale v length graph_min v_min v_max =
    int_of_num (integer_num (num_of_int graph_min +/ (v -/ v_min) */ num_of_int length
      // (v_max -/ v_min))) in
((scale x graph_width graph_x_min !x_min !x_max), (scale y graph_height graph_y_min !y_min !y_max));;

let draw_bars width color =
  let mi_grad_len = graduations_length / 2 in
begin
  set_line_width width;
  set_color color;
  moveto (graph_x_min - mi_grad_len) graph_y_min;
  lineto graph_x_max graph_y_min;
  moveto graph_x_min (graph_y_min - mi_grad_len);
  lineto graph_x_min graph_y_max;
  moveto graph_x_max x_bars_margin;
  rlineto (-8) (-6);
  moveto graph_x_max x_bars_margin;
  rlineto (-8) 6;
  moveto y_bars_margin graph_y_max;
  rlineto (-6) (-8);
  moveto y_bars_margin graph_y_max;
  rlineto 6 (-8);
end;;

let draw_graduations x_cnt y_cnt width length color =
  begin
    set_line_width width;
    set_color color;
    let index = ref (graph_x_min + x_interval) in
      while !index < graph_x_max do
	moveto !index (x_bars_margin - length / 2);
	rlineto 0 length;
	index := !index + x_interval
      done;
    let index = ref (graph_y_min + y_interval) in
      while !index < graph_y_max do
        moveto (y_bars_margin - length / 2) !index;
	rlineto length 0;
	index := !index + y_interval;
      done
  end;;

let draw_labels color =
  begin
    set_color color;
    moveto (window_width - bars_outter_margin * 2 / 3) (graph_y_min - snd (text_size "Y") / 2);
    draw_char 'X';
    moveto graph_x_min (window_height - bars_outter_margin * 2 / 3);
    draw_char 'Y';
  end;;

let draw_units minmaxcolor secondcolor =
  let y_min_str = string_of_num !y_min in
  let x_y_pos = ((graph_y_min - snd (text_size "0")) / 2)
  and y_x_pos str = ((graph_x_min - fst (text_size str)) / 2)
  and lx_min, ly_min = graph_x_min + units_offset, graph_y_min + units_offset in
  begin
    set_color minmaxcolor;
    moveto lx_min x_y_pos;
    draw_string (string_of_num !x_min);
    moveto (y_x_pos (string_of_num !y_min)) (graph_y_min + units_offset);
    draw_string (string_of_num !y_min);
    moveto (graph_x_max + units_offset) x_y_pos;
    draw_string (string_of_num !x_max);
    moveto (y_x_pos (string_of_num !y_max)) (graph_y_max + units_offset);
    draw_string (string_of_num !y_max);
    set_color secondcolor;
    moveto (lx_min + x_interval) x_y_pos;
    draw_string (string_of_num ((!x_max -/ !x_min) // num_of_int x_graduations +/ !x_min));
    let secondgrad = (!y_max -/ !y_min) // num_of_int y_graduations +/ !y_min in
      begin
	moveto (y_x_pos (string_of_num secondgrad)) (ly_min + y_interval);
	draw_string (string_of_num secondgrad);
      end
  end;;

let draw_cross (x, y) width length color =
  let milen = length / 2
in
  begin
    set_line_width width;
    set_color color;
    moveto (x - milen) (y - milen);
    rlineto length length;
    moveto (x - milen) (y + milen);
    rlineto length (-length);
  end

(************************)
(*  HERE IS THE PROBLEM *)
(************************)

let draw_curve color =
  begin
    set_color color;
    let index = ref !x_min in
    let ival = (!x_max -/ !x_min) // num_of_int (graph_width * 2) in
    while !index <=/ !x_max do
      let yval = poly_apply poly !index in
     (* uncomment the "try with" block to trigger the bug *)
(*     try    *)
     begin
	print_endline ("ici " ^ string_of_num yval);
	let (graph_x, graph_y) = scale_point (!index, yval) in
	  begin
	    printf "%d %d\n" graph_x graph_y;
	    fill_circle graph_x graph_y 1;
	  end;
	print_endline "la";
	end;
(*      with _ -> failwith "ici maintenant";     *)
      print_endline "et encore la";
      index := !index +/ ival;
    done
  end

(* for me that outputs :
   when the "try with" is uncommented

ici 0
48 147
la
ici 0
48 147
la
ici 0
48 147
la
ici 0
[....]

*)
  

let draw_points points cross_width cross_length cross_color =
  List.iter (fun point ->
    draw_cross (scale_point point) cross_width cross_length cross_color) points;;

let draw_graph () =
  begin
    draw_bars bars_width bars_color;
    draw_graduations x_graduations y_graduations graduations_width
			graduations_length graduations_color;
    draw_labels labels_color;
    draw_units units_minmax_color units_second_color;
    draw_curve curve_color;
    draw_points !points cross_width cross_length cross_color;
  end;;

try
  draw_graph ();
  while true do
    if int_of_char (wait_next_event [ Key_pressed ]).key = 27 then
      raise Exit
  done
with Exit -> exit 0;;