Fixed congruence domain
This commit is contained in:
parent
614e73bfb7
commit
43edb5714d
1 changed files with 25 additions and 22 deletions
|
@ -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,6 +28,10 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
|
|||
}
|
||||
|
||||
let meet z1 z2 =
|
||||
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
|
||||
|
@ -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 + ";
|
||||
|
|
Loading…
Reference in a new issue