1:- module(graphviz_term,
    2	  [ term_to_dot/1,		% +Term
    3	    term_to_dot/2,		% +Out, +Term
    4	    dotty_term/1		% +Term
    5	  ]).    6:- use_module(library(dcg/basics)).    7:- use_module(library(process)).    8:- use_module(library(settings)).    9:- use_module(library(gensym)).

View complex terms using Graphviz

This library translates complex Prolog terms into Graphviz (dot) output for graphical rendering.

See also
- Default renderer is xdot from https://github.com/jrfonseca/xdot.py */
   20:- setting(graphviz:dot_viewer, atom, xdot,
   21	   'Program to show dot graphs').
 dotty_term(+Term) is det
Write dot representation to temporary file and open this file using the dotty program.
   28dotty_term(Term) :-
   29	setup_call_cleanup(tmp_file_stream(utf8, File, Out),
   30			   term_to_dot(Out, Term),
   31			   close(Out)),
   32%	process_create(path(cat), ['test.dot'], []),
   33	setting(graphviz:dot_viewer, Program),
   34	thread_create(run_dotty(Program, File),
   35		      _,
   36		      [detached(true)]).
   37
   38:- dynamic
   39	dotty_process/1.   40
   41run_dotty(Program, File) :-
   42	process_create(path(Program), [File], [process(PID)]),
   43	assert(dotty_process(PID)),
   44	process_wait(PID, _),
   45	retractall(dotty_process(PID)).
   46
   47kill_dotties :-
   48	forall(dotty_process(PID),
   49	       process_kill(PID)).
   50
   51:- at_halt(kill_dotties).
 term_to_dot(+Term) is det
Emit a dot representation for Term to the curent output.
   58term_to_dot(Term) :-
   59	term_to_dot(current_output, Term).
 term_to_dot(+Out:stream, Term) is det
Emit a dot representation for Term to the stream Out.
   66term_to_dot(Out, Term) :-
   67	\+ \+ ( numbervars(Term, 0, _, [singletons(true)]),
   68		'$factorize_term'(Term, Skel, Subst),
   69		label_factors(Subst),
   70		phrase(struct0(Skel), Codes),
   71		format(Out, 'digraph structs {\n  node [shape=record];\n~s}\n', [Codes])
   72	      ).
   73
   74
   75label_factors([]).
   76label_factors([V='$VAR'(X)|T]) :- !,
   77	V = '$VAR'(X),
   78	label_factors(T).
   79label_factors(['$SKEL'(_,C)=C|T]) :-
   80	label_factors(T).
 struct0(+Term)//
Deal with the outer term. Note that labels inside terms are embedded in the term label.
   87struct0(Prim) -->
   88	{ number(Prim), !,
   89	  format(codes(Codes), '~q', [Prim])
   90	},
   91	cstring(Codes).
   92struct0(Prim) -->
   93	{ primitive(Prim), !,
   94	  format(codes(Codes), '~q', [Prim])
   95	},
   96	"\"", cstring(Codes), "\"".
   97struct0(Term) -->
   98	struct(Term, -(_), Links, []),
   99	links(Links).
 struct(+Term, Link, Links, RestLinks)//
Deal with compound and inner terms.
  105struct('$SKEL'(Done, C), -(Id), Links, LinksT) -->
  106	{ var(Done), !,
  107	  Done = top(Id)
  108	},
  109	struct(C, -(Id), Links, LinksT).
  110struct('$SKEL'(Done, C), Id-Arg, [link_c(Id-Arg, Id2, C)|LinkT], LinkT) -->
  111	{ var(Done), !,
  112	  Done = id(Id2)
  113	},
  114	".".
  115struct('$SKEL'(top(Id), _), Id-Arg,
  116       [link(Id-Arg, Id)|LinksT], LinksT) --> !,
  117	".".
  118struct('$SKEL'(id(Id2), _), Id-Arg, [link(Id-Arg, Id2)|LinkT], LinkT) --> !,
  119	".".
  120struct(Prim, _, Links, Links) -->
  121	{ primitive(Prim), !,
  122	  format(codes(Codes), '~q', [Prim])
  123	},
  124	cstring(Codes).
  125struct(Compound, -(Id), Links, LinkT) --> !,
  126	{ compound_name_arguments(Compound, F, Args),
  127	  gensym(struct, Id),
  128	  format(codes(FCodes), '~q', [F])
  129	},
  130	"  ", atom(Id),
  131	" [", "label=\"<f> ", cstring(FCodes), " ",
  132	gv_args(Args, 0, Id, Links, LinkT), "\"];\n".
  133struct(Compound, Id-Arg, [link_c(Id-Arg, _, Compound)|LinkT], LinkT) -->
  134	".".
  135
  136gv_args([], _, _, Links, Links) --> [].
  137gv_args([H|T], N, Id, Links, LinksT) -->
  138	"|", gv_arg_id(N), " ",
  139	struct(H, Id-N, Links, LT0),
  140	{N2 is N + 1},
  141	gv_args(T, N2, Id, LT0, LinksT).
  142
  143gv_arg_id(N) -->
  144	"<a", integer(N), ">".
  145
  146links(Links) -->
  147	{ \+ memberchk(link_c(_,_,_), Links)
  148	}, !,
  149	"\n",
  150	link_f(Links).
  151links(Links) -->
  152	link_c(Links, RestLinks, []),
  153	links(RestLinks).
  154
  155link_c([], Links, Links) --> [].
  156link_c([link_c(Id-Arg, Id2, Compound)|T0],
  157       [link(Id-Arg, Id2)|LinksT0], LinkT) --> !,
  158	struct(Compound, -(Id2), LinksT0, LinkT1),
  159	link_c(T0, LinkT1, LinkT).
  160link_c([H|T0], [H|T], Links) -->
  161	link_c(T0, T, Links).
  162
  163link_f([]) --> [].
  164link_f([link(Id-Arg, Id2)|T]) -->
  165	"  ", atom(Id), ":a", integer(Arg), " -> ", atom(Id2), ":f;\n",
  166	link_f(T).
  167
  168
  169primitive('$VAR'(_)) :- !.
  170primitive(X) :-
  171	\+ compound(X).
 cstring(+Codes)//
Create a C-string. Normally dot appears to be using UTF-8 encoding. Would there be a safer way to transport non-ascii characters, such as \uXXXX?
  179cstring([]) -->
  180	[].
  181cstring([H|T]) -->
  182	(   cchar(H)
  183	->  []
  184	;   [H]
  185	),
  186	cstring(T).
  187
  188cchar(0'") --> "\\\"".
  189cchar(0'\n) --> "\\n".
  190cchar(0'\t) --> "\\t".
  191cchar(0'\b) --> "\\b".
  192cchar(0'|) --> "\\|".
  193cchar(0'[) --> "\\[".
  194cchar(0']) --> "\\]".
  195
  196:- if(\+current_predicate(compound_name_arguments/3)).  197compound_name_arguments(Term, Name, Args) :-
  198	Term =.. [Name|Args].
  199:- endif.