Fixed congruence domain

This commit is contained in:
soyouzpanda 2024-06-06 15:44:16 +02:00
parent 614e73bfb7
commit 43edb5714d

View file

@ -9,7 +9,14 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
let rand a b = if Z.equal a b then const a else all_numbers
let minus z = { multiple = z.multiple; offset = Z.neg z.offset }
let is_only_zero z = Z.equal z.multiple Z.zero && Z.equal z.offset Z.zero
let has_zero z = Z.equal (Z.rem z.offset z.multiple) Z.zero
let has_zero z = Z.divisible z.offset z.multiple
let subset z1 z2 =
Z.equal z2.multiple Z.zero && Z.equal z1.multiple Z.zero
&& Z.equal z1.offset z2.offset
|| (not (Z.equal z2.multiple Z.zero))
&& (Z.equal z1.multiple Z.zero || Z.divisible z2.multiple z1.multiple)
&& Z.equal (Z.rem z1.offset z2.multiple) (Z.rem z2.offset z2.multiple)
let join z1 z2 =
{
@ -21,11 +28,15 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
}
let meet z1 z2 =
let lcm = Z.lcm z1.multiple z2.multiple in
let gcd = Z.gcd z1.multiple z2.multiple in
if Z.equal (Z.rem z1.offset gcd) (Z.rem z2.offset gcd) then
{ multiple = lcm; offset = Z.rem z1.offset gcd }
else raise Absurd
if Z.equal z1.multiple Z.zero then if subset z1 z2 then z1 else raise Absurd
else if Z.equal z2.multiple Z.zero then
if subset z2 z1 then z2 else raise Absurd
else
let lcm = Z.lcm z1.multiple z2.multiple in
let gcd = Z.gcd z1.multiple z2.multiple in
if Z.equal (Z.rem z1.offset gcd) (Z.rem z2.offset gcd) then
{ multiple = lcm; offset = Z.rem z1.offset gcd }
else raise Absurd
let multiples_of z =
if is_only_zero z then z
@ -88,20 +99,16 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
else (z1, z2)
| AST_LESS ->
if
(not (Z.equal z1.multiple Z.zero))
&& not (Z.equal z2.multiple Z.zero)
|| Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& Z.lt z1.offset z2.offset
then (z1, z2)
else raise Absurd
Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& Z.geq z1.offset z2.offset
then raise Absurd
else (z1, z2)
| AST_LESS_EQUAL ->
if
(not (Z.equal z1.multiple Z.zero))
&& not (Z.equal z2.multiple Z.zero)
|| Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& Z.leq z1.offset z2.offset
then (z1, z2)
else raise Absurd
Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& Z.gt z1.offset z2.offset
then raise Absurd
else (z1, z2)
| AST_GREATER ->
let r1, r2 = compare z2 z1 AST_LESS in
(r2, r1)
@ -132,10 +139,6 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
let widen = join
let narrow = meet
let subset z1 z2 =
Z.divisible z2.multiple z1.multiple
&& Z.equal (Z.rem z1.offset z2.multiple) (Z.rem z2.offset z2.multiple)
let print fmt z =
Z.pp_print fmt z.multiple;
Format.pp_print_string fmt "Z + ";