From 3c4870f254eb90b2d11e7e45bf76eafa6fd8bfde Mon Sep 17 00:00:00 2001
From: Valentin Perrelle <valentin.perrelle@cea.fr>
Date: Wed, 29 Jan 2025 00:36:37 +0100
Subject: [PATCH] [kernel] remove Type.precedence
---
src/libraries/datatype/datatype.ml | 61 ++++++++++------------------
src/libraries/datatype/type.ml | 22 ----------
src/libraries/datatype/type.mli | 29 -------------
src/plugins/slicing/slicingTypes.ml | 17 --------
src/plugins/slicing/slicingTypes.mli | 5 ---
5 files changed, 22 insertions(+), 112 deletions(-)
diff --git a/src/libraries/datatype/datatype.ml b/src/libraries/datatype/datatype.ml
index 608c2940555..f8d1cb4a630 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 e3deb416ab0..6be936feb26 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 022ea2caf37..f01fedaa1cf 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 03c8c010ca6..21a39fd8eec 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 bdaec9db4ad..f07bdbb5dfc 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
--
GitLab