package goblint

  1. Overview
  2. Docs
Static analysis framework for C

Install

Dune Dependency

Authors

Maintainers

Sources

goblint-2.5.0.tbz
sha256=452d8491527aea21f2cbb11defcc14ba0daf9fdb6bdb9fc0af73e56eac57b916
sha512=1993cd45c4c7fe124ca6e157f07d17ec50fab5611b270a434ed1b7fb2910aa85a8e6eaaa77dad770430710aafb2f6d676c774dd33942d921f23e2f9854486551

doc/src/goblint.domain/flagHelper.ml.html

Source file flagHelper.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(** Domain alternatives chosen by a runtime flag. *)

module type FlagError = sig
  val msg: string
  val name: string
end


module FlagHelper (L:Printable.S) (R:Printable.S) (Msg: FlagError) =
struct
  type t = L.t option * R.t option [@@deriving eq, ord, hash]

  let unop opl opr (h,r) = match (h, r) with
    | (Some l, None) -> opl l
    | (None, Some r) -> opr r
    | _ -> failwith Msg.msg

  let binop opl opr (l1,r1) (l2,r2) = match (l1, r1),(l2, r2) with
    | (Some l1, None), (Some l2, None) -> opl l1 l2
    | (None, Some r1), (None, Some r2) -> opr r1 r2
    | _ -> failwith Msg.msg

  let unop_to_t opl opr (l,t) = match (l, t) with
    | (Some p, None) -> (Some (opl p), None)
    | (None, Some t) -> (None, Some(opr t))
    | _ -> failwith Msg.msg

  let binop_to_t opl opr (l1,r1) (l2,r2)= match (l1, r1),(l2, r2) with
    | (Some p1, None), (Some p2, None) -> (Some (opl p1 p2), None)
    | (None, Some t1), (None, Some t2) -> (None, Some(opr t1 t2))
    | _ -> failwith Msg.msg

  let show = unop L.show R.show
  let pretty () = unop (L.pretty ()) (R.pretty ())
  let printXml f = unop (L.printXml f) (R.printXml f)
  let to_yojson = unop L.to_yojson R.to_yojson
  let relift = unop_to_t L.relift R.relift

  let tag _ = failwith (Msg.name ^ ": no tag")
  let arbitrary () = failwith (Msg.name ^ ": no arbitrary")
end

module type LatticeFlagHelperArg = sig
  include Lattice.PO
  val is_top: t -> bool
  val is_bot: t -> bool
end

module LatticeFlagHelper (L:LatticeFlagHelperArg) (R:LatticeFlagHelperArg) (Msg: FlagError) =
struct
  include FlagHelper (L) (R) (Msg)

  let leq = binop L.leq R.leq
  let join = binop_to_t L.join R.join
  let meet = binop_to_t L.meet R.meet
  let widen = binop_to_t L.widen R.widen
  let narrow = binop_to_t L.narrow R.narrow
  let is_top = unop L.is_top R.is_top
  let is_bot = unop L.is_bot R.is_bot
  let pretty_diff () ((l1,r1),(l2,r2)) = match (l1, r1),(l2, r2) with
    | (Some p1, None), (Some p2, None) -> L.pretty_diff () (p1, p2)
    | (None, Some t1), (None, Some t2) -> R.pretty_diff () (t1, t2)
    | _ -> failwith Msg.msg
end
OCaml

Innovation. Community. Security.