From 43edb5714da313ff98781789cc3ba8200623f8fc Mon Sep 17 00:00:00 2001 From: soyouzpanda Date: Thu, 6 Jun 2024 15:44:16 +0200 Subject: [PATCH] Fixed congruence domain --- domains/congruence.ml | 47 +++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 22 deletions(-) diff --git a/domains/congruence.ml b/domains/congruence.ml index a7b3585..ffb7188 100644 --- a/domains/congruence.ml +++ b/domains/congruence.ml @@ -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 + ";