Fixed congruence domain

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 + ";