Selene/AStat
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fixed congruence domain

Browse source
This commit is contained in:
soyouzpanda 2024-06-06 15:44:16 +02:00
parent 614e73bfb7
commit 43edb5714d
1 changed files with 25 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
domains/congruence.ml
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 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 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 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 = let join z1 z2 =
{ {
@ -21,11 +28,15 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
} }
let meet z1 z2 = let meet z1 z2 =
let lcm = Z.lcm z1.multiple z2.multiple in if Z.equal z1.multiple Z.zero then if subset z1 z2 then z1 else raise Absurd
let gcd = Z.gcd z1.multiple z2.multiple in else if Z.equal z2.multiple Z.zero then
if Z.equal (Z.rem z1.offset gcd) (Z.rem z2.offset gcd) then if subset z2 z1 then z2 else raise Absurd
{ multiple = lcm; offset = Z.rem z1.offset gcd } else
else raise Absurd 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 = let multiples_of z =
if is_only_zero z then z if is_only_zero z then z
@ -88,20 +99,16 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
else (z1, z2) else (z1, z2)
| AST_LESS -> | AST_LESS ->
if if
(not (Z.equal z1.multiple Z.zero)) Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& not (Z.equal z2.multiple Z.zero) && Z.geq z1.offset z2.offset
|| Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero then raise Absurd
&& Z.lt z1.offset z2.offset else (z1, z2)
then (z1, z2)
else raise Absurd
| AST_LESS_EQUAL -> | AST_LESS_EQUAL ->
if if
(not (Z.equal z1.multiple Z.zero)) Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero
&& not (Z.equal z2.multiple Z.zero) && Z.gt z1.offset z2.offset
|| Z.equal z1.multiple Z.zero && Z.equal z2.multiple Z.zero then raise Absurd
&& Z.leq z1.offset z2.offset else (z1, z2)
then (z1, z2)
else raise Absurd
| AST_GREATER -> | AST_GREATER ->
let r1, r2 = compare z2 z1 AST_LESS in let r1, r2 = compare z2 z1 AST_LESS in
(r2, r1) (r2, r1)
@ -132,10 +139,6 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
let widen = join let widen = join
let narrow = meet 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 = let print fmt z =
Z.pp_print fmt z.multiple; Z.pp_print fmt z.multiple;
Format.pp_print_string fmt "Z + "; Format.pp_print_string fmt "Z + ";