From 64c9ca755f6566df41b8b6a40b8aec3e30c5849a Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Wed, 11 Jan 2023 09:41:10 +0100
Subject: [PATCH] fix: truncate info displayed in dot output
---
tools/rdbg4sasa/dot4sasa.ml | 49 +++++++++++++++++++++----------------
1 file changed, 28 insertions(+), 21 deletions(-)
diff --git a/tools/rdbg4sasa/dot4sasa.ml b/tools/rdbg4sasa/dot4sasa.ml
index 25d147b9..75ea9fa8 100644
--- a/tools/rdbg4sasa/dot4sasa.ml
+++ b/tools/rdbg4sasa/dot4sasa.ml
@@ -6,7 +6,7 @@ open Data
open RdbgEvent
open Sasacore
open Topology
-
+
type process = {
name: string;
actions: (string * bool * bool) list; (* (action name, enabled, active) *)
@@ -25,14 +25,14 @@ let (is_parent: string -> string -> int -> RdbgEvent.t -> bool) =
| _ -> false
let (get_processes : RdbgEvent.t -> process list) =
- fun e ->
+ fun e ->
(* if e.kind <> Ltop then (
print_string "dot should be called from Ltop event\n";
failwith "exit dot"
);*)
let l = List.map (fun (x,v) -> Str.split (Str.regexp "_") x, v) e.data in
let rec sortv (enab, other) (x,v) =
- match args.salut_mode,x with
+ match args.salut_mode,x with
| false,"Enab"::pid::tail -> (pid, String.concat "_" tail,v)::enab, other
| false,pid::tail -> enab, (pid,(String.concat "_" tail),v)::other
| _,[] -> assert false
@@ -43,7 +43,7 @@ let (get_processes : RdbgEvent.t -> process list) =
let _i = int_of_string id in
enab, (p^id,(String.concat "_" (id2::tail)),v)::other
with _ ->
- try
+ try
let _i = int_of_string id2 in
enab, (p^id2,(String.concat "_" (id::tail)),v)::other
with _ -> assert false
@@ -53,7 +53,7 @@ let (get_processes : RdbgEvent.t -> process list) =
(string * string * Data.v) list -> process list) =
fun pidl enab other ->
match enab with
- | [] -> pidl
+ | [] -> pidl
| (pid, _, _)::_ ->
let enab_pid_list, enab =
List.partition (fun (pid0,_,_) -> pid=pid0) enab
@@ -68,9 +68,9 @@ let (get_processes : RdbgEvent.t -> process list) =
in
let get_actions (_, n, enabv) =
match List.find_opt (fun (_,n0, _) -> n=n0) acti_pid with
- | Some (_,_,activ) ->
+ | Some (_,_,activ) ->
(n, enabv = Data.B true, activ = B true)
- | None ->
+ | None ->
(n, enabv = Data.B true, false)
in
let pid = {
@@ -88,7 +88,7 @@ let (get_processes : RdbgEvent.t -> process list) =
used to compute a spanning tree, a draws edges accordingly in the
dot output. If no var of type neighbor exists, we return the emty
string here and no edges will be displayed. if several vars of type
- neighbor exist, we take the first one.
+ neighbor exist, we take the first one.
let parent_var_name = ref None (* memoize it! *)
let (get_parent_var_name: nodes list -> string) =
fun nl ->
@@ -99,7 +99,7 @@ let (get_parent_var_name: nodes list -> string) =
| [] -> ""
| n::tail -> (
let ml_file = (Filename.chop_extension file) ^ .ml in
-
+
match List.find_opt (fun (vn,vt) -> vt = Algo.Nt) n with
| None -> search tail
| Some (vn,_) -> vn
@@ -110,6 +110,13 @@ let (get_parent_var_name: nodes list -> string) =
vn
*)
+
+let val_to_string_trunc v =
+ let res = Data.val_to_string string_of_float v in
+ if String.length res > 50 (* XXX should be a sasarg *) then
+ (String.sub res 0 50^ "...")
+ else
+ res
(* Compute a dot from the content of e.data. if [only_parent], only
display the arcs of the parent, where the parent is an integer held
in a variable named "par". if no such variable exist in the current
@@ -141,29 +148,29 @@ let to_pdf engine par_var only_parent rn g f e =
let loc = String.concat "|"
(List.map (fun (n,v) ->
Printf.sprintf "%s=%s" n
- (Data.val_to_string string_of_float v))
+ (val_to_string_trunc v))
pid.vars
)
in
if (n>200 || ln > 5000) && enabled <> "" then
- Printf.sprintf " %s [shape=point]" pid.name
- else
+ Printf.sprintf " %s [shape=point]" pid.name
+ else
Printf.sprintf " %s [%slabel=\"%s|{%s%s}\"] "
pid.name color pid.name enabled loc
)
pidl
)
in
- let trans =
+ let trans =
List.flatten
(List.map
(fun n ->
let l = g.succ n.id in
List.mapi (fun i t ->
- if g.directed then
- Printf.sprintf "%s -> %s" t n.id
+ if g.directed then
+ Printf.sprintf "%s -> %s" t n.id
else if is_parent "par" n.id i e then
- Printf.sprintf "%s -> %s" n.id t
+ Printf.sprintf "%s -> %s" n.id t
else if n.id < t then (* to avoid duplication in undir graphs *)
Printf.sprintf "%s -- %s" n.id t
else
@@ -188,10 +195,10 @@ let to_pdf engine par_var only_parent rn g f e =
Str.global_replace (Str.regexp "--") "->" trans_undir_str in
let trans_str =
(* if trans_dir_str = "" then trans_undir_str else *)
- if only_parent then
- Printf.sprintf "subgraph dir {\n\t%s} " trans_dir_str
- else
- Printf.sprintf "subgraph dir {\n\t%s}
+ if only_parent then
+ Printf.sprintf "subgraph dir {\n\t%s} " trans_dir_str
+ else
+ Printf.sprintf "subgraph dir {\n\t%s}
subgraph undir {\n\t edge [dir=none]\n%s} " trans_dir_str trans_undir_str
in
let pot = match List.assoc_opt "potential" e.data with
@@ -209,7 +216,7 @@ subgraph undir {\n\t edge [dir=none]\n%s} " trans_dir_str trans_undir_str
flush stdout
)
-
+
;;
let dot = to_pdf "dot" "_par" ;;
--
GitLab