diff --git a/src/analyses/apron/relationAnalysis.apron.ml b/src/analyses/apron/relationAnalysis.apron.ml index 6bc8b3b1f2..128eda3f54 100644 --- a/src/analyses/apron/relationAnalysis.apron.ml +++ b/src/analyses/apron/relationAnalysis.apron.ml @@ -268,6 +268,58 @@ struct let branch man e b = let st = man.local in let ask = Analyses.ask_of_man man in + let () = + let r1 = RD.keep_filter st.rel (fun var -> + match RV.find_metadata var with + | Some (Local _) -> true + | _ -> false + ) + in + Logs.debug "r1: %a" RD.pretty r1; + let r1vars = RD.vars r1 in + let r1vars' = List.map (fun var -> + match RV.find_metadata var with + | Some (Local x) -> RV.arg x + | _ -> assert false + ) r1vars + in + let r2 = RD.add_vars r1 r1vars' in + let r2' = RD.assign_var_parallel' r2 r1vars' r1vars in + let r3 = RD.keep_vars r2' r1vars' in + Logs.debug "r3: %a" RD.pretty r3; + (* let r3' = RD.assr3 in *) + (* Logs.debug "r3': %a" RD.pretty r3'; *) + let r4 = RD.unify r1 r3 in + let r5 = + List.fold_left (fun acc var -> + match RV.to_cil_varinfo var with + | Some vi when TerminationPreprocessing.VarToStmt.mem vi !LoopTermination.loop_counters -> + let open Apron in + let env = RD.env acc in + (* let tcons1 = Tcons1.make Texpr1.(binop Sub (var env (RV.local vi)) (var env (RV.arg vi)) Int Zero) Lincons1.SUP in (* with AnyPrev *) *) + let tcons1 = Tcons1.make Texpr1.(binop Sub (binop Sub (var env (RV.local vi)) (var env (RV.arg vi)) Int Zero) (cst env (Coeff.s_of_int 1)) Int Zero) Lincons1.EQ in (* with LastPrev *) + let acc' = RD.meet_tcons ask acc tcons1 MyCFG.unknown_exp (lazy false) in + RD.remove_vars acc' [RV.local vi; RV.arg vi] + | _ -> + acc + ) r4 r1vars + in + Logs.debug "r5: %a" RD.pretty r5; + let scope = Node.find_fundec man.node in + let e_inv = Fun.id in (* TODO: handle globals? *) + let inv = + RD.invariant r5 + |> List.to_seq + |> Seq.filter_map (fun (lincons1: Apron.Lincons1.t) -> + RD.cil_exp_of_lincons1 lincons1 + |> Option.map e_inv + |> Option.filter (fun exp -> not (InvariantCil.exp_contains_tmp exp) && InvariantCil.exp_is_in_scope scope exp) + ) + |> Seq.fold_left (fun acc x -> Invariant.(acc && of_exp x)) Invariant.none + in + Logs.debug "inv: %a" Invariant.pretty inv; + () + in let res = assign_from_globals_wrapper ask man.global st e (fun rel' e' -> (* not an assign, but must remove g#in-s still *) RD.assert_inv ask rel' e' (not b) (no_overflow ask e) diff --git a/src/cdomains/apron/affineEqualityDenseDomain.apron.ml b/src/cdomains/apron/affineEqualityDenseDomain.apron.ml index 1db52f15a2..290f23f628 100644 --- a/src/cdomains/apron/affineEqualityDenseDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDenseDomain.apron.ml @@ -526,7 +526,7 @@ struct In case of a potential overflow, "no_ov" is set to false and Convert.tcons1_of_cil_exp will raise the exception Unsupported_CilExp Overflow *) - let meet_tcons ask t tcons expr = + let meet_tcons ask t tcons expr _ = let check_const cmp c = if cmp c Mpqf.zero then bot_env else t in let meet_vec e = (* Flip the sign of the const. val in coeff vec *) @@ -575,7 +575,7 @@ struct let assert_constraint ask d e negate no_ov = if M.tracing then M.tracel "assert_constraint" "assert_constraint with expr: %a %b" d_exp e (Lazy.force no_ov); match Convert.tcons1_of_cil_exp ask d d.env e negate no_ov with - | tcons1 -> meet_tcons ask d tcons1 e + | tcons1 -> meet_tcons ask d tcons1 e () | exception Convert.Unsupported_CilExp _ -> d let assert_constraint ask d e negate no_ov = timing_wrap "assert_constraint" (assert_constraint ask d e negate) no_ov diff --git a/src/cdomains/apron/affineEqualityDomain.apron.ml b/src/cdomains/apron/affineEqualityDomain.apron.ml index 06e131bbec..ddbc68912e 100644 --- a/src/cdomains/apron/affineEqualityDomain.apron.ml +++ b/src/cdomains/apron/affineEqualityDomain.apron.ml @@ -477,7 +477,7 @@ struct In case of a potential overflow, "no_ov" is set to false and Convert.tcons1_of_cil_exp will raise the exception Unsupported_CilExp Overflow *) - let meet_tcons ask t tcons expr = + let meet_tcons ask t tcons expr _ = let check_const cmp c = if cmp c Mpqf.zero then bot_env else t in let meet_vec e = (* Flip the sign of the const. val in coeff vec *) @@ -526,7 +526,7 @@ struct let assert_constraint ask d e negate no_ov = if M.tracing then M.tracel "assert_constraint" "assert_constraint with expr: %a %b" d_exp e (Lazy.force no_ov); match Convert.tcons1_of_cil_exp ask d d.env e negate no_ov with - | tcons1 -> meet_tcons ask d tcons1 e + | tcons1 -> meet_tcons ask d tcons1 e () | exception Convert.Unsupported_CilExp _ -> d let assert_constraint ask d e negate no_ov = timing_wrap "assert_constraint" (assert_constraint ask d e negate) no_ov diff --git a/src/cdomains/apron/apronDomain.apron.ml b/src/cdomains/apron/apronDomain.apron.ml index 2dd3b1e224..b2969af9bb 100644 --- a/src/cdomains/apron/apronDomain.apron.ml +++ b/src/cdomains/apron/apronDomain.apron.ml @@ -212,7 +212,7 @@ sig val mem_var : t -> Var.t -> bool val assign_var_parallel' : t -> Var.t list -> Var.t list -> t - val meet_tcons : Queries.ask -> t -> Tcons1.t -> exp -> t + val meet_tcons : Queries.ask -> t -> Tcons1.t -> exp -> bool Lazy.t -> t val to_lincons_array : t -> Lincons1.earray val of_lincons_array : Lincons1.earray -> t @@ -391,7 +391,7 @@ struct let texpr1 = Texpr1.of_expr (A.env nd) (Var v') in A.substitute_texpr_with Man.mgr nd v texpr1 None - let meet_tcons _ d tcons1 e = + let meet_tcons _ d tcons1 e _ = let earray = Tcons1.array_make (A.env d) 1 in Tcons1.array_set earray 0 tcons1; A.meet_tcons_array Man.mgr d earray @@ -536,7 +536,7 @@ struct if M.tracing then M.trace "apron" "assert_constraint %a %a" d_exp e Tcons1.pretty tcons1; if M.tracing then M.trace "apron" "assert_constraint st: %a" D.pretty d; if M.tracing then M.trace "apron" "assert_constraint tcons1: %a" Tcons1.pretty tcons1; - let r = meet_tcons ask d tcons1 e in + let r = meet_tcons ask d tcons1 e () in if M.tracing then M.trace "apron" "assert_constraint r: %a" D.pretty r; r | exception Convert.Unsupported_CilExp reason -> @@ -918,7 +918,8 @@ struct let substitute_var_with (b, d) v1 v2 = BoxD.substitute_var_with b v1 v2; D.substitute_var_with d v1 v2 - let meet_tcons ask (b, d) c e = (BoxD.meet_tcons ask b c e, D.meet_tcons ask d c e) + let env (b, d) = BoxD.env b + let meet_tcons ask (b, d) c e q = (BoxD.meet_tcons ask b c e q, D.meet_tcons ask d c e q) let to_lincons_array (_, d) = D.to_lincons_array d let of_lincons_array a = (BoxD.of_lincons_array a, D.of_lincons_array a) diff --git a/src/cdomains/apron/relationDomain.apron.ml b/src/cdomains/apron/relationDomain.apron.ml index 5d266cf474..ae26db68fc 100644 --- a/src/cdomains/apron/relationDomain.apron.ml +++ b/src/cdomains/apron/relationDomain.apron.ml @@ -128,6 +128,8 @@ sig val marshal: t -> marshal val unmarshal: marshal -> t val mem_var: t -> var -> bool + val env: t -> Environment.t + val meet_tcons: Queries.ask -> t -> Tcons1.t -> exp -> bool Lazy.t -> t val assert_inv : Queries.ask -> t -> exp -> bool -> bool Lazy.t -> t val eval_int : Queries.ask -> t -> exp -> bool Lazy.t -> Queries.ID.t end diff --git a/src/cdomains/apron/sharedFunctions.apron.ml b/src/cdomains/apron/sharedFunctions.apron.ml index 446b9d792d..44a2c45f26 100644 --- a/src/cdomains/apron/sharedFunctions.apron.ml +++ b/src/cdomains/apron/sharedFunctions.apron.ml @@ -210,12 +210,12 @@ struct texpr1_expr_of_cil_exp exp in let exp = Cil.constFold false exp in - if M.tracing then + if M.tracing then match conv exp with - | exception Unsupported_CilExp ex -> + | exception Unsupported_CilExp ex -> M.tracel "rel-texpr-cil-conv" "unsuccessfull: %s" (show_unsupported_cilExp ex); raise (Unsupported_CilExp ex) - | res -> + | res -> M.trace "relation" "texpr1_expr_of_cil_exp: %a -> %a (%b)" d_plainexp exp Texpr1.Expr.pretty res (Lazy.force no_ov); M.tracel "rel-texpr-cil-conv" "successfull: Good"; res @@ -296,6 +296,14 @@ struct let cil_exp_of_linexpr1_term ~scalewith (c: Coeff.t) v = match V.to_cil_varinfo v with | Some vinfo when IntDomain.Size.is_cast_injective ~from_type:vinfo.vtype ~to_type:(TInt(ILongLong,[])) -> + let vinfo = + match V.find_metadata v with + | Some (Arg v') -> + (* {v' with vname = ("\\at(" ^ v'.vname ^ ", AnyPrev)")} (* with i - i' > 0*) *) + {v' with vname = ("\\at(" ^ v'.vname ^ ", LastPrev)")} (* with i - i' - 1 = 0 *) + | _ -> + vinfo + in let var = Cilfacade.mkCast ~e:(Lval(Var vinfo,NoOffset)) ~newt:longlong in let flip, coeff = coeff_to_const ~scalewith c in let prod = BinOp(Mult, coeff, var, longlong) in @@ -461,7 +469,7 @@ struct let add_vars t vars = Vector.timing_wrap "add_vars" (add_vars t) vars let remove_vars t vars = - let t = copy t in + let t = copy t in let env' = Environment.remove_vars t.env vars in dimchange2_remove t env' @@ -514,6 +522,7 @@ sig val env: t -> Environment.t + val meet_tcons: Queries.ask -> t -> Tcons1.t -> exp -> bool Lazy.t -> t val assert_constraint: Queries.ask -> t -> exp -> bool -> bool Lazy.t -> t val eval_interval : Queries.ask -> t -> Texpr1.t -> Z.t option * Z.t option end