@ -186,7 +186,6 @@ module Bound = struct
| Linear of int * SymLinear . t
| Linear of int * SymLinear . t
| MinMax of int * sign_t * min_max_t * int * Symbol . t
| MinMax of int * sign_t * min_max_t * int * Symbol . t
| PInf
| PInf
| Bot
[ @@ deriving compare ]
[ @@ deriving compare ]
let equal = [ % compare . equal : t ]
let equal = [ % compare . equal : t ]
@ -204,8 +203,6 @@ module Bound = struct
-> F . fprintf fmt " -oo "
-> F . fprintf fmt " -oo "
| PInf
| PInf
-> F . fprintf fmt " +oo "
-> F . fprintf fmt " +oo "
| Bot
-> F . fprintf fmt " _|_ "
| Linear ( c , x )
| Linear ( c , x )
-> if SymLinear . le x SymLinear . empty then F . fprintf fmt " %d " c
-> if SymLinear . le x SymLinear . empty then F . fprintf fmt " %d " c
else if Int . equal c 0 then F . fprintf fmt " %a " SymLinear . pp x
else if Int . equal c 0 then F . fprintf fmt " %a " SymLinear . pp x
@ -224,7 +221,7 @@ module Bound = struct
let of_sym : SymLinear . t -> t = fun s -> Linear ( 0 , s )
let of_sym : SymLinear . t -> t = fun s -> Linear ( 0 , s )
let is_symbolic : t -> bool = function
let is_symbolic : t -> bool = function
| MInf | PInf | Bot
| MInf | PInf
-> false
-> false
| Linear ( _ , se )
| Linear ( _ , se )
-> not ( SymLinear . is_empty se )
-> not ( SymLinear . is_empty se )
@ -238,13 +235,13 @@ module Bound = struct
let eq_symbol : Symbol . t -> t -> bool =
let eq_symbol : Symbol . t -> t -> bool =
fun s ->
fun s ->
function
function
| Linear ( c , se )
| Linear ( 0 , se )
-> Int . equal c 0 && opt_lift Symbol . eq ( SymLinear . get_one_symbol_opt se ) ( Some s )
-> opt_lift Symbol . eq ( SymLinear . get_one_symbol_opt se ) ( Some s )
| _
| _
-> false
-> false
let lift_get_one_symbol : ( SymLinear . t -> Symbol . t option ) -> t -> Symbol . t option =
let lift_get_one_symbol : ( SymLinear . t -> Symbol . t option ) -> t -> Symbol . t option =
fun f -> function Linear ( c , se ) when Int . equal c 0 -> f se | _ -> None
fun f -> function Linear ( 0 , se ) -> f se | _ -> None
let get_one_symbol_opt : t -> Symbol . t option = lift_get_one_symbol SymLinear . get_one_symbol_opt
let get_one_symbol_opt : t -> Symbol . t option = lift_get_one_symbol SymLinear . get_one_symbol_opt
@ -264,20 +261,27 @@ module Bound = struct
let use_symbol : Symbol . t -> t -> bool =
let use_symbol : Symbol . t -> t -> bool =
fun s ->
fun s ->
function
function
| PInf | MInf | Bot
| PInf | MInf
-> false
-> false
| Linear ( _ , se )
| Linear ( _ , se )
-> SymLinear . find s se < > 0
-> SymLinear . find s se < > 0
| MinMax ( _ , _ , _ , _ , s' )
| MinMax ( _ , _ , _ , _ , s' )
-> Symbol . eq s s'
-> Symbol . eq s s'
let subst1 : t -> t -> Symbol . t -> t -> t =
let subst1 : default : t -> t bottom_lifted -> Symbol . t -> t bottom_lifted -> t bottom_lifted =
fun default x s y ->
fun ~ default x0 s y0 ->
if not ( use_symbol s x ) then x
match ( x0 , y0 ) with
else
| Bottom , _
-> x0
| NonBottom x , _ when eq_symbol s x
-> y0
| NonBottom x , _ when not ( use_symbol s x )
-> x0
| NonBottom _ , Bottom
-> NonBottom default
| NonBottom x , NonBottom y
-> let res =
match ( x , y ) with
match ( x , y ) with
| _ , _ when eq_symbol s x
-> y
| Linear ( c1 , se1 ) , Linear ( c2 , se2 )
| Linear ( c1 , se1 ) , Linear ( c2 , se2 )
-> let coeff = SymLinear . find s se1 in
-> let coeff = SymLinear . find s se1 in
let c' = c1 + coeff * c2 in
let c' = c1 + coeff * c2 in
@ -330,10 +334,12 @@ module Bound = struct
-> MinMax ( c1 - c2 , Minus , Min , min ( - d1 + c2 ) d2 , s' )
-> MinMax ( c1 - c2 , Minus , Min , min ( - d1 + c2 ) d2 , s' )
| _
| _
-> default
-> default
in
NonBottom res
(* substitution symbols in ``x'' with respect to ``map'' *)
(* substitution symbols in ``x'' with respect to ``map'' *)
let subst : t -> t -> t SubstMap . t -> t =
let subst : default: t -> t -> t bottom_lifted SubstMap . t -> t bottom_lifted =
fun default x map -> SubstMap . fold ( fun s y x -> subst1 default x s y ) map x
fun ~ default x map -> SubstMap . fold ( fun s y x -> subst1 ~ default x s y ) map ( NonBottom x )
let int_ub_of_minmax = function
let int_ub_of_minmax = function
| MinMax ( c , Plus , Min , d , _ )
| MinMax ( c , Plus , Min , d , _ )
@ -342,7 +348,7 @@ module Bound = struct
-> Some ( c - d )
-> Some ( c - d )
| MinMax _
| MinMax _
-> None
-> None
| MInf | PInf | Linear _ | Bot
| MInf | PInf | Linear _
-> assert false
-> assert false
let int_lb_of_minmax = function
let int_lb_of_minmax = function
@ -352,7 +358,7 @@ module Bound = struct
-> Some ( c - d )
-> Some ( c - d )
| MinMax _
| MinMax _
-> None
-> None
| MInf | PInf | Linear _ | Bot
| MInf | PInf | Linear _
-> assert false
-> assert false
let linear_ub_of_minmax = function
let linear_ub_of_minmax = function
@ -362,7 +368,7 @@ module Bound = struct
-> Some ( Linear ( c , SymLinear . singleton x ( - 1 ) ) )
-> Some ( Linear ( c , SymLinear . singleton x ( - 1 ) ) )
| MinMax _
| MinMax _
-> None
-> None
| MInf | PInf | Linear _ | Bot
| MInf | PInf | Linear _
-> assert false
-> assert false
let linear_lb_of_minmax = function
let linear_lb_of_minmax = function
@ -372,7 +378,7 @@ module Bound = struct
-> Some ( Linear ( c , SymLinear . singleton x ( - 1 ) ) )
-> Some ( Linear ( c , SymLinear . singleton x ( - 1 ) ) )
| MinMax _
| MinMax _
-> None
-> None
| MInf | PInf | Linear _ | Bot
| MInf | PInf | Linear _
-> assert false
-> assert false
let le_minmax_by_int x y =
let le_minmax_by_int x y =
@ -384,7 +390,6 @@ module Bound = struct
let rec le : t -> t -> bool =
let rec le : t -> t -> bool =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
match ( x , y ) with
match ( x , y ) with
| MInf , _ | _ , PInf
| MInf , _ | _ , PInf
-> true
-> true
@ -413,7 +418,6 @@ module Bound = struct
let lt : t -> t -> bool =
let lt : t -> t -> bool =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
match ( x , y ) with
match ( x , y ) with
| MInf , Linear _ | MInf , MinMax _ | MInf , PInf | Linear _ , PInf | MinMax _ , PInf
| MInf , Linear _ | MInf , MinMax _ | MInf , PInf | Linear _ , PInf | MinMax _ , PInf
-> true
-> true
@ -426,11 +430,7 @@ module Bound = struct
let gt : t -> t -> bool = fun x y -> lt y x
let gt : t -> t -> bool = fun x y -> lt y x
let eq : t -> t -> bool =
let eq : t -> t -> bool = fun x y -> le x y && le y x
fun x y ->
if equal x Bot && equal y Bot then true
else if equal x Bot | | equal y Bot then false
else le x y && le y x
let remove_max_int : t -> t =
let remove_max_int : t -> t =
fun x ->
fun x ->
@ -444,7 +444,6 @@ module Bound = struct
let rec lb : ? default : t -> t -> t -> t =
let rec lb : ? default : t -> t -> t -> t =
fun ? ( default = MInf ) x y ->
fun ? ( default = MInf ) x y ->
assert ( x < > Bot && y < > Bot ) ;
if le x y then x
if le x y then x
else if le y x then y
else if le y x then y
else
else
@ -490,7 +489,6 @@ module Bound = struct
let ub : t -> t -> t =
let ub : t -> t -> t =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
if le x y then y
if le x y then y
else if le y x then x
else if le y x then x
else
else
@ -508,14 +506,12 @@ module Bound = struct
let widen_l : t -> t -> t =
let widen_l : t -> t -> t =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
if equal x PInf | | equal y PInf then L . ( die InternalError ) " Lower bound cannot be +oo. "
if equal x PInf | | equal y PInf then L . ( die InternalError ) " Lower bound cannot be +oo. "
else if le x y then x
else if le x y then x
else MInf
else MInf
let widen_u : t -> t -> t =
let widen_u : t -> t -> t =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
if equal x MInf | | equal y MInf then L . ( die InternalError ) " Upper bound cannot be -oo. "
if equal x MInf | | equal y MInf then L . ( die InternalError ) " Upper bound cannot be -oo. "
else if le y x then x
else if le y x then x
else PInf
else PInf
@ -529,22 +525,17 @@ module Bound = struct
let mone : t = Linear ( - 1 , SymLinear . zero )
let mone : t = Linear ( - 1 , SymLinear . zero )
let is_some_const : int -> t -> bool =
let is_some_const : int -> t -> bool =
fun c x ->
fun c x -> match x with Linear ( c' , y ) -> Int . equal c c' && SymLinear . is_zero y | _ -> false
assert ( x < > Bot ) ;
match x with Linear ( c' , y ) -> Int . equal c c' && SymLinear . is_zero y | _ -> false
let is_zero : t -> bool = is_some_const 0
let is_zero : t -> bool = is_some_const 0
let is_one : t -> bool = is_some_const 1
let is_one : t -> bool = is_some_const 1
let is_const : t -> int option =
let is_const : t -> int option =
fun x ->
fun x -> match x with Linear ( c , y ) when SymLinear . is_zero y -> Some c | _ -> None
assert ( x < > Bot ) ;
match x with Linear ( c , y ) when SymLinear . is_zero y -> Some c | _ -> None
let plus_l : t -> t -> t =
let plus_l : t -> t -> t =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
match ( x , y ) with
match ( x , y ) with
| _ , _ when is_zero x
| _ , _ when is_zero x
-> y
-> y
@ -567,7 +558,6 @@ module Bound = struct
let plus_u : t -> t -> t =
let plus_u : t -> t -> t =
fun x y ->
fun x y ->
assert ( x < > Bot && y < > Bot ) ;
match ( x , y ) with
match ( x , y ) with
| _ , _ when is_zero x
| _ , _ when is_zero x
-> y
-> y
@ -590,7 +580,6 @@ module Bound = struct
let mult_const : t -> int -> t option =
let mult_const : t -> int -> t option =
fun x n ->
fun x n ->
assert ( x < > Bot ) ;
assert ( n < > 0 ) ;
assert ( n < > 0 ) ;
match x with
match x with
| MInf
| MInf
@ -604,7 +593,6 @@ module Bound = struct
let div_const : t -> int -> t option =
let div_const : t -> int -> t option =
fun x n ->
fun x n ->
assert ( x < > Bot ) ;
if Int . equal n 0 then Some zero
if Int . equal n 0 then Some zero
else
else
match x with
match x with
@ -628,8 +616,6 @@ module Bound = struct
-> Some ( Linear ( - c , SymLinear . neg x ) )
-> Some ( Linear ( - c , SymLinear . neg x ) )
| MinMax ( c , sign , min_max , d , x )
| MinMax ( c , sign , min_max , d , x )
-> Some ( MinMax ( - c , neg_sign sign , min_max , d , x ) )
-> Some ( MinMax ( - c , neg_sign sign , min_max , d , x ) )
| Bot
-> assert false
let get_symbols : t -> Symbol . t list = function
let get_symbols : t -> Symbol . t list = function
| MInf | PInf
| MInf | PInf
@ -638,8 +624,6 @@ module Bound = struct
-> SymLinear . get_symbols se
-> SymLinear . get_symbols se
| MinMax ( _ , _ , _ , _ , s )
| MinMax ( _ , _ , _ , _ , s )
-> [ s ]
-> [ s ]
| Bot
-> assert false
let is_not_infty : t -> bool = function MInf | PInf -> false | _ -> true
let is_not_infty : t -> bool = function MInf | PInf -> false | _ -> true
end
end
@ -661,8 +645,15 @@ module ItvPure = struct
let make : Bound . t -> Bound . t -> t = fun l u -> ( l , u )
let make : Bound . t -> Bound . t -> t = fun l u -> ( l , u )
let subst : t -> Bound . t SubstMap . t -> t =
let subst : t -> Bound . t bottom_lifted SubstMap . t -> t bottom_lifted =
fun x map -> ( Bound . subst Bound . MInf ( lb x ) map , Bound . subst Bound . PInf ( ub x ) map )
fun x map ->
match
( Bound . subst ~ default : Bound . MInf ( lb x ) map , Bound . subst ~ default : Bound . PInf ( ub x ) map )
with
| NonBottom l , NonBottom u
-> NonBottom ( l , u )
| _
-> Bottom
let ( < = ) : lhs : t -> rhs : t -> bool =
let ( < = ) : lhs : t -> rhs : t -> bool =
fun ~ lhs : ( l1 , u1 ) ~ rhs : ( l2 , u2 ) -> Bound . le l2 l1 && Bound . le u1 u2
fun ~ lhs : ( l1 , u1 ) ~ rhs : ( l2 , u2 ) -> Bound . le l2 l1 && Bound . le u1 u2
@ -739,11 +730,9 @@ module ItvPure = struct
let is_symbolic : t -> bool = fun ( lb , ub ) -> Bound . is_symbolic lb | | Bound . is_symbolic ub
let is_symbolic : t -> bool = fun ( lb , ub ) -> Bound . is_symbolic lb | | Bound . is_symbolic ub
let is_ge_zero : t -> bool =
let is_ge_zero : t -> bool = fun ( lb , _ ) -> Bound . le Bound . zero lb
fun ( lb , _ ) -> if lb < > Bound . Bot then Bound . le Bound . zero lb else false
let is_le_zero : t -> bool =
let is_le_zero : t -> bool = fun ( _ , ub ) -> Bound . le ub Bound . zero
fun ( _ , ub ) -> if ub < > Bound . Bot then Bound . le ub Bound . zero else false
let neg : t -> t =
let neg : t -> t =
fun ( l , u ) ->
fun ( l , u ) ->
@ -865,15 +854,12 @@ module ItvPure = struct
let min_sem : t -> t -> t = fun ( l1 , u1 ) ( l2 , u2 ) -> ( Bound . lb l1 l2 , Bound . lb ~ default : u1 u1 u2 )
let min_sem : t -> t -> t = fun ( l1 , u1 ) ( l2 , u2 ) -> ( Bound . lb l1 l2 , Bound . lb ~ default : u1 u1 u2 )
let invalid : t -> bool =
let invalid : t -> bool = function Bound . PInf , _ | _ , Bound . MInf -> true | l , u -> Bound . lt u l
fun ( l , u ) ->
Bound . equal l Bound . Bot | | Bound . equal u Bound . Bot | | Bound . eq l Bound . PInf
| | Bound . eq u Bound . MInf | | Bound . lt u l
let prune_le : t -> t -> t =
let prune_le : t -> t -> t =
fun x y ->
fun x y ->
match ( x , y ) with
match ( x , y ) with
| ( l1 , u1 ) , ( _ , u2 ) when Bound . equal u1 Bound . PInf
| ( l1 , Bound . PInf ) , ( _ , u2 )
-> ( l1 , u2 )
-> ( l1 , u2 )
| ( l1 , Bound . Linear ( c1 , s1 ) ) , ( _ , Bound . Linear ( c2 , s2 ) ) when SymLinear . eq s1 s2
| ( l1 , Bound . Linear ( c1 , s1 ) ) , ( _ , Bound . Linear ( c2 , s2 ) ) when SymLinear . eq s1 s2
-> ( l1 , Bound . Linear ( min c1 c2 , s1 ) )
-> ( l1 , Bound . Linear ( min c1 c2 , s1 ) )
@ -899,7 +885,7 @@ module ItvPure = struct
let prune_ge : t -> t -> t =
let prune_ge : t -> t -> t =
fun x y ->
fun x y ->
match ( x , y ) with
match ( x , y ) with
| ( l1 , u1 ) , ( l2 , _ ) when Bound . equal l1 Bound . MInf
| ( Bound . MInf , u1 ) , ( l2 , _ )
-> ( l2 , u1 )
-> ( l2 , u1 )
| ( Bound . Linear ( c1 , s1 ) , u1 ) , ( Bound . Linear ( c2 , s2 ) , _ ) when SymLinear . eq s1 s2
| ( Bound . Linear ( c1 , s1 ) , u1 ) , ( Bound . Linear ( c2 , s2 ) , _ ) when SymLinear . eq s1 s2
-> ( Bound . Linear ( max c1 c2 , s1 ) , u1 )
-> ( Bound . Linear ( max c1 c2 , s1 ) , u1 )
@ -971,8 +957,6 @@ module ItvPure = struct
fun ( l , u as x ) -> if Bound . lt l Bound . zero then ( Bound . zero , u ) else x
fun ( l , u as x ) -> if Bound . lt l Bound . zero then ( Bound . zero , u ) else x
let normalize : t -> t option = fun ( l , u ) -> if invalid ( l , u ) then None else Some ( l , u )
let normalize : t -> t option = fun ( l , u ) -> if invalid ( l , u ) then None else Some ( l , u )
let has_bnd_bot : t -> bool = fun ( l , u ) -> Bound . equal l Bound . Bot | | Bound . equal u Bound . Bot
end
end
include AbstractDomain . BottomLifted ( ItvPure )
include AbstractDomain . BottomLifted ( ItvPure )
@ -1124,8 +1108,8 @@ let prune_eq : t -> t -> t = lift2_opt ItvPure.prune_eq
let prune_ne : t -> t -> t = lift2_opt ItvPure . prune_ne
let prune_ne : t -> t -> t = lift2_opt ItvPure . prune_ne
let subst : t -> Bound . t SubstMap . t -> t =
let subst : t -> Bound . t bottom_lifted SubstMap . t -> t =
fun x map -> match x with NonBottom x' -> NonBottom ( ItvPure . subst x' map ) | _ -> x
fun x map -> match x with NonBottom x' -> ItvPure . subst x' map | _ -> x
let get_symbols : t -> Symbol . t list = function
let get_symbols : t -> Symbol . t list = function
| Bottom
| Bottom
@ -1134,5 +1118,3 @@ let get_symbols : t -> Symbol.t list = function
-> ItvPure . get_symbols x
-> ItvPure . get_symbols x
let normalize : t -> t = lift1_opt ItvPure . normalize
let normalize : t -> t = lift1_opt ItvPure . normalize
let has_bnd_bot : t -> bool = function Bottom -> false | NonBottom x -> ItvPure . has_bnd_bot x