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

37
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,6 +28,10 @@ module Congruence : NAKED_VALUE_DOMAIN = struct
} }
let meet z1 z2 = 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 lcm = Z.lcm z1.multiple z2.multiple in
let gcd = Z.gcd 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 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) 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 + ";