From 21c2498fea56edd6225d0124bf48be43c6f763c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Tue, 28 May 2024 17:46:19 +0200
Subject: [PATCH] [region] printers
---
src/plugins/region/memory.ml | 16 ++++++++++++++--
src/plugins/region/memory.mli | 6 +++++-
src/plugins/region/ranges.ml | 6 ++++++
src/plugins/region/ranges.mli | 6 ++++++
4 files changed, 31 insertions(+), 3 deletions(-)
diff --git a/src/plugins/region/memory.ml b/src/plugins/region/memory.ml
index 1fbb322c08a..5287fb031c7 100644
--- a/src/plugins/region/memory.ml
+++ b/src/plugins/region/memory.ml
@@ -29,8 +29,6 @@ module Vmap = Varinfo.Map
(* --- Region Maps --- *)
(* -------------------------------------------------------------------------- *)
-[@@@ warning "-37"]
-
(* All offsets in bits *)
type node = region Ufind.rref
@@ -56,6 +54,20 @@ type map = {
mutable index: node Vmap.t ;
}
+let pp_node fmt (n : node) = Format.fprintf fmt "R%04x" @@ Store.id n
+
+let pp_layout fmt = function
+ | Blob -> Format.pp_print_string fmt "<blob>"
+ | Cell(s,None) -> Format.fprintf fmt "<%04d>" s
+ | Cell(s,Some n) -> Format.fprintf fmt "<%04d>(*%a)" s pp_node n
+ | Compound(s,rg) ->
+ Format.fprintf fmt "@[<hov 2>{%04d" s ;
+ Ranges.iteri
+ (fun (rg : range) ->
+ Format.fprintf fmt "@ | %a: %a" Ranges.pp_range rg pp_node rg.data
+ ) rg ;
+ Format.fprintf fmt " }@]"
+
(* -------------------------------------------------------------------------- *)
(* --- Constructors --- *)
(* -------------------------------------------------------------------------- *)
diff --git a/src/plugins/region/memory.mli b/src/plugins/region/memory.mli
index 31ffda046f5..39bf4857944 100644
--- a/src/plugins/region/memory.mli
+++ b/src/plugins/region/memory.mli
@@ -38,6 +38,11 @@ type region = private {
layout: layout ;
}
+val sizeof : layout -> int
+
+val pp_node : Format.formatter -> node -> unit
+val pp_layout : Format.formatter -> layout -> unit
+
type map
val create : unit -> map
@@ -55,4 +60,3 @@ val read : map -> node -> Access.acs -> unit
val write : map -> node -> Access.acs -> unit
val shift : map -> node -> Access.acs -> unit
val points_to : map -> node -> node -> unit
-val sizeof : layout -> int
diff --git a/src/plugins/region/ranges.ml b/src/plugins/region/ranges.ml
index 6fd45ec606a..66cff2b51a5 100644
--- a/src/plugins/region/ranges.ml
+++ b/src/plugins/region/ranges.ml
@@ -37,6 +37,12 @@ type 'a range = {
data: 'a ;
}
+let pp_range fmt r =
+ Format.fprintf fmt "%04d..%04d" r.offset (r.offset + r.length - 1)
+
+let pp_offset fmt r =
+ Format.fprintf fmt "%04d:%04d" r.offset r.length
+
type 'a t = R of 'a range list (* sorted, no-overlap *)
let empty = R []
diff --git a/src/plugins/region/ranges.mli b/src/plugins/region/ranges.mli
index a748272bebe..64556b3f234 100644
--- a/src/plugins/region/ranges.mli
+++ b/src/plugins/region/ranges.mli
@@ -26,6 +26,12 @@ val (%.) : int -> int -> int (** gcd *)
type 'a range = { offset : int; length : int; data : 'a; }
type 'a t = private R of 'a range list (* sorted, no overlap *)
+(** Prints [offset..last] formatted with [%04d] *)
+val pp_range : Format.formatter -> 'a range -> unit
+
+(** Prints [offset:length] formatted with [%04d] *)
+val pp_offset : Format.formatter -> 'a range -> unit
+
val empty : 'a t
val singleton : 'a range -> 'a t
val range : ?offset:int -> ?length:int -> 'a -> 'a t
--
GitLab