From 8d6bf016111cede4ccd8c03e000b83fd977f99a9 Mon Sep 17 00:00:00 2001
From: Christoph Egger <Christoph.Egger@fau.de>
Date: Mon, 15 Feb 2016 16:52:12 +0100
Subject: [PATCH] Add basic graphviz export feature
---
src/debugger/debugger.ml | 9 +++++++--
src/lib/CoAlgMisc.ml | 28 +++++++++++++++++++++++++++-
src/lib/CoAlgMisc.mli | 2 ++
3 files changed, 36 insertions(+), 3 deletions(-)
diff --git a/src/debugger/debugger.ml b/src/debugger/debugger.ml
index e685a59..8e631d4 100644
--- a/src/debugger/debugger.ml
+++ b/src/debugger/debugger.ml
@@ -69,6 +69,12 @@ let listCores args =
let listStates args =
CM.graphIterStates (fun state -> print_endline (CM.stateToString state))
+let exportGraph args =
+ print_endline "digraph reasonerstate {";
+ CM.graphIterCores (fun core -> print_endline (CM.coreToDot core));
+ CM.graphIterStates (fun state -> print_endline (CM.stateToDot state));
+ print_endline "}"
+
let showNode = function
| (n::_) ->
let n = int_of_string n in
@@ -101,11 +107,10 @@ let _ =
Repl.bind "status" (fun _ -> printStatus ()) "Prints reasoning status" "";
Repl.bind "lscores" listCores "Lists all cores" "";
Repl.bind "lsstates" listStates "Lists all states" "";
+ Repl.bind "graphviz" exportGraph "Graphviz source of reasoner state" "";
Repl.bind "node" showNode "shows details of a node" "usage: node n";
Repl.exitBinding
];
}
in
Repl.start session
-
-
diff --git a/src/lib/CoAlgMisc.ml b/src/lib/CoAlgMisc.ml
index 3d5b280..2ea83af 100644
--- a/src/lib/CoAlgMisc.ml
+++ b/src/lib/CoAlgMisc.ml
@@ -709,7 +709,7 @@ let bsetToString sort bset : string =
let csetToString sort cset = bsetToString sort cset
-let coreToString core =
+let coreToString (core:core): string =
let helper cset lst : string list =
(csetToString core.sortC cset):: lst
in
@@ -758,6 +758,32 @@ let stateToString (state:state): string =
" Parents: { "^(String.concat ", " parents)^" }\n"^
"}"
+let stateToDot (state:state): string =
+ let ownidx = (string_of_int state.idx) in
+ let parents =
+ List.map (fun (co:core) -> "Node"^string_of_int co.idx^" -> Node"^ownidx^";")
+ state.parentsS
+ in
+ "Node" ^ ownidx ^ " [shape=ellipse,label=\"State " ^ ownidx
+ ^ "\\n" ^ (Str.global_replace (Str.regexp ", ") "\\n"
+ (bsetToString state.sortS state.bsS))
+ ^ "\"];\n"
+ ^ (String.concat "\n" parents)
+
+
+let coreToDot (core:core): string =
+ let ownidx = (string_of_int core.idx) in
+ let parents =
+ List.map (fun (st,_:state*int) -> "Node"^string_of_int st.idx^" -> Node"^ownidx^";")
+ core.parentsC
+ in
+ "Node" ^ ownidx ^ " [shape=ellipse,label=\"Core " ^ ownidx
+ ^ "\\n" ^ (Str.global_replace (Str.regexp ", ") "\\n"
+ (bsetToString core.sortC core.bsC))
+ ^ "\"];\n"
+ ^ (String.concat "\n" parents)
+
+
let queuePrettyStatus () =
let printList (sl : int list) : string =
String.concat ", " (List.map string_of_int sl)
diff --git a/src/lib/CoAlgMisc.mli b/src/lib/CoAlgMisc.mli
index 12aa963..160222c 100644
--- a/src/lib/CoAlgMisc.mli
+++ b/src/lib/CoAlgMisc.mli
@@ -229,6 +229,7 @@ val stateGetConstraints : state -> csetSet
val stateSetConstraints : state -> csetSet -> unit
val stateNextRule : state -> ruleEnumeration
val stateToString : state -> string
+val stateToDot : state -> string
val stateGetIdx : state -> int
@@ -256,6 +257,7 @@ val coreGetIdx : core -> int
val coreGetConstraintParents : core -> cset list
val coreAddConstraintParent : core -> cset -> unit
val coreToString : core -> string
+val coreToDot : core -> string
(*****************************************************************************)
--
GitLab