Commit e1b60790 authored by David Bühler's avatar David Bühler

[Ival] Fixes indentation.

parent 957a6506
...@@ -82,10 +82,10 @@ type t = ...@@ -82,10 +82,10 @@ type t =
| Set of Int_set.t | Set of Int_set.t
| Float of Fval.t | Float of Fval.t
| Itv of Int_interval.t | Itv of Int_interval.t
(* Binary abstract operations do not model precisely float/integer operations. (* Binary abstract operations do not model precisely float/integer operations.
It is the responsibility of the callers to have two operands of the same It is the responsibility of the callers to have two operands of the same
implicit type. The only exception is for [singleton_zero], which is the implicit type. The only exception is for [singleton_zero], which is the
correct representation of [0.] *) correct representation of [0.] *)
module Widen_Hints = Widen_Arithmetic_Value_Set module Widen_Hints = Widen_Arithmetic_Value_Set
...@@ -104,17 +104,17 @@ let hash = function ...@@ -104,17 +104,17 @@ let hash = function
let compare e1 e2 = let compare e1 e2 =
if e1==e2 then 0 else if e1==e2 then 0 else
match e1,e2 with match e1,e2 with
| Set s1, Set s2 -> Int_set.compare s1 s2 | Set s1, Set s2 -> Int_set.compare s1 s2
| _, Set _ -> 1 | _, Set _ -> 1
| Set _, _ -> -1 | Set _, _ -> -1
| Itv i1, Itv i2 -> Int_interval.compare i1 i2 | Itv i1, Itv i2 -> Int_interval.compare i1 i2
| _, Itv _ -> 1 | _, Itv _ -> 1
| Itv _, _ -> -1 | Itv _, _ -> -1
| Float(f1), Float(f2) -> | Float(f1), Float(f2) ->
Fval.compare f1 f2 Fval.compare f1 f2
(*| _, Float _ -> 1 (*| _, Float _ -> 1
| Float _, _ -> -1 *) | Float _, _ -> -1 *)
let equal e1 e2 = compare e1 e2 = 0 let equal e1 e2 = compare e1 e2 = 0
...@@ -122,7 +122,7 @@ let pretty fmt t = ...@@ -122,7 +122,7 @@ let pretty fmt t =
match t with match t with
| Itv i -> Int_interval.pretty fmt i | Itv i -> Int_interval.pretty fmt i
| Float (f) -> | Float (f) ->
Fval.pretty fmt f Fval.pretty fmt f
| Set s -> Int_set.pretty fmt s | Set s -> Int_set.pretty fmt s
let min_le_elt min elt = let min_le_elt min elt =
...@@ -166,8 +166,8 @@ let cardinal_zero_or_one v = ...@@ -166,8 +166,8 @@ let cardinal_zero_or_one v =
| Float f -> Fval.is_singleton f | Float f -> Fval.is_singleton f
let is_singleton_int v = match v with let is_singleton_int v = match v with
| Float _ | Itv _ -> false | Float _ | Itv _ -> false
| Set s -> Int_set.cardinal s = 1 | Set s -> Int_set.cardinal s = 1
(* TODO *) (* TODO *)
let is_bottom x = equal x bottom let is_bottom x = equal x bottom
...@@ -237,7 +237,7 @@ exception Not_Singleton_Int ...@@ -237,7 +237,7 @@ exception Not_Singleton_Int
let project_int v = match v with let project_int v = match v with
| Set s -> | Set s ->
if Int_set.cardinal s = 1 then Int_set.min s else raise Not_Singleton_Int if Int_set.cardinal s = 1 then Int_set.min s else raise Not_Singleton_Int
| _ -> raise Not_Singleton_Int | _ -> raise Not_Singleton_Int
let is_small_set = function let is_small_set = function
| Set _ -> true | Set _ -> true
...@@ -249,9 +249,9 @@ let project_small_set = function ...@@ -249,9 +249,9 @@ let project_small_set = function
let cardinal v = let cardinal v =
match v with match v with
| Itv i -> Int_interval.cardinal i | Itv i -> Int_interval.cardinal i
| Set s -> Some (Int.of_int (Int_set.cardinal s)) | Set s -> Some (Int.of_int (Int_set.cardinal s))
| Float f -> if Fval.is_singleton f then Some Int.one else None | Float f -> if Fval.is_singleton f then Some Int.one else None
let cardinal_estimate v ~size = let cardinal_estimate v ~size =
match v with match v with
...@@ -278,7 +278,7 @@ let cardinal_less_than v n = ...@@ -278,7 +278,7 @@ let cardinal_less_than v n =
| Itv i -> Extlib.the ~exn:Not_less_than (Int_interval.cardinal i) | Itv i -> Extlib.the ~exn:Not_less_than (Int_interval.cardinal i)
| Set s -> Int.of_int (Int_set.cardinal s) | Set s -> Int.of_int (Int_set.cardinal s)
| Float f -> | Float f ->
if Fval.is_singleton f then Int.one else raise Not_less_than if Fval.is_singleton f then Int.one else raise Not_less_than
in in
if Int.le c (Int.of_int n) if Int.le c (Int.of_int n)
then Int.to_int c (* This is smaller than the original [n] *) then Int.to_int c (* This is smaller than the original [n] *)
...@@ -296,17 +296,17 @@ let make ~min ~max ~rem ~modu = ...@@ -296,17 +296,17 @@ let make ~min ~max ~rem ~modu =
let l = Int.succ (Int.e_div (Int.sub mx mn) modu) in let l = Int.succ (Int.e_div (Int.sub mx mn) modu) in
if Int.le l !small_cardinal_Int if Int.le l !small_cardinal_Int
then then
let l = Int.to_int l in let l = Int.to_int l in
let s = Array.make l Int.zero in let s = Array.make l Int.zero in
let v = ref mn in let v = ref mn in
let i = ref 0 in let i = ref 0 in
while (!i < l) while (!i < l)
do do
s.(!i) <- !v; s.(!i) <- !v;
v := Int.add modu !v; v := Int.add modu !v;
incr i incr i
done; done;
assert (Int.equal !v (Int.add modu mx)); assert (Int.equal !v (Int.add modu mx));
Set (Int_set.inject_array s l) Set (Int_set.inject_array s l)
else Itv (Int_interval.make ~min ~max ~rem ~modu) else Itv (Int_interval.make ~min ~max ~rem ~modu)
else if Int.equal mx mn else if Int.equal mx mn
...@@ -489,27 +489,27 @@ let widen (bitsize,(wh,fh)) t1 t2 = ...@@ -489,27 +489,27 @@ let widen (bitsize,(wh,fh)) t1 t2 =
let meet v1 v2 = let meet v1 v2 =
if v1 == v2 then v1 else if v1 == v2 then v1 else
let result = let result =
match v1,v2 with match v1,v2 with
| Itv i1, Itv i2 -> inject_itv_or_bottom (Int_interval.meet i1 i2) | Itv i1, Itv i2 -> inject_itv_or_bottom (Int_interval.meet i1 i2)
| Set s1 , Set s2 -> inject_set_or_bottom (Int_set.meet s1 s2) | Set s1 , Set s2 -> inject_set_or_bottom (Int_set.meet s1 s2)
| Set s, Itv itv | Set s, Itv itv
| Itv itv, Set s -> | Itv itv, Set s ->
inject_set_or_bottom (Int_set.filter (fun i -> Int_interval.mem i itv) s) inject_set_or_bottom (Int_set.filter (fun i -> Int_interval.mem i itv) s)
| Float(f1), Float(f2) -> begin | Float(f1), Float(f2) -> begin
match Fval.meet f1 f2 with match Fval.meet f1 f2 with
| `Value f -> inject_float f | `Value f -> inject_float f
| `Bottom -> bottom | `Bottom -> bottom
end end
| (Float f as ff), (Itv _ | Set _ as o) | (Float f as ff), (Itv _ | Set _ as o)
| (Itv _ | Set _ as o), (Float f as ff) -> | (Itv _ | Set _ as o), (Float f as ff) ->
if equal o top then ff if equal o top then ff
else if contains_zero o && Fval.contains_plus_zero f then zero else if contains_zero o && Fval.contains_plus_zero f then zero
else bottom else bottom
in in
(* Format.printf "meet: %a /\\ %a -> %a@\n" (* Format.printf "meet: %a /\\ %a -> %a@\n"
pretty v1 pretty v2 pretty result;*) pretty v1 pretty v2 pretty result;*)
result result
let intersects v1 v2 = let intersects v1 v2 =
v1 == v2 || v1 == v2 ||
...@@ -530,7 +530,7 @@ let narrow v1 v2 = ...@@ -530,7 +530,7 @@ let narrow v1 v2 =
match v1, v2 with match v1, v2 with
| Set s1, Set s2 -> inject_set_or_bottom (Int_set.narrow s1 s2) | Set s1, Set s2 -> inject_set_or_bottom (Int_set.narrow s1 s2)
| Float _, Float _ | (Itv _| Set _), (Itv _ | Set _) -> | Float _, Float _ | (Itv _| Set _), (Itv _ | Set _) ->
meet v1 v2 (* meet is exact *) meet v1 v2 (* meet is exact *)
| v, (Itv _ as t) when equal t top -> v | v, (Itv _ as t) when equal t top -> v
| (Itv _ as t), v when equal t top -> v | (Itv _ as t), v when equal t top -> v
| Float f, (Set _ as s) | (Set _ as s), Float f when is_zero s -> begin | Float f, (Set _ as s) | (Set _ as s), Float f when is_zero s -> begin
...@@ -539,8 +539,8 @@ let narrow v1 v2 = ...@@ -539,8 +539,8 @@ let narrow v1 v2 =
| `Bottom -> bottom | `Bottom -> bottom
end end
| Float _, (Set _ | Itv _) | (Set _ | Itv _), Float _ -> | Float _, (Set _ | Itv _) | (Set _ | Itv _), Float _ ->
(* ill-typed case. It is better to keep the operation symmetric *) (* ill-typed case. It is better to keep the operation symmetric *)
top top
let link v1 v2 = match v1, v2 with let link v1 v2 = match v1, v2 with
| Set s1, Set s2 -> inject_set_or_top (Int_set.link s1 s2) | Set s1, Set s2 -> inject_set_or_top (Int_set.link s1 s2)
...@@ -587,15 +587,15 @@ let join v1 v2 = ...@@ -587,15 +587,15 @@ let join v1 v2 =
check min max rem modu; check min max rem modu;
Itv (Int_interval.make ~min ~max ~rem ~modu) Itv (Int_interval.make ~min ~max ~rem ~modu)
| Float(f1), Float(f2) -> | Float(f1), Float(f2) ->
inject_float (Fval.join f1 f2) inject_float (Fval.join f1 f2)
| Float (f) as ff, other | other, (Float (f) as ff) -> | Float (f) as ff, other | other, (Float (f) as ff) ->
if is_zero other if is_zero other
then inject_float (Fval.join Fval.plus_zero f) then inject_float (Fval.join Fval.plus_zero f)
else if is_bottom other then ff else if is_bottom other then ff
else top else top
in in
(* Format.printf "mod_join %a %a -> %a@." (* Format.printf "mod_join %a %a -> %a@."
pretty v1 pretty v2 pretty result; *) pretty v1 pretty v2 pretty result; *)
result result
let complement_int_under ~size ~signed i = let complement_int_under ~size ~signed i =
...@@ -676,14 +676,14 @@ let add_int v1 v2 = ...@@ -676,14 +676,14 @@ let add_int v1 v2 =
| Set s1, Set s2 -> inject_set_or_top (Int_set.add s1 s2) | Set s1, Set s2 -> inject_set_or_top (Int_set.add s1 s2)
| Itv i1, Itv i2 -> Itv (Int_interval.add i1 i2) | Itv i1, Itv i2 -> Itv (Int_interval.add i1 i2)
| Set s, Itv i | Itv i, Set s -> | Set s, Itv i | Itv i, Set s ->
let l = Int_set.cardinal s in let l = Int_set.cardinal s in
if l = 0 if l = 0
then bottom then bottom
else if l = 1 else if l = 1
then (* only one element *) then (* only one element *)
Itv (Int_interval.add_singleton_int (Int_set.min s) i) Itv (Int_interval.add_singleton_int (Int_set.min s) i)
else else
Itv (Int_interval.add i (make_itv_from_set s)) Itv (Int_interval.add i (make_itv_from_set s))
let add_int_under v1 v2 = match v1,v2 with let add_int_under v1 v2 = match v1,v2 with
| Float _, _ | _, Float _ -> assert false | Float _, _ | _, Float _ -> assert false
...@@ -756,17 +756,17 @@ let scale_div ~pos f v = ...@@ -756,17 +756,17 @@ let scale_div ~pos f v =
scale_div_common ~pos f v scale_div top scale_div_common ~pos f v scale_div top
let scale_div_under ~pos f v = let scale_div_under ~pos f v =
(* TODO: a more precise result could be obtained by transforming (* TODO: a more precise result could be obtained by transforming
Itv(min,max,r,m) into Itv(min,max,r/f,m/gcd(m,f)). But this is Itv(min,max,r,m) into Itv(min,max,r/f,m/gcd(m,f)). But this is
more complex to implement when pos or f is negative. *) more complex to implement when pos or f is negative. *)
scale_div_common ~pos f v Int_interval.scale_div_under bottom scale_div_common ~pos f v Int_interval.scale_div_under bottom
let div_set x sy = let div_set x sy =
Int_set.fold Int_set.fold
(fun acc elt -> (fun acc elt ->
if Int.is_zero elt if Int.is_zero elt
then acc then acc
else join acc (scale_div ~pos:false elt x)) else join acc (scale_div ~pos:false elt x))
bottom bottom
sy sy
...@@ -800,14 +800,14 @@ let c_rem x y = ...@@ -800,14 +800,14 @@ let c_rem x y =
if is_bottom x then bottom if is_bottom x then bottom
else inject_itv_or_bottom (Int_interval.c_rem (make_range x) iy) else inject_itv_or_bottom (Int_interval.c_rem (make_range x) iy)
| Set yy -> | Set yy ->
match x with match x with
| Set xx -> inject_set_or_top (Int_set.c_rem xx yy) | Set xx -> inject_set_or_top (Int_set.c_rem xx yy)
| Float _ -> top | Float _ -> top
| Itv _ -> | Itv _ ->
let f acc y = let f acc y =
join (scale_rem ~pos:false y x) acc join (scale_rem ~pos:false y x) acc
in in
Int_set.fold f bottom yy Int_set.fold f bottom yy
module AllValueHashtbl = module AllValueHashtbl =
Hashtbl.Make Hashtbl.Make
...@@ -815,7 +815,7 @@ module AllValueHashtbl = ...@@ -815,7 +815,7 @@ module AllValueHashtbl =
type t = Int.t * bool * int type t = Int.t * bool * int
let equal (a,b,c:t) (d,e,f:t) = b=e && c=f && Int.equal a d let equal (a,b,c:t) (d,e,f:t) = b=e && c=f && Int.equal a d
let hash (a,b,c:t) = let hash (a,b,c:t) =
257 * (Hashtbl.hash b) + 17 * (Hashtbl.hash c) + Int.hash a 257 * (Hashtbl.hash b) + 17 * (Hashtbl.hash c) + Int.hash a
end) end)
let all_values_table = AllValueHashtbl.create 7 let all_values_table = AllValueHashtbl.create 7
...@@ -823,13 +823,13 @@ let all_values_table = AllValueHashtbl.create 7 ...@@ -823,13 +823,13 @@ let all_values_table = AllValueHashtbl.create 7
let create_all_values_modu ~modu ~signed ~size = let create_all_values_modu ~modu ~signed ~size =
let t = modu, signed, size in let t = modu, signed, size in
try try
AllValueHashtbl.find all_values_table t AllValueHashtbl.find all_values_table t
with Not_found -> with Not_found ->
let mn, mx = let mn, mx =
if signed then if signed then
let b = Int.two_power_of_int (size-1) in let b = Int.two_power_of_int (size-1) in
(Int.round_up_to_r ~min:(Int.neg b) ~modu ~r:Int.zero, (Int.round_up_to_r ~min:(Int.neg b) ~modu ~r:Int.zero,
Int.round_down_to_r ~max:(Int.pred b) ~modu ~r:Int.zero) Int.round_down_to_r ~max:(Int.pred b) ~modu ~r:Int.zero)
else else
let b = Int.two_power_of_int size in let b = Int.two_power_of_int size in
Int.zero, Int.zero,
...@@ -858,65 +858,65 @@ let cast_int_to_int ~size ~signed value = ...@@ -858,65 +858,65 @@ let cast_int_to_int ~size ~signed value =
if equal top value if equal top value
then create_all_values ~size:(Int.to_int size) ~signed then create_all_values ~size:(Int.to_int size) ~signed
else else
let result = let result =
let factor = Int.two_power size in let factor = Int.two_power size in
let mask = Int.two_power (Int.pred size) in let mask = Int.two_power (Int.pred size) in
let rem_f value = Int.cast ~size ~signed ~value let rem_f value = Int.cast ~size ~signed ~value
in
let not_p_factor = Int.neg factor in
let best_effort r m =
let modu = Int.pgcd factor m in
let rr = Int.e_rem r modu in
let min_val = Some (if signed then
Int.round_up_to_r ~min:(Int.neg mask) ~r:rr ~modu
else
Int.round_up_to_r ~min:Int.zero ~r:rr ~modu)
in in
let max_val = Some (if signed then let not_p_factor = Int.neg factor in
Int.round_down_to_r ~max:(Int.pred mask) ~r:rr ~modu let best_effort r m =
else let modu = Int.pgcd factor m in
Int.round_down_to_r ~max:(Int.pred factor) let rr = Int.e_rem r modu in
~r:rr let min_val = Some (if signed then
~modu) Int.round_up_to_r ~min:(Int.neg mask) ~r:rr ~modu
else
Int.round_up_to_r ~min:Int.zero ~r:rr ~modu)
in
let max_val = Some (if signed then
Int.round_down_to_r ~max:(Int.pred mask) ~r:rr ~modu
else
Int.round_down_to_r ~max:(Int.pred factor)
~r:rr
~modu)
in
inject_top min_val max_val rr modu
in in
inject_top min_val max_val rr modu match value with
in | Itv i->
match value with begin
| Itv i-> let mn, mx, r, m = Int_interval.min_max_rem_modu i in
begin match mn, mx with
let mn, mx, r, m = Int_interval.min_max_rem_modu i in | Some mn, Some mx ->
match mn, mx with let highbits_mn,highbits_mx =
| Some mn, Some mx -> if signed then
let highbits_mn,highbits_mx = Int.logand (Int.add mn mask) not_p_factor,
if signed then Int.logand (Int.add mx mask) not_p_factor
Int.logand (Int.add mn mask) not_p_factor, else
Int.logand (Int.add mx mask) not_p_factor Int.logand mn not_p_factor, Int.logand mx not_p_factor
else in
Int.logand mn not_p_factor, Int.logand mx not_p_factor if Int.equal highbits_mn highbits_mx
then
if Int.is_zero highbits_mn
then value
else
let new_min = rem_f mn in
let new_r = Int.e_rem new_min m in
inject_top (Some new_min) (Some (rem_f mx)) new_r m
else best_effort r m
| _, _ -> best_effort r m
end
| Set s -> begin
let all =
create_all_values ~size:(Int.to_int size) ~signed
in in
if Int.equal highbits_mn highbits_mx if is_included value all
then then value
if Int.is_zero highbits_mn else Set (Int_set.map rem_f s)
then value end
else | Float _ -> assert false
let new_min = rem_f mn in in
let new_r = Int.e_rem new_min m in (* If sharing is no longer preserved, please change Cvalue.V.cast *)
inject_top (Some new_min) (Some (rem_f mx)) new_r m if equal result value then value else result
else best_effort r m
| _, _ -> best_effort r m
end
| Set s -> begin
let all =
create_all_values ~size:(Int.to_int size) ~signed
in
if is_included value all
then value
else Set (Int_set.map rem_f s)
end
| Float _ -> assert false
in
(* If sharing is no longer preserved, please change Cvalue.V.cast *)
if equal result value then value else result
let reinterpret_float_as_int ~signed ~size f = let reinterpret_float_as_int ~signed ~size f =
let reinterpret_list l = let reinterpret_list l =
...@@ -949,15 +949,15 @@ let cast_float_to_float fkind v = ...@@ -949,15 +949,15 @@ let cast_float_to_float fkind v =
match v with match v with
| Float f -> | Float f ->
begin match fkind with begin match fkind with
| Fval.Real | Fval.Long_Double | Fval.Double -> v | Fval.Real | Fval.Long_Double | Fval.Double -> v
| Fval.Single -> | Fval.Single ->
inject_float (Fval.round_to_single_precision_float f) inject_float (Fval.round_to_single_precision_float f)
end end
| Set _ when is_zero v -> zero | Set _ when is_zero v -> zero
| Set _ | Itv _ -> top_float | Set _ | Itv _ -> top_float
(* TODO rename to mul_int *) (* TODO rename to mul_int *)
let mul v1 v2 = let mul v1 v2 =
(* Format.printf "mul. Args: '%a' '%a'@\n" pretty v1 pretty v2; *) (* Format.printf "mul. Args: '%a' '%a'@\n" pretty v1 pretty v2; *)
let result = let result =
...@@ -967,7 +967,7 @@ let mul v1 v2 = ...@@ -967,7 +967,7 @@ let mul v1 v2 =
else else
match v1,v2 with match v1,v2 with
| Float _, _ | _, Float _ -> | Float _, _ | _, Float _ ->
top top
| Set s1, Set s2 -> inject_set_or_top (Int_set.mul s1 s2) | Set s1, Set s2 -> inject_set_or_top (Int_set.mul s1 s2)
| Itv i1, Itv i2 -> Itv (Int_interval.mul i1 i2) | Itv i1, Itv i2 -> Itv (Int_interval.mul i1 i2)
| Set s, Itv i | Itv i, Set s -> | Set s, Itv i | Itv i, Set s ->
...@@ -987,22 +987,22 @@ let mul v1 v2 = ...@@ -987,22 +987,22 @@ let mul v1 v2 =
let shift_aux scale op (x: t) (y: t) = let shift_aux scale op (x: t) (y: t) =
let y = narrow (inject_range (Some Int.zero) None) y in let y = narrow (inject_range (Some Int.zero) None) y in
try try
match y with match y with
| Set s -> | Set s ->
Int_set.fold (fun acc n -> join acc (scale (Int.two_power n) x)) bottom s Int_set.fold (fun acc n -> join acc (scale (Int.two_power n) x)) bottom s
| _ -> | _ ->
let min_factor = Extlib.opt_map Int.two_power (min_int y) in let min_factor = Extlib.opt_map Int.two_power (min_int y) in
let max_factor = Extlib.opt_map Int.two_power (max_int y) in let max_factor = Extlib.opt_map Int.two_power (max_int y) in
let modu = match min_factor with None -> Int.one | Some m -> m in let modu = match min_factor with None -> Int.one | Some m -> m in
let factor = inject_top min_factor max_factor Int.zero modu in let factor = inject_top min_factor max_factor Int.zero modu in
op x factor op x factor
with Z.Overflow -> with Z.Overflow ->
Lattice_messages.emit_imprecision emitter "Ival.shift_aux"; Lattice_messages.emit_imprecision emitter "Ival.shift_aux";
(* We only preserve the sign of the result *) (* We only preserve the sign of the result *)
if is_included x positive_integers then positive_integers if is_included x positive_integers then positive_integers
else else
if is_included x negative_integers then negative_integers if is_included x negative_integers then negative_integers
else top else top
let shift_right x y = shift_aux (scale_div ~pos:true) div x y let shift_right x y = shift_aux (scale_div ~pos:true) div x y
let shift_left x y = shift_aux scale mul x y let shift_left x y = shift_aux scale mul x y
...@@ -1205,15 +1205,15 @@ let rec extract_bits ~start ~stop ~size v = ...@@ -1205,15 +1205,15 @@ let rec extract_bits ~start ~stop ~size v =
let