nice bug correction wrt constants with a large number of digits. Would raise...

nice bug correction wrt constants with a large number of digits. Would raise exception when comparing these constants

src/corelang.ml

@@ -473,8 +473,21 @@ let rec dimension_of_expr expr =
 let sort_handlers hl =
  List.sort (fun (t, _) (t', _) -> compare t t') hl
 
+let num_10 = Num.num_of_int 10
+  
+let rec is_eq_const c1 c2 =
+  match c1, c2 with
+  | Const_real (n1, i1, _), Const_real (n2, i2, _)
+    -> Num.(let n1 = n1 // (num_10 **/ (num_of_int i1)) in
+	    let n2 = n2 // (num_10 **/ (num_of_int i2)) in
+	    eq_num n1 n2)
+  | Const_struct lcl1, Const_struct lcl2
+    -> List.length lcl1 = List.length lcl2
+    && List.for_all2 (fun (l1, c1) (l2, c2) -> l1 = l2 && is_eq_const c1 c2) lcl1 lcl2
+  | _  -> c1 = c2
+
 let rec is_eq_expr e1 e2 = match e1.expr_desc, e2.expr_desc with
-  | Expr_const c1, Expr_const c2 -> c1 = c2
+  | Expr_const c1, Expr_const c2 -> is_eq_const c1 c2
   | Expr_ident i1, Expr_ident i2 -> i1 = i2
   | Expr_array el1, Expr_array el2 
   | Expr_tuple el1, Expr_tuple el2 -> 

src/normalization.ml

@@ -80,8 +80,8 @@ let mk_fresh_var node loc ty ck =
 let get_expr_alias defs expr =
  try Some (List.find (fun eq -> is_eq_expr eq.eq_rhs expr) defs)
  with
-   Not_found -> None
-
+ | Not_found -> None
+  
 (* Replace [expr] with (tuple of) [locals] *)
 let replace_expr locals expr =
  match locals with
@@ -156,13 +156,13 @@ let mk_expr_alias_opt opt node (defs, vars) expr =
    taking propagated [offsets] into account
    in order to change expression type *)
 let mk_norm_expr offsets ref_e norm_d =
-(*Format.eprintf "mk_norm_expr %a %a @." Printers.pp_expr ref_e Printers.pp_expr { ref_e with expr_desc = norm_d};*)
+  (*Format.eprintf "mk_norm_expr %a %a @." Printers.pp_expr ref_e Printers.pp_expr { ref_e with expr_desc = norm_d};*)
   let drop_array_type ty =
     Types.map_tuple_type Types.array_element_type ty in
   { ref_e with
     expr_desc = norm_d;
     expr_type = Utils.repeat (List.length offsets) drop_array_type ref_e.expr_type }
-
+														
 (* normalize_<foo> : defs * used vars -> <foo> -> (updated defs * updated vars) * normalized <foo> *)
 let rec normalize_list alias node offsets norm_element defvars elist =
   List.fold_right
@@ -172,7 +172,7 @@ let rec normalize_list alias node offsets norm_element defvars elist =
     ) elist (defvars, [])
 
 let rec normalize_expr ?(alias=true) node offsets defvars expr =
-(*Format.eprintf "normalize %B %a:%a [%a]@." alias Printers.pp_expr expr Types.print_ty expr.expr_type (Utils.fprintf_list ~sep:"," Dimension.pp_dimension) offsets;*)
+  (*Format.eprintf "normalize %B %a:%a [%a]@." alias Printers.pp_expr expr Types.print_ty expr.expr_type (Utils.fprintf_list ~sep:"," Dimension.pp_dimension) offsets;*)
   match expr.expr_desc with
   | Expr_const _
   | Expr_ident _ -> defvars, unfold_offsets expr offsets