1:- module(graphviz_term,
2 [ term_to_dot/1, 3 term_to_dot/2, 4 dotty_term/1 5 ]). 6:- use_module(library(dcg/basics)). 7:- use_module(library(process)). 8:- use_module(library(settings)). 9:- use_module(library(gensym)).
20:- setting(graphviz:dot_viewer, atom, xdot,
21 'Program to show dot graphs').
28dotty_term(Term) :-
29 setup_call_cleanup(tmp_file_stream(utf8, File, Out),
30 term_to_dot(Out, Term),
31 close(Out)),
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).
58term_to_dot(Term) :-
59 term_to_dot(current_output, Term).
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).
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).
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).
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.
View complex terms using Graphviz
This library translates complex Prolog terms into Graphviz (dot) output for graphical rendering.