fix: truncate info displayed in dot output

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" ;;