diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs
index a1161e1901c453d769242119a85f4382a9c30000..3196956b2af09a6bee69aae4c36836f0a84d489c 100644
--- a/.git-blame-ignore-revs
+++ b/.git-blame-ignore-revs
@@ -30,3 +30,4 @@ e1b60790e0e28fbbd63f20413da3833a1870cc6e
dc99367c8f4a95d53ec7ce6187892b91fbfd4c1f
0e05285bd47c752f57c190683608527599fa5afb
a767fdcb7adda81a5ef192733ef7c62fd56b30e2
+4130bab7a8b59d0c94a22d792b2a7d5a26d3484d
diff --git a/share/Makefile.common b/share/Makefile.common
index 71baa15ec6b673b680f33f18a344585aea18d45b..b7a230b2545c5f3f4b019df6bd31de113098944e 100644
--- a/share/Makefile.common
+++ b/share/Makefile.common
@@ -82,13 +82,10 @@ ifeq ($(DEVELOPMENT),yes)
# module.
# - 48 (implicit elimination of optional arguments): makes use of functions
# with optional arguments heavier in higher-order context
-# - 50 (warning about ambiguously placed OCamldoc comments): while it would be
-# useful to ensure OCamldoc understands comments correctly, some clean-up
-# is needed before enabling this warning.
# - 67 (unused module parameter in functor signature): naming all parameters
# in functor signatures is a common practice that seems harmless. Warning 60
# ensures that named functor parameters are indeed used in the implementation.
-WARNINGS ?= -w +a-4-9-40-41-42-44-45-48-50-67
+WARNINGS ?= -w +a-4-9-40-41-42-44-45-48-67
# - 3 (deprecated feature) cannot always be avoided for OCaml stdlib when
# supporting several OCaml versions
diff --git a/src/kernel_internals/runtime/fc_config.ml.in b/src/kernel_internals/runtime/fc_config.ml.in
index 003f6f55169256e448bbfb2a78ab05a0bf9ad0a6..d4174a62bc502b94d33a85748ca1fc2780de4a13 100644
--- a/src/kernel_internals/runtime/fc_config.ml.in
+++ b/src/kernel_internals/runtime/fc_config.ml.in
@@ -59,7 +59,7 @@ let datadir =
let framac_libc = Filepath.Normalized.concat datadir "libc"
let extra_datadir = try getenv_list "FRAMAC_EXTRA_SHARE" with Not_found -> []
let () = add_symbolic_dir_list "FRAMAC_EXTRA_SHARE" extra_datadir
-(** After so that it has the priority for pretty printing *)
+(* After so that it has the priority for pretty printing *)
let () = Filepath.add_symbolic_dir "FRAMAC_SHARE" datadir
let datadirs = datadir::extra_datadir
diff --git a/src/kernel_internals/typing/cabs2cil.ml b/src/kernel_internals/typing/cabs2cil.ml
index f95f729713d002d77ec6f8db6bc18bdf3fdf2016..dca10f8fc7d60e91888192a45ddaf42523125ad9 100644
--- a/src/kernel_internals/typing/cabs2cil.ml
+++ b/src/kernel_internals/typing/cabs2cil.ml
@@ -2523,7 +2523,7 @@ let cabsAddAttributes al0 (al: attributes) : attributes =
"Duplicate attribute %a along with %a"
Cil_printer.pp_attribute a Cil_printer.pp_attribute a' ;
(* let acc' = dropAttribute an acc in *)
- (** Keep both attributes *)
+ (* Keep both attributes *)
addAttribute a acc
end)
al
@@ -3068,7 +3068,7 @@ let rec castTo ?context ?(fromsource=false)
| TComp (comp1, _), TComp (comp2, _) when comp1.ckey = comp2.ckey ->
result
- (** If we try to pass a transparent union value to a function
+ (* If we try to pass a transparent union value to a function
* expecting a transparent union argument, the argument type would
* have been changed to the type of the first argument, and we'll
* see a cast from a union to the type of the first argument. Turn
@@ -3124,7 +3124,7 @@ let makeGlobalVarinfo (isadef: bool) (vi: varinfo) : varinfo * bool =
vi.vname oldvi.vid Cil_printer.pp_location oldloc;
(* It was already defined. We must reuse the varinfo. But clean up the
* storage. *)
- let newstorage = (** See 6.2.2 *)
+ let newstorage = (* See 6.2.2 *)
match oldvi.vstorage, vi.vstorage with
| Extern, NoStorage when isadef -> NoStorage
(* the case above is not strictly C standard, but will not accept
@@ -3949,9 +3949,9 @@ let collapseCallCast (s1,s2) = match s1.skind, s2.skind with
let afterConversion ~ghost (c: chunk) : chunk =
(* Now scan the statements and find Instr blocks *)
- (** We want to collapse sequences of the form "tmp = f(); v = tmp". This
- * will help significantly with the handling of calls to malloc, where it
- * is important to have the cast at the same place as the call *)
+ (* We want to collapse sequences of the form "tmp = f(); v = tmp". This
+ * will help significantly with the handling of calls to malloc, where it
+ * is important to have the cast at the same place as the call *)
let block = c2block ~ghost ~collapse_block:false c in
let sl =
if Kernel.DoCollapseCallCast.get () then
@@ -4989,7 +4989,7 @@ and doAttr ghost (a: Cabs.attribute) : attribute list =
match a.expr_node with
| Cabs.VARIABLE n -> begin
let n' = if strip then stripUnderscore n else n in
- (** See if this is an enumeration *)
+ (* See if this is an enumeration *)
try
if not foldenum then raise Not_found;
let env = if ghost then ghost_env else env in
@@ -7887,7 +7887,7 @@ and doBinOp loc (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) =
* new statements.
*)
and doCondExp local_env asconst
- (** Try to evaluate the conditional expression
+ (* Try to evaluate the conditional expression
* to TRUE or FALSE, because it occurs in a constant *)
?ctxt (* ctxt is used internally to determine if we should apply
the conditional side effects hook (see above)
diff --git a/src/kernel_internals/typing/mergecil.ml b/src/kernel_internals/typing/mergecil.ml
index 0433964f1c79d790f916be819ed326584cfb16b0..1b448c946391315e745afb784c02606c32ac6630 100644
--- a/src/kernel_internals/typing/mergecil.ml
+++ b/src/kernel_internals/typing/mergecil.ml
@@ -2809,7 +2809,7 @@ let oneFilePass2 (f: file) =
(* Reflect them in the type *)
setFormals fdec fdec.sformals
end;
- (** See if we can remove this inline function *)
+ (* See if we can remove this inline function *)
if fdec'.svar.vinline && mergeInlines then begin
let mergeInlinesWithAlphaConvert =
mergeInlinesWithAlphaConvert ()
diff --git a/src/kernel_services/abstract_interp/base.mli b/src/kernel_services/abstract_interp/base.mli
index af90c99ddae6dc48e4ed24eb9c7621f5a1865dce..699d377d02bff1a5a98f38b204d80875640a5607 100644
--- a/src/kernel_services/abstract_interp/base.mli
+++ b/src/kernel_services/abstract_interp/base.mli
@@ -49,8 +49,10 @@ type base = private
| CLogic_Var of Cil_types.logic_var * Cil_types.typ * validity
(** Base for a logic variable that has a C type. *)
| Null (** Base for an address like [(int* )0x123] *)
- | String of int (** unique id of the constant string (one per code location)*)
- * cstring (** contents of the constant string *)
+ | String of int * cstring
+ (** [String(id, s)]
+ - [id]: unique id of the constant string (one per code location)
+ - [s]: contents of the constant string *)
| Allocated of Cil_types.varinfo * deallocation * validity
(** Base for a variable dynamically allocated via malloc/calloc/realloc/alloca *)
diff --git a/src/kernel_services/abstract_interp/eva_lattice_type.mli b/src/kernel_services/abstract_interp/eva_lattice_type.mli
index f973c227550b63700725856556809ae177da541a..8c5e10c62fded3e273207b4d847b732420cc76eb 100644
--- a/src/kernel_services/abstract_interp/eva_lattice_type.mli
+++ b/src/kernel_services/abstract_interp/eva_lattice_type.mli
@@ -41,8 +41,12 @@ end
module type With_Under_Approximation = sig
type t
- val link: t -> t -> t (** under-approximation of union *)
- val meet: t -> t -> t or_bottom (** under-approximation of intersection *)
+
+ val link: t -> t -> t
+ (** under-approximation of union *)
+
+ val meet: t -> t -> t or_bottom
+ (** under-approximation of intersection *)
end
module type With_Diff = sig
diff --git a/src/kernel_services/abstract_interp/float_interval.ml b/src/kernel_services/abstract_interp/float_interval.ml
index 13c0c928642143522b550d1dc9fa88a531a54703..aa8216f716a3171f1d8bcc34d6a8d022487179d0 100644
--- a/src/kernel_services/abstract_interp/float_interval.ml
+++ b/src/kernel_services/abstract_interp/float_interval.ml
@@ -321,7 +321,7 @@ module Make (F: Float_sig.S) = struct
| FRange.Itv (b1, e1, _), FRange.Itv (b2, e2, nan) ->
let b = if Cmp.equal b2 b1 then b2 else F.widen_down wh prec b2 in
let e = if Cmp.equal e2 e1 then e2 else F.widen_up wh prec e2 in
- (** widen_up and down produce double only if the input is a double *)
+ (* widen_up and down produce double only if the input is a double *)
FRange.inject ~nan b e
| FRange.NaN, f2 -> f2
| FRange.Itv _, FRange.NaN -> assert false
diff --git a/src/kernel_services/abstract_interp/float_interval_sig.mli b/src/kernel_services/abstract_interp/float_interval_sig.mli
index 4bd8f34ad5dd8db3e9169c7b101f8acbc319e6f6..560d6f692d142bc05a396c2256a84eac6920c4ec 100644
--- a/src/kernel_services/abstract_interp/float_interval_sig.mli
+++ b/src/kernel_services/abstract_interp/float_interval_sig.mli
@@ -28,9 +28,14 @@ open Bottom.Type
type prec = Float_sig.prec
module type S = sig
- type float (** Type of the interval bounds. *)
- type widen_hints (** Type of the widen hints. *)
- type t (** Type of intervals. *)
+ (** Type of the interval bounds. *)
+ type float
+
+ (** Type of the widen hints. *)
+ type widen_hints
+
+ (** Type of intervals. *)
+ type t
val packed_descr : Structural_descr.pack
diff --git a/src/kernel_services/abstract_interp/fval.mli b/src/kernel_services/abstract_interp/fval.mli
index aface641a30300208fc96d6126830ab3f9088d03..93aa5e24a914d858537e5e50fe84b9615fbac907 100644
--- a/src/kernel_services/abstract_interp/fval.mli
+++ b/src/kernel_services/abstract_interp/fval.mli
@@ -36,7 +36,9 @@ module F : sig
type t
val packed_descr : Structural_descr.pack
- val of_float : float -> t (** fails on NaNs, but allows infinities. *)
+ val of_float : float -> t
+ (** fails on NaNs, but allows infinities. *)
+
val to_float : t -> float
val compare : t -> t -> int
@@ -82,6 +84,7 @@ val minus_zero : t
val zeros: t (** Both positive and negative zero *)
val pi: t (** Real representation of \pi. *)
+
val e: t (** Real representation of \e. *)
val contains_plus_zero : t -> bool
diff --git a/src/kernel_services/abstract_interp/int_Intervals_sig.mli b/src/kernel_services/abstract_interp/int_Intervals_sig.mli
index 570a3e2867ac033e27bcfcbbeaebda244d6eecb8..9bee989ee6a851f0b769ae4b022bdd230a90d1cb 100644
--- a/src/kernel_services/abstract_interp/int_Intervals_sig.mli
+++ b/src/kernel_services/abstract_interp/int_Intervals_sig.mli
@@ -52,8 +52,10 @@ val project_set: t -> itv list
val project_singleton: t -> itv option
(** Iterators *)
+
val fold: (itv -> 'a -> 'a) -> t -> 'a -> 'a
(** May raise [Error_Top] *)
+
val iter: (itv -> unit) -> t -> unit
(** May raise [Error_Top] *)
diff --git a/src/kernel_services/abstract_interp/int_set.mli b/src/kernel_services/abstract_interp/int_set.mli
index 75737d476ad7719dbb3982a24d1a932fc2dd5997..0eab36f019c0ff870f1a29e5f7618144a8c61383 100644
--- a/src/kernel_services/abstract_interp/int_set.mli
+++ b/src/kernel_services/abstract_interp/int_set.mli
@@ -70,6 +70,7 @@ val minus_one: t
val zero_or_one: t
val min: t -> Integer.t (** Returns the smallest integer of a set. *)
+
val max: t -> Integer.t (** Returns the highest integer of a set. *)
(** Returns the number of integers in a set. *)
diff --git a/src/kernel_services/abstract_interp/int_val.mli b/src/kernel_services/abstract_interp/int_val.mli
index 815a9c3374d91840158219007e6bc57425040eb4..47b23b1d145c9f366da0773fbd2d2071dca790e1 100644
--- a/src/kernel_services/abstract_interp/int_val.mli
+++ b/src/kernel_services/abstract_interp/int_val.mli
@@ -43,8 +43,11 @@ val one: t
val minus_one: t
val zero_or_one: t
-val positive_integers: t (** All positive integers, including 0. *)
-val negative_integers: t (** All negative integers, including 0. *)
+val positive_integers: t
+(** All positive integers, including 0. *)
+
+val negative_integers: t
+(** All negative integers, including 0. *)
(** {2 Building.} *)
@@ -117,8 +120,10 @@ val contains_non_zero: t -> bool
val add: t -> t -> t
(** Addition of two integer abstractions. *)
+
val add_under: t -> t -> t or_bottom
(** Under-approximation of the addition of two integer abstractions *)
+
val add_singleton: Integer.t -> t -> t
(** Addition of an integer abstraction with a singleton integer.
Exact operation. *)
@@ -132,12 +137,15 @@ val abs: t -> t
val scale: Integer.t -> t -> t
(** [scale f v] returns an abstraction of the integers [f * x]
for all [x] in [v]. This operation is exact. *)
+
val scale_div: pos:bool -> Integer.t -> t -> t
(** [scale_div f v] is an over-approximation of the elements [x / f] for all
elements [x] in [v]. Uses the computer division (like in C99) if [pos] is
false, and the euclidean division if [pos] is true. *)
+
val scale_div_under: pos:bool -> Integer.t -> t -> t or_bottom
(** Under-approximation of the division. *)
+
val scale_rem: pos:bool -> Integer.t -> t -> t
(** Over-approximation of the remainder of the division. Uses the computer
division (like in C99) if [pos] is false, and the euclidean division if
diff --git a/src/kernel_services/abstract_interp/ival.mli b/src/kernel_services/abstract_interp/ival.mli
index 4e2bc535db76b1f6b6faecb76a62408cc13fc035..5e072bc1ecb175e16a86eaeb73675f3a214517e4 100644
--- a/src/kernel_services/abstract_interp/ival.mli
+++ b/src/kernel_services/abstract_interp/ival.mli
@@ -56,24 +56,30 @@ val is_int: t -> bool
val add_int : t -> t -> t
(** Addition of two integer (ie. not [Float]) ivals. *)
+
val add_int_under : t -> t -> t
(** Underapproximation of the same operation *)
+
val add_singleton_int: Integer.t -> t -> t
(** Addition of an integer ival with an integer. Exact operation. *)
val neg_int : t -> t
(** Negation of an integer ival. Exact operation. *)
+
val abs_int: t -> t
(** Absolute value of an integer. *)
+
val sub_int : t -> t -> t
val sub_int_under: t -> t -> t
val min_int : t -> Integer.t option
(** A [None] result means the argument is unbounded.
Raises [Error_Bottom] if the argument is bottom. *)
+
val max_int : t -> Integer.t option
(** A [None] result means the argument is unbounded.
Raises [Error_Bottom] if the argument is bottom. *)
+
val min_max_r_mod :
t -> Integer.t option * Integer.t option * Integer.t * Integer.t
@@ -101,8 +107,10 @@ val bitwise_not: size:int -> signed:bool -> t -> t
val zero : t
(** The lattice element that contains only the integer 0. *)
+
val one : t
(** The lattice element that contains only the integer 1. *)
+
val minus_one : t
(** The lattice element that contains only the integer -1. *)
@@ -123,6 +131,7 @@ val is_one : t -> bool
val contains_zero : t -> bool
(** contains the zero value (including -0. for floating-point ranges) *)
+
val contains_non_zero : t -> bool
val top_float : t
@@ -240,6 +249,7 @@ val scale_div_under : pos:bool -> Integer.t -> t -> t
set of elements [x e_div f] for [x] in [v]. *)
val div : t -> t -> t (** Integer division *)
+
val scale_rem : pos:bool -> Integer.t -> t -> t
(** [scale_rem ~pos:false f v] is an over-approximation of the set of
elements [x c_rem f] for [x] in [v].
@@ -296,6 +306,7 @@ val cast_float_to_float : Fval.kind -> t -> t
val cast_float_to_int_inverse:
single_precision:bool -> t (** integer *) -> t (** floating-point *)
+
val cast_int_to_float_inverse:
single_precision:bool -> t (** floating-point *) -> t (** integer *)
diff --git a/src/kernel_services/abstract_interp/lattice_type.mli b/src/kernel_services/abstract_interp/lattice_type.mli
index 95be6c9bf0fb475955247c0e62e112a06bb1be95..7ac4e1bf59ab43a80a9a8a6a3a01940e6b7ea085 100644
--- a/src/kernel_services/abstract_interp/lattice_type.mli
+++ b/src/kernel_services/abstract_interp/lattice_type.mli
@@ -26,8 +26,11 @@
module type Join_Semi_Lattice = sig
include Datatype.S (** datatype of element of the lattice *)
- val join: t -> t -> t (** over-approximation of union *)
- val is_included: t -> t -> bool (**is first argument included in the second?*)
+ val join: t -> t -> t
+ (** over-approximation of union *)
+
+ val is_included: t -> t -> bool
+ (**is first argument included in the second?*)
end
module type Bounded_Join_Semi_Lattice = sig
@@ -52,8 +55,11 @@ end
module type With_Under_Approximation = sig
type t
- val link: t -> t -> t (** under-approximation of union *)
- val meet: t -> t -> t (** under-approximation of intersection *)
+ val link: t -> t -> t
+ (** under-approximation of union *)
+
+ val meet: t -> t -> t
+ (** under-approximation of intersection *)
end
(** {2 Over- and under-approximations}
diff --git a/src/kernel_services/abstract_interp/lmap_sig.mli b/src/kernel_services/abstract_interp/lmap_sig.mli
index 75c1f57b577a7c8afbc5baee39de38897f8588da..00164382ae2f4fce610c6188eecb566fdd125a7e 100644
--- a/src/kernel_services/abstract_interp/lmap_sig.mli
+++ b/src/kernel_services/abstract_interp/lmap_sig.mli
@@ -25,11 +25,17 @@
open Locations
-type v (** type of the values associated to a location *)
-type offsetmap (** type of the maps associated to a base *)
-type widen_hint_base (** widening hints for each base *)
+(** type of the values associated to a location *)
+type v
-type map (** Maps from {!Base.t} to {!offsetmap} *)
+(** type of the maps associated to a base *)
+type offsetmap
+
+(** widening hints for each base *)
+type widen_hint_base
+
+(** Maps from {!Base.t} to {!offsetmap} *)
+type map
type lmap = private Bottom | Top | Map of map
include Datatype.S_with_collections with type t = lmap
@@ -39,6 +45,7 @@ val pretty_debug: Format.formatter -> t -> unit
val pretty_filter: Format.formatter -> t -> Zone.t -> unit
(** [pretty_filter m z] pretties only the part of [m] that correspond to
the bases present in [z] *)
+
val pretty_diff: Format.formatter -> t -> t -> unit
(** {2 General shape} *)
@@ -52,6 +59,7 @@ val empty_map : t
val is_empty_map : t -> bool
val bottom : t
+
(** Every location is associated to the value [bottom] of type [v] in this
state. This state can be reached only in dead code. *)
val is_reachable : t -> bool
diff --git a/src/kernel_services/abstract_interp/locations.mli b/src/kernel_services/abstract_interp/locations.mli
index bf345a9c97c00aabcbbbe0c267a3037c9b92f6c0..e071ac4420fcfa507a7e8c648830a58e0d15bc2a 100644
--- a/src/kernel_services/abstract_interp/locations.mli
+++ b/src/kernel_services/abstract_interp/locations.mli
@@ -33,7 +33,9 @@ module Location_Bytes : sig
module M : sig
type key = Base.t
- type t (** Mapping from bases to bytes-expressed offsets *)
+
+ (** Mapping from bases to bytes-expressed offsets *)
+ type t
val iter : (Base.t -> Ival.t -> unit) -> t -> unit
val find : key -> t -> Ival.t
val fold : (Base.t -> Ival.t -> 'a -> 'a) -> t -> 'a -> 'a
@@ -59,8 +61,10 @@ module Location_Bytes : sig
val singleton_zero : t
(** the set containing only the value for to the C expression [0] *)
+
val singleton_one : t
(** the set containing only the value [1] *)
+
val zero_or_one : t
val is_zero : t -> bool
@@ -114,6 +118,7 @@ module Location_Bytes : sig
val inject_top_origin : Origin.t -> Base.Hptset.t -> t
(** [inject_top_origin origin p] creates a top with origin [origin]
and additional information [param] *)
+
val top_with_origin: Origin.t -> t
(** Completely imprecise value. Use only as last resort. *)
@@ -123,9 +128,11 @@ module Location_Bytes : sig
val fold_bases : (Base.t -> 'a -> 'a) -> t -> 'a -> 'a
(** Fold on all the bases of the location, including [Top bases].
@raise Error_Top in the case [Top Top]. *)
+
val fold_i : (Base.t -> Ival.t -> 'a -> 'a) -> t -> 'a -> 'a
(** Fold with offsets.
@raise Error_Top in the cases [Top Top], [Top bases]. *)
+
val fold_topset_ok: (Base.t -> Ival.t -> 'a -> 'a) -> t -> 'a -> 'a
(** Fold with offsets, including in the case [Top bases]. In this case,
[Ival.top] is supplied to the iterator.
@@ -158,6 +165,7 @@ module Location_Bytes : sig
val cardinal_less_than : t -> int -> int
(** [cardinal_less_than v card] returns the cardinal of [v] if it is less
than [card], or raises [Not_less_than]. *)
+
val cardinal: t -> Integer.t option (** None if the cardinal is unbounded *)
val find_lonely_key : t -> Base.t * Ival.t
diff --git a/src/kernel_services/abstract_interp/offsetmap.ml b/src/kernel_services/abstract_interp/offsetmap.ml
index db8459dee24109936a077c3b1bfdcea2f098387b..98a53b5f61d76d9e3d6b63eb55c9e7a11188c812 100644
--- a/src/kernel_services/abstract_interp/offsetmap.ml
+++ b/src/kernel_services/abstract_interp/offsetmap.ml
@@ -56,33 +56,36 @@ type 'a offsetmap =
| Node of
Integer.t *
- (** Relative, upper index of the interval. Thus the interval has length
- [max+1]. The relative lower index of the interval is always zero by
- definition. *)
Integer.t * 'a offsetmap *
- (** subtree on the left: the offset [offl] of its root (relative to 0),
- and the tree [subl]. If [subl] is not empty, it maps at least one
- interval, and [offl] is strictly negative. If [subl] is empty,
- then [offl] is zero. *)
- Integer.t * 'a offsetmap
- (** subtree on the right: the offset [offr] of its root (relative to 0),
- and the tree [subr]. [offr] is greater than [max+1] by definition,
- and equal to it if [subr] is empty. ([offr] may also be equal to
- [max+1] with a non-empty [subr], when the interval at the root of
- [subr] starts exactly at [max+1].) *) *
- Rel.t * Integer.t * 'a
- (** rem * size * value, ie. the value, its size [size] and its alignment
- [rem] relative to the start of the interval. [size] can be:
- - strictly more than [max+1], in which case the value is truncated
- - equal to [max+1]:
- * if [rem] is zero, the value is stored exactly once in the interval
- * otherwise, two truncated instances of the value are stored
- consecutively.
- - strictly less than [max+1]: the value is stored more than once,
- and implicitly repeats itself to fill the entire interval. *) *
+ Integer.t * 'a offsetmap *
+ Rel.t * Integer.t * 'a *
int
- (** tag: hash-consing id of the node, plus an additional boolean.
- Not related to the contents of the tree. *)
+ (** [Node(i, offl, subl, offr, subr, rem, size, value, id)]
+ - [i]: Relative, upper index of the interval. Thus the interval has length
+ [max+1]. The relative lower index of the interval is always zero by
+ definition
+ - [offl, subl]: subtree on the left: the offset [offl] of its root
+ (relative to 0), and the tree [subl]. If [subl] is not empty, it maps at
+ least one interval, and [offl] is strictly negative. If [subl] is empty,
+ then [offl] is zero
+ - [offr, subr]: subtree on the right: the offset [offr] of its root
+ (relative to 0), and the tree [subr]. [offr] is greater than [max+1] by
+ definition, and equal to it if [subr] is empty. ([offr] may also be
+ equal to [max+1] with a non-empty [subr], when the interval at the root
+ of [subr] starts exactly at [max+1]
+ - [rem, size, value]: the value, its size [size] and its alignment
+ [rem] relative to the start of the interval. [size] can be:
+ * strictly more than [max+1], in which case the value is truncated
+ * equal to [max+1]:
+ + if [rem] is zero, the value is stored exactly once in the
+ interval
+ + otherwise, two truncated instances of the value are stored
+ consecutively.
+ * strictly less than [max+1]: the value is stored more than once,
+ and implicitly repeats itself to fill the entire interval.
+ - [id]: tag: hash-consing id of the node, plus an additional boolean.
+ Not related to the contents of the tree.
+ *)
(* In a node, the alignment of the value is relative to the start of the
@@ -381,11 +384,11 @@ module Make (V : module type of Offsetmap_lattice_with_isotropy) = struct
signature_interval min1 max1 >~ signature_interval min2 max2
+ (** Zippers : Offset of a node * Node * continuation of the zipper *)
type zipper =
| End
| Right of Integer.t * t * zipper
| Left of Integer.t * t * zipper;;
- (** Zippers : Offset of a node * Node * continuation of the zipper *)
exception End_reached;;
exception Empty_tree;;
diff --git a/src/kernel_services/abstract_interp/offsetmap_bitwise_sig.mli b/src/kernel_services/abstract_interp/offsetmap_bitwise_sig.mli
index 8cd49eabe659a53a6bd6685eda57a755489bb85b..de3bb300395095518239e2e3f1bd4e4fefa68f3d 100644
--- a/src/kernel_services/abstract_interp/offsetmap_bitwise_sig.mli
+++ b/src/kernel_services/abstract_interp/offsetmap_bitwise_sig.mli
@@ -30,7 +30,9 @@
instead. *)
-type v (** Type of the values stored in the offsetmap *)
+(** Type of the values stored in the offsetmap *)
+type v
+
include Datatype.S (** Datatype for the offsetmap *)
type intervals
diff --git a/src/kernel_services/abstract_interp/offsetmap_sig.mli b/src/kernel_services/abstract_interp/offsetmap_sig.mli
index 83d8b210549f15daf48e43879fd0a5a47d609e01..172a935d91313ae582f3be2daea2c1f30b9246bc 100644
--- a/src/kernel_services/abstract_interp/offsetmap_sig.mli
+++ b/src/kernel_services/abstract_interp/offsetmap_sig.mli
@@ -27,7 +27,8 @@
open Abstract_interp
-type v (** Type of the values stored in the offsetmap *)
+(** Type of the values stored in the offsetmap *)
+type v
type widen_hint
include Datatype.S (** Datatype for the offsetmaps *)
diff --git a/src/kernel_services/abstract_interp/tr_offset.mli b/src/kernel_services/abstract_interp/tr_offset.mli
index e39fa8f412e1042ceaf1a19ac021eeec64cdbaa4..f6b2b558d0e002bfbe3be7596beb47c43a7c4622 100644
--- a/src/kernel_services/abstract_interp/tr_offset.mli
+++ b/src/kernel_services/abstract_interp/tr_offset.mli
@@ -27,13 +27,12 @@
type t = private
| Invalid (** No location is valid *)
| Set of Integer.t list (** Limited number of locations *)
- | Interval of (** min *) Integer.t *
- (** max *) Integer.t *
- (** modu *)Integer.t
- | Overlap of (** min *) Integer.t *
- (** max *) Integer.t *
- Origin.t (** The location covers the entire range [min..max],
- but consecutive offsets overlap *)
+ | Interval of Integer.t * Integer.t * Integer.t
+ (** [Interval(min, max, modulo)]*)
+ | Overlap of Integer.t * Integer.t * Origin.t
+ (**[Overlap(min, max, origin)]
+ - [origin]: the location covers the entire range [min..max],
+ but consecutive offsets overlap *)
val pretty: t Pretty_utils.formatter
diff --git a/src/kernel_services/analysis/bit_utils.ml b/src/kernel_services/analysis/bit_utils.ml
index 56ab046111f2fe406891dac7d23a67e0bd9db79b..0bc156e72c2b1bd1999d56eabc72098b5f3e37af 100644
--- a/src/kernel_services/analysis/bit_utils.ml
+++ b/src/kernel_services/analysis/bit_utils.ml
@@ -227,7 +227,7 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
in
(if Integer.is_zero start
&& Integer.equal size req_size then
- (** pretty print a full offset *)
+ (* pretty print a full offset *)
(if not env.use_align ||
(Integer.equal start align && Integer.equal env.rh_size size)
then update_types typ
@@ -285,7 +285,7 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
[]
(Option.value ~default:[] compinfo.cfields)
in
- (** find non covered intervals in structs *)
+ (* find non covered intervals in structs *)
let non_covered,succ_last =
if compinfo.cstruct then
List.fold_left
@@ -352,7 +352,7 @@ let rec pretty_bits_internal env bfinfo typ ~align ~start ~stop =
else
let start_case,rem_start_size = Integer.e_div_rem start size in
let stop_case,rem_stop_size = Integer.e_div_rem stop size in
- if Integer.equal start_case stop_case then (** part of one element *)
+ if Integer.equal start_case stop_case then (* part of one element *)
let new_align =
Integer.e_rem
(Integer.sub align (Integer.mul start_case size))
diff --git a/src/kernel_services/analysis/dataflow2.ml b/src/kernel_services/analysis/dataflow2.ml
index c9739cb909c96afa02b8342eef94d56f63cfce3f..6d011757fcb8a6c14c10798f54f2c1bc64ee0fb7 100644
--- a/src/kernel_services/analysis/dataflow2.ml
+++ b/src/kernel_services/analysis/dataflow2.ml
@@ -131,24 +131,27 @@ module Worklist(MaybeReverse:MAYBE_REVERSE):WORKLIST = struct
type t =
{
+ bv: Bitvector.t;
(** Priority queue implemented as a bit vector. Index 0 has the
highest priority.*)
- bv: Bitvector.t;
- (** Conversions between stmt and ordered_stmt. *)
order: Ordered_stmt.stmt_to_ordered;
+ (** Conversions between stmt and ordered_stmt. *)
+
unorder: Ordered_stmt.ordered_to_stmt;
+ (** Conversions between stmt and ordered_stmt. *)
+
connex: connex_component array;
- (** Next stmt to be retrieved. *)
mutable next: ordered_stmt;
+ (** Next stmt to be retrieved. *)
- (** The connex component for the last call to next(). *)
mutable current_scc: connex_component;
+ (** The connex component for the last call to next(). *)
+ mutable must_restart_cc: ordered_stmt option;
(** The first statement changed in the current scc, or None
if the scc has not changed. *)
- mutable must_restart_cc: ordered_stmt option;
}
(* Forward and backward dataflow use the same data structure, but
@@ -296,7 +299,7 @@ module Forwards(T : ForwardsTransfer) = struct
(** We call this function when we have encountered a statement, with some
* state. *)
let reachedStatement worklist pred (s: stmt) (d: T.t) : unit =
- (** see if we know about it already *)
+ (* see if we know about it already *)
let d = T.doEdge pred s d in
let newdata: T.t option =
try
@@ -341,7 +344,7 @@ module Forwards(T : ForwardsTransfer) = struct
"FF(%s): processing block without data" T.name
in
- (** See what the custom says *)
+ (* See what the custom says *)
match T.doStmt s init with
| SDone -> ()
| (SDefault | SUse _) as act -> begin
diff --git a/src/kernel_services/analysis/dataflow2.mli b/src/kernel_services/analysis/dataflow2.mli
index 1a482adab04ca854fbfe4b2c292a93addfb97f67..904542fe9b18f29fc1b2147120ff892c18b1c4e4 100644
--- a/src/kernel_services/analysis/dataflow2.mli
+++ b/src/kernel_services/analysis/dataflow2.mli
@@ -64,8 +64,11 @@ module StartData(X:sig type t val size: int end) :
(** Interface to provide for a backward dataflow analysis. *)
module type ForwardsTransfer = sig
- val name: string (** For debugging purposes, the name of the analysis *)
- val debug: bool (** Whether to turn on debugging *)
+ val name: string
+ (** For debugging purposes, the name of the analysis *)
+
+ val debug: bool
+ (** Whether to turn on debugging *)
type t
(** The type of the data we compute for each block start. May be
@@ -152,8 +155,11 @@ end
(** Interface to provide for a backward dataflow analysis. *)
module type BackwardsTransfer = sig
- val name: string (** For debugging purposes, the name of the analysis *)
- val debug: bool (** Whether to turn on debugging *)
+ val name: string
+ (** For debugging purposes, the name of the analysis *)
+
+ val debug: bool
+ (** Whether to turn on debugging *)
type t
(** The type of the data we compute for each block start. In many
diff --git a/src/kernel_services/analysis/dataflows.ml b/src/kernel_services/analysis/dataflows.ml
index 1ae975c0352cc53e856f98ed8f0be6e746173f9c..72b33b6425c7a4a8eff13b0b37d721f60f1bd043 100644
--- a/src/kernel_services/analysis/dataflows.ml
+++ b/src/kernel_services/analysis/dataflows.ml
@@ -91,6 +91,7 @@ module type CONSULTABLE_WORKLIST = sig
end
(** {2 Examples of use} *)
+
[@@@ warning "-60"]
(* Worklist for a "rapid" framework. Just iterate over all statements
diff --git a/src/kernel_services/analysis/interpreted_automata.mli b/src/kernel_services/analysis/interpreted_automata.mli
index 7a8ea18f4382b53baeb90bf8ab30e5fc796d434d..82468ee285d1733f537d499b588ab5aab02de660 100644
--- a/src/kernel_services/analysis/interpreted_automata.mli
+++ b/src/kernel_services/analysis/interpreted_automata.mli
@@ -121,6 +121,7 @@ type wto = vertex Wto.partition
(** Datatype for vertices *)
module Vertex : Datatype.S_with_collections with type t = vertex
+
(** Datatype for edges *)
module Edge : Datatype.S_with_collections with type t = vertex edge
@@ -140,6 +141,7 @@ type automaton = {
(** Datatype for automata *)
module Automaton : Datatype.S with type t = automaton
+
(** Datatype for WTOs *)
module WTO : sig
include module type of (Wto.Make(Vertex))
@@ -148,8 +150,10 @@ end
(** Get the automaton for the given kernel_function without annotations *)
val get_automaton : Cil_types.kernel_function -> automaton
+
(** Get the wto for the automaton of the given kernel_function *)
val get_wto : Cil_types.kernel_function -> wto
+
(** Extract an exit strategy from a component, i.e. a sub-wto where all
vertices lead outside the wto without passing through the head. *)
val exit_strategy : graph -> vertex Wto.component -> wto
@@ -175,17 +179,21 @@ module WTOIndex : Datatype.S with type t = wto_index
(** @return the wto_index for a statement *)
val get_wto_index :
Cil_types.kernel_function -> vertex -> wto_index
+
(** @return the components left and the components entered when going from
one index to another *)
val wto_index_diff :
wto_index -> wto_index -> vertex list * vertex list
+
(** @return the components left and the components entered when going from
one vertex to another *)
val get_wto_index_diff :
Cil_types.kernel_function -> vertex -> vertex -> vertex list * vertex list
+
(** @return wether [v] is a component head or not *)
val is_wto_head :
Cil_types.kernel_function -> vertex -> bool
+
(** @return wether [v1,v2] is a back edge of a loop, i.e. if the vertex v1
is a wto head of any component where v2 is included. This assumes that
(v1,v2) is actually an edge present in the control flow graph. *)
@@ -200,12 +208,15 @@ module Compute: sig
expressions which will be different at each call: you may need to
memoize the results of this function. *)
val get_automaton : annotations:bool -> Cil_types.kernel_function -> automaton
+
(** Build the wto for the given automaton (No memoization, use get_wto
instead) *)
val build_wto : automaton -> wto
+
(** Extract an exit strategy from a component, i.e. a sub-wto where all
vertices lead outside the wto without passing through the head. *)
val exit_strategy : graph -> vertex Wto.component -> wto
+
(** Output the automaton in dot format *)
val output_to_dot : out_channel -> ?labeling:vertex labeling -> ?wto:wto ->
automaton -> unit
@@ -215,20 +226,25 @@ module Compute: sig
(** Compute the index table from a wto *)
val build_wto_index_table: wto -> wto_index_table
+
(** @return the wto_index for a statement *)
val get_wto_index :
wto_index_table -> vertex -> wto_index
+
(** @return the components left and the components entered when going from
one index to another *)
val wto_index_diff :
wto_index -> wto_index -> vertex list * vertex list
+
(** @return the components left and the components entered when going from
one vertex to another *)
val get_wto_index_diff :
wto_index_table -> vertex -> vertex -> vertex list * vertex list
+
(** @return wether [v] is a component head or not *)
val is_wto_head :
wto_index_table -> vertex -> bool
+
(** @return wether [v1,v2] is a back edge of a loop, i.e. if the vertex v1
is a wto head of any component where v2 is included. This assumes that
(v1,v2) is actually an edge present in the control flow graph. *)
diff --git a/src/kernel_services/analysis/logic_interp.ml b/src/kernel_services/analysis/logic_interp.ml
index 5555fed2ae94bb0428063720e2f46be67422ea7c..24cc5937c02204c9648acca91748a1e45af24b13 100644
--- a/src/kernel_services/analysis/logic_interp.ml
+++ b/src/kernel_services/analysis/logic_interp.ml
@@ -992,7 +992,7 @@ struct
| AStmtSpec _ -> (* TODO *)
raise (NYI "[logic_interp] statement contract")
| AExtended _ -> raise (NYI "[logic_interp] extension")
- (** Used by annotations entry points. *)
+ (* Used by annotations entry points. *)
let get_from_stmt_annots code_annot_filter ((ki, _kf) as stmt) =
Option.iter
(fun caf ->
diff --git a/src/kernel_services/analysis/service_graph.mli b/src/kernel_services/analysis/service_graph.mli
index b2098d87f034a9ff59bc53afaa1ac30a8d3798f5..56a7ce927f5a4e4efe65ffc631fbe977c7feb699 100644
--- a/src/kernel_services/analysis/service_graph.mli
+++ b/src/kernel_services/analysis/service_graph.mli
@@ -70,6 +70,7 @@ module Make
include Graph.Sig.COMPARABLE
val id: t -> int
(** assume [id >= 0] and unique for each vertices of the graph *)
+
val name: t -> string
val attributes: t -> Graph.Graphviz.DotAttributes.vertex list
val entry_point: unit -> t option
diff --git a/src/kernel_services/ast_data/alarms.mli b/src/kernel_services/ast_data/alarms.mli
index 216855a92d6ea6d368c505eecd9f6e4697172d86..53ffb88c69613f001d0372bdaa3d1548c8aef836 100644
--- a/src/kernel_services/ast_data/alarms.mli
+++ b/src/kernel_services/ast_data/alarms.mli
@@ -37,29 +37,26 @@ type bound_kind = Lower_bound | Upper_bound
type alarm =
| Division_by_zero of exp
| Memory_access of lval * access_kind
- | Index_out_of_bound of
- exp (** index *)
- * exp option (** None = lower bound is zero; Some up = upper bound *)
+ | Index_out_of_bound of exp * exp option
+ (** [Index_out_of_bound(index, opt)]
+ - [opt = None] -> lower bound is zero; Some up = upper bound *)
| Invalid_pointer of exp
| Invalid_shift of exp * int option (** strict upper bound, if any *)
- | Pointer_comparison of
- exp option (** [None] when implicit comparison to NULL pointer *)
- * exp
- | Differing_blocks of exp * exp (** The two expressions (which evaluate to
- pointers) must point to the same allocated block *)
- | Overflow of
- overflow_kind
- * exp
- * Integer.t (** the bound *)
- * bound_kind
- | Float_to_int of
- exp
- * Integer.t (** the bound for the integer type. The actual alarm
- is [exp < bound+1] or [bound-1 < exp]. *)
- * bound_kind
- | Not_separated of lval * lval (** the two lvalues must be separated *)
- | Overlap of lval * lval (** overlapping read/write: the two lvalues must be
- separated or equal *)
+ | Pointer_comparison of exp option * exp
+ (** First parameter is [None] when implicit comparison to NULL pointer *)
+ | Differing_blocks of exp * exp
+ (** The two expressions (which evaluate to
+ pointers) must point to the same allocated block *)
+ | Overflow of overflow_kind * exp * Integer.t * bound_kind
+ (** Integer parameters is the bound *)
+ | Float_to_int of exp * Integer.t * bound_kind
+ (** Integer parameter is the bound for the integer type. The actual alarm
+ is [exp < bound+1] or [bound-1 < exp]. *)
+ | Not_separated of lval * lval
+ (** the two lvalues must be separated *)
+ | Overlap of lval * lval
+ (** overlapping read/write: the two lvalues must be
+ separated or equal *)
| Uninitialized of lval
| Dangling of lval
| Is_nan_or_infinite of exp * fkind
diff --git a/src/kernel_services/ast_data/ast.ml b/src/kernel_services/ast_data/ast.ml
index e8e0396778181eb91d3734ae0df93a4452d557f3..bccc202c69171fec1e03c6651b02dc0fadee11f0 100644
--- a/src/kernel_services/ast_data/ast.ml
+++ b/src/kernel_services/ast_data/ast.ml
@@ -191,11 +191,11 @@ let is_def_or_last_decl g =
let is_eq v =
compute_last_def_decl ();
try
- (** using [(==)] is the only way to fulfill the spec (do not use
- [Cil_datatype.Global.equal] here): if a variable is declared several
- times in the program, each declaration are equal wrt
- [Cil_datatype.Global.equal] but only one is [(==)] (and exactly one if
- [g] comes from the AST). *)
+ (* using [(==)] is the only way to fulfill the spec (do not use
+ [Cil_datatype.Global.equal] here): if a variable is declared several
+ times in the program, each declaration are equal wrt
+ [Cil_datatype.Global.equal] but only one is [(==)] (and exactly one if
+ [g] comes from the AST). *)
LastDecl.find v == g
with Not_found ->
(* [Not_found] mainly means that the information is irrelevant at this
diff --git a/src/kernel_services/ast_data/globals.mli b/src/kernel_services/ast_data/globals.mli
index d40f6607d35c8b5626c6fcbb04c36b698419d854..ecaa1a639af77ca4e75e652f7a15222004d17ee1 100644
--- a/src/kernel_services/ast_data/globals.mli
+++ b/src/kernel_services/ast_data/globals.mli
@@ -61,6 +61,7 @@ module Vars: sig
val iter_in_file_rev_order: (varinfo -> initinfo -> unit) -> unit
(** @since Neon-20140301 *)
+
val fold_in_file_rev_order: (varinfo -> initinfo -> 'a -> 'a) -> 'a -> 'a
(** @since Neon-20140301 *)
diff --git a/src/kernel_services/ast_data/property_status.mli b/src/kernel_services/ast_data/property_status.mli
index ed38a2989952f34a22972286647aa386b09a7a62..1ac60ebf9d079e57ad8f043c645738861fc38da5 100644
--- a/src/kernel_services/ast_data/property_status.mli
+++ b/src/kernel_services/ast_data/property_status.mli
@@ -109,13 +109,14 @@ type inconsistent = private
(** Type of the local status of a property. *)
type status = private
| Never_tried (** Nobody tries to verify the property *)
- | Best of
- emitted_status (** The know more precise status *)
- * emitter_with_properties list (** who attempt the verification
- under which hypotheses *)
- | Inconsistent of inconsistent (** someone locally says the property is valid
- and someone else says it is invalid: only
- the consolidated status may conclude. *)
+ | Best of emitted_status * emitter_with_properties list
+ (** [Best(s, l)]:
+ - [s]: The know more precise status
+ - [l]: who attempt the verification under which hypotheses *)
+ | Inconsistent of inconsistent
+ (** someone locally says the property is valid
+ and someone else says it is invalid: only
+ the consolidated status may conclude. *)
include Datatype.S with type t = status
diff --git a/src/kernel_services/ast_printing/cil_printer.ml b/src/kernel_services/ast_printing/cil_printer.ml
index d7a95024779daa31e2a2c069307f9f3818b672b1..3f290a374201f3369afa8e1d0d9eb6123cc8ba44 100644
--- a/src/kernel_services/ast_printing/cil_printer.ml
+++ b/src/kernel_services/ast_printing/cil_printer.ml
@@ -641,7 +641,7 @@ class cil_printer () = object (self)
we want to print it as hexa *)
| CInt64(i, ik, _) ->
(*fprintf fmt "/* %Lx */" i;*)
- (** We must make sure to capture the type of the constant. For some
+ (* We must make sure to capture the type of the constant. For some
constants this is done with a suffix, for others with a cast
prefix.*)
let suffix = match ik with
diff --git a/src/kernel_services/ast_printing/printer_api.mli b/src/kernel_services/ast_printing/printer_api.mli
index 6da4dfa10083abc9bc10958653fadfb86869ae13..17c67011356f8414442a4cb73246944af38c8d70 100644
--- a/src/kernel_services/ast_printing/printer_api.mli
+++ b/src/kernel_services/ast_printing/printer_api.mli
@@ -237,6 +237,7 @@ class type extensible_printer_type = object
method binop: Format.formatter -> binop -> unit
method init: Format.formatter -> init -> unit
+
(** Print initializers. This can be slow. *)
method file: Format.formatter -> file -> unit
@@ -314,6 +315,7 @@ class type extensible_printer_type = object
method pp_keyword: Format.formatter -> string -> unit
(** All C99 keywords except types "char", "int", "long", "signed",
"short", "unsigned", "void" and "_XXX" (like "_Bool") **)
+
method pp_acsl_keyword: Format.formatter -> string -> unit
(** All ACSL keywords except logic types *)
@@ -361,11 +363,12 @@ type line_directive_style =
| Line_preprocessor_output (** Use # nnn directives (in gcc mode) *)
type state =
- { (** How to print line directives *)
- mutable line_directive_style: line_directive_style option;
+ { mutable line_directive_style: line_directive_style option;
+ (** How to print line directives *)
+ mutable print_cil_input: bool;
(** Whether we print something that will only be used as input to Cil's
parser. In that case we are a bit more liberal in what we print. *)
- mutable print_cil_input: bool;
+ mutable print_cil_as_is: bool;
(** Whether to print the CIL as they are, without trying to be smart and
print nicer code. Normally this is false, in which case the pretty
printer will turn the while(1) loops of CIL into nicer loops, will not
@@ -373,13 +376,13 @@ type state =
you turn this on you will get code that does not compile: if you use
varargs the __builtin_va_arg function will be printed in its internal
form. *)
- mutable print_cil_as_is: bool;
+ mutable line_length: int;
(** The length used when wrapping output lines. Setting this variable to
a large integer will prevent wrapping and make #line directives more
accurate. *)
- mutable line_length: int;
+ mutable warn_truncate: bool
(** Emit warnings when truncating integer constants (default true) *)
- mutable warn_truncate: bool }
+ }
(* ********************************************************************* *)
(** {2 Functions for pretty printing} *)
@@ -450,10 +453,12 @@ module type S_pp = sig
val pp_extended: Format.formatter -> acsl_extension -> unit
val pp_short_extended: Format.formatter -> acsl_extension -> unit
(** @since 21.0-Scandium *)
+
val pp_predicate_node: Format.formatter -> predicate_node -> unit
val pp_predicate: Format.formatter -> predicate -> unit
val pp_toplevel_predicate: Format.formatter -> toplevel_predicate -> unit
(** @since 22.0-Titanium *)
+
val pp_identified_predicate: Format.formatter -> identified_predicate -> unit
val pp_code_annotation: Format.formatter -> code_annotation -> unit
val pp_funspec: Format.formatter -> funspec -> unit
diff --git a/src/kernel_services/ast_queries/acsl_extension.mli b/src/kernel_services/ast_queries/acsl_extension.mli
index db465e067808726f7edf2d81c9562fadec33e25d..22f3a198087e98cce8c0f63009ad7da9638a5d04 100644
--- a/src/kernel_services/ast_queries/acsl_extension.mli
+++ b/src/kernel_services/ast_queries/acsl_extension.mli
@@ -35,13 +35,17 @@ type extension_preprocessor =
(** Transformers from untyped to typed ACSL extension *)
type extension_typer =
typing_context -> location -> lexpr list -> acsl_extension_kind
+
(** Visitor functions for ACSL extensions *)
type extension_visitor =
Cil.cilVisitor -> acsl_extension_kind -> acsl_extension_kind Cil.visitAction
+
type extension_preprocessor_block =
string * extended_decl list -> string * extended_decl list
+
type extension_typer_block =
typing_context -> location -> string * extended_decl list -> acsl_extension_kind
+
(** Pretty printers for ACSL extensions *)
type extension_printer =
Printer_api.extensible_printer_type -> Format.formatter ->
diff --git a/src/kernel_services/ast_queries/cil.ml b/src/kernel_services/ast_queries/cil.ml
index 43579c3d1661338d015733e3e3ce843268992ed4..99910c959b5045e6c547ec2e215a6ca8cd235ccd 100644
--- a/src/kernel_services/ast_queries/cil.ml
+++ b/src/kernel_services/ast_queries/cil.ml
@@ -905,26 +905,25 @@ class type cilVisitor = object
method vstmt: stmt -> stmt visitAction
(** Control-flow statement. *)
- method vblock: block -> block visitAction (** Block. Replaced in
- place. *)
- method vfunc: fundec -> fundec visitAction (** Function definition.
- Replaced in place. *)
- method vglob: global -> global list visitAction (** Global (vars, types,
- etc.) *)
+ method vblock: block -> block visitAction
+ (** Block. Replaced in place. *)
+
+ method vfunc: fundec -> fundec visitAction
+ (** Function definition. Replaced in place. *)
+
+ method vglob: global -> global list visitAction
+ (** Global (vars, types, etc.) *)
+
method vinit: varinfo -> offset -> init -> init visitAction
- (** Initializers for globals,
- * pass the global where this
- * occurs, and the offset *)
+ (** Initializers for globals, pass the global where this occurs, and the
+ offset *)
method vlocal_init: varinfo -> local_init -> local_init visitAction
- method vtype: typ -> typ visitAction (** Use of some type. Note
- * that for structure/union
- * and enumeration types the
- * definition of the
- * composite type is not
- * visited. Use [vglob] to
- * visit it. *)
+ method vtype: typ -> typ visitAction
+ (** Use of some type. Note that for structure/union and enumeration types the
+ definition of the composite type is not visited. Use [vglob] to visit it.
+ *)
method vcompinfo: compinfo -> compinfo visitAction
@@ -936,6 +935,7 @@ class type cilVisitor = object
method vattr: attribute -> attribute list visitAction
(** Attribute. Each attribute can be replaced by a list *)
+
method vattrparam: attrparam -> attrparam visitAction
(** Attribute parameters. *)
@@ -6466,7 +6466,7 @@ let pushGlobal (g: global)
GType (_, l) | GCompTag (_, l) -> Some (getVarsInGlobal g, l)
| GEnumTag (_, l) | GPragma (Attr("pack", _), l)
| GCompTagDecl (_, l) | GEnumTagDecl (_, l) -> Some ([], l)
- (** Move the warning pragmas early
+ (* Move the warning pragmas early
| GPragma(Attr(s, _), l) when hasPrefix "warning" s -> Some ([], l)
*)
| _ -> None (* Does not go with the types *)
diff --git a/src/kernel_services/ast_queries/cil.mli b/src/kernel_services/ast_queries/cil.mli
index 20d23f66547df8d412b198e4b737c56db12106f9..52f580d316e9e9ed45f2ef4def06748e8afc773a 100644
--- a/src/kernel_services/ast_queries/cil.mli
+++ b/src/kernel_services/ast_queries/cil.mli
@@ -659,6 +659,7 @@ val existsType: (typ -> existsAction) -> typ -> bool
* a function type *)
val splitFunctionType:
typ -> typ * (string * typ * attributes) list option * bool * attributes
+
(** Same as {!Cil.splitFunctionType} but takes a varinfo. Prints a nicer
* error message if the varinfo is not for a function *)
val splitFunctionTypeVI:
@@ -1387,12 +1388,12 @@ val typeHasQualifier: string -> typ -> bool
@since Sodium-20150201 *)
val typeHasAttributeDeep: string -> typ -> bool
+[@@ deprecated "Use Cil.typeHasAttributeMemoryBlock instead"]
(** Does the type or one of its subtypes have the given attribute. Does
not recurse through pointer types, nor inside function prototypes.
@since Oxygen-20120901
@deprecated Chlorine-20180501 see {!Cil.typeHasAttributeMemoryBlock}
*)
-[@@ deprecated "Use Cil.typeHasAttributeMemoryBlock instead"]
val typeHasAttributeMemoryBlock: string -> typ -> bool
(** [typeHasAttributeMemoryBlock attr t] is
@@ -1737,6 +1738,7 @@ class type cilVisitor = object
(** link to the current function being visited.
{b NB:} for copy visitors, the fundec is the original one. *)
+
method set_current_func: fundec -> unit
method reset_current_func: unit -> unit
@@ -1829,6 +1831,7 @@ class genericCilVisitor: Visitor_behavior.t -> cilVisitor
class nopCilVisitor: cilVisitor
(** {3 Generic visit functions} *)
+
(** [doVisit vis deepCopyVisitor copy action children node]
visits a [node]
(or its copy according to the result of [copy]) and if needed
diff --git a/src/kernel_services/ast_queries/cil_datatype.mli b/src/kernel_services/ast_queries/cil_datatype.mli
index 6bdce706e967575133a8516da9afce19ba9de512..c25bec64338e2c11fb6f5513d201d8445d7823a1 100644
--- a/src/kernel_services/ast_queries/cil_datatype.mli
+++ b/src/kernel_services/ast_queries/cil_datatype.mli
@@ -70,6 +70,7 @@ module Location: sig
include S_with_collections_pretty with type t = location
val unknown: t
val pretty_long : t Pretty_utils.formatter
+
(** Pretty the location under the form [file <f>, line <l>], without
the full-path to the file. The default pretty-printer [pretty] echoes
[<dir/f>:<l>] *)
@@ -355,6 +356,7 @@ module Toplevel_predicate: S_with_pretty with type t = toplevel_predicate
module Identified_predicate:
S_with_collections_pretty with type t = identified_predicate
(** @since Neon-20140301 *)
+
module PredicateStructEq: S_with_collections_pretty with type t = predicate
(** @since 24.0-Chromium *)
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index 3a4dd2b55f0ae4241e37da8f1a8808144683a28b..eefaadb83fee396f58195c7f4bf5804d08243135 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -1429,7 +1429,7 @@ class reorder_ast: Visitor.frama_c_visitor =
assert (List.length deps = List.length needed_annots);
match g with
| GAnnot _ -> List.rev deps
- (** g is already in the dependencies graph. *)
+ (* g is already in the dependencies graph. *)
| _ -> List.rev (g::deps)
(* TODO: add methods for uses of undeclared identifiers.
diff --git a/src/kernel_services/ast_queries/filecheck.ml b/src/kernel_services/ast_queries/filecheck.ml
index 336b5086b24b06f23e86ce89d7ddba82fe33e7ca..3a1cad261993528fc7b8c93dd1c0e06cc1705d2d 100644
--- a/src/kernel_services/ast_queries/filecheck.ml
+++ b/src/kernel_services/ast_queries/filecheck.ml
@@ -469,8 +469,8 @@ module Base_checker = struct
(Stmt.Set.elements !calls)
in Cil.ChangeDoChildrenPost(s,f)
| If (_,bt,be,_) -> begin
- (** Check that we have 2 successors, in the right order (then before
- else) *)
+ (* Check that we have 2 successors, in the right order (then before
+ else) *)
match s.succs with
| [st; se] -> begin
(match bt.bstmts with
diff --git a/src/kernel_services/ast_queries/logic_const.mli b/src/kernel_services/ast_queries/logic_const.mli
index dc0b3f4f9be555b93e3d9a2ae0fe7104c599fff2..72cb93fb3b0461c228d31d7d7e265327dee538eb 100644
--- a/src/kernel_services/ast_queries/logic_const.mli
+++ b/src/kernel_services/ast_queries/logic_const.mli
@@ -135,6 +135,7 @@ val por: ?loc:location -> predicate * predicate -> predicate
(** ^^ *)
val pxor: ?loc:location -> predicate * predicate -> predicate
+
(** ! *)
val pnot: ?loc:location -> predicate -> predicate
diff --git a/src/kernel_services/ast_queries/logic_env.ml b/src/kernel_services/ast_queries/logic_env.ml
index 179087ad2dee1f8ec4c1611d16395b166582ccd7..f9bf37714a0f8c9ccc708f6e3078b5981318fc3b 100644
--- a/src/kernel_services/ast_queries/logic_env.ml
+++ b/src/kernel_services/ast_queries/logic_env.ml
@@ -346,6 +346,7 @@ let prepare_tables () =
Logic_builtin_used.iter Logic_info.add
(** C typedefs *)
+
(**
- true => identifier is a type name
- false => identifier is a plain identifier
diff --git a/src/kernel_services/ast_queries/logic_env.mli b/src/kernel_services/ast_queries/logic_env.mli
index a10c1570b3eb6d6f9d7521909dbc585410f555f9..4e66cd33923475097bb99c37bcd7eb9abf201d07 100644
--- a/src/kernel_services/ast_queries/logic_env.mli
+++ b/src/kernel_services/ast_queries/logic_env.mli
@@ -94,6 +94,7 @@ val add_model_field: model_info -> unit
module Builtins: sig
val apply: unit -> unit
(** adds all requested objects in the environment. *)
+
val extend: (unit -> unit) -> unit
(** request an addition in the environment. Use one of the functions below
in the body of the argument.
diff --git a/src/kernel_services/ast_queries/logic_typing.mli b/src/kernel_services/ast_queries/logic_typing.mli
index 975979ba18968c6fbde157249fb261997cb06694..3ea227024a1f08a8a2387c7e183b9ff1d6524dd2 100644
--- a/src/kernel_services/ast_queries/logic_typing.mli
+++ b/src/kernel_services/ast_queries/logic_typing.mli
@@ -119,9 +119,7 @@ type typing_context = {
pre_state:Lenv.t;
post_state:termination_kind list -> Lenv.t;
assigns_env: Lenv.t;
- (**/**)
silent: bool;
- (**/**)
logic_type:
typing_context -> location -> Lenv.t ->
Logic_ptree.logic_type -> Cil_types.logic_type ;
@@ -142,6 +140,7 @@ type typing_context = {
Lenv.t -> Logic_ptree.assigns -> assigns;
error: 'a 'b. location -> ('a,Format.formatter,unit,'b) format4 -> 'a;
+ on_error: 'a 'b. ('a -> 'b) -> ((location * string) -> unit) -> 'a -> 'b
(** [on_error f rollback x] will attempt to evaluate [f x]. If this triggers
an error while in [-continue-annot-error] mode, [rollback (loc,cause)]
will be executed (where [loc] is the location of the error and [cause]
@@ -150,7 +149,6 @@ type typing_context = {
@since Chlorine-20180501
@modify Frama-C+dev rollback takes as argument the error
*)
- on_error: 'a 'b. ('a -> 'b) -> ((location * string) -> unit) -> 'a -> 'b
}
module Make
@@ -159,11 +157,13 @@ module Make
val is_loop: unit -> bool
(** whether the annotation we want to type is contained in a loop.
Only useful when creating objects of type [code_annotation]. *)
+
val anonCompFieldName : string
val conditionalConversion : typ -> typ -> typ
val find_macro : string -> Logic_ptree.lexpr
val find_var : ?label:string -> string -> logic_var
(** see corresponding field in {!Logic_typing.typing_context}. *)
+
val find_enum_tag : string -> exp * typ
val find_type : type_namespace -> string -> typ
val find_comp_field: compinfo -> string -> offset
diff --git a/src/kernel_services/ast_queries/logic_utils.ml b/src/kernel_services/ast_queries/logic_utils.ml
index 954673433e980f2412f420c70e5c15b5d6689138..abaf9ce3212b52599eced4dfbaf1bb3944fe671d 100644
--- a/src/kernel_services/ast_queries/logic_utils.ml
+++ b/src/kernel_services/ast_queries/logic_utils.ml
@@ -2711,7 +2711,7 @@ let find_initial_value init loff =
let eval_term_lval global_find_init (lhost, loff) =
match lhost with
| TVar lvi -> begin
- (** See if we can evaluate the l-value using the initializer of lvi*)
+ (* See if we can evaluate the l-value using the initializer of lvi*)
let off_type = Cil.typeTermOffset lvi.lv_type loff in
if Logic_const.plain_or_set Cil.isLogicIntegralType off_type then
match lvi.lv_origin with
diff --git a/src/kernel_services/ast_queries/logic_utils.mli b/src/kernel_services/ast_queries/logic_utils.mli
index 45a093462439078aea8e72cea36526d453bc1504..ef79c06f510414ea50d57d1a24f4484cea12a90a 100644
--- a/src/kernel_services/ast_queries/logic_utils.mli
+++ b/src/kernel_services/ast_queries/logic_utils.mli
@@ -389,6 +389,7 @@ val is_same_code_annotation : code_annotation -> code_annotation -> bool
val is_same_global_annotation : global_annotation -> global_annotation -> bool
val is_same_axiomatic :
global_annotation list -> global_annotation list -> bool
+
(** @since Oxygen-20120901 *)
val is_same_model_info: model_info -> model_info -> bool
diff --git a/src/kernel_services/ast_transformations/filter.mli b/src/kernel_services/ast_transformations/filter.mli
index 67676816445b0208fb67fe92c00a8fcab60d73e2..7c0de0eee698e7bbf47450030a827a61ae23db0e 100644
--- a/src/kernel_services/ast_transformations/filter.mli
+++ b/src/kernel_services/ast_transformations/filter.mli
@@ -92,6 +92,7 @@ module type RemoveInfo = sig
should be erased entirely (i.e. assigns everything. If it were to
just return false to all elements, this would result in assigns \nothing
*)
+
val fun_deps_visible : fct -> identified_term -> bool
(** true if the corresponding functional dependency is visible. *)
diff --git a/src/kernel_services/ast_transformations/inline.ml b/src/kernel_services/ast_transformations/inline.ml
index abc07955e5d3b7f347d06c660023c18f3aad4ff4..3a3739578a46efacdff8f39271f69dba00faefb3 100644
--- a/src/kernel_services/ast_transformations/inline.ml
+++ b/src/kernel_services/ast_transformations/inline.ml
@@ -428,23 +428,23 @@ open Cil_datatype
exception CannotInline
type inline_env = {
+ inline: logic_info -> bool;
(** Returns true for predicate and logic functions to be inlined. Other
predicates and functions are left unchanged. *)
- inline: logic_info -> bool;
+ map_param: (term * logic_label) Logic_var.Map.t;
(** logic argument of the predicate -> term that replaces it, plus the label
at which it must be evaluated. *)
- map_param: (term * logic_label) Logic_var.Map.t;
- (** logic label of the predicate -> label at call site *)
map_label: logic_label Logic_label.Map.t;
+ (** logic label of the predicate -> label at call site *)
+ already_seen: Logic_info.Set.t;
(** predicates and functions already inlined once, to prevent loops on
recursive definitions *)
- already_seen: Logic_info.Set.t;
- (** current default label, Here at the beginning *)
curr_label: logic_label;
+ (** current default label, Here at the beginning *)
}
(* Specification of the following inliner: the resulting term/predicate
diff --git a/src/kernel_services/cmdline_parameters/cmdline.mli b/src/kernel_services/cmdline_parameters/cmdline.mli
index 479673b70bc7def46f42dc402d6276f15de23082..593030013953876e2785ddb547c7d7f07f623e52 100644
--- a/src/kernel_services/cmdline_parameters/cmdline.mli
+++ b/src/kernel_services/cmdline_parameters/cmdline.mli
@@ -124,8 +124,12 @@ val at_error_exit: (exn -> unit) -> unit
(** Group of command line options.
@since Beryllium-20090901 *)
module Group : sig
- type t (** @since Beryllium-20090901 *)
- val default: t (** @since Beryllium-20090901 *)
+ (** @since Beryllium-20090901 *)
+ type t
+
+ val default: t
+ (** @since Beryllium-20090901 *)
+
val name: t -> string
(** @since Beryllium-20090901 *)
diff --git a/src/kernel_services/cmdline_parameters/parameter_sig.mli b/src/kernel_services/cmdline_parameters/parameter_sig.mli
index ac477a68a06b9aae816672017cd947fff68a942c..13e4e754a2d155a8a300913aae812136da1b67c1 100644
--- a/src/kernel_services/cmdline_parameters/parameter_sig.mli
+++ b/src/kernel_services/cmdline_parameters/parameter_sig.mli
@@ -34,6 +34,7 @@
module type Input = sig
val option_name: string
(** The name of the option *)
+
val help: string
(** A description for this option (e.g. used by -help).
If [help = ""], then it has the special meaning "undocumented" *)
@@ -352,7 +353,8 @@ end
(** Signature for a category over a collection.
@since Sodium-20150201 *)
module type Collection_category = sig
- type elt (** Element in the category *)
+ (** Element in the category *)
+ type elt
type t = elt Parameter_category.t
val none: t
@@ -475,8 +477,11 @@ module type Filepath_list =
@since Sodium-20150201 *)
module type Map = sig
- type key (** Type of keys of the map. *)
- type value (** Type of the values associated to the keys. *)
+ (** Type of keys of the map. *)
+ type key
+
+ (** Type of the values associated to the keys. *)
+ type value
include Collection with type elt = key * value option
(** A map is a collection in which elements are pairs [(key, value)], but some
diff --git a/src/kernel_services/parsetree/cabs.mli b/src/kernel_services/parsetree/cabs.mli
index 44d168dec6fbdef792a3bd9d673216dfce5e9431..5313481fd20a90ef97ce08562d05128293185d6c 100644
--- a/src/kernel_services/parsetree/cabs.mli
+++ b/src/kernel_services/parsetree/cabs.mli
@@ -252,12 +252,11 @@ and raw_statement =
front-ends.
*)
- (** MS SEH *)
- | TRY_EXCEPT of block * expression * block * cabsloc
- | TRY_FINALLY of block * block * cabsloc
- (* annotations *)
- | CODE_ANNOT of (Logic_ptree.code_annot * cabsloc)
- | CODE_SPEC of (Logic_ptree.spec * cabsloc)
+ | TRY_EXCEPT of block * expression * block * cabsloc (** MS SEH *)
+ | TRY_FINALLY of block * block * cabsloc (** MS SEH *)
+
+ | CODE_ANNOT of (Logic_ptree.code_annot * cabsloc) (* annotations *)
+ | CODE_SPEC of (Logic_ptree.spec * cabsloc) (* annotations *)
and statement = { mutable stmt_ghost: bool; stmt_node:raw_statement }
diff --git a/src/kernel_services/parsetree/logic_ptree.mli b/src/kernel_services/parsetree/logic_ptree.mli
index 88bb70b04a13f8264a732ae6936fe346cf53fa3f..413cb1a91ff2b622f4f533f4de7bc8b30068b513 100644
--- a/src/kernel_services/parsetree/logic_ptree.mli
+++ b/src/kernel_services/parsetree/logic_ptree.mli
@@ -77,15 +77,16 @@ type lexpr = {
}
(* PL is for Parsed Logic *)
-(** kind of expression. *)
+(** construct inside a functional update. *)
and path_elt =
- (** construct inside a functional update. *)
| PLpathField of string
| PLpathIndex of lexpr
and update_term =
| PLupdateTerm of lexpr
| PLupdateCont of ((path_elt list) * update_term) list
+
+(** Kind of expression *)
and lexpr_node =
(* both terms and predicates *)
| PLvar of string (** a variable *)
diff --git a/src/kernel_services/plugin_entry_points/db.mli b/src/kernel_services/plugin_entry_points/db.mli
index a166b8e46287145c04a2686a07542b107de1fc76..e595d96f0bc6d567de1e130b8a743a89c0f4d5ef 100644
--- a/src/kernel_services/plugin_entry_points/db.mli
+++ b/src/kernel_services/plugin_entry_points/db.mli
@@ -1237,6 +1237,7 @@ module type INOUTKF = sig
val pretty : Format.formatter -> t -> unit
end
+
(** Signature common to inputs and outputs computations. The results
are also available on a per-statement basis. *)
module type INOUT = sig
diff --git a/src/kernel_services/plugin_entry_points/dynamic.ml b/src/kernel_services/plugin_entry_points/dynamic.ml
index e7d1990771570d6b985b1c22077f7be484483a5a..8ca60609d5e03713020c43c70223417c5c2b9c47 100644
--- a/src/kernel_services/plugin_entry_points/dynamic.ml
+++ b/src/kernel_services/plugin_entry_points/dynamic.ml
@@ -175,7 +175,7 @@ let load_packages pkgs =
*)
let gui = if !Fc_config.is_gui then ["gui"] else [] in
let predicates =
- (** The order is important for the archive cases *)
+ (* The order is important for the archive cases *)
if Dynlink.is_native then
[
"plugin", ["native"]@gui;
diff --git a/src/kernel_services/plugin_entry_points/dynamic.mli b/src/kernel_services/plugin_entry_points/dynamic.mli
index 29275fb8863df2665a35f1b86bbbbb2fbea0c458..71f0267fcfc3b9f3bbf3bcb234bde5b58b82ac11 100644
--- a/src/kernel_services/plugin_entry_points/dynamic.mli
+++ b/src/kernel_services/plugin_entry_points/dynamic.mli
@@ -105,6 +105,7 @@ module Parameter : sig
include Common with type t = bool
val on: string -> unit -> unit
(** Set the parameter to [true]. *)
+
val off : string -> unit -> unit
(** Set the parameter to [false]. *)
end
@@ -136,8 +137,10 @@ module Parameter : sig
val add: string -> string -> unit
val append_before: string -> string list -> unit
(** @since Neon-20140301 *)
+
val append_after: string -> string list -> unit
(** @since Neon-20140301 *)
+
val remove: string -> string -> unit
val is_empty: string -> unit -> bool
val iter: string -> (string -> unit) -> unit
diff --git a/src/kernel_services/plugin_entry_points/emitter.mli b/src/kernel_services/plugin_entry_points/emitter.mli
index 30161f67416127dc7a3ac942ffc7944787083ce2..0da83cb0b710ac6047360386ad0213799464dfbf 100644
--- a/src/kernel_services/plugin_entry_points/emitter.mli
+++ b/src/kernel_services/plugin_entry_points/emitter.mli
@@ -145,6 +145,7 @@ sig
val add_hook_on_remove: (E.t -> H.key -> D.t -> unit) -> unit
(** Register a hook to be applied whenever a binding is removed from the table.
@since Fluorine-20130401 *)
+
val apply_hooks_on_remove: E.t -> H.key -> D.t -> unit
(** This function must be called on each binding which is removed from the
table without directly calling the function {!remove}.
diff --git a/src/kernel_services/plugin_entry_points/journal.ml b/src/kernel_services/plugin_entry_points/journal.ml
index bf6186eda86346eeae526434acefc965c2b4fce1..4c81ac38b9cd345d4a0ffa98eaff99af3c4dc2bc 100644
--- a/src/kernel_services/plugin_entry_points/journal.ml
+++ b/src/kernel_services/plugin_entry_points/journal.ml
@@ -238,10 +238,12 @@ module Binding: sig
(** [add ty v var] binds the value [v] to the variable name [var]. Thus,
[pp ty v] prints [var] and not use the standard pretty printer. Very
useful to pretty print values with no associated pretty printer. *)
+
exception Name_already_exists of string
val add_once: 'a Type.t -> 'a -> string -> unit
(** Same as function [add] above but raise the exception [Already_exists]
if the binding previously exists *)
+
val find: 'a Type.t -> 'a -> string
val iter: ('a Type.t -> 'a -> string -> unit) -> unit
end = struct
diff --git a/src/kernel_services/plugin_entry_points/journal.mli b/src/kernel_services/plugin_entry_points/journal.mli
index a5f020bca47c089698bd911e763c4e8e84fbe72e..f9be3ee7a31b714322c560bbe4e62871328f29e5 100644
--- a/src/kernel_services/plugin_entry_points/journal.mli
+++ b/src/kernel_services/plugin_entry_points/journal.mli
@@ -60,6 +60,7 @@ module Binding: sig
(** [add ty v var] binds the value [v] to the variable name [var]. Thus,
[pp ty v] prints [var] and not use the standard pretty printer. Very
useful to pretty print values with no associated pretty printer. *)
+
exception Name_already_exists of string
val add_once: 'a Type.t -> 'a -> string -> unit
(** Same as function [add] above but raise the exception [Already_exists]
diff --git a/src/kernel_services/plugin_entry_points/kernel.mli b/src/kernel_services/plugin_entry_points/kernel.mli
index aa8edb92053a3a009ba32c0039308314e88e52da..c0c5520fecd00d44fd7af902841648e080d9164e 100644
--- a/src/kernel_services/plugin_entry_points/kernel.mli
+++ b/src/kernel_services/plugin_entry_points/kernel.mli
@@ -464,8 +464,8 @@ module PreprocessAnnot: Parameter_sig.Bool
(** Behavior of option "-pp-annot" *)
module ContinueOnAnnotError: Parameter_sig.Bool
-(** Behavior of option "-continue-annot-error" *)
[@@ deprecated "Use Kernel.wkey_annot_error instead"]
+(** Behavior of option "-continue-annot-error" *)
module SimplifyCfg: Parameter_sig.Bool
(** Behavior of option "-simplify-cfg" *)
@@ -515,12 +515,12 @@ val normalization_parameters: unit -> Typed_parameter.t list
*)
module WarnDecimalFloat: Parameter_sig.String
-(** Behavior of option "-warn-decimal-float" *)
[@@ deprecated "Uses kernel.wkey_decimal_float instead."]
+(** Behavior of option "-warn-decimal-float" *)
module ImplicitFunctionDeclaration: Parameter_sig.String
-(** Behavior of option "-implicit-function-declaration" *)
[@@ deprecated "Uses kernel.wkey_implicit_function_declaration instead."]
+(** Behavior of option "-implicit-function-declaration" *)
module C11: Parameter_sig.Bool
(** Behavior of option "-c11" *)
diff --git a/src/kernel_services/plugin_entry_points/log.ml b/src/kernel_services/plugin_entry_points/log.ml
index 9479bf54faca0f5d7f1b31b27591eabf6648a552..3daac4379d69558c708f6e108cde453d3f0c1b00 100644
--- a/src/kernel_services/plugin_entry_points/log.ml
+++ b/src/kernel_services/plugin_entry_points/log.ml
@@ -827,6 +827,7 @@ sig
?wkey: warn_category -> ?emitwith:(event -> unit) -> ?once:bool -> ('a,'b) pretty_aborter
val register : kind -> (event -> unit) -> unit (** Very local listener. *)
+
val register_tag_handlers : (string -> string) * (string -> string) -> unit
val register_category: string -> category
diff --git a/src/kernel_services/plugin_entry_points/plugin.mli b/src/kernel_services/plugin_entry_points/plugin.mli
index b144f80aa83553c1042d53d531e2f1d405c0b455..da7d795389d76899763eb37e2670329f8d149f15 100644
--- a/src/kernel_services/plugin_entry_points/plugin.mli
+++ b/src/kernel_services/plugin_entry_points/plugin.mli
@@ -112,9 +112,14 @@ val register_kernel: unit -> unit
@plugin development guide *)
module Register
(P: sig
- val name: string (** Name of the module. Arbitrary non-empty string. *)
- val shortname: string (** Prefix for plugin options. No space allowed. *)
- val help: string (** description of the module. Free-form text. *)
+ val name: string
+ (** Name of the module. Arbitrary non-empty string. *)
+
+ val shortname: string
+ (** Prefix for plugin options. No space allowed. *)
+
+ val help: string
+ (** description of the module. Free-form text. *)
end):
General_services
diff --git a/src/libraries/datatype/datatype.ml b/src/libraries/datatype/datatype.ml
index 95161b497972531c5a1f9fce4165299cb33e2fdf..0db6b38c6c5659189e009ccf723ca23329f88d65 100644
--- a/src/libraries/datatype/datatype.ml
+++ b/src/libraries/datatype/datatype.ml
@@ -776,8 +776,8 @@ module Pair_arg = struct
let mk_mem_project mem1 mem2 f (x1, x2) = mem1 f x1 && mem2 f x2
end
-(** warning is unsound in that case:
- http://caml.inria.fr/mantis/view.php?id=7314#c16232
+(* warning is unsound in that case:
+ http://caml.inria.fr/mantis/view.php?id=7314#c16232
*)
[@@@ warning "-60"]
@@ -1996,7 +1996,7 @@ module Triple_arg = struct
mem1 f x1 && mem2 f x2 && mem3 f x3
end
-(** warning is unsound in that case:
+(* warning is unsound in that case:
http://caml.inria.fr/mantis/view.php?id=7314#c16232
*)
[@@@ warning "-60"]
@@ -2106,7 +2106,7 @@ module Quadruple_arg = struct
mem1 f x1 && mem2 f x2 && mem3 f x3 && mem4 f x4
end
-(** warning is unsound in that case:
+(* warning is unsound in that case:
http://caml.inria.fr/mantis/view.php?id=7314#c16232
*)
[@@@ warning "-60"]
diff --git a/src/libraries/datatype/datatype.mli b/src/libraries/datatype/datatype.mli
index f19bc1989cfde3d0a7530d822cc4f6e0fca2b5f2..34026478a1a927da4afaf3547b4eb8731d96f1a9 100644
--- a/src/libraries/datatype/datatype.mli
+++ b/src/libraries/datatype/datatype.mli
@@ -208,7 +208,9 @@ module type Make_input = sig
value specified in module type {!S}. *)
val structural_descr: Structural_descr.t
- val reprs: t list (** Must be non-empty.*)
+ val reprs: t list
+ (** Must be non-empty.*)
+
val equal: t -> t -> bool
val compare: t -> t -> int
val hash: t -> int
diff --git a/src/libraries/datatype/type.mli b/src/libraries/datatype/type.mli
index c0c8d7f2df6530b3411f36f0d9d90c93a1a2d410..0cc7b1ff57f7b15825f0d3d5345f128eb616e94d 100644
--- a/src/libraries/datatype/type.mli
+++ b/src/libraries/datatype/type.mli
@@ -235,6 +235,7 @@ module Function : sig
- [~label:(p,None)] for a mandatory labeled parameter [p];
- [~label:(p,Some f)] for an optional labeled parameter [p],
with default value [f ()]. *)
+
val is_instance_of: 'a t -> bool
val get_instance: ('a -> 'b) t -> 'a t * 'b t * string option
val get_optional_argument: ('a -> 'b) t -> (unit -> 'a) option
diff --git a/src/libraries/project/state_builder.mli b/src/libraries/project/state_builder.mli
index 1b90a729453014bc03f665577daa7e8f77b3f198..fbcfb611dedcd1f455444bd07712f0f702b2d183 100644
--- a/src/libraries/project/state_builder.mli
+++ b/src/libraries/project/state_builder.mli
@@ -34,8 +34,11 @@
(** Additional information required by {!State_builder.Register}. *)
module type Info = sig
- val name: string (** Name of the internal state. *)
- val dependencies : State.t list (** Dependencies of this internal state. *)
+ val name: string
+ (** Name of the internal state. *)
+
+ val dependencies : State.t list
+ (** Dependencies of this internal state. *)
end
module type Info_with_size = sig
@@ -102,12 +105,16 @@ module Register
(** Output signature of [Ref]. *)
module type Ref = sig
include S
- type data
+
(** Type of the referenced value. *)
+ type data
+
val set: data -> unit
(** Change the referenced value. *)
+
val get: unit -> data
(** Get the referenced value. *)
+
val clear: unit -> unit
(** Reset the reference to its default value. *)
end
@@ -131,6 +138,7 @@ module type Option_ref = sig
(** Memoization. Compute on need the stored value.
If the data is already computed (i.e. is not [None]),
it is possible to change with [change]. *)
+
val map: (data -> data) -> data option
val may: (data -> unit) -> unit
val get_option : unit -> data option
@@ -146,7 +154,9 @@ module Option_ref(Data:Datatype.S)(Info: Info) :
module type List_ref = sig
type data_in_list
include Ref
- val add: data_in_list -> unit (** @since Nitrogen-20111001 *)
+ val add: data_in_list -> unit
+ (** @since Nitrogen-20111001 *)
+
val iter: (data_in_list -> unit) -> unit
val fold_left: ('a -> data_in_list -> 'a) -> 'a -> 'a
end
@@ -263,12 +273,15 @@ module Caml_weak_hashtbl(Data: Datatype.S)(Info: Info_with_size) :
module type Hashconsing_tbl =
functor
(Data: sig
- include Datatype.S
(** The hashconsed datatype *)
+ include Datatype.S
+
val equal_internal: t -> t -> bool
(** Equality on the datatype internally used by the built table. *)
+
val hash_internal: t -> int
(** Hash function for datatype internally used by the built table. *)
+
val initial_values: t list
(** Pre-existing values stored in the built table and shared by all
existing projects. *)
@@ -313,12 +326,16 @@ module type Hashtbl = sig
type data
val replace: key -> data -> unit
(** Add a new binding. The previous one is removed. *)
+
val add: key -> data -> unit
(** Add a new binding. The previous one is only hidden. *)
+
val clear: unit -> unit
(** Clear the table. *)
+
val length: unit -> int
(** Length of the table. *)
+
val iter: (key -> data -> unit) -> unit
val iter_sorted:
?cmp:(key -> key -> int) -> (key -> data -> unit) -> unit
@@ -330,19 +347,25 @@ module type Hashtbl = sig
the given function.
If the data is already computed, it is possible to change with
[change]. *)
+
val find: key -> data
(** Return the current binding of the given key.
@raise Not_found if the key is not in the table. *)
+
val find_all: key -> data list
(** Return the list of all data associated with the given key. *)
+
val mem: key -> bool
val remove: key -> unit
end
-(** @plugin development guide *)
+(** @plugin development guide
+ - [H] is the hashtable implementation
+ - [Data] is the datatype for values stored in the table
+*)
module Hashtbl
- (H: Datatype.Hashtbl (** hashtable implementation *))
- (Data: Datatype.S (** datatype for values stored in the table *))
+ (H: Datatype.Hashtbl)
+ (Data: Datatype.S)
(Info: Info_with_size) :
Hashtbl with type key = H.key and type data = Data.t
and module Datatype = H.Make(Data)
@@ -359,7 +382,9 @@ module type Set_ref = sig
include Ref
type elt
val add: elt -> unit
- val remove: elt -> unit (** @since Neon-20140301 *)
+ val remove: elt -> unit
+ (** @since Neon-20140301 *)
+
val is_empty: unit -> bool
val mem: elt -> bool
val fold: (elt -> 'a -> 'a) -> 'a -> 'a
@@ -476,11 +501,15 @@ module type Hashcons = sig
include Datatype.S_with_collections (** hashconsed version of {!elt} *)
- val hashcons: elt -> t (** Injection as an hashconsed value. *)
- val get: t -> elt (** Projection out of hashconsing. *)
+ val hashcons: elt -> t
+ (** Injection as an hashconsed value. *)
+
+ val get: t -> elt
+ (** Projection out of hashconsing. *)
- val id: t -> int (** Id of an hashconsed value. Unique:
- [id x = id y] is equivalent to equality on {!elt}. *)
+ val id: t -> int
+ (** Id of an hashconsed value. Unique:
+ [id x = id y] is equivalent to equality on {!elt}. *)
val self: State.t
end
diff --git a/src/libraries/stdlib/extlib.mli b/src/libraries/stdlib/extlib.mli
index fe02f5aa9f8ab4e65895abc67027200dc9991414..d8551183ffe17a263faf75b9e971f34c7c69fc2f 100644
--- a/src/libraries/stdlib/extlib.mli
+++ b/src/libraries/stdlib/extlib.mli
@@ -118,6 +118,7 @@ val filter_map_opt: ('a -> 'b option) -> 'a list -> 'b list
val fold_map: ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
(** Combines [fold_left] and [map] *)
+
val fold_map_opt: ('a -> 'b -> 'a * 'c option) -> 'a -> 'b list -> 'a * 'c list
(** Combines [filter] [fold_left] and [map] *)
diff --git a/src/libraries/stdlib/integer.mli b/src/libraries/stdlib/integer.mli
index bcb278dbefef0218c665eea43ffb5ef9c28b574c..33ec8281a3a85c2e36b1690ac67a444cdb485cb6 100644
--- a/src/libraries/stdlib/integer.mli
+++ b/src/libraries/stdlib/integer.mli
@@ -216,6 +216,7 @@ val of_string : string -> t
(** @modify Frama-C+dev remove optional `hexa` argument *)
val pretty : t formatter
+
(** @since Frama-C+dev *)
val pretty_hex : t formatter
diff --git a/src/libraries/utils/bitvector.mli b/src/libraries/utils/bitvector.mli
index 1252701c6d9ad1b2f9c0ebbcfc2a9e0d4d3f9546..63346ddbde8c182fd7429030c128cfd3d8859e36 100644
--- a/src/libraries/utils/bitvector.mli
+++ b/src/libraries/utils/bitvector.mli
@@ -28,8 +28,11 @@
type t
-val create : int -> t (** Create a vector of [n] bits, with all bits unset. *)
-val create_set : int -> t (** Create a vector of [n] bits, with all bits set.*)
+val create : int -> t
+(** Create a vector of [n] bits, with all bits unset. *)
+
+val create_set : int -> t
+(** Create a vector of [n] bits, with all bits set.*)
val capacity : t -> int
(** Maximum number of bits in the bitvector. *)
@@ -41,7 +44,9 @@ val resize : int -> t -> t
val mem : t -> int -> bool
val set : t -> int -> unit
val clear : t -> int -> unit
-val once : t -> int -> bool (** return [true] if unset, then set the bit. *)
+val once : t -> int -> bool
+(** return [true] if unset, then set the bit. *)
+
val set_range : t -> int -> int -> unit
val is_empty : t -> bool
diff --git a/src/libraries/utils/cilconfig.ml b/src/libraries/utils/cilconfig.ml
index 478d2a2017a84999d49cb72fae54206f90e1c7ed..4b479e985f7674cdaa4ac5a21df7e2a720b1c968 100644
--- a/src/libraries/utils/cilconfig.ml
+++ b/src/libraries/utils/cilconfig.ml
@@ -128,7 +128,7 @@ let useConfigurationList (key: string) (f: configData list -> unit) =
let saveConfiguration (fname : Datatype.Filepath.t) =
- (** Convert configuration data to a string, for saving externally *)
+ (* Convert configuration data to a string, for saving externally *)
let configToString (c: configData) : string =
let buff = Buffer.create 80 in
let rec loop (c: configData) : unit =
@@ -185,7 +185,7 @@ let loadConfiguration (fname : Datatype.Filepath.t) : unit =
H.clear configurationData;
let stringToConfig (s: string) : configData =
- let idx = ref 0 in (** the current index *)
+ let idx = ref 0 in (* the current index *)
let l = String.length s in
let rec getOne () : configData =
diff --git a/src/libraries/utils/command.mli b/src/libraries/utils/command.mli
index 8a8c49a610ed090ead89c84ea434aca4ca5d52f6..52645e14bd181810e376fd56c345fee907de3e54 100644
--- a/src/libraries/utils/command.mli
+++ b/src/libraries/utils/command.mli
@@ -50,10 +50,13 @@ val copy : string -> string -> unit
val read_file : string -> (in_channel -> 'a) -> 'a
(** Properly close the channel and re-raise exceptions *)
+
val read_lines : string -> (string -> unit) -> unit
(** Iter over all text lines in the file *)
+
val write_file : string -> (out_channel -> 'a) -> 'a
(** Properly close the channel and re-raise exceptions *)
+
val print_file : string -> (Format.formatter -> 'a) -> 'a
(** Properly flush and close the channel and re-raise exceptions *)
diff --git a/src/libraries/utils/hook.ml b/src/libraries/utils/hook.ml
index a3adcfd202c8be0b4a75f9913bafde11c7cd31bd..a501930e240537d943898b251fc0eb596815f5f3 100644
--- a/src/libraries/utils/hook.ml
+++ b/src/libraries/utils/hook.ml
@@ -41,7 +41,7 @@ end
module type S_ordered = sig
include S
type key
- type id (** identifier of the hook *)
+ type id (* identifier of the hook *)
val register_key: key -> id
val extend: id -> (param->result)->unit
val extend_once: id -> (param->result) -> unit
diff --git a/src/libraries/utils/hptmap.ml b/src/libraries/utils/hptmap.ml
index 2fb29508aeb912328d5d6098fbf832fd6dc198e7..2a29fcb5437f90b027183178cc4279b67ca55df2 100644
--- a/src/libraries/utils/hptmap.ml
+++ b/src/libraries/utils/hptmap.ml
@@ -110,7 +110,7 @@ end
type ('key, 'value) tree =
| Empty
| Leaf of 'key * 'value * tag
- | Branch of int (** prefix *) *
+ | Branch of int (* prefix *) *
Big_Endian.mask *
('key, 'value) tree *
('key, 'value) tree *
@@ -495,10 +495,10 @@ module Shape(Key: Id_Datatype) = struct
if s == t || s == Empty then PTrue else PUnknown
let make_binary_predicate cache_merge pt ~decide_fast ~decide_fst ~decide_snd ~decide_both =
- (** We cannot use [&&] and [||] under another name, as functions are not
- lazy in OCaml. Instead, we defer the evaluation of the right part by
- calling a function. Due to typing issues, we must actually define
- two functions... *)
+ (* We cannot use [&&] and [||] under another name, as functions are not
+ lazy in OCaml. Instead, we defer the evaluation of the right part by
+ calling a function. Due to typing issues, we must actually define
+ two functions... *)
let comb1, comb2 =
match pt with
| UniversalPredicate -> let f b f v1 v2 = b && f v1 v2 in f, f
diff --git a/src/libraries/utils/hptmap.mli b/src/libraries/utils/hptmap.mli
index c6c6999870f32a0be676de972ef4c5d6c86be540..3f00916041af9ec45a9f6c29c8dad15bf5d49d2e 100644
--- a/src/libraries/utils/hptmap.mli
+++ b/src/libraries/utils/hptmap.mli
@@ -55,8 +55,12 @@ module Make
boolean on the subtrees and the value information present on each leaf.
See {!Comp_unused} for a default implementation. *)
- val e: bool (** Value for the empty tree *)
- val f : Key.t -> V.t -> bool (** Value for a leaf *)
+ val e: bool
+ (** Value for the empty tree *)
+
+ val f : Key.t -> V.t -> bool
+ (** Value for a leaf *)
+
val compose : bool -> bool -> bool
(** Composition of the values of two subtrees *)
end)
diff --git a/src/libraries/utils/hptmap_sig.mli b/src/libraries/utils/hptmap_sig.mli
index d283837f2d501645482e8a9278f8ad82c81fa5dd..f1937bb3a9f822f6c297c571f19a2cec250dc795 100644
--- a/src/libraries/utils/hptmap_sig.mli
+++ b/src/libraries/utils/hptmap_sig.mli
@@ -39,8 +39,11 @@ type cache_type =
These functions can be applied to any maps from a given type [key],
regardless of the type of values bound. *)
module type Shape = sig
- type key (** Type of the keys. *)
- type 'v map (** Type of the maps from type [key] to type ['v]. *)
+ (** Type of the keys. *)
+ type key
+
+ (** Type of the maps from type [key] to type ['v]. *)
+ type 'v map
(** Bijective function. The ids are positive. *)
val id: 'v map -> int
@@ -204,8 +207,11 @@ end
(** Signature for hptmaps from hash-consed trees to values. *)
module type S = sig
- type key (** type of the keys *)
- type v (** type of the values *)
+ (** type of the keys *)
+ type key
+
+ (** type of the values *)
+ type v
type prefix
include Shape with type key := key
diff --git a/src/libraries/utils/indexer.mli b/src/libraries/utils/indexer.mli
index a356d184f360268387e626962a53ae1f9f69b84d..08c880416769bc5d61275916ea3bb6b058271f7d 100644
--- a/src/libraries/utils/indexer.mli
+++ b/src/libraries/utils/indexer.mli
@@ -37,20 +37,27 @@ module Make(E : Elt) : sig
(** Number of elements in the collection. Constant time. *)
val mem : E.t -> t -> bool (** Log complexity. *)
+
val get : int -> t -> E.t (** raises Not_found. Log complexity. *)
+
val index : E.t -> t -> int (** raise Not_found. Log complexity. *)
+
val is_empty : t -> bool
val empty : t
val add : E.t -> t -> t (** Log complexity. *)
+
val remove : E.t -> t -> t (** Log complexity. *)
+
val filter : (E.t -> bool) -> t -> t (** Linear. *)
+
val update : E.t option -> E.t option -> t -> int * int * t
(** [update x y t] replaces [x] by [y]
and returns the range [a..b] of modified indices.
Log complexity. *)
val iter : (E.t -> unit) -> t -> unit (** Linear. *)
+
val iteri : (int -> E.t -> unit) -> t -> unit (** Linear. *)
end
diff --git a/src/libraries/utils/json.mli b/src/libraries/utils/json.mli
index 71713a06059b04dc7312e9d828dd6c0c72006045..ba4179ae57c7f7e8cdfea47694125949ee2bf92e 100644
--- a/src/libraries/utils/json.mli
+++ b/src/libraries/utils/json.mli
@@ -44,9 +44,13 @@ type json =
| `String of string ]
type t = json
+
val equal : t -> t -> bool (** Stdlib *)
+
val compare : t -> t -> int (** Stdlib *)
+
val pp : Format.formatter -> t -> unit
+
val pp_dump : Format.formatter -> t -> unit (** without formatting *)
exception Error of Filepath.Normalized.t * int * string
@@ -64,10 +68,17 @@ val of_fields : (string * t) list -> t
(** {2 Parsers} Parsing raise [Error] in case of error. *)
-val load_lexbuf : Lexing.lexbuf -> t (** Consumes the entire buffer. *)
-val load_channel : ?file:string -> in_channel -> t (** Parses the stream until EOF. *)
-val load_string : string -> t (** Parses the Json in the string. *)
-val load_file : string -> t (** May also raise system exception. *)
+val load_lexbuf : Lexing.lexbuf -> t
+(** Consumes the entire buffer. *)
+
+val load_channel : ?file:string -> in_channel -> t
+(** Parses the stream until EOF. *)
+
+val load_string : string -> t
+(** Parses the Json in the string. *)
+
+val load_file : string -> t
+(** May also raise system exception. *)
(** {2 Printers} Printers use formatting unless [~pretty:false]. *)
diff --git a/src/libraries/utils/pretty_utils.mli b/src/libraries/utils/pretty_utils.mli
index 6df2dd0dfdbe2e1cff3d93b7f99b7423b2ff429f..1434abb59f7609ebc978c098e5fef779d422146c 100644
--- a/src/libraries/utils/pretty_utils.mli
+++ b/src/libraries/utils/pretty_utils.mli
@@ -207,8 +207,12 @@ val pp_items :
{!pp_margin} and {!add_margin} below.
*)
-type marger (** Margin accumulator (low-level API to [pp_items]). *)
-val marger : unit -> marger (** Create an empty marger *)
+(** Margin accumulator (low-level API to [pp_items]). *)
+type marger
+
+val marger : unit -> marger
+(** Create an empty marger *)
+
val add_margin : marger -> ?margin:int -> ?min:int -> ?max:int -> string -> unit
(** Updates the marger with new text dimension.
The marger width is updated with the width of the provided text.
diff --git a/src/libraries/utils/rangemap.mli b/src/libraries/utils/rangemap.mli
index aad77b23a420cd80ec60444dcfd4adb3fa7e3c96..d5559dab4375791062be11b5721781468891b3e6 100644
--- a/src/libraries/utils/rangemap.mli
+++ b/src/libraries/utils/rangemap.mli
@@ -51,7 +51,8 @@
implementation. *)
module type S = sig
- type key (** The type of the map keys. *)
+ (** The type of the map keys. *)
+ type key
type value
type rangemap
diff --git a/src/libraries/utils/rich_text.mli b/src/libraries/utils/rich_text.mli
index dd06e5ac7913f3edb1d3242057b93c5168ce4527..c5371d1dd5be767c8816e95314258ac10f91435f 100644
--- a/src/libraries/utils/rich_text.mli
+++ b/src/libraries/utils/rich_text.mli
@@ -80,7 +80,9 @@ val message : buffer -> message
(** Buffer contents, with its formatting tags. *)
val add_char : buffer -> char -> unit (** Buffer-like *)
+
val add_string : buffer -> string -> unit (** Buffer-like *)
+
val add_substring : buffer -> string -> int -> int -> unit (** Buffer-like *)
val formatter : buffer -> Format.formatter
diff --git a/src/libraries/utils/sanitizer.mli b/src/libraries/utils/sanitizer.mli
index c556ffd115b74e5195ac355b812246aca159920f..ec8603de33f8ba94d32ad0ec3e28865987776eaa 100644
--- a/src/libraries/utils/sanitizer.mli
+++ b/src/libraries/utils/sanitizer.mli
@@ -33,6 +33,7 @@ val create : ?truncate:bool -> int -> buffer
val clear : buffer -> unit
val add_sep : buffer -> unit (** Adds ['_'] character *)
+
val add_char : buffer -> char -> unit
val add_string : buffer -> string -> unit
val add_list : buffer -> string list -> unit (** Separated with ['_'] *)
diff --git a/src/libraries/utils/task.mli b/src/libraries/utils/task.mli
index 18d5246c0eac132b69e1c9cb894e87c57fbdae24..20bcaf4065310cda84df7243e83f333a575eeafb 100644
--- a/src/libraries/utils/task.mli
+++ b/src/libraries/utils/task.mli
@@ -112,8 +112,11 @@ val async : (coin -> 'a status async) -> 'a task
val (>>>) : 'a task -> ('a status -> 'b task) -> 'b task (** [bind] infix. *)
+
val (>>=) : 'a task -> ('a -> 'b task) -> 'b task (** [sequence] infix. *)
+
val (>>?) : 'a task -> ('a status -> unit) -> 'a task (** [finally] infix. *)
+
val (>>!) : 'a task -> ('a status -> unit) -> unit task (** [callback] infix. *)
(* ************************************************************************* *)
@@ -193,10 +196,15 @@ val run : thread -> unit
(* ************************************************************************* *)
type pool
+
val pool : unit -> pool
+
val add : pool -> thread -> unit (** Auto-flush *)
+
val iter : (thread -> unit) -> pool -> unit (** Auto-flush *)
+
val flush : pool -> unit (** Clean all terminated tasks *)
+
val size : pool -> int (** Auto-flush. Number of living tasks *)
(* ************************************************************************* *)
@@ -240,7 +248,9 @@ val on_server_wait : server -> (unit -> unit) -> unit
(** On-wait server callback (all tasks are scheduled) *)
val scheduled : server -> int (** Number of scheduled process *)
+
val terminated : server -> int (** Number of terminated process *)
+
val waiting : server -> int option
(** All task scheduled and server is waiting for termination *)
diff --git a/src/libraries/utils/vector.mli b/src/libraries/utils/vector.mli
index 30153d7b14a00322546ac5021621e31d079c527a..d5a60a45e75c0e09d769f10fbadadfe770f517cf 100644
--- a/src/libraries/utils/vector.mli
+++ b/src/libraries/utils/vector.mli
@@ -31,15 +31,28 @@ val create : unit -> 'a t
val length : 'a t -> int
val size : 'a t -> int (** Same as [length] *)
-val get : 'a t -> int -> 'a (** Raise [Not_found] if out-of-bounds. *)
-val set : 'a t -> int -> 'a -> unit (** Raise [Not_found] if out-of-bounds. *)
-val add : 'a t -> 'a -> unit (** Element will be added at index [size]. After addition, it is at index [size-1]. *)
-val addi : 'a t -> 'a -> int (** Return index of added (last) element. *)
-val clear : 'a t -> unit (** Do not modify actual capacity. *)
+val get : 'a t -> int -> 'a
+(** Raise [Not_found] if out-of-bounds. *)
+
+val set : 'a t -> int -> 'a -> unit
+(** Raise [Not_found] if out-of-bounds. *)
+
+val add : 'a t -> 'a -> unit
+(** Element will be added at index [size]. After addition, it is at index [size-1]. *)
+
+val addi : 'a t -> 'a -> int
+(** Return index of added (last) element. *)
+
+val clear : 'a t -> unit
+(** Do not modify actual capacity. *)
+
val iter : ('a -> unit) -> 'a t -> unit
val iteri : (int -> 'a -> unit) -> 'a t -> unit
-val map : ('a -> 'b) -> 'a t -> 'b t (** Result is shrunk. *)
-val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** Result is shrunk. *)
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** Result is shrunk. *)
+
+val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
+(** Result is shrunk. *)
val find : 'a t -> ?default:'a -> ?exn:exn -> int -> 'a
(** Default exception is [Not_found].
@@ -52,8 +65,11 @@ val update : 'a t -> ?default:'a -> int -> 'a -> unit
@raise Invalid_argument if the index is negative or when it exceeds the
the vector size but the default value is not provided. *)
-val to_array : 'a t -> 'a array (** Makes a copy. *)
-val of_array : 'a array -> 'a t (** Makes a copy. *)
+val to_array : 'a t -> 'a array
+(** Makes a copy. *)
+
+val of_array : 'a array -> 'a t
+(** Makes a copy. *)
(** Low-level interface. Internal capacity. *)
val capacity : 'a t -> int
diff --git a/src/libraries/utils/wto.ml b/src/libraries/utils/wto.ml
index 404caad089a5f347e275af521410117ef9b0a588..07056a2b7f00edc1f7a00a5b171f084d91a4b140 100644
--- a/src/libraries/utils/wto.ml
+++ b/src/libraries/utils/wto.ml
@@ -187,11 +187,11 @@ module Make(N:sig
(* Unmark all vertices in the loop, and, if pref is given, try to
return a better head *)
let rec reset_SCC best_head =
- (** pop until vertex *)
+ (* pop until vertex *)
let element = Stack.pop state.stack in
DFN.remove state.dfn element;
if not (N.equal element vertex) then begin
- (** the strict is important because we are conservative *)
+ (* the strict is important because we are conservative *)
let best_head =
if pref best_head element < 0 then element else best_head
in
diff --git a/src/plugins/aorai/data_for_aorai.mli b/src/plugins/aorai/data_for_aorai.mli
index 647a37ca2ca75f5c5c7dd451f041796346a6d74f..03273e2359ff85f7d6b411ba7fea77bd4fc465d4 100644
--- a/src/plugins/aorai/data_for_aorai.mli
+++ b/src/plugins/aorai/data_for_aorai.mli
@@ -85,6 +85,7 @@ val cst_one: expression
val cst_zero: expression
(** {2 Utilities for parsed_conditions } *)
+
(** [true] iff the expression is 1 *)
val is_cst_one: expression -> bool
diff --git a/src/plugins/callgraph/subgraph.mli b/src/plugins/callgraph/subgraph.mli
index ef7cfbbf61fb3bf596eeecc5ad43133220a8affe..196c1b9cd14861871b9d6221fb62a071ed1a2047 100644
--- a/src/plugins/callgraph/subgraph.mli
+++ b/src/plugins/callgraph/subgraph.mli
@@ -28,11 +28,13 @@ module Make
val create: ?size:int -> unit -> t
val add_edge_e: t -> E.t -> unit
end)
- (D: Datatype.S with type t = G.t (** Graph datatype *))
+ (D: Datatype.S with type t = G.t(* Graph datatype *))
(Info: sig
(** additional information *)
val self: State.t
- val name: string (** name of the state *)
+ val name: string
+ (** name of the state *)
+
val get: unit -> G.t
val vertex: Kernel_function.t -> G.V.t
end) :
diff --git a/src/plugins/e-acsl/src/analyses/analyses_types.mli b/src/plugins/e-acsl/src/analyses/analyses_types.mli
index 357f0dda4d19e382bae81bf1ffb09287f0c46da7..54a1a7811033753afb1cd7445ffa76c68fb31ad7 100644
--- a/src/plugins/e-acsl/src/analyses/analyses_types.mli
+++ b/src/plugins/e-acsl/src/analyses/analyses_types.mli
@@ -39,25 +39,25 @@ type pred_or_term =
(** Type uniquely representing a [predicate] or [term] with an associated
[label], and the necessary information for its translation. *)
type at_data = {
- (** [kernel_function] englobing the [pred_or_term]. *)
kf: kernel_function;
+ (** [kernel_function] englobing the [pred_or_term]. *)
- (** [kinstr] where the [pred_or_term] is used. *)
kinstr: kinstr;
+ (** [kinstr] where the [pred_or_term] is used. *)
- (** Current state of the [lscope] for the [pred_or_term]. *)
lscope: lscope;
+ (** Current state of the [lscope] for the [pred_or_term]. *)
- (** [pred_or_term] to translate. *)
pot: pred_or_term;
+ (** [pred_or_term] to translate. *)
- (** Label of the [pred_or_term]. *)
label: logic_label;
+ (** Label of the [pred_or_term]. *)
+ error: exn option
(** Error raised during the pre-analysis.
This field does not contribute to the equality and comparison between two
[at_data]. *)
- error: exn option
}
type annotation_kind =
diff --git a/src/plugins/e-acsl/src/analyses/bound_variables.ml b/src/plugins/e-acsl/src/analyses/bound_variables.ml
index 9db23dccc336b8794c111e0552f860375aee763a..a6d9c51b5a27682162e9a05e6662b1ec3dd4ac3a 100644
--- a/src/plugins/e-acsl/src/analyses/bound_variables.ml
+++ b/src/plugins/e-acsl/src/analyses/bound_variables.ml
@@ -89,6 +89,7 @@ module Quantifier: sig
val get:
predicate ->
((term * logic_var * term) list * predicate) Error.result
+
(** getter and setter for the additional guard that intersects with the type
of the variable *)
val get_guard_for_small_type : logic_var -> predicate option
@@ -199,18 +200,18 @@ module Constraints: sig
val raise_error_invalid_pred: ?warn_rel:bool -> predicate -> t -> 'a
end = struct
type t = {
- (** Quantification predicate being analyzed. *)
quantif: predicate;
- (** Variables of the quantification that still need guards. *)
+ (** Quantification predicate being analyzed. *)
bounded_vars: Logic_var.Set.t;
+ (** Variables of the quantification that still need guards. *)
+ rev_order: Logic_var.t list;
(** Bounded variables list in reverse order in which they must be
generated. *)
- rev_order: Logic_var.t list;
- (** Table associating a bounded variable with its guard. *)
guards: (term * relation * (relation * term) option) Logic_var.Map.t;
+ (** Table associating a bounded variable with its guard. *)
+ linked_upper_bounds: (logic_var * relation) Logic_var.Map.t;
(** Table associating a bounded variable with a relation with another
bounded variable. *)
- linked_upper_bounds: (logic_var * relation) Logic_var.Map.t;
}
let empty quantif bounded_vars =
diff --git a/src/plugins/e-acsl/src/analyses/labels.ml b/src/plugins/e-acsl/src/analyses/labels.ml
index 423e630b1ab8de860350f50d9d6ba3cce30075c3..ac331df4d8f01b835ca9c4b83847e9d090758caf 100644
--- a/src/plugins/e-acsl/src/analyses/labels.ml
+++ b/src/plugins/e-acsl/src/analyses/labels.ml
@@ -135,14 +135,14 @@ module Process: sig
end = struct
module Env = struct
type t = {
- (** Enclosing function of the predicate or term being analysed. *)
kf: kernel_function;
- (** Kinstr of the predicate or term being analysed. *)
+ (** Enclosing function of the predicate or term being analysed. *)
kinstr: kinstr;
- (** Kind of annotation for the predicate or term being analysed. *)
+ (** Kinstr of the predicate or term being analysed. *)
akind: annotation_kind;
- (** Logic scope for the predicate or term being analysed. *)
+ (** Kind of annotation for the predicate or term being analysed. *)
lscope: Lscope.t;
+ (** Logic scope for the predicate or term being analysed. *)
}
let create kf kinstr akind =
diff --git a/src/plugins/e-acsl/src/analyses/logic_normalizer.mli b/src/plugins/e-acsl/src/analyses/logic_normalizer.mli
index d31a59ca38179242a48b56a61c817d3b579f6b8c..ed2aa084552166b458774a72c56ae361c9a57ef8 100644
--- a/src/plugins/e-acsl/src/analyses/logic_normalizer.mli
+++ b/src/plugins/e-acsl/src/analyses/logic_normalizer.mli
@@ -43,7 +43,9 @@ val preprocess_predicate : predicate -> unit
val get_pred : predicate -> predicate
(** Retrieve the preprocessed form of a predicate *)
+
val get_term : term -> term
(** Retrieve the preprocessed form of a term *)
+
val clear: unit -> unit
(** clear the table of normalized predicates *)
diff --git a/src/plugins/e-acsl/src/code_generator/assert.ml b/src/plugins/e-acsl/src/code_generator/assert.ml
index c10e0bab5ce9bfcd0f6c412e003d4b01c9ecfc42..3dfc72367d67cff7e1b7824e603179dd5a836568 100644
--- a/src/plugins/e-acsl/src/code_generator/assert.ml
+++ b/src/plugins/e-acsl/src/code_generator/assert.ml
@@ -29,14 +29,13 @@ open Analyses_datatype
(** Type holding information about the C variable representing the assertion
data. *)
-[@@@ warning "-69"]
type data = {
- (** Indicates if some data have been registered in the context or not. *)
data_registered: bool;
- (** [varinfo] representing the C variable for the assertion data. *)
+ (** Indicates if some data have been registered in the context or not. *)
data_vi: varinfo;
- (** [exp] representing a pointer to the C variable for the assertion data. *)
+ (** [varinfo] representing the C variable for the assertion data. *)
data_ptr: exp;
+ (** [exp] representing a pointer to the C variable for the assertion data. *)
}
(** External type representing the assertion context. Either [Some data] if we
diff --git a/src/plugins/e-acsl/src/code_generator/env.mli b/src/plugins/e-acsl/src/code_generator/env.mli
index b71b062e18dbb5fae50975c9239208bdb28d1c79..20583a0fef7d515a3a9ae7bbafc0f27df2ca92ee 100644
--- a/src/plugins/e-acsl/src/code_generator/env.mli
+++ b/src/plugins/e-acsl/src/code_generator/env.mli
@@ -217,6 +217,7 @@ val get_kinstr: t -> kinstr
val push_contract: t -> contract -> t
(** Push a contract to the environment's stack *)
+
val pop_and_get_contract: t -> contract * t
(** Pop and return the top contract of the environment's stack *)
diff --git a/src/plugins/e-acsl/src/code_generator/global_observer.mli b/src/plugins/e-acsl/src/code_generator/global_observer.mli
index 0970d0f3cee95e621121e2fd42492c8e7b11a792..41bf628a3f55b5adef1a98265e8bcdae52179a9c 100644
--- a/src/plugins/e-acsl/src/code_generator/global_observer.mli
+++ b/src/plugins/e-acsl/src/code_generator/global_observer.mli
@@ -27,6 +27,7 @@ open Cil_types
val function_init_name: string
(** Name of the function in which [mk_init_function] (see below) generates the
code. *)
+
val function_clean_name: string
(** Name of the function in which [mk_clean_function] (see below) generates the
code. *)
diff --git a/src/plugins/from/from_compute.mli b/src/plugins/from/from_compute.mli
index e11c0300a83faaa8ca4b4173d4328afb2d7b6dd3..b1017c26489bec197e63d2acd77ffdc687858fcf 100644
--- a/src/plugins/from/from_compute.mli
+++ b/src/plugins/from/from_compute.mli
@@ -67,6 +67,7 @@ val find_deps_lval_no_transitivity :
module Make (To_Use: To_Use) : sig
(** Compute the dependencies of the given function, and return them *)
val compute_and_return : Kernel_function.t -> Function_Froms.t
+
(** Compute the dependencies of the given function *)
val compute : Kernel_function.t -> unit
end
diff --git a/src/plugins/gui/design.ml b/src/plugins/gui/design.ml
index b84c78b521a758476eb3fa02d6364fc0a5b58700..a5c36fd3ae135e030646302b0e16d597b6ff338b 100644
--- a/src/plugins/gui/design.ml
+++ b/src/plugins/gui/design.ml
@@ -96,9 +96,11 @@ end
(** The list of registered extension *)
let (handlers:(main_window_extension_points -> unit) list ref) = ref []
+
(** Insert an extension *)
let register_extension f =
handlers := f::!handlers
+
(** Apply all extensions *)
let process_extensions window =
List.iter (fun f -> f window) (List.rev !handlers)
diff --git a/src/plugins/gui/design.mli b/src/plugins/gui/design.mli
index d9c87ce57bf8007f44fd108b47547df213171edc..ae4018e81bf4f4fac9d8d4cb6cac0932494c5d4a 100644
--- a/src/plugins/gui/design.mli
+++ b/src/plugins/gui/design.mli
@@ -113,6 +113,7 @@ class type main_window_extension_points = object
You should not directly use the buffer contained in the annot_window
to add text. Use the method [pretty_information].
*)
+
method pretty_information : 'a. ?scroll:bool -> ('a, Format.formatter, unit) format -> 'a
(** Pretty print a message in the [annot_window],
optionally scrolling it to the beginning of the message. *)
diff --git a/src/plugins/gui/file_manager.ml b/src/plugins/gui/file_manager.ml
index d0b7e8b624783a92a35cf798b0dc5d9164c46a50..16d5b2633970de4581c40a1dfb59106033f3efb6 100644
--- a/src/plugins/gui/file_manager.ml
+++ b/src/plugins/gui/file_manager.ml
@@ -53,15 +53,15 @@ let reparse (host_window: Design.main_window_extension_points) =
Source_manager.clear host_window#original_source_viewer)
in
begin match old_helt, succeeded with
- | None, _ -> (** no history available before reparsing *)
+ | None, _ -> (* no history available before reparsing *)
host_window#reset ()
- | _, None -> (** the user stopped or an error occurred *)
+ | _, None -> (* the user stopped or an error occurred *)
host_window#reset ()
| Some old_helt, Some () ->
let new_helt = History.translate_history_elt old_helt in
Option.iter History.push new_helt;
host_window#reset ();
- (** The buffer is not ready yet, modification of its vadjustement
+ (* The buffer is not ready yet, modification of its vadjustement
is unreliable *)
let set () =
let adj = host_window#source_viewer_scroll#vadjustment in
diff --git a/src/plugins/gui/gtk_compat.mli b/src/plugins/gui/gtk_compat.mli
index 3aa2308eda7060a9b90599af698b65e415a67519..3434be547f8042db844db7bb02a2b217bde75f02 100644
--- a/src/plugins/gui/gtk_compat.mli
+++ b/src/plugins/gui/gtk_compat.mli
@@ -21,8 +21,11 @@
(**************************************************************************)
module Pango : sig
- val set_small_font : #GObj.widget -> unit (** makes the font smaller. *)
- val set_bold_font : #GObj.widget -> unit (** makes the font bold. *)
+ val set_small_font : #GObj.widget -> unit
+ (** makes the font smaller. *)
+
+ val set_bold_font : #GObj.widget -> unit
+ (** makes the font bold. *)
end
val get_toolbar_index: GButton.toolbar -> GButton.tool_item -> int
diff --git a/src/plugins/gui/gtk_helper.mli b/src/plugins/gui/gtk_helper.mli
index eeb0f7aa5d947a028cb1f053d591068a3af02231..34c05fad0767b5bac34c87c041d1fad594efe36a 100644
--- a/src/plugins/gui/gtk_helper.mli
+++ b/src/plugins/gui/gtk_helper.mli
@@ -140,6 +140,7 @@ module Configuration: sig
object
method set : 'a -> unit
(** Set's widget value to given one. *)
+
method connect : ('a -> unit) -> unit
(** Register a callback invoked by the widget each time the value is edited. *)
end
diff --git a/src/plugins/gui/history.ml b/src/plugins/gui/history.ml
index ef700440d4081b9f8010c6b86edf14a18379a382..fdb998483bc9bc27e4af8a728962c605c3a83876 100644
--- a/src/plugins/gui/history.ml
+++ b/src/plugins/gui/history.ml
@@ -199,7 +199,7 @@ let translate_history_elt old_helt =
let global old_g =
let iter new_g =
let open Cil_types in
- (** In the same file, same constructor and same original name *)
+ (* In the same file, same constructor and same original name *)
match old_g,
new_g with
| (GType( {torig_name = old_name}, old_loc),
@@ -239,8 +239,8 @@ let translate_history_elt old_helt =
| GAnnot(Dinvariant _,_), GAnnot(Dinvariant _,_)
| GAnnot(Dtype_annot _,_), GAnnot(Dtype_annot _,_)
| GAnnot(Dmodel_annot _,_), GAnnot(Dmodel_annot _,_)
- -> (** they have no names *) ()
- | _ -> (** different constructors *) ()
+ -> (* they have no names *) ()
+ | _ -> (* different constructors *) ()
in
try
List.iter iter (Ast.get ()).globals;
@@ -259,10 +259,10 @@ let translate_history_elt old_helt =
| PTermLval(Some kf,_,_,_) as loc) ->
begin match global (kf_to_global kf) with
| None ->
- (** The kernel function can't be found nothing to say *)
+ (* The kernel function can't be found nothing to say *)
None
| Some g ->
- (** Try to stay at the same offset in the function *)
+ (* Try to stay at the same offset in the function *)
let old_kf_loc = fst (Kernel_function.get_location kf) in
let old_loc = match ki_of_localizable loc with
| Kstmt s -> fst (Stmt.loc s)
@@ -276,23 +276,23 @@ let translate_history_elt old_helt =
}
in
match Printer_tag.loc_to_localizable new_loc with
- | None -> (** the line is unknown *)
+ | None -> (* the line is unknown *)
Some (Global g)
| Some locali ->
begin match kf_of_localizable locali with
- | None -> (** not in a kf so return the start of the function *)
+ | None -> (* not in a kf so return the start of the function *)
Some (Global g)
| Some kf when not (Global.equal (kf_to_global kf) g) ->
- (** Fall in the wrong global, so return the start of the function *)
+ (* Fall in the wrong global, so return the start of the function *)
Some (Global g)
| _ ->
- (** Fall in the correct global *)
+ (* Fall in the correct global *)
Some (Localizable locali)
end
end
| Localizable (PLval(None,_,_) | PExp(None,_,_) | PTermLval(None,_,_,_)
- | PVDecl(None,_,_)) -> (** no names useful? *) None
- | Localizable (PIP _ ) -> (** no names available *) None
+ | PVDecl(None,_,_)) -> (* no names useful? *) None
+ | Localizable (PIP _ ) -> (* no names available *) None
(*
Local Variables:
diff --git a/src/plugins/gui/menu_manager.mli b/src/plugins/gui/menu_manager.mli
index e82442b4b7f6f275a7160d735e90c8393916968a..aff7abcebf2a0bc69907af6fcbfda29ca8ae89cd 100644
--- a/src/plugins/gui/menu_manager.mli
+++ b/src/plugins/gui/menu_manager.mli
@@ -27,8 +27,7 @@
@since Boron-20100401 *)
type where =
| Toolbar of GtkStock.id * string * string (** Label then tooltip *)
- | Menubar of
- GtkStock.id option (** Stock used for the icon *) * string (** Label *)
+ | Menubar of GtkStock.id option * string (** Stock used for icon * Label *)
| ToolMenubar of GtkStock.id * string * string (** Label then tooltip *)
(** Callback for the buttons that can be in the menus. Standard buttons/menus
diff --git a/src/plugins/gui/pretty_source.mli b/src/plugins/gui/pretty_source.mli
index 145955d23667e1e9c392add8c3ce3941d7872106..a76f237f0cbcc4b53fea9d3bf7e6f9ce16b5beed 100644
--- a/src/plugins/gui/pretty_source.mli
+++ b/src/plugins/gui/pretty_source.mli
@@ -43,6 +43,7 @@ type localizable = Printer_tag.localizable =
module Locs: sig
type state
+
(** To call when the source buffer is about to be discarded *)
val create: unit -> state
val clear: state -> unit
diff --git a/src/plugins/gui/source_manager.mli b/src/plugins/gui/source_manager.mli
index 16f1e62a93454c890d10fc37c4f08deeed25c0d6..f624073b8988487d9a3a6b5a1db671dfa959b974 100644
--- a/src/plugins/gui/source_manager.mli
+++ b/src/plugins/gui/source_manager.mli
@@ -43,8 +43,12 @@ val load_file:
a reverse mapping from the original source to the Cil source, and not
always exact. *)
-val select_file: t -> Datatype.Filepath.t -> unit (** Selection by page filename *)
-val select_name: t -> string -> unit (** Selection by page title *)
+val select_file: t -> Datatype.Filepath.t -> unit
+(** Selection by page filename *)
+
+val select_name: t -> string -> unit
+(** Selection by page title *)
+
val get_current_source_view : t -> GSourceView.source_view
(** Returns the source viewer for the currently displayed tab *)
diff --git a/src/plugins/gui/wbox.mli b/src/plugins/gui/wbox.mli
index d358a86ed182ca42fb49421cb5046fe0d7a5dc7b..3eb1e1716d9575fbd2ae6da4efdee775e8e73a1f 100644
--- a/src/plugins/gui/wbox.mli
+++ b/src/plugins/gui/wbox.mli
@@ -43,9 +43,15 @@ val g : ?expand:expand -> ?padding:int -> #GObj.widget -> box
(** Helper to [box] for packing a [widget]. Same defaults than [box]. *)
val w : ?expand:expand -> ?padding:int -> #widget -> box
-val h : ?padding:int -> #widget -> box (** [w ~expand:H] *)
-val v : ?padding:int -> #widget -> box (** [w ~expand:V] *)
-val hv : ?padding:int -> #widget -> box (** [w ~expand:HV] *)
+
+(** [w ~expand:H] *)
+val h : ?padding:int -> #widget -> box
+
+(** [w ~expand:V] *)
+val v : ?padding:int -> #widget -> box
+
+(** [w ~expand:HV] *)
+val hv : ?padding:int -> #widget -> box
val label : ?fill:bool -> ?style:style -> ?align:align -> ?padding:int -> string -> box
(** Helper to pack a [Widget.label] widget using [box].
@@ -60,8 +66,11 @@ val label : ?fill:bool -> ?style:style -> ?align:align -> ?padding:int -> string
Notice that nested boxes can {i generally} be packed using default
[W] mode, even if they contains horizontal or vertical widgets. *)
-val hbox : box list -> widget (** Pack a list of boxes horizontally. *)
-val vbox : box list -> widget (** Pack a list of boxes vertically. *)
+(** Pack a list of boxes horizontally. *)
+val hbox : box list -> widget
+
+(** Pack a list of boxes vertically. *)
+val vbox : box list -> widget
(** Pack a list of widgets horizontally, with all widgets stuck to the same width *)
val hgroup : widget list -> widget
diff --git a/src/plugins/gui/wfile.mli b/src/plugins/gui/wfile.mli
index 1c33a00148370ec13d5d69278a87cb2d5b8fe7dd..e07aa23d37488358145577af06a437a5efe34786 100644
--- a/src/plugins/gui/wfile.mli
+++ b/src/plugins/gui/wfile.mli
@@ -53,9 +53,12 @@ class button :
object
inherit widget
inherit dialog
- inherit [string] selector (** Holds the selected filename, [""] by default. *)
+ inherit [string] selector
+ (** Holds the selected filename, [""] by default. *)
+
method set_tooltip : (string -> string) -> unit
(** Set the pretty-printer for tooltip. *)
+
method set_display : (string -> string) -> unit
(** Set the pretty-printer for button. *)
end
diff --git a/src/plugins/gui/widget.mli b/src/plugins/gui/widget.mli
index a7f4db05165b008357d4172fe966398d9ed265ae..3b660c3cff195f59eb065ed966e31c42e15c243d 100644
--- a/src/plugins/gui/widget.mli
+++ b/src/plugins/gui/widget.mli
@@ -67,11 +67,13 @@ class type ['a] signal =
class type ['a] selector =
object
- inherit ['a] signal (** listen to all sets. *)
+ inherit ['a] signal
+ (** listen to all sets. *)
+
method set : 'a -> unit
method get : 'a
method send : ('a -> unit) -> unit -> unit
- (* [send f] calls [f] with the current value {i via} the signal lock. *)
+ (** [send f] calls [f] with the current value {i via} the signal lock. *)
end
(** {2 Labels} *)
@@ -189,11 +191,14 @@ class popup : unit ->
object
method clear : unit
(** Remove all items *)
+
method add_item : label:string -> callback:(unit -> unit) -> unit
(** Adds an item. *)
+
method add_separator : unit
(** Inserts a separator.
Consecutive and trailing separators are eliminated. *)
+
method run : unit -> unit
(** Run the menu. *)
end
diff --git a/src/plugins/gui/wpane.mli b/src/plugins/gui/wpane.mli
index 9a8d463a143c746a39abfad32809caf6e3762088..3bd6cc8f2ddc51090c8a6804a7295bc9fbb79459 100644
--- a/src/plugins/gui/wpane.mli
+++ b/src/plugins/gui/wpane.mli
@@ -91,9 +91,14 @@ class ['a] notebook : ?tabs:Gtk.Tags.position -> default:'a -> unit ->
class type entry =
object
- method widget : GObj.widget (** Returns the widget *)
- method update : unit -> unit (** On array request *)
- method delete : unit -> unit (** When removed *)
+ method widget : GObj.widget
+ (** Returns the widget *)
+
+ method update : unit -> unit
+ (** On array request *)
+
+ method delete : unit -> unit
+ (** When removed *)
end
class ['a] warray :
@@ -102,8 +107,10 @@ class ['a] warray :
unit ->
object
inherit widget
- (** Install the new-entry creator. *)
+
method set_entry : ('a -> entry) -> unit
+ (** Install the new-entry creator. *)
+
method set : 'a list -> unit
method get : 'a list
method mem : 'a -> bool
@@ -146,8 +153,15 @@ class ['a] dialog :
method button :
action:'a action ->
?label:string -> ?icon:icon -> ?tooltip:string ->
- unit -> unit (** Closes the dialog. *)
- method select : 'a -> unit (** Closes the dialog. *)
- method run : unit -> unit (** Opens the dialog (asynchronously). *)
- inherit ['a] signal (** Emitted when the dialog is closed. *)
+ unit -> unit
+ (** Closes the dialog. *)
+
+ method select : 'a -> unit
+ (** Closes the dialog. *)
+
+ method run : unit -> unit
+ (** Opens the dialog (asynchronously). *)
+
+ inherit ['a] signal
+ (** Emitted when the dialog is closed. *)
end
diff --git a/src/plugins/gui/wtable.ml b/src/plugins/gui/wtable.ml
index 1668d4b4951e5d0dbbe788b6be38c2245175e3b9..8533566a03e3798876d7bb1dd14a9162cdb6fea9 100644
--- a/src/plugins/gui/wtable.ml
+++ b/src/plugins/gui/wtable.ml
@@ -31,12 +31,24 @@ class type virtual ['a] custom =
class type ['a] columns =
object
- method view : GTree.view (** the tree *)
- method scroll : GBin.scrolled_window (** scrolled tree (build on demand) *)
- method coerce : GObj.widget (** widget of the scroll *)
- method pack : (GObj.widget -> unit) -> unit (** packs the scroll *)
- method reload : unit (** Structure has changed *)
- method update_all : unit (** (only) Content of rows has changed *)
+ method view : GTree.view
+ (** the tree *)
+
+ method scroll : GBin.scrolled_window
+ (** scrolled tree (build on demand) *)
+
+ method coerce : GObj.widget
+ (** widget of the scroll *)
+
+ method pack : (GObj.widget -> unit) -> unit
+ (** packs the scroll *)
+
+ method reload : unit
+ (** Structure has changed *)
+
+ method update_all : unit
+ (** (only) Content of rows has changed *)
+
method update_row : 'a -> unit
method insert_row : 'a -> unit
method set_focus : 'a -> GTree.view_column -> unit
diff --git a/src/plugins/gui/wtable.mli b/src/plugins/gui/wtable.mli
index 7f19499ae1c3937cd8dd6e17e02de4e27b81c508..4f99f9a8472c94ba7b0daa45bca257b8496af62d 100644
--- a/src/plugins/gui/wtable.mli
+++ b/src/plugins/gui/wtable.mli
@@ -27,12 +27,24 @@ type ('a,'b) column =
class type ['a] columns =
object
- method view : GTree.view (** the tree *)
- method scroll : GBin.scrolled_window (** scrolled tree (build on demand) *)
- method coerce : GObj.widget (** widget of the scroll *)
- method pack : (GObj.widget -> unit) -> unit (** packs the scroll *)
- method reload : unit (** Structure has changed *)
- method update_all : unit (** (only) Content of rows has changed *)
+ method view : GTree.view
+ (** the tree *)
+
+ method scroll : GBin.scrolled_window
+ (** scrolled tree (build on demand) *)
+
+ method coerce : GObj.widget
+ (** widget of the scroll *)
+
+ method pack : (GObj.widget -> unit) -> unit
+ (** packs the scroll *)
+
+ method reload : unit
+ (** Structure has changed *)
+
+ method update_all : unit
+ (** (only) Content of rows has changed *)
+
method update_row : 'a -> unit
method insert_row : 'a -> unit
method set_focus : 'a -> GTree.view_column -> unit
diff --git a/src/plugins/gui/wtext.mli b/src/plugins/gui/wtext.mli
index 9276626cd25794067fa30d4ec7246e68d8f0f990..938972688d9d30c26576ba74f6970cc677bef0cb 100644
--- a/src/plugins/gui/wtext.mli
+++ b/src/plugins/gui/wtext.mli
@@ -30,6 +30,7 @@ class type ['a] marker =
(** The style of added entries. Defaults to empty.
{b Warning} must be set before any entry is added. *)
+
method set_hover : GText.tag_property list -> unit
(** The style of hovered entries. Defaults to background green.
@@ -59,7 +60,9 @@ class text : ?autoscroll:bool -> ?width:int -> ?indent:int -> unit ->
method clear : unit
method fmt : Format.formatter (** The formatter used by [printf] method. *)
- method hrule : unit (** Print an horizontal rule. Consecutive rules are collapsed. *)
+ method hrule : unit
+ (** Print an horizontal rule. Consecutive rules are collapsed. *)
+
method printf : 'a. ?scroll:bool -> ('a,Format.formatter,unit) format -> 'a
(** Append material to the text buffer, optionally scrolling it to the
beginning of the message (defaults to autoscrolling setting).
diff --git a/src/plugins/impact/Impact.mli b/src/plugins/impact/Impact.mli
index 6581d1fd86216e99626a7252e0cbdb97bd043e96..83f3ffda6440089966ef8fd8a071754ed8a60dd7 100644
--- a/src/plugins/impact/Impact.mli
+++ b/src/plugins/impact/Impact.mli
@@ -32,9 +32,11 @@ module Register : sig
Print and slice the results according to the parameters -impact-print
and -impact-slice.
@return the impacted statements *)
+
val from_stmt: (stmt -> stmt list)
(** Compute the impact analysis of the given statement.
@return the impacted statements *)
+
val from_nodes:
(kernel_function -> PdgTypes.Node.t list -> PdgTypes.NodeSet.t)
(** Compute the impact analysis of the given set of PDG nodes,
diff --git a/src/plugins/impact/compute_impact.mli b/src/plugins/impact/compute_impact.mli
index 4952d6cda09861378edf1dac458b906ea0530417..64307dc66281a1879dd0e7332ef9748ce058813c 100644
--- a/src/plugins/impact/compute_impact.mli
+++ b/src/plugins/impact/compute_impact.mli
@@ -31,12 +31,14 @@ val initial_nodes:
val nodes_impacted_by_stmts:
?skip:Locations.Zone.t -> ?restrict:Locations.Zone.t -> ?reason:bool ->
kernel_function -> stmt list ->
- result * (** Initial *) nodes Kernel_function.Map.t * Reason_graph.reason
+ result * nodes Kernel_function.Map.t * Reason_graph.reason
+(** nodes in returned map are initial nodes *)
val nodes_impacted_by_nodes:
?skip:Locations.Zone.t -> ?restrict:Locations.Zone.t -> ?reason:bool ->
kernel_function -> PdgTypes.Node.t list ->
- result * (** Initial *) nodes Kernel_function.Map.t * Reason_graph.reason
+ result * nodes Kernel_function.Map.t * Reason_graph.reason
+(** nodes in returned map are initial nodes *)
val stmts_impacted:
?skip:Locations.Zone.t -> reason:bool ->
diff --git a/src/plugins/inout/cumulative_analysis.mli b/src/plugins/inout/cumulative_analysis.mli
index cf913c35840d750769abd41f98338830f518ea05..f98bd1b9848ee3c045654c636598f4beab594b8c 100644
--- a/src/plugins/inout/cumulative_analysis.mli
+++ b/src/plugins/inout/cumulative_analysis.mli
@@ -72,6 +72,7 @@ class type virtual ['a] cumulative_class = object
(** Result of the analysis *)
method result: 'a
+
(** Adding partial results to the current ones *)
method join: 'a -> unit
diff --git a/src/plugins/instantiate/instantiator_builder.mli b/src/plugins/instantiate/instantiator_builder.mli
index 4f584fbf15f4f03446e6a0f50200b0055a2a735a..1601fe66ff225c04bf3ba7cb23d6eb581f523de6 100644
--- a/src/plugins/instantiate/instantiator_builder.mli
+++ b/src/plugins/instantiate/instantiator_builder.mli
@@ -100,15 +100,19 @@ end
module type Instantiator = sig
(** Plugin option that allows to check whether the instantiator is enabled. *)
module Enabled: Parameter_sig.Bool
+
(** Same as [Generator_sig.override_key] *)
type override_key
(** Same as [Generator_sig.override_key] *)
val function_name: string
+
(** Same as [Generator_sig.override_key] *)
val well_typed_call: lval option -> varinfo -> exp list -> bool
+
(** Same as [Generator_sig.override_key] *)
val key_from_call: lval option -> varinfo -> exp list -> override_key
+
(** Same as [Generator_sig.override_key] *)
val retype_args: override_key -> exp list -> exp list
diff --git a/src/plugins/markdown-report/sarif.ml b/src/plugins/markdown-report/sarif.ml
index e55c11e4f87eecf1a2e1ea9398b76162d7035722..4521b2d4541333546abb3373ac5d82aaf76039fb 100644
--- a/src/plugins/markdown-report/sarif.ml
+++ b/src/plugins/markdown-report/sarif.ml
@@ -22,8 +22,8 @@
(** OCaml representation for the sarif 2.1 schema. *)
-(** ppx_deriving_yojson generates parser and printer that are recursive
- by default: we must thus silence spurious let rec warning (39). *)
+(* ppx_deriving_yojson generates parser and printer that are recursive
+ by default: we must thus silence spurious let rec warning (39). *)
[@@@ warning "-39"]
type 'a dict = (string * 'a) list
diff --git a/src/plugins/metrics/metrics_coverage.mli b/src/plugins/metrics/metrics_coverage.mli
index 72bafdfce1f6960cbdce39ce38e10782128b3673..cb9224aa0e5d7a2130f17378df5e0dda538fc2ff 100644
--- a/src/plugins/metrics/metrics_coverage.mli
+++ b/src/plugins/metrics/metrics_coverage.mli
@@ -36,9 +36,9 @@ type coverage_metrics = {
initializers: (Cil_types.varinfo * Cil_types.init) list; (** initializers *)
}
-val percent_coverage : libc:bool -> coverage_metrics -> float ;;
+val percent_coverage : libc:bool -> coverage_metrics -> float
-val compute : libc:bool -> coverage_metrics ;;
+val compute : libc:bool -> coverage_metrics
(** Computes both syntactic and semantic coverage information. *)
(** Computes the semantic coverage by function. *)
diff --git a/src/plugins/occurrence/Occurrence.mli b/src/plugins/occurrence/Occurrence.mli
index edd45120c909faf4343e95edbbf074fba062cf65..2f606eebc35504cb7d04704e8afa7525279c7a0c 100644
--- a/src/plugins/occurrence/Occurrence.mli
+++ b/src/plugins/occurrence/Occurrence.mli
@@ -33,6 +33,7 @@ module Register: sig
(** Return the occurrences of the given varinfo.
An occurrence [ki, lv] is a left-value [lv] which uses the location of
[vi] at the position [ki]. *)
+
val print_all: (unit -> unit)
(** Print all the occurrence of each variable declarations. *)
end
diff --git a/src/plugins/pdg/build.ml b/src/plugins/pdg/build.ml
index 25aae34647763bf81d689a6121ff339dc3430c87..6b5be2c31fa08deedea5532993759c686f387bb7 100644
--- a/src/plugins/pdg/build.ml
+++ b/src/plugins/pdg/build.ml
@@ -233,7 +233,7 @@ let add_ctrl_dpds pdg =
let process_declarations pdg ~formals ~locals =
- (** 2 new nodes for each formal parameters :
+ (* 2 new nodes for each formal parameters :
one for its declaration, and one for its values.
This is because it might be the case that we only need the declaration
whatever the value is.
@@ -695,8 +695,8 @@ let call_outputs pdg state_before_call state_with_inputs stmt
*)
let process_call pdg state stmt lvaloption funcexp argl _loc =
let state_before_call = state in
- (** add a simple node for each call in order to have something in the PDG
- for this statement even if there are no input/output *)
+ (* add a simple node for each call in order to have something in the PDG
+ for this statement even if there are no input/output *)
ignore (add_elem pdg (Key.call_ctrl_key stmt));
let arg_nodes = process_args pdg state_before_call stmt argl in
let state_with_args = state in
diff --git a/src/plugins/pdg/ctrlDpds.ml b/src/plugins/pdg/ctrlDpds.ml
index 960f0db2193cb581f13d496613c16832018d65e5..124de06e6d73bf81ee4d5522aa251c506cf0f759 100644
--- a/src/plugins/pdg/ctrlDpds.ml
+++ b/src/plugins/pdg/ctrlDpds.ml
@@ -25,9 +25,8 @@ let dkey = Pdg_parameters.register_category "ctrl-dpds"
open Cil_types
open Cil_datatype
-(*============================================================================*)
-(** Lexical successors *)
-(*============================================================================*)
+(** {2 Lexical successors} *)
+
(** Compute a graph which provide the lexical successor of each statement s,
ie. the statement which is the next one if 's' is replaced by Nop.
Notice that if 's' is an If, Loop, ...
@@ -151,9 +150,8 @@ end = struct
raise Not_found
end
-(*============================================================================*)
-(** Postdominators (with infinite path extension) *)
-(*============================================================================*)
+(** {2 Postdominators (with infinite path extension)} *)
+
(** This backward dataflow implements a variant of postdominators that verify
the property P enunciated in bts 963: a statement postdominates itself
if and only it is within the main path of a syntactically infinite loop.
diff --git a/src/plugins/pdg_types/pdgIndex.ml b/src/plugins/pdg_types/pdgIndex.ml
index 37d4b2f13828cb70435f68d66c29a3ffe78d8651..99da46e3a2ae7d02ed21a005519da2ad1b0bf0dc 100644
--- a/src/plugins/pdg_types/pdgIndex.ml
+++ b/src/plugins/pdg_types/pdgIndex.ml
@@ -446,13 +446,13 @@ end
module FctIndex = struct
type ('node_info, 'call_info) t = {
- (** inputs and outputs of the function *)
mutable sgn : 'node_info Signature.t ;
- (** calls signatures *)
+ (** inputs and outputs of the function *)
mutable calls :
(Cil_types.stmt * ('call_info option * 'node_info Signature.t)) list ;
- (** everything else *)
+ (** calls signatures *)
other : 'node_info H.t
+ (** everything else *)
}
open Structural_descr
diff --git a/src/plugins/pdg_types/pdgIndex.mli b/src/plugins/pdg_types/pdgIndex.mli
index cae2d7c94df5fe807ae429ffaa502b55fb70aa3c..9919d9c431655e41744320472de3a8ea10516f8c 100644
--- a/src/plugins/pdg_types/pdgIndex.mli
+++ b/src/plugins/pdg_types/pdgIndex.mli
@@ -207,9 +207,11 @@ module FctIndex : sig
(** store the information for the key.
@raise AddError if there is already something stored. *)
val add : ('ni, 'ci) t -> Key.t-> 'ni -> unit
+
(** store the information for the key. Replace the previously stored
information if any. *)
val add_or_replace : ('ni, 'ci) t -> Key.t-> 'ni -> unit
+
val add_info_call :
('ni, 'ci) t -> Cil_types.stmt -> 'ci -> replace:bool -> unit
val add_info_call_key : ('ni, 'ci) t -> Key.t -> 'ci -> replace:bool -> unit
diff --git a/src/plugins/pdg_types/pdgTypes.ml b/src/plugins/pdg_types/pdgTypes.ml
index 75a92ed2c68594278ff1e90237b8e71ad34b5727..afbaaced4783c835beed71eb744ce1d972674fdd 100644
--- a/src/plugins/pdg_types/pdgTypes.ml
+++ b/src/plugins/pdg_types/pdgTypes.ml
@@ -601,8 +601,11 @@ module Pdg = struct
type t = parent_t
module V = Node
module E = struct
- type t = G.E.t * bool (** boolean to say that the edge is dynamic *)
+ (** boolean to say that the edge is dynamic *)
+ type t = G.E.t * bool
+
let src (e, _d) = G.E.dst e (* We reverse the direction of edges *)
+
let dst (e, _d) = G.E.src e (* to get graphs with a correct orientation*)
end
diff --git a/src/plugins/qed/bvars.mli b/src/plugins/qed/bvars.mli
index 0f2410e19768ca2ba58b937baf0539b33bbdebb8..7e286675d4db7db7ed3e94fdaf8a18cb433988c8 100644
--- a/src/plugins/qed/bvars.mli
+++ b/src/plugins/qed/bvars.mli
@@ -32,12 +32,17 @@ type t (** An over-approximation of set of integers *)
val empty : t
val singleton : int -> t
-val order : t -> int (** Max stack of binders *)
-val bind : t -> t (** Decrease all elements in [s] after removing [0] *)
+val order : t -> int
+(** Max stack of binders *)
+
+val bind : t -> t
+(** Decrease all elements in [s] after removing [0] *)
val union : t -> t -> t
-val closed : t -> bool (** All variables are bound *)
+val closed : t -> bool
+(** All variables are bound *)
+
val closed_at : int -> t -> bool
(** [closed_at n a] Does not contains variables [k<n] *)
diff --git a/src/plugins/qed/engine.mli b/src/plugins/qed/engine.mli
index 7992dac2873d4dde346f9f0191d28360f2b09e3d..b2e33b0a66f344031e8a59b53013bac1692f94e7 100644
--- a/src/plugins/qed/engine.mli
+++ b/src/plugins/qed/engine.mli
@@ -112,9 +112,15 @@ class type virtual ['z,'adt,'field,'logic,'tau,'var,'term,'env] engine =
(** {3 Global and Local Environment} *)
- method env : 'env (** Returns a fresh copy of the current environment. *)
- method set_env : 'env -> unit (** Set environment. *)
- method lookup : 'term -> scope (** Term scope in the current environment. *)
+ method env : 'env
+ (** Returns a fresh copy of the current environment. *)
+
+ method set_env : 'env -> unit
+ (** Set environment. *)
+
+ method lookup : 'term -> scope
+ (** Term scope in the current environment. *)
+
method scope : 'env -> (unit -> unit) -> unit
(** Calls the continuation in the provided environment.
Previous environment is restored after return. *)
@@ -139,14 +145,22 @@ class type virtual ['z,'adt,'field,'logic,'tau,'var,'term,'env] engine =
method t_prop : string
method t_atomic : 'tau -> bool
- method pp_array : 'tau printer (** For [Z->a] arrays *)
- method pp_farray : 'tau printer2 (** For [k->a] arrays *)
+ method pp_array : 'tau printer
+ (** For [Z->a] arrays *)
+
+ method pp_farray : 'tau printer2
+ (** For [k->a] arrays *)
+
+ method pp_tvar : int printer
+ (** Type variables. *)
- method pp_tvar : int printer (** Type variables. *)
method pp_datatype : 'adt -> 'tau list printer
- method pp_tau : 'tau printer (** Without parentheses. *)
- method pp_subtau : 'tau printer (** With parentheses if non-atomic. *)
+ method pp_tau : 'tau printer
+ (** Without parentheses. *)
+
+ method pp_subtau : 'tau printer
+ (** With parentheses if non-atomic. *)
(** {3 Current Mode}
@@ -167,8 +181,11 @@ class type virtual ['z,'adt,'field,'logic,'tau,'var,'term,'env] engine =
(** {3 Primitives} *)
- method e_true : cmode -> string (** ["true"] *)
- method e_false : cmode -> string (** ["false"] *)
+ method e_true : cmode -> string
+ (** ["true"] *)
+
+ method e_false : cmode -> string
+ (** ["false"] *)
method pp_int : amode -> 'z printer
method pp_real : Q.t printer
diff --git a/src/plugins/qed/export.mli b/src/plugins/qed/export.mli
index 44f2cf2fc281ddbb3d75d960f84bd0811f1cfe5c..34698c3bc8919afac35b468cf7c36b07027dbb39 100644
--- a/src/plugins/qed/export.mli
+++ b/src/plugins/qed/export.mli
@@ -61,9 +61,15 @@ sig
method virtual field : Field.t -> string
method virtual link : Fun.t -> link
- method env : Env.t (** A safe copy of the environment *)
- method set_env : Env.t -> unit (** Set the environment *)
- method marks : Env.t * T.marks (** The current environment with empty marks *)
+ method env : Env.t
+ (** A safe copy of the environment *)
+
+ method set_env : Env.t -> unit
+ (** Set the environment *)
+
+ method marks : Env.t * T.marks
+ (** The current environment with empty marks *)
+
method lookup : term -> scope
method set_env : Env.t -> unit
method scope : Env.t -> (unit -> unit) -> unit
diff --git a/src/plugins/qed/hcons.mli b/src/plugins/qed/hcons.mli
index 7e749e4d0467b8a269e83e9cb9170f6bb6f19799..7f92bb04cb150ce3fb5b2b729b5333fad673dc75 100644
--- a/src/plugins/qed/hcons.mli
+++ b/src/plugins/qed/hcons.mli
@@ -33,8 +33,12 @@ val hash_list : ('a -> int) -> int -> 'a list -> int
val hash_array : ('a -> int) -> int -> 'a array -> int
val hash_opt : ('a -> int) -> int -> 'a option -> int
-val eq_list : 'a list -> 'a list -> bool (** Uses [==]. *)
-val eq_array : 'a array -> 'a array -> bool (** Uses [==]. *)
+val eq_list : 'a list -> 'a list -> bool
+(** Uses [==]. *)
+
+val eq_array : 'a array -> 'a array -> bool
+(** Uses [==]. *)
+
val equal_list : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool
val equal_array : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool
val compare_list : ('a -> 'a -> int) -> 'a list -> 'a list -> int
diff --git a/src/plugins/qed/logic.mli b/src/plugins/qed/logic.mli
index 648d787c4abc25777d976d6d2ea6bd5993679eee..a59161af28f80b0b0239375df045a90820d706bb 100644
--- a/src/plugins/qed/logic.mli
+++ b/src/plugins/qed/logic.mli
@@ -104,8 +104,11 @@ module type Function =
sig
include Symbol
val category : t -> t category
- val params : t -> sort list (** params ; exceeding params use Sdata *)
- val sort : t -> sort (** result *)
+ val params : t -> sort list
+ (** params ; exceeding params use Sdata *)
+
+ val sort : t -> sort
+ (** result *)
end
(** {2 Bound Variables} *)
@@ -225,23 +228,50 @@ sig
type record = (Field.t * term) list
- val decide : term -> bool (** Return [true] if and only the term is [e_true]. Constant time. *)
- val is_true : term -> maybe (** Constant time. *)
- val is_false : term -> maybe (** Constant time. *)
- val is_prop : term -> bool (** Boolean or Property *)
- val is_int : term -> bool (** Integer sort *)
- val is_real : term -> bool (** Real sort *)
- val is_arith : term -> bool (** Integer or Real sort *)
+ val decide : term -> bool
+ (** Return [true] if and only the term is [e_true]. Constant time. *)
+
+ val is_true : term -> maybe
+ (** Constant time. *)
+
+ val is_false : term -> maybe
+ (** Constant time. *)
+
+ val is_prop : term -> bool
+ (** Boolean or Property *)
+
+ val is_int : term -> bool
+ (** Integer sort *)
+
+ val is_real : term -> bool
+ (** Real sort *)
+
+ val is_arith : term -> bool
+ (** Integer or Real sort *)
+
+ val are_equal : term -> term -> maybe
+ (** Computes equality *)
+
+ val eval_eq : term -> term -> bool
+ (** Same as [are_equal] is [Yes] *)
+
+ val eval_neq : term -> term -> bool
+ (** Same as [are_equal] is [No] *)
+
+ val eval_lt : term -> term -> bool
+ (** Same as [e_lt] is [e_true] *)
+
+ val eval_leq : term -> term -> bool
+ (** Same as [e_leq] is [e_true] *)
+
+ val repr : term -> repr
+ (** Constant time *)
- val are_equal : term -> term -> maybe (** Computes equality *)
- val eval_eq : term -> term -> bool (** Same as [are_equal] is [Yes] *)
- val eval_neq : term -> term -> bool (** Same as [are_equal] is [No] *)
- val eval_lt : term -> term -> bool (** Same as [e_lt] is [e_true] *)
- val eval_leq : term -> term -> bool (** Same as [e_leq] is [e_true] *)
+ val sort : term -> sort
+ (** Constant time *)
- val repr : term -> repr (** Constant time *)
- val sort : term -> sort (** Constant time *)
- val vars : term -> Vars.t (** Constant time *)
+ val vars : term -> Vars.t
+ (** Constant time *)
(** Path-positioning access
@@ -496,6 +526,7 @@ sig
val consequence : term -> term -> term
(** Knowing [h], [consequence h a] returns [b] such that [h -> (a<->b)] *)
+
val literal : term -> bool * term
val affine : term -> term affine
@@ -504,19 +535,36 @@ sig
(** {3 Symbol} *)
type t = term
- val id : t -> int (** unique identifier (stored in t) *)
- val hash : t -> int (** constant access (stored in t) *)
- val equal : t -> t -> bool (** physical equality *)
- val compare : t -> t -> int (** atoms are lower than complex terms ; otherwise, sorted by id. *)
+ val id : t -> int
+ (** unique identifier (stored in t) *)
+
+ val hash : t -> int
+ (** constant access (stored in t) *)
+
+ val equal : t -> t -> bool
+ (** physical equality *)
+
+ val compare : t -> t -> int
+ (** atoms are lower than complex terms ; otherwise, sorted by id. *)
+
val pretty : Format.formatter -> t -> unit
- val weigth : t -> int (** Informal size *)
+ val weigth : t -> int
+ (** Informal size *)
(** {3 Utilities} *)
- val is_closed : t -> bool (** No bound variables *)
- val is_simple : t -> bool (** Constants, variables, functions of arity 0 *)
- val is_atomic : t -> bool (** Constants and variables *)
- val is_primitive : t -> bool (** Constants only *)
+ val is_closed : t -> bool
+ (** No bound variables *)
+
+ val is_simple : t -> bool
+ (** Constants, variables, functions of arity 0 *)
+
+ val is_atomic : t -> bool
+ (** Constants and variables *)
+
+ val is_primitive : t -> bool
+ (** Constants only *)
+
val is_neutral : Fun.t -> t -> bool
val is_absorbant : Fun.t -> t -> bool
@@ -524,9 +572,14 @@ sig
val basename : t -> string
val debug : Format.formatter -> t -> unit
- val pp_id : Format.formatter -> t -> unit (** internal id *)
- val pp_rid : Format.formatter -> t -> unit (** head symbol with children id's *)
- val pp_repr : Format.formatter -> repr -> unit (** head symbol with children id's *)
+ val pp_id : Format.formatter -> t -> unit
+ (** internal id *)
+
+ val pp_rid : Format.formatter -> t -> unit
+ (** head symbol with children id's *)
+
+ val pp_repr : Format.formatter -> repr -> unit
+ (** head symbol with children id's *)
(** {2 Shared sub-terms} *)
diff --git a/src/plugins/qed/pool.mli b/src/plugins/qed/pool.mli
index 7186d08df27df130cdeef2a1756456de839443e0..b45d81c849ba05763e610289afd4c678f8fbbacf 100644
--- a/src/plugins/qed/pool.mli
+++ b/src/plugins/qed/pool.mli
@@ -34,7 +34,8 @@ end
module Make(T : Type) :
sig
- type var = (** Hashconsed *)
+ (** Hashconsed *)
+ type var =
private {
vid : int ;
vbase : string ;
@@ -44,8 +45,12 @@ sig
val dummy : var (** null vid *)
- val hash : var -> int (** [vid] *)
- val equal : var -> var -> bool (** [==] *)
+ val hash : var -> int
+ (** [vid] *)
+
+ val equal : var -> var -> bool
+ (** [==] *)
+
val compare : var -> var -> int
val pretty : Format.formatter -> var -> unit
diff --git a/src/plugins/qed/term.mli b/src/plugins/qed/term.mli
index 4f557674371acd702a17e597ea3c26ebdbd7b684..afec11e96dc53957536c283cae535be482b640ce 100644
--- a/src/plugins/qed/term.mli
+++ b/src/plugins/qed/term.mli
@@ -39,13 +39,19 @@ module Make
(** {2 Global State}
One given [term] has valid meaning only for one particular state. *)
- type state (** Hash-consing, cache, rewriting rules, etc. *)
+ (** Hash-consing, cache, rewriting rules, etc. *)
+ type state
val create : unit -> state
(** Create a new fresh state. Local state is not modified. *)
- val get_state : unit -> state (** Return local state. *)
- val set_state : state -> unit (** Update local state. *)
- val clr_state : state -> unit (** Clear local state. *)
+ val get_state : unit -> state
+ (** Return local state. *)
+
+ val set_state : state -> unit
+ (** Update local state. *)
+
+ val clr_state : state -> unit
+ (** Clear local state. *)
val in_state : state -> ('a -> 'b) -> 'a -> 'b
(** execute in a particular state. *)
diff --git a/src/plugins/rte/rte.ml b/src/plugins/rte/rte.ml
index dfc8a41beaeba51b51835f627db3de22e56eea7f..98067747ac9b948bbc46a07ca222c7f269cde467 100644
--- a/src/plugins/rte/rte.ml
+++ b/src/plugins/rte/rte.ml
@@ -109,11 +109,11 @@ let lval_initialized_assertion ~remove_trivial:_ ~on_alarm lv =
let typ = Cil.typeOfLval lv in
match lv with
| Var vi, NoOffset ->
- (** Note: here [lv] has structure/union type or fundamental type.
- We exclude structures and unions. And for fundamental types:
- - globals (initialized and then only written with initialized values)
- - formals (checked at function call)
- - temporary variables (initialized during AST normalization)
+ (* Note: here [lv] has structure/union type or fundamental type.
+ We exclude structures and unions. And for fundamental types:
+ - globals (initialized and then only written with initialized values)
+ - formals (checked at function call)
+ - temporary variables (initialized during AST normalization)
*)
if not (vi.vglob || vi.vformal || vi.vtemp)
&& not (Cil.isStructOrUnionType typ)
diff --git a/src/plugins/server/data.mli b/src/plugins/server/data.mli
index 5be781efc69c9fb0d282c76393b01ebed6330ab4..d3e2e79bdf8285b2e600ed75f241068dac836bfd 100644
--- a/src/plugins/server/data.mli
+++ b/src/plugins/server/data.mli
@@ -81,7 +81,10 @@ module Jint : S with type t = int
module Jfloat : S with type t = float
module Jstring : S with type t = string
module Jalpha : S with type t = string
-module Jtext : S with type t = json (** Rich text encoding, see [Jbuffer]. *)
+
+(** Rich text encoding, see [Jbuffer]. *)
+module Jtext : S with type t = json
+
module Jmarkdown : S with type t = Markdown.text
(* -------------------------------------------------------------------------- *)
@@ -164,9 +167,14 @@ val declare :
module Record :
sig
- type 'a record (** Records of type ['a]. *)
- type 'a signature (** Opened signature for record of type ['a]. *)
- type ('a,'b) field (** Field of type ['b] for a record of type ['a]. *)
+ (** Records of type ['a]. *)
+ type 'a record
+
+ (** Opened signature for record of type ['a]. *)
+ type 'a signature
+
+ (** Field of type ['b] for a record of type ['a]. *)
+ type ('a,'b) field
(** Data with [type t = r record].
Also contains getters and setters for fields. *)
@@ -344,7 +352,9 @@ module type Index =
sig
include S
val get : t -> int
- val find : int -> t (** @raise Not_found if not registered. *)
+ val find : int -> t
+ (** @raise Not_found if not registered. *)
+
val clear : unit -> unit
(** Clear index tables. Use with extreme care. *)
end
diff --git a/src/plugins/server/kernel_ast.mli b/src/plugins/server/kernel_ast.mli
index 9ca8ae7ef6d09187e1682a27872dbd8753be8d03..448d6f373dee42b1fb0d2c98e6afa7184207a340 100644
--- a/src/plugins/server/kernel_ast.mli
+++ b/src/plugins/server/kernel_ast.mli
@@ -47,8 +47,11 @@ sig
val jglobal : jtype
val jproperty : jtype
- val create : t -> string (** Memoized unique identifier. *)
- val lookup : string -> t (** Get back the localizable, if any. *)
+ val create : t -> string
+ (** Memoized unique identifier. *)
+
+ val lookup : string -> t
+ (** Get back the localizable, if any. *)
end
module KfMarker : Data.S with type t = kernel_function * Printer_tag.localizable
diff --git a/src/plugins/server/package.mli b/src/plugins/server/package.mli
index 2713082dc46bf7201a69b6af7cafa62d3e57ab5d..56b0f3a34c0f74585b2c3abb3488e37020c135ed 100644
--- a/src/plugins/server/package.mli
+++ b/src/plugins/server/package.mli
@@ -143,8 +143,12 @@ module Scope :
sig
type t
val create : plugin -> t
- val reserve : t -> string -> unit (** Must _not_ be call after [use] *)
- val declare : t -> ident -> unit (** Must _not_ be call after [use] *)
+ val reserve : t -> string -> unit
+ (** Must _not_ be call after [use] *)
+
+ val declare : t -> ident -> unit
+ (** Must _not_ be call after [use] *)
+
val use : t -> ident -> unit
val resolve : t -> string IdMap.t
end
diff --git a/src/plugins/server/server_parameters.mli b/src/plugins/server/server_parameters.mli
index a6120b992abc540228cc8054e7ec6acd4ff4cc59..f5b2ba814db91380679115390910b8960c558977 100644
--- a/src/plugins/server/server_parameters.mli
+++ b/src/plugins/server/server_parameters.mli
@@ -24,13 +24,23 @@
include Plugin.General_services
-module Doc : Parameter_sig.Filepath (** Generate documentation *)
-module Polling : Parameter_sig.Int (** Idle waiting time (in ms) *)
-module AutoLog : Parameter_sig.Bool (** Monitor logs *)
+(** Generate documentation *)
+module Doc : Parameter_sig.Filepath
-val wpage : warn_category (** Inconsistent page warning *)
-val wkind : warn_category (** Inconsistent category warning *)
-val wname : warn_category (** Invalid name warning *)
+(** Idle waiting time (in ms) *)
+module Polling : Parameter_sig.Int
+
+(** Monitor logs *)
+module AutoLog : Parameter_sig.Bool
+
+val wpage : warn_category
+(** Inconsistent page warning *)
+
+val wkind : warn_category
+(** Inconsistent category warning *)
+
+val wname : warn_category
+(** Invalid name warning *)
val has_relative_filepath: unit -> bool
diff --git a/src/plugins/slicing/Slicing.mli b/src/plugins/slicing/Slicing.mli
index 20d25256918bc8839c7ab8fda2e5ee9d8d37219c..fb4dda8b2f6efbdfd7089b4a51d07c1ce9b7b53b 100644
--- a/src/plugins/slicing/Slicing.mli
+++ b/src/plugins/slicing/Slicing.mli
@@ -106,8 +106,9 @@ module Api:sig
(** Access to slicing results. *)
module Mark : sig
- type t
(** Abstract data type for mark value. *)
+ type t
+
val dyn_t : t Type.t
(** For dynamic type checking and journalization. *)
diff --git a/src/plugins/slicing/api.ml b/src/plugins/slicing/api.ml
index 9300aec55d06506385aff25c654fbb9c331d4aec..4f188601176098412d2a35e81ffbae854fbc8c2e 100644
--- a/src/plugins/slicing/api.ml
+++ b/src/plugins/slicing/api.ml
@@ -164,7 +164,6 @@ module Select = struct
let dyn_t = SlicingTypes.Sl_select.ty
type set = SlicingCmds.set
module S = Cil_datatype.Varinfo.Map.Make(SlicingTypes.Fct_user_crit)
- type selections = S.t
let dyn_set = S.ty
(** {2 Journalized selectors } *)
diff --git a/src/plugins/slicing/api.mli b/src/plugins/slicing/api.mli
index 126938a341116a6b15f8db7ec4a923fad318ec2f..bba2afb4077e1b3c97f97c1bf787a860faa1d2d5 100644
--- a/src/plugins/slicing/api.mli
+++ b/src/plugins/slicing/api.mli
@@ -21,62 +21,72 @@
(**************************************************************************)
(* ---------------------------------------------------------------------- *)
-(** Global data management *)
-
-val split_slice :
- SlicingInternals.fct_slice -> SlicingInternals.fct_slice list
-
-val merge_slices :
- SlicingInternals.fct_slice ->
- SlicingInternals.fct_slice -> replace:bool -> SlicingInternals.fct_slice
-
-val copy_slice : SlicingInternals.fct_slice -> SlicingInternals.fct_slice
-
-(* ---------------------------------------------------------------------- *)
-(** {1 Global setting } *)
+(** {1 Global setting.} *)
+(** Internal state of the slicing tool from project viewpoints. *)
val self : State.t
(* ---------------------------------------------------------------------- *)
(** {2 Functions with journalized side effects } *)
+(** Set the used slicing modes. *)
val set_modes :
?calls:SlicingParameters.Mode.Calls.t ->
?callers:SlicingParameters.Mode.Callers.t ->
?sliceUndef:SlicingParameters.Mode.SliceUndef.t ->
?keepAnnotations:SlicingParameters.Mode.KeepAnnotations.t -> unit -> unit
-
(* ---------------------------------------------------------------------- *)
-(** {1 Slicing project } *)
+(** {1 Slicing project management.} *)
module Project : sig
- (** {2 Values } *)
-
- val default_slice_names :
- Cil_types.kernel_function -> bool -> int -> string
-
(** {2 Functions with journalized side effects } *)
+ (** Init/reset a slicing project. *)
val reset_slicing : unit -> unit
+ (** Change the slicing level of this function
+ (see the [-slicing-level] option documentation to know the meaning of
+ the number)
+ @raise SlicingTypes.ExternalFunction if [kf] has no definition.
+ @raise SlicingTypes.WrongSlicingLevel if [n] is not valid. *)
+ val change_slicing_level : Cil_types.kernel_function -> int -> unit
+
+ (** Build a new [Db.Project.t] from all [Slice.t] of a project.
+ Can optionally specify how to name the sliced functions
+ by defining [f_slice_names].
+ [f_slice_names kf src_visi num_slice] has to return the name
+ of the exported functions based on the source function [kf].
+ - [src_visi] tells if the source function name is used
+ (if not, it can be used for a slice)
+ - [num_slice] gives the number of the slice to name.
+ The entry point function is only exported once :
+ it is VERY recommended to give to it its original name,
+ even if it is sliced. *)
val extract :
- ?f_slice_names:(Kernel_function.t -> bool -> int -> string) ->
+ ?f_slice_names:(Cil_types.kernel_function -> bool -> int -> string) ->
string -> Project.t
+ (** Print a representation of the slicing project (call graph)
+ in a dot file which name is the given string. *)
val print_dot : filename:string -> title:string -> unit
- val change_slicing_level : Kernel_function.t -> int -> unit
-
(** {2 No needs of Journalization} *)
- val is_directly_called_internal : Kernel_function.t -> bool
+ val default_slice_names : Cil_types.kernel_function -> bool -> int -> string
+ (** Return [true] iff the source function is called (even indirectly via
+ transitivity) from a [Slice.t]. *)
val is_called : Cil_types.kernel_function -> bool
- val has_persistent_selection : Kernel_function.t -> bool
+ (** Return [true] iff the source function has persistent selection *)
+ val has_persistent_selection : Cil_types.kernel_function -> bool
+
+ (** Return [true] if the source function is directly (even via pointer
+ function) called from a [Slice.t]. *)
+ val is_directly_called_internal : Cil_types.kernel_function -> bool
(** {2 Debug} *)
@@ -86,257 +96,330 @@ end
(* ---------------------------------------------------------------------- *)
-(** {1 Mark} *)
+(** {1 Access to slicing results.} *)
module Mark : sig
+ (** Abstract data type for mark value. *)
type t = SlicingTypes.sl_mark
- val dyn_t : SlicingTypes.Sl_mark.t Type.t
+
+ (** For dynamic type checking and journalization. *)
+ val dyn_t : t Type.t
(** {2 No needs of Journalization} *)
- val compare : SlicingTypes.sl_mark -> SlicingTypes.sl_mark -> int
+ (** To construct a mark such as
+ [(is_ctrl result, is_data result, isaddr result) = (~ctrl, ~data, ~addr)],
+ [(is_bottom result) = false] and
+ [(is_spare result) = not (~ctrl || ~data || ~addr)]. *)
+ val make : data:bool -> addr:bool -> ctrl:bool -> t
- val pretty : Format.formatter -> SlicingTypes.sl_mark -> unit
+ (** A total ordering function similar to the generic structural
+ comparison function [compare].
+ Can be used to build a map from [t] marks to, for example, colors for
+ the GUI. *)
+ val compare : t -> t -> int
- val make : data:bool -> addr:bool -> ctrl:bool -> SlicingTypes.sl_mark
+ (** [true] iff the mark is empty: it is the only case where the associated
+ element is invisible. *)
+ val is_bottom : t -> bool
- val is_bottom : SlicingTypes.sl_mark -> bool
+ (** Smallest visible mark. Usually used to mark element that need to be
+ visible for compilation purpose, not really for the selected computations.
+ That mark is related to transparent selection. *)
+ val is_spare : t -> bool
- val is_spare : SlicingTypes.sl_mark -> bool
+ (** The element is used to control the program point of a selected data. *)
+ val is_ctrl : t -> bool
- val is_ctrl : SlicingTypes.sl_mark -> bool
+ (** The element is used to compute selected data.
+ Notice that a mark can be [is_data] and/or [is_ctrl] and/or [is_addr]
+ at the same time. *)
+ val is_data : t -> bool
- val is_data : SlicingTypes.sl_mark -> bool
+ (** The element is used to compute the address of a selected data. *)
+ val is_addr : t -> bool
- val is_addr : SlicingTypes.sl_mark -> bool
+ (** The mark [m] related to all statements of a source function [kf].
+ Property : [is_bottom (get_from_func proj kf) =
+ not (Project.is_called proj kf) ] *)
+ val get_from_src_func : Cil_types.kernel_function -> t
- val get_from_src_func : Kernel_function.t -> SlicingInternals.pdg_mark
+ (** {2 Debug} *)
+
+ val pretty : Format.formatter -> t -> unit
end
(* ---------------------------------------------------------------------- *)
-(** {1 Selection} *)
+(** {1 Slicing selections.} *)
module Select : sig
+ (** Internal selection. *)
type t = SlicingTypes.sl_select
- val dyn_t : SlicingTypes.Sl_select.t Type.t
+ (** For dynamic type checking and journalization. *)
+ val dyn_t : t Type.t
+
+ (** Set of colored selections. *)
type set = SlicingCmds.set
- type selections = SlicingTypes.Fct_user_crit.t Cil_datatype.Varinfo.Map.t
+ (** For dynamic type checking and journalization. *)
+ val dyn_set : set Type.t
- val dyn_set : selections Type.t
+ (** {2 Selectors.} *)
- (** {2 Journalized selectors } *)
+ (** Empty selection. *)
+ val empty_selects : set
- val empty_selects : selections
+ (** {3 Statement selectors.} *)
+ (** To select a statement. *)
val select_stmt :
- selections -> spare:bool -> Cil_datatype.Stmt.t -> Kernel_function.t -> selections
+ set -> spare:bool -> Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+ (** To select a statement reachability.
+ Note: add also a transparent selection on the whole statement. *)
val select_stmt_ctrl :
- selections -> spare:bool -> Cil_datatype.Stmt.t -> Kernel_function.t -> selections
-
+ set -> spare:bool -> Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+
+ (** To select rw accesses to lvalues (given as string) related to a statement.
+ Variables of [~rd] and [~wr] string are bounded relatively to the whole
+ scope of the function.
+ The interpretation of the address of the lvalues is done just before the
+ execution of the statement [~eval].
+ The selection preserve the [~rd] and ~[wr] accesses contained into the
+ statement [ki].
+ Note: add also a transparent selection on the whole statement.
+ @modify Magnesium-20151001 argument [~scope] removed. *)
val select_stmt_lval_rw :
- selections ->
- SlicingTypes.Sl_mark.t ->
+ set ->
+ Mark.t ->
rd:Datatype.String.Set.t ->
wr:Datatype.String.Set.t ->
Cil_datatype.Stmt.t ->
- eval:Cil_datatype.Stmt.t -> Kernel_function.t -> selections
-
+ eval:Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+
+ (** To select lvalues (given as string) related to a statement.
+ Variables of [lval_str] string are bounded relatively to the whole scope
+ of the function.
+ The interpretation of the address of the lvalue is done just before the
+ execution of the statement [~eval].
+ The selection preserve the value of these lvalues before or after (c.f.
+ boolean [~before]) the statement [ki].
+ Note: add also a transparent selection on the whole statement.
+ @modify Magnesium-20151001 argument [~scope] removed. *)
val select_stmt_lval :
- selections ->
- SlicingTypes.Sl_mark.t ->
+ set ->
+ Mark.t ->
Datatype.String.Set.t ->
before:bool ->
Cil_datatype.Stmt.t ->
- eval:Cil_datatype.Stmt.t -> Kernel_function.t -> selections
+ eval:Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+ (** To select a zone value related to a statement.
+ Note: add also a transparent selection on the whole statement. *)
+ val select_stmt_zone :
+ set ->
+ Mark.t ->
+ Locations.Zone.t ->
+ before:bool ->
+ Cil_types.stmt -> Cil_types.kernel_function -> set
+
+ (** To select a predicate value related to a statement.
+ Note: add also a transparent selection on the whole statement. *)
+ val select_stmt_term :
+ set ->
+ Mark.t ->
+ Cil_types.term ->
+ Cil_types.stmt -> Cil_types.kernel_function -> set
+
+ (** To select a predicate value related to a statement.
+ Note: add also a transparent selection on the whole statement. *)
+ val select_stmt_pred :
+ set ->
+ Mark.t ->
+ Cil_types.predicate ->
+ Cil_types.stmt -> Cil_types.kernel_function -> set
+
+ (** To select the annotations related to a statement.
+ Note: add also a transparent selection on the whole statement. *)
+ val select_stmt_annot :
+ set ->
+ Mark.t ->
+ spare:bool ->
+ Cil_types.code_annotation ->
+ Cil_types.stmt -> Cil_types.kernel_function -> set
+
+ (** To select the annotations related to a statement.
+ Note: add also a transparent selection on the whole statement. *)
val select_stmt_annots :
- selections ->
- SlicingTypes.Sl_mark.t ->
+ set ->
+ Mark.t ->
spare:bool ->
threat:bool ->
user_assert:bool ->
slicing_pragma:bool ->
loop_inv:bool ->
- loop_var:bool -> Cil_datatype.Stmt.t -> Kernel_function.t -> selections
-
+ loop_var:bool -> Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+
+ (** {3 Function selectors.} *)
+
+ (** To select rw accesses to lvalues (given as a string) related to a
+ function.
+ Variables of [~rd] and [~wr] string are bounded relatively to the whole
+ scope of the function.
+ The interpretation of the address of the lvalues is done just before the
+ execution of the statement [~eval].
+ The selection preserve the value of these lvalues into the whole project.
+ @modify Magnesium-20151001 argument [~scope] removed. *)
+ val select_func_lval_rw :
+ set -> Mark.t -> rd:Datatype.String.Set.t -> wr:Datatype.String.Set.t ->
+ eval:Cil_datatype.Stmt.t -> Cil_types.kernel_function -> set
+
+ (** To select lvalues (given as a string) related to a function.
+ Variables of [lval_str] string are bounded relatively to the scope of the
+ first statement of [kf].
+ The interpretation of the address of the lvalues is done just before the
+ execution of the first statement [kf].
+ The selection preserve the value of these lvalues before execution of the
+ return statement. *)
val select_func_lval :
- selections ->
- SlicingTypes.Sl_mark.t ->
- Datatype.String.Set.t -> Kernel_function.t -> selections
+ set -> Mark.t -> Datatype.String.Set.t -> Cil_types.kernel_function -> set
- val select_func_lval_rw :
- selections ->
- SlicingTypes.Sl_mark.t ->
- rd:Datatype.String.Set.t ->
- wr:Datatype.String.Set.t ->
- eval:Cil_datatype.Stmt.t -> Kernel_function.t -> selections
+ (** To select an output zone related to a function. *)
+ val select_func_zone :
+ set -> Mark.t -> Locations.Zone.t -> Cil_types.kernel_function -> set
- val select_func_return : selections -> spare:bool -> Kernel_function.t -> selections
+ (** To select the function result (returned value). *)
+ val select_func_return : set -> spare:bool -> Cil_types.kernel_function -> set
+ (** To select every calls to the given function, i.e. the call keeps its
+ semantics in the slice. *)
val select_func_calls_to :
- selections -> spare:bool -> Kernel_function.t -> selections
+ set -> spare:bool -> Cil_types.kernel_function -> set
+ (** To select every calls to the given function without the selection of its
+ inputs/outputs. *)
val select_func_calls_into :
- selections -> spare:bool -> Kernel_function.t -> selections
+ set -> spare:bool -> Cil_types.kernel_function -> set
+ (** To select the annotations related to a function. *)
val select_func_annots :
- selections ->
- SlicingTypes.Sl_mark.t ->
- spare:bool ->
- threat:bool ->
- user_assert:bool ->
- slicing_pragma:bool ->
- loop_inv:bool -> loop_var:bool -> Kernel_function.t -> selections
-
- val select_func_zone :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- Locations.Zone.t -> Cil_types.kernel_function -> SlicingCmds.set
-
- val select_stmt_term :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- Cil_types.term ->
- Cil_types.stmt -> Cil_types.kernel_function -> SlicingCmds.set
+ set -> Mark.t -> spare:bool -> threat:bool -> user_assert:bool ->
+ slicing_pragma:bool -> loop_inv:bool -> loop_var:bool ->
+ Cil_types.kernel_function -> set
- val select_stmt_pred :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- Cil_types.predicate ->
- Cil_types.stmt -> Cil_types.kernel_function -> SlicingCmds.set
-
- val select_stmt_annot :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- spare:bool ->
- Cil_types.code_annotation ->
- Cil_types.stmt -> Cil_types.kernel_function -> SlicingCmds.set
-
- val select_stmt_zone :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- Locations.Zone.t ->
- before:bool ->
- Cil_types.stmt -> Cil_types.kernel_function -> SlicingCmds.set
+ (** {3 Pdg selectors.} *)
val select_pdg_nodes :
- SlicingCmds.set ->
- SlicingTypes.sl_mark ->
- PdgTypes.Node.t list -> Cil_types.kernel_function -> SlicingCmds.set
+ set -> Mark.t -> PdgTypes.Node.t list -> Cil_types.kernel_function -> set
+
+ (** {3 Internal use only} *)
- val get_function : SlicingTypes.sl_select -> Cil_types.kernel_function
+ (** The function related to an internal selection. *)
+ val get_function : t -> Cil_types.kernel_function
- val merge_internal :
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ (** The function related to an internal selection. *)
+ val merge_internal : t -> t -> t
- val add_to_selects_internal :
- Cil_datatype.Varinfo.Map.key * SlicingInternals.fct_user_crit ->
- SlicingInternals.fct_user_crit Cil_datatype.Varinfo.Map.t ->
- SlicingInternals.fct_user_crit Cil_datatype.Varinfo.Map.t
+ val add_to_selects_internal : t -> set -> set
- val iter_selects_internal :
- (Cil_datatype.Varinfo.Map.key * 'a -> unit) ->
- 'a Cil_datatype.Varinfo.Map.t -> unit
+ val iter_selects_internal : (t -> unit) -> set -> unit
- val fold_selects_internal :
- ('a -> Cil_datatype.Varinfo.Map.key * 'b -> 'a) ->
- 'a -> 'b Cil_datatype.Varinfo.Map.t -> 'a
+ val fold_selects_internal : (('a -> t -> 'a) -> 'a -> set -> 'a)
+ (** Internally used to select a statement :
+ - if [is_ctrl_mark m],
+ propagate ctrl_mark on ctrl dependencies of the statement
+ - if [is_addr_mark m],
+ propagate addr_mark on addr dependencies of the statement
+ - if [is_data_mark m],
+ propagate data_mark on data dependencies of the statement
+ Marks the node with a spare_mark and propagate so that the dependencies
+ that were not selected yet will be marked spare.
+ When the statement is a call, its functional inputs/outputs are also
+ selected (The call is still selected even it has no output).
+ When the statement is a composed one (block, if, etc...),
+ all the sub-statements are selected.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_stmt_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.stmt ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Cil_types.stmt -> Mark.t -> t
val select_label_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.logic_label ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
-
+ Cil_types.kernel_function ->
+ ?select:t -> Cil_types.logic_label -> Mark.t -> t
+
+ (** Internally used to select a statement call without its
+ inputs/outputs so that it doesn't select the statements computing the
+ inputs of the called function as [select_stmt_internal] would do.
+ Raise [Invalid_argument] when the [stmt] isn't a call.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_min_call_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.stmt ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Cil_types.stmt -> Mark.t -> t
+ (** Internally used to select a zone value at a program point.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_stmt_zone_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.stmt ->
- before:bool ->
- Locations.Zone.t ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
-
+ Cil_types.kernel_function ->
+ ?select:t ->
+ Cil_types.stmt -> before:bool -> Locations.Zone.t -> Mark.t -> t
+
+ (** Internally used to select a zone value at the beginning of a function.
+ For a defined function, it is similar to [select_stmt_zone_internal]
+ with the initial statement, but it can also be used for undefined
+ functions.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_zone_at_entry_point_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Locations.Zone.t ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Locations.Zone.t -> Mark.t -> t
+ (** Internally used to select a zone value at the end of a function.
+ For a defined function, it is similar to [select_stmt_zone_internal]
+ with the return statement, but it can also be used for undefined
+ functions.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_zone_at_end_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Locations.Zone.t ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Locations.Zone.t -> Mark.t -> t
+ (** Internally used to select the statements that modify the
+ given zone considered as in output.
+ Be careful that it is NOT the same as selecting the zone at the end!
+ The 'undef' zone is not propagated...
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_modified_output_zone_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Locations.Zone.t ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Locations.Zone.t -> Mark.t -> t
+ (** Internally used to select a statement reachability :
+ Only propagate a ctrl_mark on the statement control dependencies.
+ @raise SlicingTypes.NoPdg when the Pdg cannot be computed. *)
val select_stmt_ctrl_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.stmt ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Cil_types.stmt -> t
val select_entry_point_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Mark.t -> t
val select_return_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function -> ?select:t -> Mark.t -> t
val select_decl_var_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.varinfo ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
-
+ Cil_types.kernel_function -> ?select:t -> Cil_types.varinfo -> Mark.t -> t
+
+ (** Internally used to select PDG nodes :
+ - if [is_ctrl_mark m],
+ propagate ctrl_mark on ctrl dependencies of the statement
+ - if [is_addr_mark m],
+ propagate addr_mark on addr dependencies of the statement
+ - if [is_data_mark m],
+ propagate data_mark on data dependencies of the statement
+ Marks the node with a spare_mark and propagate so that
+ the dependencies that were not selected yet will be marked spare. *)
val select_pdg_nodes_internal :
- Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- PdgTypes.Node.t list ->
- SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ Cil_types.kernel_function ->
+ ?select:t -> PdgTypes.Node.t list -> Mark.t -> t
(** {2 Debug} *)
- val pretty :
- Format.formatter ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ val pretty : Format.formatter -> t -> unit
end
@@ -346,61 +429,45 @@ end
module Slice : sig
type t = SlicingTypes.sl_fct_slice
- val dyn_t : SlicingTypes.Sl_fct_slice.t Type.t
+ val dyn_t : t Type.t
(** {2 Functions with journalized side effects } *)
- val create : Kernel_function.t -> SlicingTypes.Sl_fct_slice.t
+ val create : Cil_types.kernel_function -> t
- val remove : SlicingTypes.Sl_fct_slice.t -> unit
+ val remove : t -> unit
val remove_uncalled : unit -> unit
(** {2 No needs of Journalization} *)
- val get_all : Kernel_function.t -> SlicingInternals.fct_slice list
+ val get_all : Cil_types.kernel_function -> t list
- val get_function :
- SlicingInternals.fct_slice -> Cil_types.kernel_function
+ val get_function : t -> Cil_types.kernel_function
- val get_callers :
- SlicingInternals.fct_slice -> SlicingInternals.fct_slice list
+ val get_callers : t -> t list
- val get_called_slice :
- SlicingInternals.fct_slice ->
- Cil_types.stmt -> SlicingInternals.fct_slice option
+ val get_called_slice : t -> Cil_types.stmt -> t option
- val get_called_funcs :
- SlicingInternals.fct_slice ->
- Cil_types.stmt -> Kernel_function.Hptset.elt list
+ val get_called_funcs : t -> Cil_types.stmt -> Cil_types.kernel_function list
- val get_mark_from_stmt :
- SlicingInternals.fct_slice ->
- Cil_types.stmt -> SlicingInternals.pdg_mark
+ val get_mark_from_stmt : t -> Cil_types.stmt -> Mark.t
- val get_mark_from_label :
- SlicingInternals.fct_slice ->
- Cil_types.stmt -> Cil_types.label -> SlicingInternals.pdg_mark
+ val get_mark_from_label : t -> Cil_types.stmt -> Cil_types.label -> Mark.t
- val get_mark_from_local_var :
- SlicingInternals.fct_slice ->
- Cil_types.varinfo -> SlicingInternals.pdg_mark
+ val get_mark_from_local_var : t -> Cil_types.varinfo -> Mark.t
- val get_mark_from_formal :
- SlicingInternals.fct_slice ->
- Cil_datatype.Varinfo.t -> SlicingInternals.pdg_mark
+ val get_mark_from_formal : t -> Cil_datatype.Varinfo.t -> Mark.t
- val get_user_mark_from_inputs :
- SlicingInternals.fct_slice -> SlicingInternals.pdg_mark
+ val get_user_mark_from_inputs : t -> Mark.t
- val get_num_id : SlicingInternals.fct_slice -> int
+ val get_num_id : t -> int
- val from_num_id :
- Kernel_function.t -> int -> SlicingInternals.fct_slice
+ val from_num_id : Cil_types.kernel_function -> int -> t
(** {2 Debug} *)
- val pretty : Format.formatter -> SlicingInternals.fct_slice -> unit
+ val pretty : Format.formatter -> t -> unit
end
@@ -419,32 +486,22 @@ module Request : sig
val propagate_user_marks : unit -> unit
- val copy_slice :
- SlicingTypes.Sl_fct_slice.t -> SlicingTypes.Sl_fct_slice.t
+ val copy_slice : Slice.t -> Slice.t
- val split_slice :
- SlicingTypes.Sl_fct_slice.t -> SlicingTypes.Sl_fct_slice.t list
+ val split_slice : Slice.t -> Slice.t list
- val merge_slices :
- SlicingTypes.Sl_fct_slice.t ->
- SlicingTypes.Sl_fct_slice.t ->
- replace:bool -> SlicingTypes.Sl_fct_slice.t
+ val merge_slices : Slice.t -> Slice.t -> replace:bool -> Slice.t
- val add_call_slice :
- caller:SlicingTypes.Sl_fct_slice.t ->
- to_call:SlicingTypes.Sl_fct_slice.t -> unit
+ val add_call_slice : caller:Slice.t -> to_call:Slice.t -> unit
- val add_call_fun :
- caller:SlicingTypes.Sl_fct_slice.t ->
- to_call:Kernel_function.t -> unit
+ val add_call_fun : caller:Slice.t -> to_call:Cil_types.kernel_function -> unit
val add_call_min_fun :
- caller:SlicingTypes.Sl_fct_slice.t ->
- to_call:Kernel_function.t -> unit
+ caller:Slice.t -> to_call:Cil_types.kernel_function -> unit
- val add_selection : Select.selections -> unit
+ val add_selection : Select.set -> unit
- val add_persistent_selection : Select.selections -> unit
+ val add_persistent_selection : Select.set -> unit
val add_persistent_cmdline : unit -> unit
@@ -452,15 +509,23 @@ module Request : sig
val is_request_empty_internal : unit -> bool
- val add_slice_selection_internal :
- SlicingInternals.fct_slice ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ val add_slice_selection_internal : Slice.t -> Select.t -> unit
- val add_selection_internal :
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ val add_selection_internal : Select.t -> unit
(** {2 Debug} *)
val pretty : Format.formatter -> unit
end
+
+(* ---------------------------------------------------------------------- *)
+(** {1 Global data management} *)
+
+val split_slice : Slice.t -> Slice.t list
+
+val merge_slices : Slice.t -> Slice.t -> replace:bool -> Slice.t
+
+val copy_slice : Slice.t -> Slice.t
+
+(* -- end -------------------------------------------------------------- *)
diff --git a/src/plugins/slicing/fct_slice.mli b/src/plugins/slicing/fct_slice.mli
index 41afe344ff50ec0467d3adaa923515589b1e0819..b05520e7f73f19e64f0c4652c31bf54f0ce85523 100644
--- a/src/plugins/slicing/fct_slice.mli
+++ b/src/plugins/slicing/fct_slice.mli
@@ -32,6 +32,7 @@ val is_src_fun_called :
* (even indirectly via transitivity) from a [Slice.t]. *)
val is_src_fun_visible :
Cil_types.kernel_function -> bool
+
(**
* @raise SlicingTypes.ExternalFunction if the function has no source code,
* because there cannot be any slice for it.
diff --git a/src/plugins/slicing/slicingInternals.ml b/src/plugins/slicing/slicingInternals.ml
index 61c77fabcdc53420fd1628fdf57eb366a288fdf2..849167e818a6e85c001f7a2a84a342583d24898c 100644
--- a/src/plugins/slicing/slicingInternals.ml
+++ b/src/plugins/slicing/slicingInternals.ml
@@ -90,56 +90,48 @@ type fct_info = {
(** calls in slices that call source fct *)
}
-and
- (** to represent where a function is called. *)
- called_by = (fct_slice * Cil_types.stmt) list
+(** to represent where a function is called. *)
+and called_by = (fct_slice * Cil_types.stmt) list
-and
- (** Function slice :
+(** Function slice :
created as soon as there is a criterion to compute it,
even if the slice itself hasn't been computed yet.
- *)
- fct_slice = {
+*)
+and fct_slice = {
ff_fct : fct_info ;
ff_id : int ;
mutable ff_marks : ff_marks;
mutable ff_called_by : called_by
}
-and
- (** [fct_id] is used to identify either a source function or a sliced one.*)
- fct_id =
+(** [fct_id] is used to identify either a source function or a sliced one.*)
+and fct_id =
| FctSrc of fct_info (** source function *)
| FctSliced of fct_slice (** sliced function *)
-and
- called_fct =
+and called_fct =
| CallSrc of fct_info option
(** call the source function (might be unknown if the call uses pointer) *)
| CallSlice of fct_slice
-and
- (** information about a call in a slice which gives the function to call *)
- call_info = called_fct option
+(** information about a call in a slice which gives the function to call *)
+and call_info = called_fct option
-and
- (** main part of a slice = mapping between the function elements
- * and information about them in the slice. *)
- marks_index = (pdg_mark, call_info) PdgIndex.FctIndex.t
+(** main part of a slice = mapping between the function elements
+ and information about them in the slice. *)
+and marks_index = (pdg_mark, call_info) PdgIndex.FctIndex.t
-and
- ff_marks = PdgTypes.Pdg.t * marks_index
+and ff_marks = PdgTypes.Pdg.t * marks_index
-and
- project = { functions : fct_info Varinfo.Hashtbl.t;
- mutable actions : criterion list;
- }
+and project = {
+ functions : fct_info Varinfo.Hashtbl.t;
+ mutable actions : criterion list;
+}
-and
- (** Slicing criterion at the application level.
+(** Slicing criterion at the application level.
When applied, they are translated into [fct_criterion]
- *)
- appli_criterion =
+*)
+and appli_criterion =
| CaGlobalData of Locations.Zone.t
(** select all that is necessary to compute the given location. *)
| CaCall of fct_info
@@ -148,38 +140,30 @@ and
* to all the function callers. *)
| CaOther
-and
- (** Base criterion for the functions. These are the only one that can
- really generate function slices. All the other criteria are
- translated in more basic ones.
- Note that to build such a base criterion, the PDG has to be already
- computed.
- *)
- fct_base_criterion = pdg_mark PdgMarks.select
+(** Base criterion for the functions. These are the only one that can
+ really generate function slices. All the other criteria are
+ translated in more basic ones.
+ Note that to build such a base criterion, the PDG has to be already
+ computed.
+*)
+and fct_base_criterion = pdg_mark PdgMarks.select
-and
- (** Used to identify a location (zone) at a given program point.
+(** Used to identify a location (zone) at a given program point.
* The boolean tell if the point is before (true) or after the statement *)
- loc_point = Cil_types.stmt * Locations.Zone.t * bool
-
-(** List of pdg nodes to be selected (see {!fct_user_crit})*)
-(*type nodes = pdg_node list*)
+and loc_point = Cil_types.stmt * Locations.Zone.t * bool
-and
- (** [node_or_dpds] tells how we want to select nodes,
- * or some of their dependencies (see {!fct_user_crit}). *)
- node_or_dpds = CwNode | CwAddrDpds | CwDataDpds | CwCtrlDpds
+(** [node_or_dpds] tells how we want to select nodes,
+ or some of their dependencies (see {!fct_user_crit}). *)
+and node_or_dpds = CwNode | CwAddrDpds | CwDataDpds | CwCtrlDpds
-and
- (** Tells which marks we want to put in the slice of a function *)
- fct_user_crit =
- (* | CuNodes of (pdg_node list * (node_or_dpds * pdg_mark) list) list *)
+(** Tells which marks we want to put in the slice of a function *)
+and fct_user_crit =
| CuSelect of pdg_mark PdgMarks.select
| CuTop of pdg_mark (** the function has probably no PDG,
- but we nonetheless give a mark to propagate *)
-and
- (** kinds of actions that can be apply to a function *)
- fct_crit =
+ but we nonetheless give a mark to propagate *)
+
+(** kinds of actions that can be apply to a function *)
+and fct_crit =
| CcUserMark of fct_user_crit
(** add marks to a slice *)
| CcChooseCall of Cil_types.stmt
@@ -201,9 +185,9 @@ and
| CcPropagate of (pdg_mark PdgMarks.select)
(** simply propagate the given marks *)
| CcExamineCalls of pdg_mark PdgMarks.info_called_outputs
-and
- (** Slicing criterion for a function. *)
- fct_criterion = {
+
+(** Slicing criterion for a function. *)
+and fct_criterion = {
cf_fct : fct_id ;
(** Identification of the {b RESULT} of this filter.
* When it a a slice, it might be an existing slice that will be modified,
@@ -214,10 +198,10 @@ and
*)
cf_info : fct_crit
}
-and
- (** A slicing criterion is either an application level criterion,
- * or a function level one. *)
- criterion =
+
+(** A slicing criterion is either an application level criterion,
+ or a function level one. *)
+and criterion =
CrAppli of appli_criterion | CrFct of fct_criterion
(** {2 Internals values} *)
diff --git a/src/plugins/slicing/slicingInternals.mli b/src/plugins/slicing/slicingInternals.mli
index 3d371794fd03d20cd73193a2f2104666baef9698..e7e9074c4f76f3f46dde2de8ee60591b0164c680 100644
--- a/src/plugins/slicing/slicingInternals.mli
+++ b/src/plugins/slicing/slicingInternals.mli
@@ -78,56 +78,48 @@ type fct_info = {
(** calls in slices that call source fct *)
}
-and
- (** to represent where a function is called. *)
- called_by = (fct_slice * Cil_types.stmt) list
+(** to represent where a function is called. *)
+and called_by = (fct_slice * Cil_types.stmt) list
-and
- (** Function slice :
+(** Function slice :
created as soon as there is a criterion to compute it,
even if the slice itself hasn't been computed yet.
- *)
- fct_slice = {
+*)
+and fct_slice = {
ff_fct : fct_info ;
ff_id : int ;
mutable ff_marks : ff_marks;
mutable ff_called_by : called_by
}
-and
- (** [fct_id] is used to identify either a source function or a sliced one.*)
- fct_id =
+(** [fct_id] is used to identify either a source function or a sliced one.*)
+and fct_id =
| FctSrc of fct_info (** source function *)
| FctSliced of fct_slice (** sliced function *)
-and
- called_fct =
+and called_fct =
| CallSrc of fct_info option
(** call the source function (might be unknown if the call uses pointer) *)
| CallSlice of fct_slice
-and
- (** information about a call in a slice which gives the function to call *)
- call_info = called_fct option
+(** information about a call in a slice which gives the function to call *)
+and call_info = called_fct option
-and
- (** main part of a slice = mapping between the function elements
- * and information about them in the slice. *)
- marks_index = (pdg_mark, call_info) PdgIndex.FctIndex.t
+(** main part of a slice = mapping between the function elements
+ and information about them in the slice. *)
+and marks_index = (pdg_mark, call_info) PdgIndex.FctIndex.t
-and
- ff_marks = PdgTypes.Pdg.t * marks_index
+and ff_marks = PdgTypes.Pdg.t * marks_index
-and
- project = { functions : fct_info Varinfo.Hashtbl.t;
- mutable actions : criterion list;
- }
+and project = {
+ functions : fct_info Varinfo.Hashtbl.t;
+ mutable actions : criterion list;
+}
-and
- (** Slicing criterion at the application level.
+(** Slicing criterion at the application level.
When applied, they are translated into [fct_criterion]
- *)
- appli_criterion =
+*)
+and appli_criterion =
| CaGlobalData of Locations.Zone.t
(** select all that is necessary to compute the given location. *)
| CaCall of fct_info
@@ -136,38 +128,30 @@ and
* to all the function callers. *)
| CaOther
-and
- (** Base criterion for the functions. These are the only one that can
- really generate function slices. All the other criteria are
- translated in more basic ones.
- Note that to build such a base criterion, the PDG has to be already
- computed.
- *)
- fct_base_criterion = pdg_mark PdgMarks.select
+(** Base criterion for the functions. These are the only one that can
+ really generate function slices. All the other criteria are
+ translated in more basic ones.
+ Note that to build such a base criterion, the PDG has to be already
+ computed.
+*)
+and fct_base_criterion = pdg_mark PdgMarks.select
-and
- (** Used to identify a location (zone) at a given program point.
+(** Used to identify a location (zone) at a given program point.
* The boolean tell if the point is before (true) or after the statement *)
- loc_point = Cil_types.stmt * Locations.Zone.t * bool
+and loc_point = Cil_types.stmt * Locations.Zone.t * bool
-(** List of pdg nodes to be selected (see {!fct_user_crit})*)
-(*type nodes = pdg_node list*)
+(** [node_or_dpds] tells how we want to select nodes,
+ or some of their dependencies (see {!fct_user_crit}). *)
+and node_or_dpds = CwNode | CwAddrDpds | CwDataDpds | CwCtrlDpds
-and
- (** [node_or_dpds] tells how we want to select nodes,
- * or some of their dependencies (see {!fct_user_crit}). *)
- node_or_dpds = CwNode | CwAddrDpds | CwDataDpds | CwCtrlDpds
-
-and
- (** Tells which marks we want to put in the slice of a function *)
- fct_user_crit =
- (* | CuNodes of (pdg_node list * (node_or_dpds * pdg_mark) list) list *)
+(** Tells which marks we want to put in the slice of a function *)
+and fct_user_crit =
| CuSelect of pdg_mark PdgMarks.select
| CuTop of pdg_mark (** the function has probably no PDG,
- but we nonetheless give a mark to propagate *)
-and
- (** kinds of actions that can be apply to a function *)
- fct_crit =
+ but we nonetheless give a mark to propagate *)
+
+(** kinds of actions that can be apply to a function *)
+and fct_crit =
| CcUserMark of fct_user_crit
(** add marks to a slice *)
| CcChooseCall of Cil_types.stmt
@@ -189,9 +173,9 @@ and
| CcPropagate of (pdg_mark PdgMarks.select)
(** simply propagate the given marks *)
| CcExamineCalls of pdg_mark PdgMarks.info_called_outputs
-and
- (** Slicing criterion for a function. *)
- fct_criterion = {
+
+(** Slicing criterion for a function. *)
+and fct_criterion = {
cf_fct : fct_id ;
(** Identification of the {b RESULT} of this filter.
* When it a a slice, it might be an existing slice that will be modified,
@@ -202,10 +186,10 @@ and
*)
cf_info : fct_crit
}
-and
- (** A slicing criterion is either an application level criterion,
- * or a function level one. *)
- criterion =
+
+(** A slicing criterion is either an application level criterion,
+ or a function level one. *)
+and criterion =
CrAppli of appli_criterion | CrFct of fct_criterion
(** {2 Internals values} *)
diff --git a/src/plugins/slicing/slicingSelect.mli b/src/plugins/slicing/slicingSelect.mli
index e751a2cf45aae07f9a995aa4276a17d182f35a92..c139085e9da9b6f5dd0b7925a88397f5e229405c 100644
--- a/src/plugins/slicing/slicingSelect.mli
+++ b/src/plugins/slicing/slicingSelect.mli
@@ -24,14 +24,14 @@ val check_call : Cil_types.stmt -> bool -> Cil_types.stmt
val print_select :
Format.formatter ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ SlicingTypes.sl_select -> unit
val get_select_kf : Cil_types.varinfo * 'a -> Cil_types.kernel_function
val check_db_select :
Cil_datatype.Varinfo.t ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select ->
+ SlicingTypes.sl_select
val empty_db_select :
Kernel_function.t -> Cil_types.varinfo * SlicingInternals.fct_user_crit
@@ -43,30 +43,30 @@ val top_db_select :
val check_kf_db_select :
Kernel_function.t ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select ->
+ SlicingTypes.sl_select
val check_ff_db_select :
SlicingInternals.fct_slice ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ SlicingTypes.sl_select ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val bottom_msg : Kernel_function.t -> unit
val basic_add_select :
Kernel_function.t ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ SlicingTypes.sl_select ->
PdgTypes.Node.t list ->
?undef:Locations.Zone.t option * SlicingTypes.sl_mark ->
SlicingActions.n_or_d_marks ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_pdg_nodes :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
PdgTypes.Node.t list ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val mk_select :
Db.Pdg.t ->
@@ -77,12 +77,12 @@ val mk_select :
val select_stmt_zone :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Cil_types.stmt ->
before:bool ->
Locations.Zone.t ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
(** this one is similar to [select_stmt_zone] with the return statement
* when the function is defined, but it can also be used for undefined functions. *)
@@ -90,91 +90,91 @@ val select_in_out_zone :
at_end:bool ->
use_undef:bool ->
Kernel_function.t ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ SlicingTypes.sl_select ->
Locations.Zone.t ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_zone_at_end :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Locations.Zone.t ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_modified_output_zone :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Locations.Zone.t ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_zone_at_entry :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Locations.Zone.t ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val stmt_nodes_to_select :
Db.Pdg.t -> Cil_types.stmt -> PdgTypes.Node.t list
val select_stmt_computation :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Cil_types.stmt ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_label :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Cil_types.logic_label ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
(** marking a call node means that a [choose_call] will have to decide that to
* call according to the slicing-level, but anyway, the call will be visible.
*)
val select_minimal_call :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Cil_types.stmt ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_stmt_ctrl :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_types.stmt -> Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ ?select:SlicingTypes.sl_select ->
+ Cil_types.stmt -> SlicingTypes.sl_select
val select_entry_point :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_return :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val select_decl_var :
Kernel_function.t ->
- ?select:Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
+ ?select:SlicingTypes.sl_select ->
Cil_types.varinfo ->
SlicingTypes.sl_mark ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select
val merge_select :
SlicingInternals.fct_user_crit ->
SlicingInternals.fct_user_crit -> SlicingInternals.fct_user_crit
val merge_db_select :
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit
+ SlicingTypes.sl_select ->
+ SlicingTypes.sl_select ->
+ SlicingTypes.sl_select
module Selections : sig
@@ -214,13 +214,13 @@ val call_min_f_in_caller :
val is_already_selected :
SlicingInternals.fct_slice ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> bool
+ SlicingTypes.sl_select -> bool
val add_ff_selection :
SlicingInternals.fct_slice ->
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ SlicingTypes.sl_select -> unit
(** add a persistent selection to the function.
* This might change its slicing level in order to call slices later on. *)
val add_fi_selection :
- Cil_datatype.Varinfo.t * SlicingInternals.fct_user_crit -> unit
+ SlicingTypes.sl_select -> unit
diff --git a/src/plugins/sparecode/Sparecode.mli b/src/plugins/sparecode/Sparecode.mli
index 6929a20bc53672fba4315c367a837ddfe2ad0ac7..079e468002f8bf311c3bb758cf65f5aa15782f93 100644
--- a/src/plugins/sparecode/Sparecode.mli
+++ b/src/plugins/sparecode/Sparecode.mli
@@ -31,6 +31,7 @@ module Register: sig
* or its slicing pragmas when [select_slice_pragmas] is true.
* @return a new project where the sparecode has been removed.
*)
+
val rm_unused_globals : ?new_proj_name:string -> ?project:Project.t -> unit -> Project.t
(** Remove unused global types and variables from the given project
* (the current one if no project given).
@@ -38,4 +39,5 @@ module Register: sig
* The result is in the returned new project.
* @modify Carbon-20110201 optional argument [new_proj_name] added
* *)
+
end
diff --git a/src/plugins/sparecode/spare_marks.ml b/src/plugins/sparecode/spare_marks.ml
index 4764f643b019463dae0dcdd17eceb33172b85c68..2f0c83674a97d3f143b99a5c84ed36342cbb6ae6 100644
--- a/src/plugins/sparecode/spare_marks.ml
+++ b/src/plugins/sparecode/spare_marks.ml
@@ -157,7 +157,7 @@ let rec key_visible fm key =
BoolMark.visible m
with Not_found -> false
and
- (** the call is visible if its control node is visible *)
+ (* the call is visible if its control node is visible *)
call_visible fm call =
let key = PdgIndex.Key.call_ctrl_key call in
key_visible fm key
diff --git a/src/plugins/value/Eva.mli b/src/plugins/value/Eva.mli
index 7b6776718948e5ecec37c97108ad24a046e4c653..41f19858cfe82dd3e0e362d3efdd0abfdde5629f 100644
--- a/src/plugins/value/Eva.mli
+++ b/src/plugins/value/Eva.mli
@@ -30,9 +30,11 @@ module Analysis: sig
val self : State.t
(** Internal state of Eva analysis from projects viewpoint. *)
+
end
module Results: sig
+
(** Eva's result API is a work-in-progress interface to allow accessing the
analysis results once its completed. It is experimental and is very likely
to change in the future. It aims at replacing [Db.Value] but does not
@@ -300,6 +302,7 @@ module Results: sig
end
module Parameters: sig
+
(** Configuration of the analysis. *)
(** Returns the list (name, descr) of currently enabled abstract domains. *)
@@ -316,6 +319,7 @@ module Parameters: sig
end
module Eva_annotations: sig
+
(** Register special annotations to locally guide the Eva analysis:
- slevel annotations: "slevel default", "slevel merge" and "slevel i"
@@ -368,6 +372,7 @@ module Eva_annotations: sig
end
module Eval: sig
+
(** Can the results of a function call be cached with memexec? *)
type cacheable =
| Cacheable (** Functions whose result can be safely cached. *)
@@ -379,6 +384,7 @@ module Eval: sig
end
module Builtins: sig
+
(** Eva analysis builtins for the cvalue domain, more efficient than their
equivalent in C. *)
@@ -440,6 +446,7 @@ module Builtins: sig
end
module Eval_terms: sig
+
(** [annot_predicate_deps ~pre ~here p] computes the logic dependencies needed
to evaluate the predicate [p] in a code annotation in cvalue state [here],
in a function whose pre-state is [pre].
@@ -460,9 +467,11 @@ module Eva_results: sig
(** Change the callstacks for the results for which this is meaningful.
For technical reasons, the top of the callstack must currently
be preserved. *)
+
end
module Unit_tests: sig
+
(** Currently tested by this module:
- semantics of sign values. *)
diff --git a/src/plugins/value/domains/abstract_domain.mli b/src/plugins/value/domains/abstract_domain.mli
index 788fc04b50c9e1359009b01b1f696e2af08403cc..346c82aff7689261fb4e1536c91660a51ed19f35 100644
--- a/src/plugins/value/domains/abstract_domain.mli
+++ b/src/plugins/value/domains/abstract_domain.mli
@@ -89,13 +89,17 @@ module type Lattice = sig
val top: state
(** Greatest element. *)
+
val is_included: state -> state -> bool
(** Inclusion test. *)
+
val join: state -> state -> state
(** Semi-lattice structure. *)
+
val widen: kernel_function -> stmt -> state -> state -> state
(** [widen h t1 t2] is an over-approximation of [join t1 t2].
Assumes [is_included t1 t2] *)
+
val narrow: state -> state -> state or_bottom
(** Over-approximation of the intersection of two abstract states (called meet
in the literature). Used only to gain some precision when interpreting the
@@ -120,9 +124,14 @@ type evaluation_context = {
Used in the evaluation of expressions and lvalues. *)
module type Queries = sig
- type state (** Domain state. *)
- type value (** Numerical values to which the expressions are evaluated. *)
- type location (** Abstract memory locations associated to left values. *)
+ (** Domain state. *)
+ type state
+
+ (** Numerical values to which the expressions are evaluated. *)
+ type value
+
+ (** Abstract memory locations associated to left values. *)
+ type location
(** The [origin] is used by the domain combiners to track the origin
of a value. An abstract domain can always use a dummy type unit for
@@ -293,12 +302,12 @@ end
(** Environment for the logical evaluation of predicates. *)
type 'state logic_environment = {
+ states: logic_label -> 'state;
(** The logic can refer to the states at other points of the program using
labels. [states] associates a state (which can be top) to each label. *)
- states: logic_label -> 'state;
+ result: varinfo option;
(** [result] contains the variable corresponding to \result. It is None when
\result is meaningless. *)
- result: varinfo option;
}
type variable_kind =
diff --git a/src/plugins/value/domains/cvalue/builtins.ml b/src/plugins/value/domains/cvalue/builtins.ml
index 06eec4755b14cc185ca7efd41d6135183a6d6ad6..e630950b1fd2fbcc3a0dea44b31d44f218c9b301 100644
--- a/src/plugins/value/domains/cvalue/builtins.ml
+++ b/src/plugins/value/domains/cvalue/builtins.ml
@@ -52,6 +52,7 @@ module Info = struct
let name = "Eva.Builtins.BuiltinsOverride"
let dependencies = [ Self.state ]
end
+
(** Set of functions overridden by a builtin. *)
module BuiltinsOverride = State_builder.Set_ref (Kernel_function.Set) (Info)
diff --git a/src/plugins/value/domains/cvalue/builtins.mli b/src/plugins/value/domains/cvalue/builtins.mli
index 3218d20182e4a88c019e9a50d76816143793c26d..b68cb238a08660b37f23a8ba88b178bd601fd56c 100644
--- a/src/plugins/value/domains/cvalue/builtins.mli
+++ b/src/plugins/value/domains/cvalue/builtins.mli
@@ -21,6 +21,7 @@
(**************************************************************************)
[@@@ api_start]
+
(** Eva analysis builtins for the cvalue domain, more efficient than their
equivalent in C. *)
diff --git a/src/plugins/value/domains/cvalue/cvalue_init.ml b/src/plugins/value/domains/cvalue/cvalue_init.ml
index f0d608eb0f3c65dbae57ddc6c848be2b344b1e5c..2e7a999996e74d54cb0151c2a35cf8020e1ee26a 100644
--- a/src/plugins/value/domains/cvalue/cvalue_init.ml
+++ b/src/plugins/value/domains/cvalue/cvalue_init.ml
@@ -123,7 +123,7 @@ let initialize_var_using_type varinfo state =
bind_entire_loc Cvalue.V.top_int
| TFloat (fkind, _) -> begin
- (** TODO: depend on the option for finitness *)
+ (* TODO: depend on the option for finitness *)
bind_entire_loc
(Cvalue.V.inject_float (Fval.top_finite (Fval.kind fkind)))
end
diff --git a/src/plugins/value/domains/gauges/gauges_domain.ml b/src/plugins/value/domains/gauges/gauges_domain.ml
index 33c306fa18c7233fadedfe06787c7a027f9f3030..27188a34302751add35377747f6ad6027edb0f48 100644
--- a/src/plugins/value/domains/gauges/gauges_domain.ml
+++ b/src/plugins/value/domains/gauges/gauges_domain.ml
@@ -624,7 +624,7 @@ module G = struct
| (_, []), (_, _ :: _) | (_, _ :: _) , (_, []) ->
raise MessyJoin (* should always be in the same number of loops *)
- | (ct1, []), (ct2, []) -> (** out of any loop *)
+ | (ct1, []), (ct2, []) -> (* out of any loop *)
ct1, ct2, [], false
| (ct1, (stmt1, nb1) :: q1), (ct2, (stmt2, nb2) :: q2) ->
@@ -632,35 +632,35 @@ module G = struct
let ct1, ct2, q, joined_iter = join_iterations (ct1, q1) (ct2, q2) in
match nb1, nb2 with
| MultipleIterations i1, MultipleIterations i2 ->
- (** Coefficients have already been found. Just merge the number of
- iterations. *)
+ (* Coefficients have already been found. Just merge the number of
+ iterations. *)
let i = MultipleIterations (MultipleIterations.join i1 i2) in
ct1, ct2, (stmt1, i) :: q, joined_iter
| PreciseIteration n1, PreciseIteration n2 ->
- (** Two exact number of iterations. If equal, do nothing. If not,
- infer coefficients, or go to top. *)
+ (* Two exact number of iterations. If equal, do nothing. If not,
+ infer coefficients, or go to top. *)
let nb = Bounds.inject_range n1 n2 in
let (ct1, ct2), nb, joined_iter = match n1 - n2 with
- | 0 -> (** Same number of iterations *)
+ | 0 -> (* Same number of iterations *)
(ct1, ct2), PreciseIteration n1, false
- | 1 -> (** One more iteration in s1 *)
+ | 1 -> (* One more iteration in s1 *)
let coeffs, ct1, ct2 = join_consecutive_lambda n2 ct2 ct1 in
(ct1, ct2), MultipleIterations { nb; coeffs }, true
- | -1 -> (** One more iteration in s2 *)
+ | -1 -> (* One more iteration in s2 *)
let coeffs, ct1, ct2 = join_consecutive_lambda n1 ct1 ct2 in
(ct1, ct2), MultipleIterations { nb; coeffs }, true
- | _ -> (** difference > 1. This case does not happen with the
- current iteration engine, and requires a division function
- in module Bounds. Go to top *)
+ | _ -> (* difference > 1. This case does not happen with the
+ current iteration engine, and requires a division function
+ in module Bounds. Go to top *)
(MV.empty, MV.empty),
MultipleIterations { nb; coeffs = MC.empty }, true
in
ct1, ct2, (stmt1, nb) :: q, joined_iter
| PreciseIteration i1, MultipleIterations m2 ->
- (** Normalizes the initial values [ct1] according to the coefficients
- computed in [m2] *)
+ (* Normalizes the initial values [ct1] according to the coefficients
+ computed in [m2] *)
let ct1 = remove_coeffs m2.coeffs i1 ct1 in
let nb = Bounds.enlarge (Integer.of_int i1) m2.nb in
let ii = MultipleIterations { m2 with nb } in
diff --git a/src/plugins/value/domains/traces_domain.ml b/src/plugins/value/domains/traces_domain.ml
index cea3e5a9f1801fca4953fdfb8dcdc3c29e4deef6..6341124d00598a7fec90ff64b3811920abe18d20 100644
--- a/src/plugins/value/domains/traces_domain.ml
+++ b/src/plugins/value/domains/traces_domain.ml
@@ -60,7 +60,7 @@ type transition =
| LeaveScope of kernel_function * varinfo list
(** For call of functions without definition *)
| CallDeclared of kernel_function * exp list * lval option
- | Loop of stmt * node (** start *) * edge list GraphShape.t
+ | Loop of stmt * node * edge list GraphShape.t (** node is starting node *)
| Msg of string
and edge = {
@@ -333,7 +333,7 @@ let join_path ~all_edges_ever_created g c1 c2 =
(* A loop .*)
type loops =
| Base of Node.t * Graph.t (* current last *)
- | OpenLoop of Cil_types.stmt * Node.t (* start node *) * Graph.t (* last iteration *) * Node.t (** current *) * Graph.t * loops
+ | OpenLoop of Cil_types.stmt * Node.t (* start node *) * Graph.t (* last iteration *) * Node.t (* current *) * Graph.t * loops
| UnrollLoop of Cil_types.stmt * loops
module Loops = struct
@@ -598,11 +598,11 @@ module Traces = struct
let add_trans_aux state t =
let add_edge (current, graph) =
let e =
- (** try to reuse an edge from the pool *)
+ (* try to reuse an edge from the pool *)
let succs = Graph.succs current !(state.all_edges_ever_created) in
try List.find (Edge.has_transition t) succs
with Not_found ->
- (** create a new edge *)
+ (* create a new edge *)
{ edge_trans = t; edge_dst = Node.next () }
in
let n = e.edge_dst in
@@ -614,7 +614,7 @@ module Traces = struct
let add_trans c t =
if c == top then c
- else if c.call_declared_function then c (** forget intermediary state *)
+ else if c.call_declared_function then c (* forget intermediary state *)
else
let c = if c == empty then new_empty () else c in
add_trans_aux c t
@@ -732,7 +732,7 @@ module Traces = struct
then c2
else begin
match c2.current with
- | Base _ -> assert false (** must be in a loop *)
+ | Base _ -> assert false (* must be in a loop *)
| OpenLoop(stmt,_,_,_,_,_) ->
assert (Stmt.equal stmt' stmt);
c2
@@ -921,7 +921,7 @@ let rec stmts_of_cfg cfg current var_map locals return_exp acc =
stmts_of_cfg cfg n var_map locals return_exp (stmt::acc)
| EnterScope (_, vs) ->
- (** all our variables are assigned, not defined *)
+ (* all our variables are assigned, not defined *)
let var_map = List.fold_left fresh_varinfo var_map vs in
let vs = List.map (subst_in_varinfo var_map) vs in
List.iter (fun v -> v.vformal <- false) vs;
@@ -995,7 +995,7 @@ let project_of_cfg vreturn s =
| _ -> Cil.JustCopy
method! vfunc fundec =
if Varinfo.equal (Visitor_behavior.Get_orig.varinfo self#behavior fundec.Cil_types.svar) main then begin
- (** copy of the fundec structure has already been done *)
+ (* copy of the fundec structure has already been done *)
fundec.slocals <- [];
let var_map = Varinfo.Map.empty in
let return_stmt, return_equal, blocals = match vreturn with
@@ -1120,7 +1120,7 @@ module D = struct
arg.Eval.concrete))) state call.Eval.arguments in
`Value state
else
- (** enter the scope of the dumb result variable *)
+ (* enter the scope of the dumb result variable *)
let var = call.Eval.return in
let state = match var with
| Some var -> Traces.add_trans state (EnterScope (kf, [var]))
@@ -1234,7 +1234,6 @@ module D = struct
let output_dot filename state =
let out = open_out filename in
Self.feedback ~dkey:log_category "@[Output dot produced to %s.@]" filename;
- (** *)
GraphDot.output_graph out (complete_graph (snd (Traces.get_current state)));
close_out out
diff --git a/src/plugins/value/domains/traces_domain.mli b/src/plugins/value/domains/traces_domain.mli
index a0113f486c29c3ab9866b4486801f78b6082da15..dd5630fb9bcf3c14ccd233c755b57ec5a0b5248c 100644
--- a/src/plugins/value/domains/traces_domain.mli
+++ b/src/plugins/value/domains/traces_domain.mli
@@ -36,7 +36,7 @@ type transition =
| LeaveScope of kernel_function * varinfo list
(** For call of functions without definition *)
| CallDeclared of kernel_function * exp list * lval option
- | Loop of stmt * node (** start *) * edge list GraphShape.t
+ | Loop of stmt * node * edge list GraphShape.t (** node is starting node *)
| Msg of string
and edge = {
@@ -57,7 +57,8 @@ end
(** stack of open loops *)
type loops =
| Base of Node.t * Graph.t (* current last *)
- | OpenLoop of Cil_types.stmt * Node.t (* start node *) * Graph.t (* last iteration *) * Node.t (** current *) * Graph.t * loops
+ | OpenLoop of Cil_types.stmt * Node.t * Graph.t * Node.t * Graph.t * loops
+ (** [OpenLoop(stmt, starting_node, last_iteration, current_node, g, loop)] *)
| UnrollLoop of Cil_types.stmt * loops
module Loops : sig
diff --git a/src/plugins/value/engine/abstractions.mli b/src/plugins/value/engine/abstractions.mli
index 22f2066a16bc0bddb77a6a79caed4dae0bf474b7..4f761517c0d69f6c2605ab9f4ec452f7bd51c7fe 100644
--- a/src/plugins/value/engine/abstractions.mli
+++ b/src/plugins/value/engine/abstractions.mli
@@ -161,9 +161,12 @@ module Config : sig
val multidim: flag
val printer: flag
- val default: t (** The default configuration of Eva. *)
- val legacy: t (** The configuration corresponding to the old "Value" analysis,
- with only the cvalue domain enabled. *)
+ val default: t
+ (** The default configuration of Eva. *)
+
+ val legacy: t
+ (** The configuration corresponding to the old "Value" analysis,
+ with only the cvalue domain enabled. *)
end
(** Creates the configuration according to the analysis parameters. *)
diff --git a/src/plugins/value/engine/analysis.mli b/src/plugins/value/engine/analysis.mli
index e7989595f594a88cdd96bd25692593ca99a57bb5..92dfdb74955a4ac80169393ca2738ec52269ad2e 100644
--- a/src/plugins/value/engine/analysis.mli
+++ b/src/plugins/value/engine/analysis.mli
@@ -105,6 +105,7 @@ val is_computed : unit -> bool
val self : State.t
(** Internal state of Eva analysis from projects viewpoint. *)
+
[@@@ api_end]
val cvalue_initial_state: unit -> Cvalue.Model.t
diff --git a/src/plugins/value/engine/evaluation.mli b/src/plugins/value/engine/evaluation.mli
index b634c903943bc9a40896aac99c401271bb707fe6..f894bb7f648fe18d8147e1ac83453af6d48749ce 100644
--- a/src/plugins/value/engine/evaluation.mli
+++ b/src/plugins/value/engine/evaluation.mli
@@ -27,10 +27,17 @@ open Eval
module type S = sig
- type state (** State of abstract domain. *)
- type value (** Numeric values to which the expressions are evaluated. *)
- type origin (** Origin of values. *)
- type loc (** Location of an lvalue. *)
+ (** State of abstract domain. *)
+ type state
+
+ (** Numeric values to which the expressions are evaluated. *)
+ type value
+
+ (** Origin of values. *)
+ type origin
+
+ (** Location of an lvalue. *)
+ type loc
(** Results of an evaluation: the results of all intermediate calculation (the
value of each expression and the location of each lvalue) are cached here.
diff --git a/src/plugins/value/eval.mli b/src/plugins/value/eval.mli
index 3b299c0489e98710432033c45bcacdda65b5ab54..f1220412daae8394c2042f5b4dbc1353220f8a89 100644
--- a/src/plugins/value/eval.mli
+++ b/src/plugins/value/eval.mli
@@ -148,9 +148,15 @@ type 'a record_loc = {
map. *)
module type Valuation = sig
type t
- type value (** Abstract value. *)
- type origin (** Origin of values. *)
- type loc (** Abstract memory location. *)
+
+ (** Abstract value. *)
+ type value
+
+ (** Origin of values. *)
+ type origin
+
+ (** Abstract memory location. *)
+ type loc
val empty : t
val find : t -> exp -> (value, origin) record_val or_top
@@ -271,6 +277,7 @@ type recursion = {
}
[@@@ api_start]
+
(** Can the results of a function call be cached with memexec? *)
type cacheable =
| Cacheable (** Functions whose result can be safely cached. *)
diff --git a/src/plugins/value/gui_files/gui_red.ml b/src/plugins/value/gui_files/gui_red.ml
index d930bc028367175be99711d0e61ed6e44d1fad85..c049565d3bc6b95d68c8c0d23dcc17a1c9f4cac6 100644
--- a/src/plugins/value/gui_files/gui_red.ml
+++ b/src/plugins/value/gui_files/gui_red.ml
@@ -151,7 +151,7 @@ let build_list () =
w#reload ;
in
let r = {widget=w; append; clear} in
- (** End of generic code *)
+ (* End of generic code *)
let props = [`YALIGN 0.0] in
let _ = w#add_column_text ~title:"Function" props
(function (_, {function_name}) -> [`TEXT function_name])
diff --git a/src/plugins/value/legacy/eval_terms.ml b/src/plugins/value/legacy/eval_terms.ml
index f67de28e246188d45b482be494873e72e6800d98..ae229527a499bc4e76e252368008be0047956ce1 100644
--- a/src/plugins/value/legacy/eval_terms.ml
+++ b/src/plugins/value/legacy/eval_terms.ml
@@ -1206,7 +1206,7 @@ let rec eval_term ~alarm_mode env t =
then V.cast_int_to_float Fval.Real r.eover
else V.cast_float_to_float Fval.Real r.eover
in
- { etype = Cil.longDoubleType; (** hack until logic type *)
+ { etype = Cil.longDoubleType; (* hack until logic type *)
ldeps = r.ldeps;
eover; eunder = under_from_over eover;
empty = r.empty }
diff --git a/src/plugins/value/legacy/eval_terms.mli b/src/plugins/value/legacy/eval_terms.mli
index 06dc4328c52ba15965102a93620416945bf693ef..95e826556e32e440404e88b6fc1c057993778897 100644
--- a/src/plugins/value/legacy/eval_terms.mli
+++ b/src/plugins/value/legacy/eval_terms.mli
@@ -122,6 +122,7 @@ val reduce_by_predicate :
[@@@ api_start]
+
(** [annot_predicate_deps ~pre ~here p] computes the logic dependencies needed
to evaluate the predicate [p] in a code annotation in cvalue state [here],
in a function whose pre-state is [pre].
diff --git a/src/plugins/value/parameters.mli b/src/plugins/value/parameters.mli
index 4768798e97aadc3573a4ad14ef8b2a752b6b8ad9..6f45638c5ca84bb224e0112612ebd5a7f5f8347f 100644
--- a/src/plugins/value/parameters.mli
+++ b/src/plugins/value/parameters.mli
@@ -155,6 +155,7 @@ val register_builtin: string -> unit
val register_domain: name:string -> descr:string -> unit
[@@@ api_start]
+
(** Configuration of the analysis. *)
(** Returns the list (name, descr) of currently enabled abstract domains. *)
diff --git a/src/plugins/value/partitioning/partition.mli b/src/plugins/value/partitioning/partition.mli
index 7849fcc9d76243869309628209eff722c910b8f8..0cfb0929527fea824a89d7c46676421ccbd64986 100644
--- a/src/plugins/value/partitioning/partition.mli
+++ b/src/plugins/value/partitioning/partition.mli
@@ -50,7 +50,9 @@ type call_return_policy = {
module Key : sig
include Datatype.S_with_collections with type t = key
- val empty : t (** Initial key: no partitioning. *)
+ val empty : t
+ (** Initial key: no partitioning. *)
+
val exceed_rationing: t -> bool
val combine : policy:call_return_policy -> caller:t -> callee:t -> t
(** Recombinaison of keys after a call *)
diff --git a/src/plugins/value/partitioning/trace_partitioning.mli b/src/plugins/value/partitioning/trace_partitioning.mli
index 0e16ac7f7fdf3b3caacd81405fd64b13350d05bf..c4d4d76cd11713c881842c50b387094a43874314 100644
--- a/src/plugins/value/partitioning/trace_partitioning.mli
+++ b/src/plugins/value/partitioning/trace_partitioning.mli
@@ -26,12 +26,20 @@ module Make
(Abstract : Abstractions.Eva)
(Kf : sig val kf: Cil_types.kernel_function end) :
sig
- type state = Abstract.Dom.t (** The states being partitioned *)
- type store (** The storage of all states ever met at a control point *)
- type tank (** The set of states that remains to propagate from a
- control point. *)
- type flow (** A set of states which are currently propagated *)
- type widening (** Widening information *)
+ (** The states being partitioned *)
+ type state = Abstract.Dom.t
+
+ (** The storage of all states ever met at a control point *)
+ type store
+
+ (** The set of states that remains to propagate from a control point. *)
+ type tank
+
+ (** A set of states which are currently propagated *)
+ type flow
+
+ (** Widening information *)
+ type widening
(* --- Constructors --- *)
diff --git a/src/plugins/value/utils/eva_annotations.mli b/src/plugins/value/utils/eva_annotations.mli
index 5dd4642601e758bd7c4d9c64ed8875eeda80b992..4aaa3084dee25d9baa453c6d2680593b76401e3b 100644
--- a/src/plugins/value/utils/eva_annotations.mli
+++ b/src/plugins/value/utils/eva_annotations.mli
@@ -23,6 +23,7 @@
(* Note: widen hints annotations are still registered in !{widen_hints_ext.ml}. *)
[@@@ api_start]
+
(** Register special annotations to locally guide the Eva analysis:
- slevel annotations: "slevel default", "slevel merge" and "slevel i"
diff --git a/src/plugins/value/utils/eva_results.mli b/src/plugins/value/utils/eva_results.mli
index acd1cec8c33d548ded6373533816ce5b7b2419f0..4a40e7f9d069e2ed58e22ea8d92e8ee3f507b997 100644
--- a/src/plugins/value/utils/eva_results.mli
+++ b/src/plugins/value/utils/eva_results.mli
@@ -36,6 +36,7 @@ val is_non_terminating_instr: stmt -> bool
statements that are instructions. *)
(** {2 Results} *)
+
[@@@ api_start]
type results
@@ -47,6 +48,7 @@ val change_callstacks:
(** Change the callstacks for the results for which this is meaningful.
For technical reasons, the top of the callstack must currently
be preserved. *)
+
[@@@ api_end]
(*
diff --git a/src/plugins/value/utils/results.mli b/src/plugins/value/utils/results.mli
index 70167d27b70b6971f6c5132e50a02e43d144e2b3..6af834e3fa2ba7acdb59491a1c58789465235bc0 100644
--- a/src/plugins/value/utils/results.mli
+++ b/src/plugins/value/utils/results.mli
@@ -21,6 +21,7 @@
(**************************************************************************)
[@@@ api_start]
+
(** Eva's result API is a work-in-progress interface to allow accessing the
analysis results once its completed. It is experimental and is very likely
to change in the future. It aims at replacing [Db.Value] but does not
diff --git a/src/plugins/value/utils/unit_tests.mli b/src/plugins/value/utils/unit_tests.mli
index 51c1aeb6004e954d55906bf3c008ba1ab6bceec2..1be9839639722d7119448bbafcc32448dfd3d83b 100644
--- a/src/plugins/value/utils/unit_tests.mli
+++ b/src/plugins/value/utils/unit_tests.mli
@@ -21,6 +21,7 @@
(**************************************************************************)
[@@@ api_start]
+
(** Currently tested by this module:
- semantics of sign values. *)
diff --git a/src/plugins/value/values/abstract_location.mli b/src/plugins/value/values/abstract_location.mli
index e70648946b1406b0f873ca5de2e6e0afa8090f99..dfde41f94b09fe44bf8930ed950999c9a5188f60 100644
--- a/src/plugins/value/values/abstract_location.mli
+++ b/src/plugins/value/values/abstract_location.mli
@@ -31,8 +31,11 @@ type 'v truth = 'v Abstract_value.truth
module type S = sig
type value
- type location (** abstract locations *)
- type offset (** abstract offsets *)
+ (** abstract locations *)
+ type location
+
+ (** abstract offsets *)
+ type offset
val top: location
diff --git a/src/plugins/value_types/cvalue.ml b/src/plugins/value_types/cvalue.ml
index ba493d0e92be6e70a989450823c77722455bc0c5..6a236513097a604c4fe7822cde08b948cc6370c5 100644
--- a/src/plugins/value_types/cvalue.ml
+++ b/src/plugins/value_types/cvalue.ml
@@ -951,7 +951,7 @@ module V_Offsetmap = struct
let v = V_Or_Uninitialized.initialized (V.of_char s.[i]) in
acc := f !acc v;
done;
- f !acc V_Or_Uninitialized.singleton_zero (** add null terminator *)
+ f !acc V_Or_Uninitialized.singleton_zero (* add null terminator *)
in
let size_char = Integer.of_int (Cil.bitsSizeOfInt IChar) in
of_list fold_string s size_char
diff --git a/src/plugins/value_types/function_Froms.mli b/src/plugins/value_types/function_Froms.mli
index e50fe9a12fd1eca8d770424912ed6707492d8d11..7620b22be6ab62030eafc98608b366875ae71d60 100644
--- a/src/plugins/value_types/function_Froms.mli
+++ b/src/plugins/value_types/function_Froms.mli
@@ -159,9 +159,11 @@ include Datatype.S with type t = froms
val join: froms -> froms -> froms
val top: froms
+
(** Display dependencies of a function, using the function's type to improve
readability *)
val pretty_with_type: Cil_types.typ -> froms Pretty_utils.formatter
+
(** Display dependencies of a function, using the function's type to improve
readability, separating direct and indirect dependencies *)
val pretty_with_type_indirect: Cil_types.typ -> froms Pretty_utils.formatter
diff --git a/src/plugins/variadic/Variadic.mli b/src/plugins/variadic/Variadic.mli
index 484dbbd3d2264e78a90f71e1d7fb0b4b68f60c98..53abf7a4f86ac7ae44e75cdbd09d697b49d46996 100644
--- a/src/plugins/variadic/Variadic.mli
+++ b/src/plugins/variadic/Variadic.mli
@@ -21,10 +21,12 @@
(**************************************************************************)
module Options: sig
+
(** When enabled, the plugin traverses the current AST, and translates
variadic functions, references to va_arg and variadic builtins to a
semantically code. *)
module Enabled : Parameter_sig.Bool
+
(** In strict mode, non-portable casts between integral types are forbidden
in calls to LibC's variadic functions. *)
module Strict : Parameter_sig.Bool
diff --git a/src/plugins/wp/CfgCompiler.ml b/src/plugins/wp/CfgCompiler.ml
index 74d30b9af0e9328d106fca1752bc2f47327213a9..89dfecbee0c933ac414d8b83668e33c8fbcc4e48 100644
--- a/src/plugins/wp/CfgCompiler.ml
+++ b/src/plugins/wp/CfgCompiler.ml
@@ -473,13 +473,13 @@ struct
| Binding (_,n2) -> add_edge n1 [`Label (escape "binding")] n2
in
Node.Map.iter add_edges env.succs;
- (** assumes *)
+ (* assumes *)
Bag.iter (fun (m,p) ->
let n1 = V.Assume(count (), p) in
let assume_label = [`Style `Dashed ] in
Node.Map.iter (fun n2 _ -> G.add_edge_e g (n1,assume_label,V.Node n2)) m
) env.assumes;
- (** checks *)
+ (* checks *)
Bag.iter (fun (m,p) ->
let n1 = V.Check(count (), p) in
let label = [`Style `Dotted ] in
@@ -642,7 +642,7 @@ struct
(Some (new_env edge))
(walk acc node2)
| Branch (pred, node2, node3) ->
- (** it is important to visit all the childrens *)
+ (* it is important to visit all the childrens *)
let f acc node =
match option_bind ~f:(walk acc) node with
| None -> None, acc
@@ -767,7 +767,7 @@ struct
Node.Map.map (fun _ n' -> compress n') subst
in
let find n = find_def ~def:n n subst in
- (** detect either that could be transformed in branch *)
+ (* detect either that could be transformed in branch *)
let to_remove = Node.Hashtbl.create 10 in
Node.Map.iter (fun _ e ->
match (e:(_,without_bindings) edge) with
@@ -802,7 +802,7 @@ struct
| Implies _
| Havoc (_,_) -> ()
) env.succs;
- (** substitute and remove *)
+ (* substitute and remove *)
let succs = Node.Map.mapq (fun n e ->
match (e:(_,without_bindings) edge) with
| _ when Node.Hashtbl.mem to_remove n -> None
@@ -850,7 +850,7 @@ struct
let subst = Node.Map.map (fun _ n' -> find_def ~def:n' n' subst') subst in
Node.Map.merge (fun _ a b ->
match a, b with
- | Some _, Some _ -> assert false (** the elements are remove in the new env *)
+ | Some _, Some _ -> assert false (* the elements are remove in the new env *)
| Some x, None | None, Some x -> Some x
| None, None -> assert false
) subst subst', env
@@ -876,7 +876,7 @@ struct
let ret =
match Node.Map.find node env.succs with
| exception Not_found ->
- (** posts node *)
+ (* posts node *)
let s1 = S.create () in
allocate dom s1;
s1
@@ -989,14 +989,14 @@ struct
| l -> !. (Conditions.Either l)
in
let f = Conditions.empty in
- (** The start state is accessible *)
+ (* The start state is accessible *)
let pre = Conditions.Have (access pre) in
let f = add_cond f pre in
- (** The posts state are accessible *)
+ (* The posts state are accessible *)
let f = Node.Set.fold
(fun n f -> add_cond f (Conditions.Have (access n)))
posts f in
- (** The assumes are true if all their nodes are accessible *)
+ (* The assumes are true if all their nodes are accessible *)
let f =
Bag.fold_left (fun f p ->
let nodes_are_accessible =
@@ -1006,7 +1006,7 @@ struct
add_cond f (Conditions.Have f')
) f env.assumes in
- (** compute predecessors *)
+ (* compute predecessors *)
let to_sequence_basic_backward f =
let predecessors = Node.Map.fold (fun n s acc ->
let add acc n' p =
@@ -1052,7 +1052,7 @@ struct
) predecessors f
in
- (** The transitions *)
+ (* The transitions *)
let to_sequence_basic_forward f =
Node.Map.fold (fun n s f ->
let node_is_accessible = access n in
@@ -1096,7 +1096,7 @@ struct
(have_access n) ,
Conditions.empty)
| Binding (b,n') ->
- (** For basic: all the variables are important *)
+ (* For basic: all the variables are important *)
let b = !. (Conditions.Have(F.p_conj (Passive.conditions b (fun _ -> true)))) in
Conditions.Branch(node_is_accessible,
Conditions.append b (have_access n'),
@@ -1123,7 +1123,7 @@ struct
f,Node.Hashtbl.fold Node.Map.add preds Node.Map.empty
module To_tree = struct
- (** Use a simplified version of "A New Elimination-Based Data Flow Analysis
+ (* Use a simplified version of "A New Elimination-Based Data Flow Analysis
Framework Using Annotated Decomposition Trees" where there is no loop *)
@@ -1164,39 +1164,44 @@ struct
type env_to_sequence_tree = {
env: localised_env;
- (** predecessors *)
+
pred: Node.t -> Node.t list;
- (** topological order *)
+ (** predecessors *)
topo_order : Node.t -> int;
- (** Immediate dominator forward *)
+ (** topological order *)
get_idom_forward: Node.t -> Node.t;
- (** Immediate dominator backward *)
+ (** Immediate dominator forward *)
get_idom_backward: int -> int;
+ (** Immediate dominator backward *)
- (** For each node we are going to compute different formulas *)
- (** Necessary conditions of the node from start *)
full_conds: Lang.F.pred Node.Hashtbl.t;
- (** Necessary conditions from its forward idiom *)
+ (** For each node we are going to compute different formulas
+ Necessary conditions of the node from start *)
+
conds: Lang.F.pred Node.Hashtbl.t;
- (** To which subtree corresponds this node *)
+ (** Necessary conditions from its forward idiom *)
+
subtrees: tree Node.Hashtbl.t;
- (** Root the full tree *)
+ (** To which subtree corresponds this node *)
+
root: tree;
- (** Variable used for the non-deterministic choice of either *)
+ (** Root the full tree *)
+
eithers: Lang.F.pred Node.Hashtbl.t Node.Hashtbl.t;
+ (** Variable used for the non-deterministic choice of either *)
}
let is_after n1 n2 = n1 > n2
let is_before n1 n2 = n1 < n2
let create_env_to_sequence_tree env =
- (** Compute topological order for immediate dominator computation
+ (* Compute topological order for immediate dominator computation
and the main iteration on nodes
*)
let node_int,int_node,ordered = topological env in
let nb = Node.Hashtbl.length node_int in
- (** We compute the forward immediate dominators (path that use succ)
+ (* We compute the forward immediate dominators (path that use succ)
and the backward immediate dominators (path that use pred)
*)
let predecessors = compute_preds env in
@@ -1245,7 +1250,7 @@ struct
let acc = F.p_and acc (Node.Hashtbl.find env.conds n') in
get_cond acc (env.get_idom_forward n')
in
- (** find all the conditions that keep the path toward n, i.e.
+ (* find all the conditions that keep the path toward n, i.e.
the condition of the nodes that are not dominated backwardly
(for which not all the nodes goes to n)
*)
@@ -1273,7 +1278,7 @@ struct
let c, q =
if Node.equal idom n
then
- (** it is the root *)
+ (* it is the root *)
begin
Node.Hashtbl.add env.full_conds n F.p_true;
Node.Hashtbl.add env.conds n F.p_true;
@@ -1325,7 +1330,7 @@ struct
let add_assumes_fact env = Bag.iter (fun p ->
let nodes = P.nodes_list p in
let nodes_are_accessible =
- (** TODO: don't add the condition of access of the node that are dominators of latest *)
+ (* TODO: don't add the condition of access of the node that are dominators of latest *)
List.fold_left (fun acc n -> F.p_and (access env n) acc) F.p_true nodes in
let f' = F.p_imply nodes_are_accessible (P.get p) in
let t = get_latest_node env nodes in
@@ -1347,16 +1352,16 @@ struct
let to_sequence_tree _ posts env =
let env,ordered = create_env_to_sequence_tree env in
- (** Iterate in topo order the vertex.
+ (* Iterate in topo order the vertex.
Except for root, the tree of the vertex is the one of its immediate dominator forward.
*)
List.iter (iter env) ordered;
let f = Conditions.empty in
- (** The posts state are accessible *)
+ (* The posts state are accessible *)
let f = Node.Set.fold
(fun n f -> add_cond f (Conditions.Have (access env n)))
posts f in
- (** For all either one of the condition is true *)
+ (* For all either one of the condition is true *)
let f = Node.Hashtbl.fold (fun _ h f ->
let p = Node.Hashtbl.fold (fun _ t p -> F.p_or p t) h F.p_false in
add_cond f (Conditions.Have p)
@@ -1374,7 +1379,7 @@ struct
Node.pp pre (Pretty_utils.pp_iter ~sep:"@ " Node.Set.iter Node.pp) posts;
if Wp_parameters.has_dkey dkey then
Format.printf "@[1) %a@]@." pretty_env env;
- (** restrict environment to useful node and compute havoc effects *)
+ (* restrict environment to useful node and compute havoc effects *)
let env = restrict env pre posts in
if Wp_parameters.has_dkey dkey then
Format.printf "@[2) %a@]@." pretty_env env;
@@ -1382,14 +1387,14 @@ struct
Node.Map.empty,Node.Map.empty,
Conditions.sequence [Conditions.step (Conditions.Have(F.p_false))]
else
- (** Simplify *)
+ (* Simplify *)
let subst,env =
if true
then remove_dumb_gotos env
else Node.Map.empty, env
in
let pre = find_def ~def:pre pre subst in
- (** Substitute in user_reads *)
+ (* Substitute in user_reads *)
let user_reads =
Node.Map.fold
(fun n n' acc ->
@@ -1404,14 +1409,14 @@ struct
Node.Map.add n' domain' acc)
subst user_reads
in
- (** For each node what must be read for assumes *)
+ (* For each node what must be read for assumes *)
let reads =
Bag.fold_left (fun acc e ->
Node.Map.union
(fun _ -> S.union) acc
(P.reads e))
user_reads env.assumes in
- (** compute sigmas and relocate them *)
+ (* compute sigmas and relocate them *)
let env, sigmas = domains env reads pre in
if Wp_parameters.has_dkey dkey then
Format.printf "@[3) %a@]@." pretty_env env;
@@ -1420,7 +1425,7 @@ struct
let f, preds =
match mode with
| `Tree ->
- (** Add a unique post node *)
+ (* Add a unique post node *)
let final_node = node () in
let env =
Node.Set.fold (fun p cfg ->
@@ -1437,7 +1442,7 @@ struct
Node.Map.merge
(fun _ p s -> Some (Option.value ~default:F.p_false p, Option.value ~default:(S.create ()) s))
preds sigmas in
- (** readd simplified nodes *)
+ (* readd simplified nodes *)
let predssigmas =
Node.Map.fold (fun n n' acc -> Node.Map.add n (Node.Map.find n' predssigmas) acc )
subst predssigmas
diff --git a/src/plugins/wp/CfgCompiler.mli b/src/plugins/wp/CfgCompiler.mli
index ce1b5e54ae9113ecf5171911c152d0acdf337ebd..4870247246d32281b3c9dddda6d33abc19e39381 100644
--- a/src/plugins/wp/CfgCompiler.mli
+++ b/src/plugins/wp/CfgCompiler.mli
@@ -137,6 +137,7 @@ sig
val reads : t -> S.domain
val writes : t -> S.domain
(** as defined by S.writes *)
+
val relocate : S.t sequence -> t -> t
end
diff --git a/src/plugins/wp/Cfloat.mli b/src/plugins/wp/Cfloat.mli
index 9f564cce07bdf918b08621e2c5f4f20d175dadd6..ac1389502162f9c265babadd2c1c8458e6713d62 100644
--- a/src/plugins/wp/Cfloat.mli
+++ b/src/plugins/wp/Cfloat.mli
@@ -40,8 +40,11 @@ val fq64 : lfun
type model = Real | Float
val configure : model -> WpContext.rollback
-val ftau : c_float -> tau (** model independant *)
-val tau_of_float : c_float -> tau (** with respect to model *)
+val ftau : c_float -> tau
+(** model independant *)
+
+val tau_of_float : c_float -> tau
+(** with respect to model *)
type op =
| LT
diff --git a/src/plugins/wp/Cint.ml b/src/plugins/wp/Cint.ml
index 6d7db0fdcdf3076997182072db359fe1dccc1dae..6053d614cd0a5021adc3d0ed24c637bc4c8d78d8 100644
--- a/src/plugins/wp/Cint.ml
+++ b/src/plugins/wp/Cint.ml
@@ -1066,13 +1066,13 @@ end
let is_cint_simplifier =
let reduce_bound ~add_bonus quant v tv dom t : term =
- (** Returns [new_t] such that [c_bind quant (alpha,t)]
- equals [c_bind quant v (alpha,new_t)]
- under the knowledge that [(not t) ==> (var in dom)].
- Note: [~add_bonus] has not effect on the correctness.
- It is a parameter that can be used in order to get better results.
- Bonus: Add additionnal hypothesis when we could deduce better constraint
- on the variable *)
+ (* Returns [new_t] such that [c_bind quant (alpha,t)]
+ equals [c_bind quant v (alpha,new_t)]
+ under the knowledge that [(not t) ==> (var in dom)].
+ Note: [~add_bonus] has not effect on the correctness.
+ It is a parameter that can be used in order to get better results.
+ Bonus: Add additionnal hypothesis when we could deduce better constraint
+ on the variable *)
let module Tool = struct
exception Stop
exception Empty
@@ -1227,8 +1227,8 @@ let is_cint_simplifier =
| (quant,var), None -> e_bind quant var t
| (quant,var), Some (tvar,var_domain) ->
domain <- IntDomain.remove tvar domain;
- (** Bonus: Add additionnal hypothesis in forall when we could
- deduce a better constraint on the variable *)
+ (* Bonus: Add additionnal hypothesis in forall when we could
+ deduce a better constraint on the variable *)
let add_bonus = match term_pol with
| Polarity.Both -> false
| _ -> (term_pol=Polarity.Pos) = (quant=Forall)
@@ -1238,7 +1238,7 @@ let is_cint_simplifier =
in
List.fold_left f_close t ctx_with_dom
| Fun(g,[a]) ->
- (** Here we simplifies the cints which are redoundant *)
+ (* Here we simplifies the cints which are redoundant *)
begin try
let ubound = c_int_bounds_ival (is_cint g) in
let dom = (Tmap.find a domain) in
diff --git a/src/plugins/wp/Cint.mli b/src/plugins/wp/Cint.mli
index 1e59dbb4144f5b1c19ab05d27d0c055f05ea87ba..019be56f0f81d8d7c7748e80be476430eb682d6e 100644
--- a/src/plugins/wp/Cint.mli
+++ b/src/plugins/wp/Cint.mli
@@ -29,20 +29,27 @@ open Lang
open Lang.F
val of_real : c_int -> unop
-val convert : c_int -> unop (** Independent from model *)
+val convert : c_int -> unop
+(** Independent from model *)
val to_integer : unop
val of_integer : c_int -> unop
-val to_cint : lfun -> c_int (** Raises [Not_found] if not. *)
-val is_cint : lfun -> c_int (** Raises [Not_found] if not. *)
+val to_cint : lfun -> c_int
+(** Raises [Not_found] if not. *)
+
+val is_cint : lfun -> c_int
+(** Raises [Not_found] if not. *)
type model = Natural | Machine
val configure : model -> WpContext.rollback
val current : unit -> model
-val range : c_int -> term -> pred (** Dependent on model *)
-val downcast : c_int -> unop (** Dependent on model *)
+val range : c_int -> term -> pred
+(** Dependent on model *)
+
+val downcast : c_int -> unop
+(** Dependent on model *)
val iopp : c_int -> unop
val iadd : c_int -> binop
@@ -72,8 +79,11 @@ val f_lor : lfun
val f_lsl : lfun
val f_lsr : lfun
-val f_bitwised : lfun list (** All except f_bit_positive *)
-val f_bits : lfun list (** All bit-test functions *)
+val f_bitwised : lfun list
+(** All except f_bit_positive *)
+
+val f_bits : lfun list
+(** All bit-test functions *)
val bit_test : term -> int -> term
diff --git a/src/plugins/wp/Conditions.mli b/src/plugins/wp/Conditions.mli
index acda913ad6ed75dccd2a38c3d17f2efa0568bd26..c5cb34a4b3a57094ba09f1ff735f7d5cb72c5f3d 100644
--- a/src/plugins/wp/Conditions.mli
+++ b/src/plugins/wp/Conditions.mli
@@ -85,19 +85,31 @@ val update_cond :
step ->
condition -> step
-val is_true : sequence -> bool (** Contains only true or empty steps *)
-val is_empty : sequence -> bool (** No step at all *)
-val vars_hyp : sequence -> Vars.t (** Pre-computed and available in constant time. *)
-val vars_seq : sequent -> Vars.t (** At the cost of the union of hypotheses and goal. *)
+val is_true : sequence -> bool
+(** Contains only true or empty steps *)
+
+val is_empty : sequence -> bool
+(** No step at all *)
+
+val vars_hyp : sequence -> Vars.t
+(** Pre-computed and available in constant time. *)
+
+val vars_seq : sequent -> Vars.t
+(** At the cost of the union of hypotheses and goal. *)
+
+val empty : sequence
+(** empty sequence, equivalent to true assumption *)
+
+val trivial : sequent
+(** empty implies true *)
-val empty : sequence (** empty sequence, equivalent to true assumption *)
-val trivial : sequent (** empty implies true *)
val sequence : step list -> sequence
val seq_branch : ?stmt:stmt -> F.pred -> sequence -> sequence -> sequence
(** Creates an If-Then-Else branch located at the provided stmt, if any. *)
val append : sequence -> sequence -> sequence (** Conjunction *)
+
val concat : sequence list -> sequence (** List conjunction *)
(** Iterate only over the head steps of the sequence.
@@ -174,15 +186,22 @@ val introduction_eq : sequent -> sequent
val lemma : pred -> sequent
(** Performs existential, universal and hypotheses introductions *)
-val head : step -> pred (** Predicate for Have and such, Condition for Branch, True for Either *)
-val have : step -> pred (** Predicate for Have and such, True for any other *)
+val head : step -> pred
+(** Predicate for Have and such, Condition for Branch, True for Either *)
+
+val have : step -> pred
+(** Predicate for Have and such, True for any other *)
val pred_cond : condition -> pred
-val condition : sequence -> pred (** With free variables kept. *)
-val close : sequent -> pred (** With free variables {i quantified}. *)
+val condition : sequence -> pred
+(** With free variables kept. *)
-val at_closure : (sequent -> sequent ) -> unit (** register a transformation applied just before close *)
+val close : sequent -> pred
+(** With free variables {i quantified}. *)
+
+val at_closure : (sequent -> sequent ) -> unit
+(** register a transformation applied just before close *)
(** {2 Bundles}
@@ -204,6 +223,7 @@ type 'a attributed =
'a )
val nil : bundle (** Same as empty *)
+
val occurs : F.var -> bundle -> bool
val intersect : F.pred -> bundle -> bool
(** Variables of predicate and the bundle intersects *)
diff --git a/src/plugins/wp/Cstring.ml b/src/plugins/wp/Cstring.ml
index f259b3965a8028b6865c017c1f5f6b34edd11948..e8e19af65af1ab9aaa29c4858f9fd75fbe763681 100644
--- a/src/plugins/wp/Cstring.ml
+++ b/src/plugins/wp/Cstring.ml
@@ -86,7 +86,7 @@ module LIT = WpContext.Generator(STR)
let compile s =
let id = lookup (STR.hash s) in
let lfun = Lang.generated_f ~result:(Array(Int,Int)) "Lit_%04X" id in
- (** Since its a generated it is the unique name given ["Lit_%04X" id] *)
+ (* Since its a generated it is the unique name given ["Lit_%04X" id] *)
let prefix = Lang.Fun.debug lfun in
define_symbol {
d_lfun = lfun ;
diff --git a/src/plugins/wp/Cvalues.mli b/src/plugins/wp/Cvalues.mli
index bab7b3f089c00f42b80322723521a21aece3813c..5de05af70ef150369357fb3acdd2a4fcb67a5283 100644
--- a/src/plugins/wp/Cvalues.mli
+++ b/src/plugins/wp/Cvalues.mli
@@ -52,8 +52,11 @@ val bool_neq : binop
val bool_leq : binop
val bool_and : binop
val bool_or : binop
-val is_true : pred -> term (** [p ? 1 : 0] *)
-val is_false : pred -> term (** [p ? 0 : 1] *)
+val is_true : pred -> term
+(** [p ? 1 : 0] *)
+
+val is_false : pred -> term
+(** [p ? 0 : 1] *)
(** {2 Null Values} *)
@@ -91,8 +94,11 @@ val equal_array : matrixinfo -> term -> term -> pred
(** {2 C and ACSL Constants} *)
-val ainf : term option (** Array lower-bound, ie `Some(0)` *)
-val asup : int -> term option (** Array upper-bound, ie `Some(n-1)` *)
+val ainf : term option
+(** Array lower-bound, ie `Some(0)` *)
+
+val asup : int -> term option
+(** Array upper-bound, ie `Some(n-1)` *)
val constant : constant -> term
val logic_constant : logic_constant -> term
diff --git a/src/plugins/wp/Definitions.mli b/src/plugins/wp/Definitions.mli
index 1e9dc8934db7476561701c39a5c8c88f940d7f96..55eec99b97ff310c02f89b115f273734b2e5e951 100644
--- a/src/plugins/wp/Definitions.mli
+++ b/src/plugins/wp/Definitions.mli
@@ -35,6 +35,7 @@ val compinfo : compinfo -> cluster
val matrix : unit -> cluster
val cluster_id : cluster -> string (** Unique *)
+
val cluster_title : cluster -> string
val cluster_position : cluster -> Filepath.position option
val cluster_age : cluster -> int
@@ -78,12 +79,16 @@ sig
val vars : trigger -> Vars.t
end
-val find_symbol : lfun -> dfun (** @raise Not_found if symbol is not compiled (yet) *)
+val find_symbol : lfun -> dfun
+(** @raise Not_found if symbol is not compiled (yet) *)
+
val define_symbol : dfun -> unit
val update_symbol : dfun -> unit
val find_name : string -> dlemma
-val find_lemma : logic_lemma -> dlemma (** @raise Not_found if lemma is not compiled (yet) *)
+val find_lemma : logic_lemma -> dlemma
+(** @raise Not_found if lemma is not compiled (yet) *)
+
val compile_lemma : (logic_lemma -> dlemma) -> logic_lemma -> unit
val define_lemma : dlemma -> unit
val define_type : cluster -> logic_type_info -> unit
@@ -117,10 +122,18 @@ class virtual visitor : cluster ->
method vcluster : cluster -> unit
method vlibrary : string -> unit
method vgoal : axioms option -> F.pred -> unit
- method vtypes : unit (** Visit all typedefs *)
- method vsymbols : unit (** Visit all definitions *)
- method vlemmas : unit (** Visit all lemmas *)
- method vself : unit (** Visit all records, types, defs and lemmas *)
+
+ method vtypes : unit
+ (** Visit all typedefs *)
+
+ method vsymbols : unit
+ (** Visit all definitions *)
+
+ method vlemmas : unit
+ (** Visit all lemmas *)
+
+ method vself : unit
+ (** Visit all records, types, defs and lemmas *)
(** {2 Visited definitions} *)
diff --git a/src/plugins/wp/Factory.mli b/src/plugins/wp/Factory.mli
index 1bc4ee62518fc96fa8e1200618ff49dbd9c36ee5..e4d76b022023c4b16ffc3aac11e8674129f3e3a5 100644
--- a/src/plugins/wp/Factory.mli
+++ b/src/plugins/wp/Factory.mli
@@ -42,6 +42,7 @@ val compiler : mheap -> mvar -> (module Sigs.Compiler)
val configure_driver : setup -> driver -> unit -> WpContext.rollback
val instance : setup -> driver -> WpContext.model
val default : setup (** ["Var,Typed,Nat,Real"] memory model. *)
+
val parse :
?default:setup ->
?warning:(string -> unit) ->
diff --git a/src/plugins/wp/GuiComposer.mli b/src/plugins/wp/GuiComposer.mli
index 45f58c170feb115247ddb77ce118957c3f5c107b..4867f6a93b00e3561d563384333d8396b96bb74e 100644
--- a/src/plugins/wp/GuiComposer.mli
+++ b/src/plugins/wp/GuiComposer.mli
@@ -28,7 +28,9 @@ class composer : GuiSequent.focused ->
object
method clear : unit
- method connect : (unit -> unit) -> unit (** request-for-update event *)
+ method connect : (unit -> unit) -> unit
+ (** request-for-update event *)
+
method print :
GuiTactic.composer -> quit:(unit -> unit) -> Format.formatter -> unit
@@ -38,7 +40,9 @@ class browser : GuiSequent.focused ->
object
method clear : unit
- method connect : (unit -> unit) -> unit (** request-for-update event *)
+ method connect : (unit -> unit) -> unit
+ (** request-for-update event *)
+
method print :
GuiTactic.browser -> quit:(unit -> unit) -> Format.formatter -> unit
diff --git a/src/plugins/wp/GuiConfig.ml b/src/plugins/wp/GuiConfig.ml
index 9fe462a707db986786a0a0f99545c961320829fc..c13995c364c0b7c648cf1af6c75720ac1417f3ed 100644
--- a/src/plugins/wp/GuiConfig.ml
+++ b/src/plugins/wp/GuiConfig.ml
@@ -33,7 +33,7 @@ class provers =
initializer
begin
- (** select automatically the provers set on the command line *)
+ (* select automatically the provers set on the command line *)
let cmdline =
match Wp_parameters.Provers.get () with
| [] -> [ "alt-ergo" ]
diff --git a/src/plugins/wp/Lang.ml b/src/plugins/wp/Lang.ml
index 52c49b7561c3b043368ee3305b791f4fb25a2d32..eabb6008c81ca45170de446d1244c53128f7e8e7 100644
--- a/src/plugins/wp/Lang.ml
+++ b/src/plugins/wp/Lang.ml
@@ -113,7 +113,9 @@ type adt =
| Mrecord of mdt * fields (* Model record-type *)
| Atype of logic_type_info (* Logic Type *)
| Comp of compinfo * datakind (* C-code struct or union *)
-and mdt = string extern (** name to print to the provers *)
+
+(** name to print to the provers *)
+and mdt = string extern
and 'a extern = {
ext_id : int;
ext_link : 'a ;
@@ -446,7 +448,7 @@ let symbolf
?library
?context
?link
- ?(balance=Nary) (** specify a default for link *)
+ ?(balance=Nary) (* specify a default for link *)
?(category=Logic.Function)
?(params=[])
?(sort=Logic.Sdata)
diff --git a/src/plugins/wp/Lang.mli b/src/plugins/wp/Lang.mli
index 33d34d7a0b602cd8c320700b7ad4284bff993431..f93ec5f6fb1128aec68241983a17994bf6166476 100644
--- a/src/plugins/wp/Lang.mli
+++ b/src/plugins/wp/Lang.mli
@@ -46,12 +46,16 @@ val lemma_id : string -> string
type datakind = KValue | KInit
-type adt = private (** A type is never registered in a Definition.t *)
+(** A type is never registered in a Definition.t *)
+type adt = private
| Mtype of mdt (** External type *)
| Mrecord of mdt * fields (** External record-type *)
| Atype of logic_type_info (** Logic Type *)
| Comp of compinfo * datakind (** C-code struct or union *)
-and mdt = string extern (** name to print to the provers *)
+
+(** name to print to the provers *)
+and mdt = string extern
+
and 'a extern = {
ext_id : int;
ext_link : 'a ;
@@ -175,11 +179,20 @@ val t_farray : tau -> tau -> tau
val t_datatype : adt -> tau list -> tau
val t_matrix : tau -> int -> tau
-val pointer : tau Context.value (** type of pointers *)
-val floats : (c_float -> tau) Context.value (** type of floats *)
-val poly : string list Context.value (** polymorphism *)
-val builtin_types: (string -> t_builtin) Context.value (* builtin types *)
-val parameters : (lfun -> sort list) -> unit (** definitions *)
+val pointer : tau Context.value
+(** type of pointers *)
+
+val floats : (c_float -> tau) Context.value
+(** type of floats *)
+
+val poly : string list Context.value
+(** polymorphism *)
+
+val builtin_types: (string -> t_builtin) Context.value
+(* builtin types *)
+
+val parameters : (lfun -> sort list) -> unit
+(** definitions *)
val name_of_lfun : lfun -> string
val name_of_field : field -> string
@@ -240,8 +253,12 @@ sig
type term = QED.term
type record = (field * term) list
- val hash : term -> int (** Constant time *)
- val equal : term -> term -> bool (** Same as [==] *)
+ val hash : term -> int
+ (** Constant time *)
+
+ val equal : term -> term -> bool
+ (** Same as [==] *)
+
val compare : term -> term -> int
module Tset : Qed.Idxset.S with type elt = term
@@ -265,7 +282,9 @@ sig
val e_bigint : Integer.t -> term
val e_float : float -> term
val e_setfield : term -> field -> term -> term
- val e_range : term -> term -> term (** e_range a b = b+1-a *)
+ val e_range : term -> term -> term
+ (** [e_range a b] = [b+1-a] *)
+
val is_zero : term -> bool
val e_true : term
@@ -378,8 +397,11 @@ sig
val p_subst : sigma -> pred -> pred
val p_subst_var : var -> term -> pred -> pred
- val e_vars : term -> var list (** Sorted *)
- val p_vars : pred -> var list (** Sorted *)
+ val e_vars : term -> var list
+ (** Sorted *)
+
+ val p_vars : pred -> var list
+ (** Sorted *)
val p_close : pred -> pred (** Quantify over (sorted) free variables *)
@@ -405,6 +427,7 @@ sig
(** Returns a list of terms to be shared among all {i shared} or {i
marked} subterms. The order of terms is consistent with
definition order: head terms might be used in tail ones. *)
+
val defs : marks -> term list
val define : (env -> string -> term -> unit) -> env -> marks -> env
val pp_eterm : env -> Format.formatter -> term -> unit
@@ -422,33 +445,73 @@ sig
(** {3 Utilities} *)
- val decide : term -> bool (** Return [true] if and only the term is [e_true]. Constant time. *)
+ val decide : term -> bool
+ (** Return [true] if and only the term is [e_true]. Constant time. *)
+
val basename : term -> string
- val is_true : term -> maybe (** Constant time. *)
- val is_false : term -> maybe (** Constant time. *)
- val is_prop : term -> bool (** Boolean or Property *)
- val is_int : term -> bool (** Integer sort *)
- val is_real : term -> bool (** Real sort *)
- val is_arith : term -> bool (** Integer or Real sort *)
-
- val is_closed : term -> bool (** No bound variables *)
- val is_simple : term -> bool (** Constants, variables, functions of arity 0 *)
- val is_atomic : term -> bool (** Constants and variables *)
- val is_primitive : term -> bool (** Constants only *)
+
+ val is_true : term -> maybe
+ (** Constant time. *)
+
+ val is_false : term -> maybe
+ (** Constant time. *)
+
+ val is_prop : term -> bool
+ (** Boolean or Property *)
+
+ val is_int : term -> bool
+ (** Integer sort *)
+
+ val is_real : term -> bool
+ (** Real sort *)
+
+ val is_arith : term -> bool
+ (** Integer or Real sort *)
+
+ val is_closed : term -> bool
+ (** No bound variables *)
+
+ val is_simple : term -> bool
+ (** Constants, variables, functions of arity 0 *)
+
+ val is_atomic : term -> bool
+ (** Constants and variables *)
+
+ val is_primitive : term -> bool
+ (** Constants only *)
+
val is_neutral : Fun.t -> term -> bool
val is_absorbant : Fun.t -> term -> bool
val record_with : record -> (term * record) option
- val are_equal : term -> term -> maybe (** Computes equality *)
- val eval_eq : term -> term -> bool (** Same as [are_equal] is [Yes] *)
- val eval_neq : term -> term -> bool (** Same as [are_equal] is [No] *)
- val eval_lt : term -> term -> bool (** Same as [e_lt] is [e_true] *)
- val eval_leq : term -> term -> bool (** Same as [e_leq] is [e_true] *)
+ val are_equal : term -> term -> maybe
+ (** Computes equality *)
+
+ val eval_eq : term -> term -> bool
+ (** Same as [are_equal] is [Yes] *)
+
+ val eval_neq : term -> term -> bool
+ (** Same as [are_equal] is [No] *)
+
+ val eval_lt : term -> term -> bool
+ (** Same as [e_lt] is [e_true] *)
+
+ val eval_leq : term -> term -> bool
+ (** Same as [e_leq] is [e_true] *)
+
+
+ val repr : term -> QED.repr
+ (** Constant time *)
+
+ val sort : term -> Logic.sort
+ (** Constant time *)
+
+ val vars : term -> Vars.t
+ (** Constant time *)
+
+ val varsp : pred -> Vars.t
+ (** Constant time *)
- val repr : term -> QED.repr (** Constant time *)
- val sort : term -> Logic.sort (** Constant time *)
- val vars : term -> Vars.t (** Constant time *)
- val varsp : pred -> Vars.t (** Constant time *)
val occurs : var -> term -> bool
val occursp : var -> pred -> bool
val intersect : term -> term -> bool
@@ -497,27 +560,63 @@ end
module N: sig
(** simpler notation for writing {!F.term} and {F.pred} *)
- val ( + ): F.binop (** {! F.p_add } *)
- val ( - ): F.binop (** {! F.p_sub } *)
- val ( ~- ): F.unop (** [fun x -> p_sub 0 x] *)
- val ( * ): F.binop (** {! F.p_mul} *)
- val ( / ): F.binop (** {! F.p_div} *)
- val ( mod ): F.binop (** {! F.p_mod} *)
-
- val ( = ): F.cmp (** {! F.p_equal} *)
- val ( < ): F.cmp (** {! F.p_lt} *)
- val ( > ): F.cmp (** {! F.p_lt} with inversed argument *)
- val ( <= ): F.cmp (** {! F.p_leq } *)
- val ( >= ): F.cmp (** {! F.p_leq } with inversed argument *)
- val ( <> ): F.cmp (** {! F.p_neq } *)
-
- val ( ==> ): F.operator (** {! F.p_imply } *)
- val ( && ): F.operator (** {! F.p_and } *)
- val ( || ): F.operator (** {! F.p_or } *)
- val not: F.pred -> F.pred (** {! F.p_not } *)
-
- val ( $ ): ?result:tau -> lfun -> F.term list -> F.term (** {! F.e_fun } *)
- val ( $$ ): lfun -> F.term list -> F.pred (** {! F.p_call } *)
+ val ( + ): F.binop
+ (** {! F.p_add } *)
+
+ val ( - ): F.binop
+ (** {! F.p_sub } *)
+
+ val ( ~- ): F.unop
+ (** [fun x -> p_sub 0 x] *)
+
+ val ( * ): F.binop
+ (** {! F.p_mul} *)
+
+ val ( / ): F.binop
+ (** {! F.p_div} *)
+
+ val ( mod ): F.binop
+ (** {! F.p_mod} *)
+
+
+ val ( = ): F.cmp
+ (** {! F.p_equal} *)
+
+ val ( < ): F.cmp
+ (** {! F.p_lt} *)
+
+ val ( > ): F.cmp
+ (** {! F.p_lt} with inversed argument *)
+
+ val ( <= ): F.cmp
+ (** {! F.p_leq } *)
+
+ val ( >= ): F.cmp
+ (** {! F.p_leq } with inversed argument *)
+
+ val ( <> ): F.cmp
+ (** {! F.p_neq } *)
+
+
+ val ( ==> ): F.operator
+ (** {! F.p_imply } *)
+
+ val ( && ): F.operator
+ (** {! F.p_and } *)
+
+ val ( || ): F.operator
+ (** {! F.p_or } *)
+
+ val not: F.pred -> F.pred
+ (** {! F.p_not } *)
+
+
+ val ( $ ): ?result:tau -> lfun -> F.term list -> F.term
+ (** {! F.e_fun } *)
+
+ val ( $$ ): lfun -> F.term list -> F.pred
+ (** {! F.p_call } *)
+
end
@@ -545,12 +644,22 @@ val filter_hypotheses : var list -> pred list
(** {2 Substitutions} *)
-val sigma : unit -> F.sigma (** uses current pool *)
-val alpha : unit -> F.sigma (** freshen all variables *)
-val subst : F.var list -> F.term list -> F.sigma (** replace variables *)
+val sigma : unit -> F.sigma
+(** uses current pool *)
+
+val alpha : unit -> F.sigma
+(** freshen all variables *)
+
+val subst : F.var list -> F.term list -> F.sigma
+(** replace variables *)
+
+
+val e_subst : (term -> term) -> term -> term
+(** uses current pool *)
+
+val p_subst : (term -> term) -> pred -> pred
+(** uses current pool *)
-val e_subst : (term -> term) -> term -> term (** uses current pool *)
-val p_subst : (term -> term) -> pred -> pred (** uses current pool *)
(** {2 Simplifiers} *)
@@ -569,22 +678,28 @@ class type simplifier =
method copy : simplifier
method assume : F.pred -> unit
(** Assumes the hypothesis *)
+
method target : F.pred -> unit
(** Give the predicate that will be simplified later *)
+
method fixpoint : unit
(** Called after assuming hypothesis and knowing the goal *)
+
method infer : F.pred list
(** Add new hypotheses implied by the original hypothesis. *)
method equivalent_exp : F.term -> F.term
(** Currently simplify an expression.
It must returns a equivalent formula from the assumed hypotheses. *)
+
method weaker_hyp : F.pred -> F.pred
(** Currently simplify an hypothesis before assuming it.
It must return a weaker formula from the assumed hypotheses. *)
+
method equivalent_branch : F.pred -> F.pred
(** Currently simplify a branch condition.
It must return an equivalent formula from the assumed hypotheses. *)
+
method stronger_goal : F.pred -> F.pred
(** Simplify the goal.
It must return a stronger formula from the assumed hypotheses. *)
diff --git a/src/plugins/wp/Layout.mli b/src/plugins/wp/Layout.mli
index b06b25fddfe0bae020af555fb4d61853c481e8a6..8301c7dbc5f5864b9a23bba055e39bd6b7c77d1f 100644
--- a/src/plugins/wp/Layout.mli
+++ b/src/plugins/wp/Layout.mli
@@ -41,7 +41,8 @@ type offset =
| Field of fieldinfo
| Index of typ * int
-type lvalue = (** Generalized l-values *)
+(** Generalized l-values *)
+type lvalue =
| Eval of exp
| Tval of term
| Assigned of stmt
diff --git a/src/plugins/wp/Letify.ml b/src/plugins/wp/Letify.ml
index 7e63ed5192fa04ff8fca8f9113c122c7ac0d9b86..27e8e435d685cd3ac66257d2279a93608ad0aa8a 100644
--- a/src/plugins/wp/Letify.ml
+++ b/src/plugins/wp/Letify.ml
@@ -311,7 +311,7 @@ struct
| Imply ([la;lb],c) ->
begin match F.repr c with
| Eq _ ->
- let order = 0 in (** todo get the order from term *)
+ let order = 0 in (* todo get the order from term *)
begin match F.repr la, F.repr lb with
| Leq(a,b), Leq(c,d) ->
begin
@@ -367,7 +367,7 @@ struct
if Integer.lt cstb i then sigma
else begin
let eq = F.QED.e_apply p [e_zint i] in
- (** qed should be able to simplify it directly *)
+ (* qed should be able to simplify it directly *)
let sigma = add_pred sigma eq in
aux sigma (Integer.succ i)
end
diff --git a/src/plugins/wp/LogicCompiler.ml b/src/plugins/wp/LogicCompiler.ml
index 1aa822d26e27495c1f887205210d853d272b3bd7..1d5296b4466b6825cbcf385b2f89f27a9951b024 100644
--- a/src/plugins/wp/LogicCompiler.ml
+++ b/src/plugins/wp/LogicCompiler.ml
@@ -938,9 +938,9 @@ struct
try Logic_var.Map.find x env.vars
with Not_found ->
try
- (** It is here because currently the application of a function
- of arity 0 are represented in the AST as a variable not
- as an application of the function with no arguments *)
+ (* It is here because currently the application of a function
+ of arity 0 are represented in the AST as a variable not
+ as an application of the function with no arguments *)
let cst = Logic_env.find_logic_cons x in
let result = Lang.tau_of_ltype x.lv_type in
let v =
diff --git a/src/plugins/wp/Matrix.mli b/src/plugins/wp/Matrix.mli
index 37e81b2adfeed514f2283cf8f6170e6a2a22e10d..8da26bab4b4c5c7b4248a49bf499ee871b3aba76 100644
--- a/src/plugins/wp/Matrix.mli
+++ b/src/plugins/wp/Matrix.mli
@@ -46,8 +46,13 @@ type env = {
length : term option ; (** number of cells (None is infinite) *)
}
-val cc_tau : tau -> t -> tau (** Type of matrix *)
-val cc_env : t -> env (** Dimension environment *)
-val cc_dims : int option list -> term list (** Value of size variables *)
+val cc_tau : tau -> t -> tau
+(** Type of matrix *)
+
+val cc_env : t -> env
+(** Dimension environment *)
+
+val cc_dims : int option list -> term list
+(** Value of size variables *)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/wp/MemMemory.mli b/src/plugins/wp/MemMemory.mli
index d164a101ca27a0170d23c662a5f0f0d36a26e4cc..8012487657993aa17a71bcf06cd73fbe41e99ef5 100644
--- a/src/plugins/wp/MemMemory.mli
+++ b/src/plugins/wp/MemMemory.mli
@@ -31,15 +31,26 @@ open Lang.F
val t_addr : tau
val t_malloc : tau (** allocation tables *)
+
val t_init : tau (** initialization tables *)
+
val t_mem : tau -> tau (** t_addr indexed array *)
val a_null : term (** Null address. Same as [a_addr 0 0] *)
+
val a_global : term -> term (** Zero-offset base. Same as [a_addr base 0] *)
+
val a_addr : term -> term -> term (** Constructor for [{ base ; offset }] *)
-val a_shift : term -> term -> term (** Shift: [a_shift a k] adds [k] to [a.offset] *)
-val a_base : term -> term (** Returns the base *)
-val a_offset : term -> term (** Returns the offset *)
+
+val a_shift : term -> term -> term
+(** Shift: [a_shift a k] adds [k] to [a.offset] *)
+
+val a_base : term -> term
+(** Returns the base *)
+
+val a_offset : term -> term
+(** Returns the offset *)
+
val a_base_offset : term -> term -> term
(** Returns the offset in {i bytes} from the {i logic} offset
(which is a memory cell index, actually) *)
@@ -52,7 +63,9 @@ val f_offset : lfun
val f_havoc : lfun
val f_set_init : lfun
val f_region : lfun
+
val f_addr_of_int : lfun (** Physical address *)
+
val f_int_of_addr : lfun (** Physical address *)
val p_addr_lt : lfun
diff --git a/src/plugins/wp/MemTyped.ml b/src/plugins/wp/MemTyped.ml
index 50a414265a5c5538e3659b30fba7ca427a996905..0bee9720d0670116e6b1f4e2fe5a63f7a0b75d61 100644
--- a/src/plugins/wp/MemTyped.ml
+++ b/src/plugins/wp/MemTyped.ml
@@ -475,7 +475,7 @@ module STRING = WpContext.Generator(LITERAL)
}
let sconst prefix base cst =
- (** describe the content of literal strings *)
+ (* describe the content of literal strings *)
let name = prefix ^ "_literal" in
let i = Lang.freshvar ~basename:"i" L.Int in
let c = Cstring.char_at cst (e_var i) in
diff --git a/src/plugins/wp/MemVal.ml b/src/plugins/wp/MemVal.ml
index 77fa59fa0149adce4c2bbe383faaa219166d48f0..aeecf7e84820410826c9442ad442f23a165461ed 100644
--- a/src/plugins/wp/MemVal.ml
+++ b/src/plugins/wp/MemVal.ml
@@ -747,7 +747,7 @@ struct
let initialized _sigma _l = F.p_true (* todo *)
let is_well_formed _ = F.p_true (* todo *)
- let base_offset _loc = assert false (** TODO *)
+ let base_offset _loc = assert false (* TODO *)
type domain = Sigma.domain
let no_binder = { bind = fun _ f v -> f v }
let configure_ia _ = no_binder (* todo *)
diff --git a/src/plugins/wp/MemVal.mli b/src/plugins/wp/MemVal.mli
index e7d666cdb9e50c365dce9dd8053e28584166598f..b784252cbe3643c060e000e925755586c9986683 100644
--- a/src/plugins/wp/MemVal.mli
+++ b/src/plugins/wp/MemVal.mli
@@ -24,15 +24,18 @@ open Lang.F
module type State =
sig
- type t (** abstract state **)
+ (** abstract state **)
+ type t
val bottom : t
val join : t -> t -> t
val of_kinstr : Cil_types.kinstr -> t
(** [of_stmt stmt] get the abstract state of [stmt]. **)
+
val of_stmt : Cil_types.stmt -> t
(** [of_kf kf] get the join state of all [kf]'s statements states **)
+
val of_kf : Cil_types.kernel_function -> t
val pretty : Format.formatter -> t -> unit
@@ -45,23 +48,28 @@ sig
module State : State
- type t (** abstract value **)
+ (** abstract value **)
+ type t
type state = State.t
val null : t
+
(** [literal eid cstr] returns the pair of base identifier and abstract value
corresponding to the concrete string constant [cstr] of unique expression
identifier [eid]. [eid] should be a valid identifier for [cstr]. **)
val literal: eid:int -> Cstring.cst -> int * t
+
(** [cvar x] returns the abstract value corresponding to &[x]. **)
val cvar : Cil_types.varinfo -> t
(** [field v fd] returns the value obtained by access to field [fd]
from [v]. **)
val field : t -> Cil_types.fieldinfo -> t
+
(** [shift v obj k] returns the value obtained by access at an index [k]
with type [obj] from [v]. **)
val shift : t -> Ctypes.c_object -> term -> t
+
(** [base_addr v] returns the value corresponding to the base address
of [v]. **)
val base_addr : t -> t
@@ -72,6 +80,7 @@ sig
(** [domain v] returns a list of all possible concrete bases of [v]. **)
val domain : t -> Base.t list
+
(** [offset v] returns a function which when applied with a term returns
a predicate over [v]'s offset. *)
val offset : t -> (term -> pred)
diff --git a/src/plugins/wp/Pcfg.mli b/src/plugins/wp/Pcfg.mli
index 0c5ab9d6976323cdaa607add692e115002297963..cdc54843445e5ecd5cfea6dcbeef867d8562718c 100644
--- a/src/plugins/wp/Pcfg.mli
+++ b/src/plugins/wp/Pcfg.mli
@@ -56,10 +56,16 @@ class virtual engine :
method pp_ofs : Format.formatter -> s_offset -> unit
method pp_offset : Format.formatter -> s_offset list -> unit
+
method pp_host : Format.formatter -> s_host -> unit (** current state *)
+
method pp_lval : Format.formatter -> s_lval -> unit (** current state *)
+
method pp_init : Format.formatter -> s_lval -> unit (** current state *)
+
method pp_addr : Format.formatter -> s_lval -> unit
+
method pp_label : Format.formatter -> label -> unit (** label name *)
+
method pp_chunk : Format.formatter -> string -> unit (** chunk name *)
end
diff --git a/src/plugins/wp/Pcond.mli b/src/plugins/wp/Pcond.mli
index 51f6b075290647b823a4b173bf575e15552aa83a..9ca6d2a5b56a63988381e2a953d015f165f6547c 100644
--- a/src/plugins/wp/Pcond.mli
+++ b/src/plugins/wp/Pcond.mli
@@ -51,15 +51,32 @@ class engine : #Plang.engine ->
object
(** {2 Printer Components} *)
- method name : env -> term -> string (** Generate a name for marked term *)
- method mark : marks -> step -> unit (** Marks terms to share in step *)
- method pp_clause : string printer (** Default: ["@{<wp:clause>...}"] *)
- method pp_stmt : string printer (** Default: ["@{<wp:stmt>...}"] *)
- method pp_comment : string printer (** Default: ["@{<wp:comment>(* ... *)}"] *)
- method pp_property : Property.t printer (** Default: ["@{<wp:property>(* ... *)}"] *)
- method pp_warning : Warning.t printer (** Default: ["@{<wp:warning>Warning}..."] *)
- method pp_name : string printer (** Default: [Format.pp_print_string] *)
- method pp_core : term printer (** Default: [plang#pp_sort] *)
+ method name : env -> term -> string
+ (** Generate a name for marked term *)
+
+ method mark : marks -> step -> unit
+ (** Marks terms to share in step *)
+
+ method pp_clause : string printer
+ (** Default: ["@{<wp:clause>...}"] *)
+
+ method pp_stmt : string printer
+ (** Default: ["@{<wp:stmt>...}"] *)
+
+ method pp_comment : string printer
+ (** Default: ["@{<wp:comment>(* ... *)}"] *)
+
+ method pp_property : Property.t printer
+ (** Default: ["@{<wp:property>(* ... *)}"] *)
+
+ method pp_warning : Warning.t printer
+ (** Default: ["@{<wp:warning>Warning}..."] *)
+
+ method pp_name : string printer
+ (** Default: [Format.pp_print_string] *)
+
+ method pp_core : term printer
+ (** Default: [plang#pp_sort] *)
method pp_definition : Format.formatter -> string -> term -> unit
method pp_intro : step:step -> clause:string -> ?dot:string -> pred printer
@@ -96,7 +113,9 @@ class state :
inherit Pcfg.engine
method clear : unit
method set_sequence : Conditions.sequence -> unit
- method set_domain : Vars.t -> unit (** Default is sequence's domain *)
+ method set_domain : Vars.t -> unit
+ (** Default is sequence's domain *)
+
method domain : Vars.t
method label_at : id:int -> Pcfg.label
method updates : Pcfg.label Sigs.sequence -> Sigs.update Bag.t
@@ -110,12 +129,16 @@ class seqengine : #state ->
inherit engine
method set_sequence : Conditions.sequence -> unit
(** Initialize state with this sequence *)
+
method set_goal : pred -> unit
(** Adds goal to state domain *)
+
method set_sequent : sequent -> unit
(** Set sequence and goal *)
+
method get_state : bool
(** If [true], states are rendered when printing sequences. *)
+
method set_state : bool -> unit
(** If set to [false], states rendering is deactivated. *)
end
diff --git a/src/plugins/wp/ProofEngine.mli b/src/plugins/wp/ProofEngine.mli
index 544351477bd39504505a8d891c214ab3c9ff74a5..e64e6f3234b74e5d428e69eedd951199b1d46c91 100644
--- a/src/plugins/wp/ProofEngine.mli
+++ b/src/plugins/wp/ProofEngine.mli
@@ -24,8 +24,11 @@
(** Interactive Proof Engine *)
(* -------------------------------------------------------------------------- *)
-type tree (** A proof tree *)
-type node (** A proof node *)
+(** A proof tree *)
+type tree
+
+(** A proof node *)
+type node
val get : Wpo.t -> [ `Script | `Proof | `Saved | `None ]
val proof : main:Wpo.t -> tree
@@ -63,7 +66,9 @@ val node_context : node -> WpContext.t
val title : node -> string
val proved : node -> bool
-val pending : node -> int (** 0 means proved *)
+val pending : node -> int
+(** 0 means proved *)
+
val parent : node -> node option
val children : node -> (string * node) list
val tactical : node -> ProofScript.jtactic option
diff --git a/src/plugins/wp/ProofScript.mli b/src/plugins/wp/ProofScript.mli
index 01a305471aca4423ee3ce570a5227a65542ca94b..9393a2efc371cd28be929c5f9ae25353edad81ab 100644
--- a/src/plugins/wp/ProofScript.mli
+++ b/src/plugins/wp/ProofScript.mli
@@ -42,9 +42,15 @@ val is_tactic : alternative -> bool
val a_prover : VCS.prover -> VCS.result -> alternative
val a_tactic : jtactic -> (string * jscript) list -> alternative
-val pending : alternative -> int (** pending goals *)
-val pending_any : jscript -> int (** minimum of pending goals *)
-val has_proof : jscript -> bool (** Has a tactical alternative *)
+val pending : alternative -> int
+(** pending goals *)
+
+val pending_any : jscript -> int
+(** minimum of pending goals *)
+
+val has_proof : jscript -> bool
+(** Has a tactical alternative *)
+
val decode : Json.t -> jscript
val encode : jscript -> Json.t
diff --git a/src/plugins/wp/ProverScript.mli b/src/plugins/wp/ProverScript.mli
index de3880d615b59aa944cb521ec57c195ea5f951c7..69e8f3c954307f753f8dd00f09ec1b3efc145482 100644
--- a/src/plugins/wp/ProverScript.mli
+++ b/src/plugins/wp/ProverScript.mli
@@ -22,14 +22,22 @@
open VCS
+(** - [valid]: Play provers with valid result (default: true)
+ - [failed]: Play provers with invalid result (default: true)
+ - [provers]: Additional list of provers to {i try} when stuck
+ - [depth]: Strategy search depth (default: 0)
+ - [width]: Strategy search width (default: 0)
+ - [backtrack]: Strategy backtracking (default: 0)
+ - [auto]: Strategies to try (default: none)
+*)
type 'a process =
- ?valid:bool -> (** Play provers with valid result (default: true) *)
- ?failed:bool -> (** Play provers with invalid result (default: true) *)
- ?provers:prover list -> (** Additional list of provers to {i try} when stuck *)
- ?depth:int -> (** Strategy search depth (default: 0) *)
- ?width:int -> (** Strategy search width (default: 0) *)
- ?backtrack:int -> (** Strategy backtracking (default: 0) *)
- ?auto:Strategy.heuristic list -> (** Strategies to try (default: none) *)
+ ?valid:bool ->
+ ?failed:bool ->
+ ?provers:prover list ->
+ ?depth:int ->
+ ?width:int ->
+ ?backtrack:int ->
+ ?auto:Strategy.heuristic list ->
?start:(Wpo.t -> unit) ->
?progress:(Wpo.t -> string -> unit) ->
?result:(Wpo.t -> prover -> result -> unit) ->
diff --git a/src/plugins/wp/ProverTask.mli b/src/plugins/wp/ProverTask.mli
index 9bbf616916535843d903d89ea27a0fb848685516..3aadf0968070cd7f8bd3e7a147337010ce52e91d 100644
--- a/src/plugins/wp/ProverTask.mli
+++ b/src/plugins/wp/ProverTask.mli
@@ -41,16 +41,26 @@ class type pattern =
method get_after : ?offset:int -> int -> string
(** [get_after ~offset:p k] returns the end of the message
starting [p] characters after the end of group [k]. *)
+
method get_string : int -> string
method get_int : int -> int
method get_float : int -> float
end
-val p_group : string -> string (** Put pattern in group [\(p\)] *)
-val p_int : string (** Int group pattern [\([0-9]+\)] *)
-val p_float : string (** Float group pattern [\([0-9.]+\)] *)
-val p_string : string (** String group pattern ["\(...\)"] *)
-val p_until_space : string (** No space group pattern "\\([^ \t\n]*\\)" *)
+val p_group : string -> string
+(** Put pattern in group [\(p\)] *)
+
+val p_int : string
+(** Int group pattern [\([0-9]+\)] *)
+
+val p_float : string
+(** Float group pattern [\([0-9.]+\)] *)
+
+val p_string : string
+(** String group pattern ["\(...\)"] *)
+
+val p_until_space : string
+(** No space group pattern "\\([^ \t\n]*\\)" *)
val location : string -> int -> Lexing.position
@@ -85,7 +95,6 @@ val spawn :
?pool:Task.pool ->
all:bool -> smoke:bool ->
('a * bool Task.task) list -> unit
-
(** Spawn all the tasks over the server and retain the first 'validated' one.
The callback [monitor] is called with [Some] at first success, and [None]
if none succeed. An option [pool] task can be passed to register
diff --git a/src/plugins/wp/ProverWhy3.ml b/src/plugins/wp/ProverWhy3.ml
index 72fc49e17cb073adcb0e0303ee6af51aa3404b94..44ab3d0f7f41c3a5b67289e40192f687657f0ffe 100644
--- a/src/plugins/wp/ProverWhy3.ml
+++ b/src/plugins/wp/ProverWhy3.ml
@@ -114,7 +114,7 @@ let t_app' ~cnv ~f ~l ~p tl ty =
(** fold map list of at least one element *)
let fold_map map fold = function
- | [] -> assert false (** absurd: forbidden by qed *)
+ | [] -> assert false (* absurd: forbidden by qed *)
| a::tl ->
List.fold_left (fun acc a -> fold acc (map a)) (map a) tl
@@ -317,7 +317,7 @@ let rec full_triggers = function
let rec of_trigger ~cnv t =
match t with
- | Qed.Engine.TgAny -> assert false (** absurd: filter by full_triggers *)
+ | Qed.Engine.TgAny -> assert false (* absurd: filter by full_triggers *)
| Qed.Engine.TgVar v -> begin
try Lang.F.Tmap.find (Lang.F.e_var v) cnv.subst
with Not_found -> why3_failure "Unbound variable %a" Lang.F.pp_var v
@@ -486,7 +486,7 @@ let rec of_term ~cnv expected t : Why3.Term.term =
let mtau = Lang.F.typeof m in
let ksort = match mtau with
| Array(ksort,_) -> ksort
- | _ -> assert false (** absurd: by qed typing *)in
+ | _ -> assert false (* absurd: by qed typing *)in
t_app ~cnv ~f:["map"] ~l:"Map" ~p:["get"] [of_term ~cnv mtau m;of_term ~cnv ksort k]
end
| Aset(m,k,v), Array(ksort,vsort), _ ->
@@ -603,7 +603,7 @@ let rec of_term ~cnv expected t : Why3.Term.term =
| (False, _, (Int|Real|Tvar _|Array (_, _)|Record _|Data (_, _)))
| (True, _, (Int|Real|Tvar _|Array (_, _)|Record _|Data (_, _)))
| (Acst (_, _), (Prop|Bool|Int|Real|Tvar _|Record _|Data (_, _)), _)
- -> assert false (** absurd: by typing *)
+ -> assert false (* absurd: by typing *)
| (Bind (Lambda, _, _), _, _)
| Apply _ , _, _
| Rdef _, Record _, _ ->
@@ -672,7 +672,7 @@ and int_or_real ~cnv ~fint ~lint ~pint ~freal ~lreal ~preal a b =
| _ -> assert false
let convert cnv expected t =
- (** rewrite terms which normal form inside qed are different from the one of the provers *)
+ (* rewrite terms which normal form inside qed are different from the one of the provers *)
let t, convert_for_export = Lang.For_export.rebuild ~cache:cnv.convert_for_export t in
cnv.convert_for_export <- convert_for_export;
Lang.For_export.in_state (share cnv expected) t
diff --git a/src/plugins/wp/RefUsage.ml b/src/plugins/wp/RefUsage.ml
index aba320386be55c760015f14251f26179ebe80ab6..44d7b51f4bbab76f747ce6ada0af767ccdb6d492 100644
--- a/src/plugins/wp/RefUsage.ml
+++ b/src/plugins/wp/RefUsage.ml
@@ -276,22 +276,22 @@ module LFset = Qed.Mergeset.Make(Logic_info)
type global_ctx = {
- (** Variable accesses from C code and code annotations *)
mutable code : value ;
+ (** Variable accesses from C code and code annotations *)
- (** Accesses of formal variables from function specs *)
mutable spec_formals : value ;
+ (** Accesses of formal variables from function specs *)
- (** Accesses of global variables from function specs *)
mutable spec_globals : value ;
+ (** Accesses of global variables from function specs *)
+ mutable cphi : (model list list) KFmap.t ;
(** A map to a list (since a same kf can be called more than ones)
to a list of models for each arg_exp of the call to the kf. *)
- mutable cphi : (model list list) KFmap.t ;
+ mutable lphi : LFset.t ;
(** Logical function/predicate used directly and indirectly by
specs/annots of a C function *)
- mutable lphi : LFset.t ;
}
let mk_global_ctx () =
{ code = E.bot ; spec_formals = E.bot ; spec_globals = E.bot ;
diff --git a/src/plugins/wp/Sigma.ml b/src/plugins/wp/Sigma.ml
index 0d685e1bf9cd27527974e292d1daa7a43ac0b3ef..507e0cb80a17f3c556d029aa0d878e0bb9a046b3 100644
--- a/src/plugins/wp/Sigma.ml
+++ b/src/plugins/wp/Sigma.ml
@@ -67,27 +67,27 @@ struct
| Unused
let merge_list l =
- (** Get a map of the chunks (the data is not important) *)
+ (* Get a map of the chunks (the data is not important) *)
let union = List.fold_left (fun acc e -> H.Map.union (fun _ v1 _ -> v1) acc e.map) H.Map.empty l in
- (** The goal is to build a matrix chunk -> elt of the list -> Used/Unused
+ (* The goal is to build a matrix chunk -> elt of the list -> Used/Unused
*)
- (** Set the data of the map to []. *)
+ (* Set the data of the map to []. *)
let union = H.Map.map (fun _ -> []) union in
- (** For each elements of the list tell if each chunk is used *)
+ (* For each elements of the list tell if each chunk is used *)
let merge _ m e =
match m, e with
| Some m, Some e -> Some (Used e::m)
| Some m, None -> Some (Unused::m)
| None, _ -> assert false in
let union = List.fold_left (fun acc e -> H.Map.merge merge acc e.map) union
- (** important so that the list in the map are in the correct order *)
+ (* important so that the list in the map are in the correct order *)
(List.rev l) in
- (** Build the passive for each element of the list, and the final domain *)
+ (* Build the passive for each element of the list, and the final domain *)
let p = ref (List.map (fun _ -> Passive.empty) l) in
let map c l =
match List.filter (fun x -> not (Unused = x)) l with
| [] -> assert false
- (** If all the sigmas use the same variable *)
+ (* If all the sigmas use the same variable *)
| (Used a)::l when List.for_all (function | Unused -> true | Used x -> Var.equal x a) l ->
a
| _ ->
@@ -177,7 +177,7 @@ struct
match u,v with
| Some x , Some y -> not (Var.equal x y)
| None , Some _ -> true
- | Some _ , None -> false (** no need to create a new so it is the same *)
+ | Some _ , None -> false (* no need to create a new so it is the same *)
| None, None -> assert false
in
if written then effect := Chunk.Set.add chunk !effect
diff --git a/src/plugins/wp/Sigs.mli b/src/plugins/wp/Sigs.mli
index 5d362ba513126f022329b226cca4cbc0d09d05da..075deeb6ff482eda71a3e1118f470ecff510922d 100644
--- a/src/plugins/wp/Sigs.mli
+++ b/src/plugins/wp/Sigs.mli
@@ -145,7 +145,9 @@ module type Chunk =
sig
type t
- val self : string (** Chunk names, for pretty-printing. *)
+ val self : string
+ (** Chunk names, for pretty-printing. *)
+
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
@@ -175,7 +177,9 @@ end
module type Sigma =
sig
- type chunk (** The type of memory chunks. *)
+ type chunk
+ (** The type of memory chunks. *)
+
module Chunk : Qed.Collection.S with type t = chunk
(** Memory footprint. *)
@@ -194,11 +198,17 @@ sig
val pretty : Format.formatter -> t -> unit
(** For debugging purpose *)
- val create : unit -> t (** Initially empty environment. *)
+ val create : unit -> t
+ (** Initially empty environment. *)
+
+ val mem : t -> chunk -> bool
+ (** Whether a chunk has been assigned. *)
- val mem : t -> chunk -> bool (** Whether a chunk has been assigned. *)
- val get : t -> chunk -> var (** Lazily get the variable for a chunk. *)
- val value : t -> chunk -> term (** Same as [Lang.F.e_var] of [get]. *)
+ val get : t -> chunk -> var
+ (** Lazily get the variable for a chunk. *)
+
+ val value : t -> chunk -> term
+ (** Same as [Lang.F.e_var] of [get]. *)
val copy : t -> t (** Duplicate the environment. Fresh chunks in the copy
are {i not} duplicated into the source environment. *)
@@ -265,8 +275,11 @@ sig
(** Footprint of a memory environment.
That is, the set of accessed chunks so far in the environment. *)
- val union : domain -> domain -> domain (** Same as [Chunk.Set.union] *)
- val empty : domain (** Same as [Chunk.Set.empty] *)
+ val union : domain -> domain -> domain
+ (** Same as [Chunk.Set.union] *)
+
+ val empty : domain
+ (** Same as [Chunk.Set.empty] *)
val writes : t sequence -> domain
(** [writes s] indicates which chunks are new in [s.post] compared
diff --git a/src/plugins/wp/StmtSemantics.ml b/src/plugins/wp/StmtSemantics.ml
index bdef7e39bacdb888fdabdf020c480a06b5a45801..89f1ef2aa32acc251e75a1d9325a3a58f57c4118 100644
--- a/src/plugins/wp/StmtSemantics.ml
+++ b/src/plugins/wp/StmtSemantics.ml
@@ -288,7 +288,7 @@ struct
let here = LabelMap.find Clabels.here lsigmas in
let lenv = L.mk_env ~here () in
let pred = L.in_frame frame (L.pred polarity lenv) p in
- (** Remove the sigmas not used for the compilation, but here must stay *)
+ (* Remove the sigmas not used for the compilation, but here must stay *)
let nsigmas = Cfg.Node.Map.filter (fun _ s ->
s == here || not (Sigma.Chunk.Set.is_empty (Sigma.domain s))
) nsigmas
@@ -456,7 +456,7 @@ struct
assume,
sequence
(fun env ip ->
- (** TODO: Kglobal is it always Kglobal ? *)
+ (* TODO: Kglobal is it always Kglobal ? *)
let prop_id = WpPropId.mk_pre_id env.kf Kglobal b ip in
pre_cond env ip prop_id)
(env @* [Clabels.next, nrequires]) b.b_requires
@@ -666,9 +666,9 @@ struct
let init ~is_pre_main env =
let ninit = (env @: Clabels.init) in
let sinit = Sigma.create () in
- (** todo Globals.is_entry_point kf, need to test that seq.pre is the
+ (* todo Globals.is_entry_point kf, need to test that seq.pre is the
start of the function *)
- (** todo warning *)
+ (* todo warning *)
let cfg_init = Globals.Vars.fold_in_file_order
(fun var initinfo cfg ->
if var.vstorage = Extern then cfg else
diff --git a/src/plugins/wp/StmtSemantics.mli b/src/plugins/wp/StmtSemantics.mli
index ddf058fa2e0df3a665059fe0dc4b3f49b571cb0a..70a0d9ba6ee33ddd2b67f4d3bb5a3b0b015d7bb3 100644
--- a/src/plugins/wp/StmtSemantics.mli
+++ b/src/plugins/wp/StmtSemantics.mli
@@ -52,8 +52,12 @@ sig
val result : env -> Lang.F.var
- val (@^) : paths -> paths -> paths (** Same as [Cfg.concat] *)
- val (@*) : env -> ( c_label * node ) list -> env (** fold bind *)
+ val (@^) : paths -> paths -> paths
+ (** Same as [Cfg.concat] *)
+
+ val (@*) : env -> ( c_label * node ) list -> env
+ (** fold bind *)
+
val (@:) : env -> c_label -> node
(** LabelMap.find with refined excpetion.
@raise LabelNotFound instead of [Not_found] *)
diff --git a/src/plugins/wp/Tactical.mli b/src/plugins/wp/Tactical.mli
index a03e1f3d644ade2f0941957a1ea11be9e1b305a4..27089dbe4e417449aae31799f1bb16fdbd32542c 100644
--- a/src/plugins/wp/Tactical.mli
+++ b/src/plugins/wp/Tactical.mli
@@ -77,7 +77,9 @@ module Fmap :
sig
type t
val create : unit -> t
- val get : t -> 'a field -> 'a (** raises Not_found if absent *)
+ val get : t -> 'a field -> 'a
+ (** raises Not_found if absent *)
+
val set : t -> 'a field -> 'a -> unit
end
@@ -249,7 +251,9 @@ class type composer =
type t = tactical
val register : #tactical -> unit
-val export : #tactical -> tactical (** Register and returns the tactical *)
+val export : #tactical -> tactical
+(** Register and returns the tactical *)
+
val lookup : id:string -> tactical
val iter : (tactical -> unit) -> unit
diff --git a/src/plugins/wp/VC.mli b/src/plugins/wp/VC.mli
index 89b0c555ea6c1c015446a0c5dc8543797f2b5d82..60140062de2e61534c7560dcdd97c83f66f38bd7 100644
--- a/src/plugins/wp/VC.mli
+++ b/src/plugins/wp/VC.mli
@@ -38,8 +38,12 @@ val get_description : t -> string
val get_property : t -> Property.t
val get_result : t -> prover -> result
val get_results : t -> (prover * result) list
-val get_logout : t -> prover -> string (** only file name, might not exists *)
-val get_logerr : t -> prover -> string (** only file name, might not exists *)
+val get_logout : t -> prover -> string
+(** only file name, might not exists *)
+
+val get_logerr : t -> prover -> string
+(** only file name, might not exists *)
+
val get_sequent : t -> Conditions.sequent
val get_formula: t -> Lang.F.pred
val is_trivial : t -> bool
diff --git a/src/plugins/wp/VCS.mli b/src/plugins/wp/VCS.mli
index fb3f4bb4fac7d16fd0ff905655a3c77ba3de0810..99a4c9eaaed0d172df50af8bb284070bbd6b869f 100644
--- a/src/plugins/wp/VCS.mli
+++ b/src/plugins/wp/VCS.mli
@@ -67,6 +67,7 @@ type config = {
}
val current : unit -> config (** Current parameters *)
+
val default : config (** all None *)
val get_timeout : ?kf:Kernel_function.t -> smoke:bool -> config -> int
@@ -126,6 +127,7 @@ val pp_result_qualif : ?updating:bool -> prover -> result ->
Format.formatter -> unit
val compare : result -> result -> int (* best is minimal *)
+
val merge : result -> result -> result
val choose : result -> result -> result
val best : result list -> result
diff --git a/src/plugins/wp/cfgCalculus.ml b/src/plugins/wp/cfgCalculus.ml
index 9539d4f1f879a53346423fadf7519ab921133690..88e7586d15dd316fc78877df5dd42929f16ce9ba 100644
--- a/src/plugins/wp/cfgCalculus.ml
+++ b/src/plugins/wp/cfgCalculus.ml
@@ -372,7 +372,7 @@ struct
else w_call
in
let callee_t =
- (** TODO when kernel terminates complete: remove this code. *)
+ (* TODO when kernel terminates complete: remove this code. *)
let generated, callee_t = c.contract_terminates in
if generated && env.terminates <> None then
Wp_parameters.warning ~once:true
diff --git a/src/plugins/wp/cfgInfos.ml b/src/plugins/wp/cfgInfos.ml
index aac7e6d857e5c7575ae20ff883b0f0fce9ec0800..41d92ef3416dd5b18a2a087f38dffb4da401b797 100644
--- a/src/plugins/wp/cfgInfos.ml
+++ b/src/plugins/wp/cfgInfos.ml
@@ -193,6 +193,7 @@ module Callees = WpContext.StaticGenerator(Kernel_function)
type key = Kernel_function.t
type data = Fset.t * Cil_types.stmt list
(** functions + unspecified function pointer calls *)
+
let name = "Wp.CfgInfos.SCallees"
let compile = function
| { Cil_types.fundec = Definition(fd, _ ) } as kf ->
diff --git a/src/plugins/wp/ctypes.mli b/src/plugins/wp/ctypes.mli
index 88dddf51663154b38702809547fd7ebb020a9fbe..559768c449dd3041f13f98809fc657779f1dc6e7 100644
--- a/src/plugins/wp/ctypes.mli
+++ b/src/plugins/wp/ctypes.mli
@@ -82,12 +82,21 @@ val f_memo : (c_float -> 'a) -> c_float -> 'a
(** memoized, not-projectified *)
val is_char : c_int -> bool
-val c_char : unit -> c_int (** Returns the type of [char] *)
-val c_bool : unit -> c_int (** Returns the type of [int] *)
-val c_ptr : unit -> c_int (** Returns the type of pointers *)
+val c_char : unit -> c_int
+(** Returns the type of [char] *)
+
+val c_bool : unit -> c_int
+(** Returns the type of [int] *)
+
+val c_ptr : unit -> c_int
+(** Returns the type of pointers *)
+
+val c_int : ikind -> c_int
+(** Conforms to {Cil.theMachine} *)
+
+val c_float : fkind -> c_float
+(** Conforms to {Cil.theMachine} *)
-val c_int : ikind -> c_int (** Conforms to {Cil.theMachine} *)
-val c_float : fkind -> c_float (** Conforms to {Cil.theMachine} *)
val object_of : typ -> c_object
val is_pointer : c_object -> bool
@@ -98,15 +107,29 @@ val constant : exp -> int64
val get_int : exp -> int option
val get_int64 : exp -> int64 option
-val signed : c_int -> bool (** [true] if signed *)
-val bounds: c_int -> Integer.t * Integer.t (** domain, bounds included *)
+val signed : c_int -> bool
+(** [true] if signed *)
+
+val bounds: c_int -> Integer.t * Integer.t
+(** domain, bounds included *)
+
+val i_bits : c_int -> int
+(** size in bits *)
-val i_bits : c_int -> int (** size in bits *)
-val i_bytes : c_int -> int (** size in bytes *)
-val f_bits : c_float -> int (** size in bits *)
-val f_bytes : c_float -> int (** size in bytes *)
-val p_bits : unit -> int (** pointer size in bits *)
-val p_bytes : unit -> int (** pointer size in bits *)
+val i_bytes : c_int -> int
+(** size in bytes *)
+
+val f_bits : c_float -> int
+(** size in bits *)
+
+val f_bytes : c_float -> int
+(** size in bytes *)
+
+val p_bits : unit -> int
+(** pointer size in bits *)
+
+val p_bytes : unit -> int
+(** pointer size in bits *)
val sub_c_int: c_int -> c_int -> bool
@@ -131,6 +154,7 @@ val array_size : arrayinfo -> int option
val array_dimensions : arrayinfo -> c_object * int option list
(** Returns the list of dimensions the array consists of.
None-dimension means undefined one. *)
+
val dimension_of_object : c_object -> (int * int64) option
(** Returns None for 1-dimension objects, and Some(d,N) for d-matrix with N cells *)
diff --git a/src/plugins/wp/filter_axioms.ml b/src/plugins/wp/filter_axioms.ml
index 0e8a3fce1fa5a91ee072b8722bf97ab39a897665..63346e653106a630a5e44894890654c780b8cc37 100644
--- a/src/plugins/wp/filter_axioms.ml
+++ b/src/plugins/wp/filter_axioms.ml
@@ -85,7 +85,7 @@ let meta_inline_in =
let t_unfold defs fs tl ty =
match Mls.find_opt fs defs with
| None ->
- assert false (** absurd: it is in mpr so it is in sls so added in defs *)
+ assert false (* absurd: it is in mpr so it is in sls so added in defs *)
| Some (vl,e) ->
let add (mt,mv) x y = Ty.ty_match mt x.vs_ty (t_type y), Mvs.add x y mv in
let (mt,mv) = List.fold_left2 add (Ty.Mtv.empty, Mvs.empty) vl tl in
@@ -102,7 +102,7 @@ let rec t_replace_all defs s t =
| _ -> t
let fold mpr sls d (defs, task) =
- (** replace *)
+ (* replace *)
let d = match d.d_node with
| Dprop (k,pr,f) ->
let s = Mpr.find_def Sls.empty pr mpr in
@@ -110,7 +110,7 @@ let fold mpr sls d (defs, task) =
else create_prop_decl k pr (t_replace_all defs s f)
| _ -> d
in
- (** add to defs if needed *)
+ (* add to defs if needed *)
match d.d_node with
| Dlogic [ls,ld] when Sls.mem ls sls ->
let vl,e = open_ls_defn ld in
diff --git a/src/plugins/wp/register.ml b/src/plugins/wp/register.ml
index 37197fd2a5acbc874e1edb1dd06a7a0b32458990..69f8a7c0d65e78534f2b1f5ca8393306ed3def5c 100644
--- a/src/plugins/wp/register.ml
+++ b/src/plugins/wp/register.ml
@@ -713,7 +713,7 @@ let cmdline_run () =
end ;
let bhv = Wp_parameters.Behaviors.get () in
let prop = Wp_parameters.Properties.get () in
- (** TODO entry point *)
+ (* TODO entry point *)
if Wp_parameters.has_dkey dkey_builtins then
begin
WpContext.on_context (model,WpContext.Global)
diff --git a/src/plugins/wp/tests/wp/stmtcompiler_test.ml b/src/plugins/wp/tests/wp/stmtcompiler_test.ml
index 0cc749a809c564c2bce0ef192377b3dbacd53066..fe54b94378ffabe4b984539937ef4537ef194dbb 100644
--- a/src/plugins/wp/tests/wp/stmtcompiler_test.ml
+++ b/src/plugins/wp/tests/wp/stmtcompiler_test.ml
@@ -86,7 +86,7 @@ let run () =
prove_sequent kf goal.Compiler.goal_prop sequent
in
- (** Test on real Cil functions *)
+ (* Test on real Cil functions *)
let _run_test model kf =
let context = model , WpContext.Kf kf in
WpContext.on_context context
diff --git a/src/plugins/wp/wpContext.mli b/src/plugins/wp/wpContext.mli
index c0c8ebe5c59d92a5ca3694aea621cae12ef0d3b7..183be6676ce1b20f3b2b2678a7fadeb7c07b84e5 100644
--- a/src/plugins/wp/wpContext.mli
+++ b/src/plugins/wp/wpContext.mli
@@ -113,10 +113,13 @@ sig
val remove : key -> unit
val define : key -> data -> unit
(** no redefinition ; circularity protected *)
+
val update : key -> data -> unit
(** set current value, with no protection *)
+
val memoize : (key -> data) -> key -> data
(** with circularity protection *)
+
val compile : (key -> data) -> key -> unit
(** with circularity protection *)
diff --git a/src/plugins/wp/wpPropId.ml b/src/plugins/wp/wpPropId.ml
index 6cfe1a111264208d5a3c3c3d82608fccb3ef747a..b11a73f320de7ae2c6d42da2e0ea491449ab13d0 100644
--- a/src/plugins/wp/wpPropId.ml
+++ b/src/plugins/wp/wpPropId.ml
@@ -374,7 +374,7 @@ struct
let call_string =
Uniquify_Stmt.unique_basename (caller_kf,callee_kf,stmt)
in
- (** remove name of callee kernel function given by get_ip *)
+ (* remove name of callee kernel function given by get_ip *)
let ip_string = get_ip pre in
let ip_string =
Option.value ~default:ip_string
diff --git a/src/plugins/wp/wpPropId.mli b/src/plugins/wp/wpPropId.mli
index 7b58664ae49ede446276ac24ceb95b5886a1da68..cae435d078622a181de3167ed4db1537a13b330e 100644
--- a/src/plugins/wp/wpPropId.mli
+++ b/src/plugins/wp/wpPropId.mli
@@ -78,16 +78,19 @@ val ident_names : string list -> string list
val prop_id_keys : prop_id -> string list * string list (* required , hints *)
-val get_propid : prop_id -> string (** Unique identifier of [prop_id] *)
-val pp_propid : Format.formatter -> prop_id -> unit (** Print unique id of [prop_id] *)
+(** Unique identifier of [prop_id] *)
+val get_propid : prop_id -> string
+
+(** Print unique id of [prop_id] *)
+val pp_propid : Format.formatter -> prop_id -> unit
val user_pred_names: toplevel_predicate -> string list
val user_bhv_names: Property.identified_property -> string list
val user_prop_names: Property.identified_property -> string list
-val are_selected_names: string list -> string list -> bool
+
(** [are_selected_names asked names] checks if [names] of a property are
selected according to [asked] names. *)
-
+val are_selected_names: string list -> string list -> bool
val pretty : Format.formatter -> prop_id -> unit
val pretty_context : Description.kf -> Format.formatter -> prop_id -> unit
diff --git a/src/plugins/wp/wp_parameters.mli b/src/plugins/wp/wp_parameters.mli
index e46a5ab90df74b122dd5ca291df37252e0bea7d0..c4fbeaac966bcba3fae7f3a0f2efebb772dc7fec 100644
--- a/src/plugins/wp/wp_parameters.mli
+++ b/src/plugins/wp/wp_parameters.mli
@@ -166,10 +166,12 @@ val get_output_dir : string -> Datatype.Filepath.t
val make_output_dir : string -> unit
(** {2 Debugging Categories} *)
+
val has_print_generated: unit -> bool
val print_generated: ?header:string -> string -> unit
(** print the given file if the debugging category
"print-generated" is set *)
+
val cat_print_generated: category
val protect : exn -> bool
diff --git a/src/plugins/wp/wpo.mli b/src/plugins/wp/wpo.mli
index 8e5d77e36866e983e5300b84da9bc5c2cbd66f4e..93ddc06982ba7dff8a5fa43395173c4c86f13676 100644
--- a/src/plugins/wp/wpo.mli
+++ b/src/plugins/wp/wpo.mli
@@ -130,8 +130,11 @@ val get_label : t -> string
val get_model : t -> WpContext.model
val get_scope : t -> WpContext.scope
val get_context : t -> WpContext.context
-val get_file_logout : t -> prover -> string (** only filename, might not exists *)
-val get_file_logerr : t -> prover -> string (** only filename, might not exists *)
+val get_file_logout : t -> prover -> string
+(** only filename, might not exists *)
+
+val get_file_logerr : t -> prover -> string
+(** only filename, might not exists *)
val get_files : t -> (string * string) list
@@ -144,8 +147,12 @@ val on_remove : (t -> unit) -> unit
val add : t -> unit
val age : t -> int (* generation *)
-val reduce : t -> bool (** tries simplification *)
-val resolve : t -> bool (** tries simplification and set result if valid *)
+val reduce : t -> bool
+(** tries simplification *)
+
+val resolve : t -> bool
+(** tries simplification and set result if valid *)
+
val set_result : t -> prover -> result -> unit
val clear_results : t -> unit
@@ -156,10 +163,18 @@ val get_result : t -> prover -> result
val get_results : t -> (prover * result) list
val get_proof : t -> [`Passed|`Failed|`Unknown] * Property.t
val get_target : t -> Property.t
-val is_trivial : t -> bool (** do not tries simplification, do not check prover results *)
-val is_proved : t -> bool (** do not tries simplification, check prover results *)
-val is_unknown : t -> bool (** at least one prover returns « Unknown » *)
-val is_passed : t -> bool (** proved, or unknown for smoke tests *)
+val is_trivial : t -> bool
+(** do not tries simplification, do not check prover results *)
+
+val is_proved : t -> bool
+(** do not tries simplification, check prover results *)
+
+val is_unknown : t -> bool
+(** at least one prover returns « Unknown » *)
+
+val is_passed : t -> bool
+(** proved, or unknown for smoke tests *)
+
val warnings : t -> Warning.t list
(** [true] if the result is valid. Dynamically exported.
@@ -220,13 +235,16 @@ class type generator =
object
method model : WpContext.model
(** Generate VCs for the given Property. *)
+
method compute_ip : Property.t -> t Bag.t
(** Generate VCs for call preconditions at the given statement. *)
+
method compute_call : stmt -> t Bag.t
(** Generate VCs for all functions
matching provided behaviors and property names.
For `~bhv` and `~prop` optional arguments,
default and empty list means {i all} properties. *)
+
method compute_main :
?fct:Wp_parameters.functions ->
?bhv:string list ->
diff --git a/tests/slicing/select_by_annot.ml b/tests/slicing/select_by_annot.ml
index 75508ce846022c06b09834bfe61bff5c0713672c..907f258bc0d565ba2f3570e5067d55a05534dd1e 100644
--- a/tests/slicing/select_by_annot.ml
+++ b/tests/slicing/select_by_annot.ml
@@ -33,8 +33,8 @@ let main _ =
Slicing.Api.Project.pretty Format.std_formatter;
extract_and_print ();
- (** create another slice for "main" to check if it also contains the previous
- * selection. *)
+ (* create another slice for "main" to check if it also contains the previous
+ * selection. *)
let ff = Slicing.Api.Slice.create kf_main in
let select = LibSelect.select_data "b" kf_main in