diff --git a/src/libraries/datatype/datatype.ml b/src/libraries/datatype/datatype.ml index 608c29405556b58b5cf223a792c00aca7838e3d1..f8d1cb4a6307f8cb41d5b69d1fcd249e8e34a600 100644 --- a/src/libraries/datatype/datatype.ml +++ b/src/libraries/datatype/datatype.ml @@ -602,8 +602,7 @@ module Pair_arg = struct let mk_hash f1 f2 (x1,x2) = f1 x1 + 1351 * f2 x2 let map f1 f2 (x1,x2) = f1 x1, f2 x2 let mk_pretty f1 f2 fmt (x1, x2) = - let pp fmt = Format.fprintf fmt "@[<hv 2>%a,@;%a@]" f1 x1 f2 x2 in - Type.par Type.Basic Type.Tuple fmt pp + Format.fprintf fmt "(@[<hv 2>%a,@;%a@])" f1 x1 f2 x2 let mk_mem_project mem1 mem2 f (x1, x2) = mem1 f x1 && mem2 f x2 end @@ -809,8 +808,7 @@ module Poly_ref = let mk_hash f x = f !x let map f x = ref (f !x) let mk_pretty f fmt x = - let pp fmt = Format.fprintf fmt "@[<hv 2>ref@;%a@]" f !x in - Type.par Type.Basic Type.Call fmt pp + Format.fprintf fmt "(@[<hv 2>ref@;%a@])" f !x let mk_mem_project mem f x = mem f !x end) @@ -864,10 +862,7 @@ module Poly_option = let mk_pretty f fmt = function | None -> Format.fprintf fmt "None" | Some x -> - let pp fmt = - Format.fprintf fmt "@[<hv 2>Some@;%a@]" f x - in - Type.par Type.Basic Type.Call fmt pp + Format.fprintf fmt "(@[<hv 2>Some@;%a@])" f x let mk_mem_project mem f = function None -> false | Some x -> mem f x end) @@ -929,17 +924,14 @@ module Poly_list = with Too_long n -> n let map = List.map let mk_pretty f fmt l = - let pp fmt = - Format.fprintf fmt "@[<hv 2>[ %t ]@]" - (fun fmt -> - let rec print fmt = function - | [] -> () - | [ x ] -> Format.fprintf fmt "%a" f x - | x :: l -> Format.fprintf fmt "%a;@;%a" f x print l - in - print fmt l) - in - Type.par Type.Basic Type.Basic fmt pp (* Never enclose lists in parentheses *) + Format.fprintf fmt "(@[<hv 2>[ %t ]@])" + (fun fmt -> + let rec print fmt = function + | [] -> () + | [ x ] -> Format.fprintf fmt "%a" f x + | x :: l -> Format.fprintf fmt "%a;@;%a" f x print l + in + print fmt l) let mk_mem_project mem f = List.exists (mem f) end) @@ -1011,18 +1003,15 @@ module Poly_array = ;; let map = Array.map let mk_pretty f fmt a = - let pp fmt = - Format.fprintf fmt "@[<hv 2>[| %t |]@]" - (fun fmt -> - let length = Array.length a in - match length with - | 0 -> () - | _ -> (Format.fprintf fmt "%a" f a.(0); - for i = 1 to (length - 1) do - Format.fprintf fmt ";@;%a" f a.(i) - done)) - in - Type.par Type.Basic Type.Basic fmt pp (* Never enclose arrays in parentheses *) + Format.fprintf fmt "(@[<hv 2>[| %t |]@])" + (fun fmt -> + let length = Array.length a in + match length with + | 0 -> () + | _ -> (Format.fprintf fmt "%a" f a.(0); + for i = 1 to (length - 1) do + Format.fprintf fmt ";@;%a" f a.(i) + done)) let mk_mem_project mem f a = try for i = 0 to (Array.length a - 1) do @@ -1683,10 +1672,7 @@ module Triple_arg = struct let mk_hash f1 f2 f3 (x1,x2,x3) = f1 x1 + 1351 * f2 x2 + 257 * f3 x3 let map f1 f2 f3 (x1,x2,x3) = f1 x1, f2 x2, f3 x3 let mk_pretty f1 f2 f3 fmt (x1, x2, x3) = - let pp fmt = - Format.fprintf fmt "@[<hv 2>%a,@;%a,@;%a@]" f1 x1 f2 x2 f3 x3 - in - Type.par Type.Basic Type.Tuple fmt pp + Format.fprintf fmt "(@[<hv 2>%a,@;%a,@;%a@])" f1 x1 f2 x2 f3 x3 let mk_mem_project mem1 mem2 mem3 f (x1, x2, x3) = mem1 f x1 && mem2 f x2 && mem3 f x3 end @@ -1779,10 +1765,7 @@ module Quadruple_arg = struct f1 x1 + 1351 * f2 x2 + 257 * f3 x3 + 997 * f4 x4 let map f1 f2 f3 f4 (x1,x2,x3,x4) = f1 x1, f2 x2, f3 x3, f4 x4 let mk_pretty f1 f2 f3 f4 fmt (x1, x2, x3, x4) = - let pp fmt = - Format.fprintf fmt "@[<hv 2>%a,@;%a,@;%a,@;%a@]" f1 x1 f2 x2 f3 x3 f4 x4 - in - Type.par Type.Basic Type.Tuple fmt pp + Format.fprintf fmt "(@[<hv 2>%a,@;%a,@;%a,@;%a@])" f1 x1 f2 x2 f3 x3 f4 x4 let mk_mem_project mem1 mem2 mem3 mem4 f (x1, x2, x3, x4) = mem1 f x1 && mem2 f x2 && mem3 f x3 && mem4 f x4 end diff --git a/src/libraries/datatype/type.ml b/src/libraries/datatype/type.ml index e3deb416ab0b988a8b1bc8703243820318c6588d..6be936feb266faa39f64d2132c00fec7108aa584 100644 --- a/src/libraries/datatype/type.ml +++ b/src/libraries/datatype/type.ml @@ -35,28 +35,6 @@ (* ****************************************************************************) (* ****************************************************************************) -(** Precedences used for generating the minimal number of parenthesis in - combination with function {!par} below. *) -type precedence = - | Basic - | Call - | Tuple - | List - | NoPar - -(* p1 <= p2 *) -let lower_prec p1 p2 = match p1, p2 with - | NoPar, _ - | _, Basic -> true - | x, y when x = y -> true - | List, (Tuple | Call) | Tuple, Call -> true - | _, _ -> false - -let par p_caller p_callee fmt pp = - (* if p_callee <= p_caller then parenthesis else no parenthesis *) - if lower_prec p_callee p_caller then Format.fprintf fmt "(%t)" pp - else Format.fprintf fmt "%t" pp - type concrete_repr = { mutable name: string; digest: Digest.t; diff --git a/src/libraries/datatype/type.mli b/src/libraries/datatype/type.mli index 022ea2caf3769ef8716d5851d67d1f20b15315c6..f01fedaa1cfbcac8957a995094bd2eee3a1f2971 100644 --- a/src/libraries/datatype/type.mli +++ b/src/libraries/datatype/type.mli @@ -42,35 +42,6 @@ type 'a ty = 'a t (** {2 Pretty printing materials} *) (* ****************************************************************************) -(** Precedences used for generating the minimal number of parenthesis in - combination with function {!par} below. *) -type precedence = - | Basic - (** Normal precedence - @see <https://frama-c.com/download/frama-c-plugin-development-guide.pdf> *) - | Call - (** Instantiation of polymorphic type - @see <https://frama-c.com/download/frama-c-plugin-development-guide.pdf> *) - | Tuple - | List - | NoPar - -(** [par context myself fmt pp] puts parenthesis around the verbatim - prints by [pp] according to the precedence [myself] of the verbatim and to - the precedence [context] of the caller of the pretty printer. [fmt] is the - output formatter. - - The typical use is the following: - [let pretty_print p_caller fmt x = - let pp fmt = Format.fprintf "..." ... x ... in - let myself = Call in - par p_caller myself fmt pp] - - @see <https://frama-c.com/download/frama-c-plugin-development-guide.pdf> *) -val par: - precedence -> precedence -> Format.formatter -> (Format.formatter -> unit) -> - unit - (** [par_ty_name f ty] puts parenthesis around the name of the [ty] iff [f ty] is [true]. @since Carbon-20101201 *) diff --git a/src/plugins/slicing/slicingTypes.ml b/src/plugins/slicing/slicingTypes.ml index 03c8c010ca6e5d6e70ad32035c4e6972cd2efd4d..21a39fd8eec8b08edd579a7bfad19d9c8409c427 100644 --- a/src/plugins/slicing/slicingTypes.ml +++ b/src/plugins/slicing/slicingTypes.ml @@ -75,13 +75,6 @@ type sl_fct_slice = SlicingInternals.fct_slice (** Marks : used to put 'colors' in the result *) type sl_mark = SlicingInternals.pdg_mark -let pp_sl_project p_caller fmt _p = - let pp fmt = - Format.fprintf fmt - "@[<hv 2>Extlib.the@;~exn:Db.Slicing.No_Project@;@[<hv 2>(!Db.Slicing.Project.get_project@;())@]@]" - in - Type.par p_caller Type.Call fmt pp - module Sl_project = Datatype.Make (struct @@ -105,16 +98,6 @@ module Sl_select = let mem_project = Datatype.never_any_project end) -let pp_sl_fct_slice p_caller fmt ff = - let pp fmt = - Format.fprintf fmt - "@[<hv 2>!Db.Slicing.Slice.from_num_id@;%a@;%d@]" - Kernel_function.pretty - ff.SlicingInternals.ff_fct.SlicingInternals.fi_kf - ff.SlicingInternals.ff_id - in - Type.par p_caller Type.Call fmt pp - module Sl_fct_slice = Datatype.Make (struct diff --git a/src/plugins/slicing/slicingTypes.mli b/src/plugins/slicing/slicingTypes.mli index bdaec9db4ad6cb5dda7ed419b6692ef9c8ee4450..f07bdbb5dfc3af5e5e03ae8c6099a09b6a13c281 100644 --- a/src/plugins/slicing/slicingTypes.mli +++ b/src/plugins/slicing/slicingTypes.mli @@ -63,15 +63,10 @@ type sl_fct_slice = SlicingInternals.fct_slice (** Marks : used to put 'colors' in the result *) type sl_mark = SlicingInternals.pdg_mark -val pp_sl_project : Type.precedence -> Format.formatter -> 'a -> unit - module Sl_project : Datatype.S with type t = sl_project module Sl_select : Datatype.S with type t = sl_select -val pp_sl_fct_slice : - Type.precedence -> Format.formatter -> SlicingInternals.fct_slice -> unit - module Sl_fct_slice : Datatype.S with type t = SlicingInternals.fct_slice val dyn_sl_fct_slice : Sl_fct_slice.t Type.t