@@ -266,7 +266,15 @@ struct
266266 let ur = if Int64. compare max_int x2 = 0 then y2 else x2 in
267267 norm @@ Some (lr,ur)
268268
269+ (* Returns top if one of a, b is top, otherwise return result *)
270+ let on_top_return_top_bin a b result =
271+ if is_top a || is_top b then top () else result
272+
273+ let on_top_return_top_un a result =
274+ if is_top a then top () else result
275+
269276 let log f i1 i2 =
277+ on_top_return_top_bin i1 i2 @@
270278 match is_bot i1, is_bot i2 with
271279 | true , true -> bot ()
272280 | true , _
@@ -280,6 +288,7 @@ struct
280288 let logand = log (&& )
281289
282290 let log1 f i1 =
291+ on_top_return_top_un i1 @@
283292 if is_bot i1 then
284293 bot ()
285294 else
@@ -290,6 +299,7 @@ struct
290299 let lognot = log1 not
291300
292301 let bit f i1 i2 =
302+ on_top_return_top_bin i1 i2 @@
293303 match is_bot i1, is_bot i2 with
294304 | true , true -> bot ()
295305 | true , _
@@ -315,17 +325,20 @@ struct
315325 let shift_right = bit (fun x y -> Int64. shift_right x (Int64. to_int y))
316326 let shift_left = bit (fun x y -> Int64. shift_left x (Int64. to_int y))
317327
318- let neg = function None -> None | Some (x ,y ) -> norm @@ Some (Int64. neg y, Int64. neg x)
328+ let neg x = on_top_return_top_un x @@ match x with None -> None | Some (x ,y ) -> norm @@ Some (Int64. neg y, Int64. neg x)
319329
320330 let add x y =
331+ on_top_return_top_bin x y @@
321332 match x, y with
322333 | None , None -> None
323334 | None , _ | _ , None -> raise (ArithmeticOnIntegerBot (Printf. sprintf " %s op %s" (short 80 x) (short 80 y)))
324335 | Some (x1 ,x2 ), Some (y1 ,y2 ) -> norm @@ Some (Int64. add x1 y1, Int64. add x2 y2)
325336
326337 let sub i1 i2 = add i1 (neg i2)
327338
328- let rem x y = match x, y with
339+ let rem x y =
340+ on_top_return_top_bin x y @@
341+ match x, y with
329342 | None , None -> None
330343 | None , _ | _ , None -> raise (ArithmeticOnIntegerBot (Printf. sprintf " %s op %s" (short 80 x) (short 80 y)))
331344 | Some (xl , xu ), Some (yl , yu ) ->
@@ -348,16 +361,21 @@ struct
348361 meet (bit Int64. rem x y) range
349362
350363 let mul x y =
351- match x, y with
352- | None , None -> bot ()
353- | None , _ | _ , None -> raise (ArithmeticOnIntegerBot (Printf. sprintf " %s op %s" (short 80 x) (short 80 y)))
354- | Some (x1 ,x2 ), Some (y1 ,y2 ) ->
355- let x1y1 = (Int64. mul x1 y1) in let x1y2 = (Int64. mul x1 y2) in
356- let x2y1 = (Int64. mul x2 y1) in let x2y2 = (Int64. mul x2 y2) in
357- norm @@ Some ((min (min x1y1 x1y2) (min x2y1 x2y2)),
358- (max (max x1y1 x1y2) (max x2y1 x2y2)))
364+ if (is_top x || is_top y) && to_int x <> Some 0L && to_int y <> Some 0L then
365+ (* if one of the argument is zero, the result must be zero, even if the value is outside the range of Interval32 *)
366+ top ()
367+ else
368+ match x, y with
369+ | None , None -> bot ()
370+ | None , _ | _ , None -> raise (ArithmeticOnIntegerBot (Printf. sprintf " %s op %s" (short 80 x) (short 80 y)))
371+ | Some (x1 ,x2 ), Some (y1 ,y2 ) ->
372+ let x1y1 = (Int64. mul x1 y1) in let x1y2 = (Int64. mul x1 y2) in
373+ let x2y1 = (Int64. mul x2 y1) in let x2y2 = (Int64. mul x2 y2) in
374+ norm @@ Some ((min (min x1y1 x1y2) (min x2y1 x2y2)),
375+ (max (max x1y1 x1y2) (max x2y1 x2y2)))
359376
360377 let rec div x y =
378+ on_top_return_top_bin x y @@
361379 match x, y with
362380 | None , None -> bot ()
363381 | None , _ | _ , None -> raise (ArithmeticOnIntegerBot (Printf. sprintf " %s op %s" (short 80 x) (short 80 y)))
0 commit comments