[region] printers

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                                                       --- *)
 (* -------------------------------------------------------------------------- *)

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

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 []

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