36
37:- module(prolog_pretty_print,
38 [ print_term/2 39 ]). 40:- autoload(library(option),
41 [merge_options/3, select_option/3, select_option/4,
42 option/2, option/3]).
61:- predicate_options(print_term/2, 2,
62 [ output(stream),
63 right_margin(integer),
64 left_margin(integer),
65 tab_width(integer),
66 indent_arguments(integer),
67 operators(boolean),
68 write_options(list)
69 ]).
110print_term(Term, Options) :-
111 \+ \+ print_term_2(Term, Options).
112
113print_term_2(Term, Options0) :-
114 prepare_term(Term, Template, Cycles, Constraints),
115 defaults(Defs0),
116 select_option(write_options(WrtDefs), Defs0, Defs),
117 select_option(write_options(WrtUser), Options0, Options1, []),
118 merge_options(WrtUser, WrtDefs, WrtOpts),
119 merge_options(Options1, Defs, Options2),
120 option(max_depth(MaxDepth), WrtOpts, infinite),
121 Options = [write_options(WrtOpts)|Options2],
122
123 dict_create(Context, #, [max_depth(MaxDepth)|Options]),
124 pp(Template, Context, Options),
125 print_extra(Cycles, Context, 'where', Options),
126 print_extra(Constraints, Context, 'with constraints', Options).
127
([], _, _, _) :- !.
129print_extra(List, Context, Comment, Options) :-
130 option(output(Out), Options),
131 format(Out, ', % ~w', [Comment]),
132 modify_context(Context, [indent=4], Context1),
133 print_extra_2(List, Context1, Options).
134
([H|T], Context, Options) :-
136 option(output(Out), Options),
137 context(Context, indent, Indent),
138 indent(Out, Indent, Options),
139 pp(H, Context, Options),
140 ( T == []
141 -> true
142 ; format(Out, ',', []),
143 print_extra_2(T, Context, Options)
144 ).
152prepare_term(Term, Template, Cycles, Constraints) :-
153 term_attvars(Term, []),
154 !,
155 Constraints = [],
156 '$factorize_term'(Term, Template, Factors),
157 bind_non_cycles(Factors, 1, Cycles),
158 numbervars(Template+Cycles+Constraints, 0, _,
159 [singletons(true)]).
160prepare_term(Term, Template, Cycles, Constraints) :-
161 copy_term(Term, Copy, Constraints),
162 !,
163 '$factorize_term'(Copy, Template, Factors),
164 bind_non_cycles(Factors, 1, Cycles),
165 numbervars(Template+Cycles+Constraints, 0, _,
166 [singletons(true)]).
167
168
169bind_non_cycles([], _, []).
170bind_non_cycles([V=Term|T], I, L) :-
171 unify_with_occurs_check(V, Term),
172 !,
173 bind_non_cycles(T, I, L).
174bind_non_cycles([H|T0], I, [H|T]) :-
175 H = ('$VAR'(Name)=_),
176 atom_concat('_S', I, Name),
177 I2 is I + 1,
178 bind_non_cycles(T0, I2, T).
179
180
181defaults([ output(user_output),
182 left_margin(0),
183 right_margin(72),
184 depth(0),
185 indent(0),
186 indent_arguments(auto),
187 operators(true),
188 write_options([ quoted(true),
189 numbervars(true),
190 portray(true),
191 attributes(portray)
192 ]),
193 priority(1200)
194 ]).
195
196
197 200
201context(Ctx, Name, Value) :-
202 get_dict(Name, Ctx, Value).
203
204modify_context(Ctx0, Mapping, Ctx) :-
205 Ctx = Ctx0.put(Mapping).
206
207dec_depth(Ctx, Ctx) :-
208 context(Ctx, max_depth, infinite),
209 !.
210dec_depth(Ctx0, Ctx) :-
211 ND is Ctx0.max_depth - 1,
212 Ctx = Ctx0.put(max_depth, ND).
213
214
215 218
219pp(Primitive, Ctx, Options) :-
220 ( atomic(Primitive)
221 ; var(Primitive)
222 ; Primitive = '$VAR'(Var),
223 ( integer(Var)
224 ; atom(Var)
225 )
226 ),
227 !,
228 pprint(Primitive, Ctx, Options).
229pp(Portray, _Ctx, Options) :-
230 option(write_options(WriteOptions), Options),
231 option(portray(true), WriteOptions),
232 option(output(Out), Options),
233 with_output_to(Out, user:portray(Portray)),
234 !.
235pp(List, Ctx, Options) :-
236 List = [_|_],
237 !,
238 context(Ctx, indent, Indent),
239 context(Ctx, depth, Depth),
240 option(output(Out), Options),
241 option(indent_arguments(IndentStyle), Options),
242 ( ( IndentStyle == false
243 -> true
244 ; IndentStyle == auto,
245 print_width(List, Width, Options),
246 option(right_margin(RM), Options),
247 Indent + Width < RM
248 )
249 -> pprint(List, Ctx, Options)
250 ; format(Out, '[ ', []),
251 Nindent is Indent + 2,
252 NDepth is Depth + 1,
253 modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx),
254 pp_list_elements(List, NCtx, Options),
255 indent(Out, Indent, Options),
256 format(Out, ']', [])
257 ).
258:- if(current_predicate(is_dict/1)). 259pp(Dict, Ctx, Options) :-
260 is_dict(Dict),
261 !,
262 dict_pairs(Dict, Tag, Pairs),
263 option(output(Out), Options),
264 option(indent_arguments(IndentStyle), Options),
265 context(Ctx, indent, Indent),
266 ( IndentStyle == false ; Pairs == []
267 -> pprint(Dict, Ctx, Options)
268 ; IndentStyle == auto,
269 print_width(Dict, Width, Options),
270 option(right_margin(RM), Options),
271 Indent + Width < RM 272 -> pprint(Dict, Ctx, Options)
273 ; format(atom(Buf2), '~q{ ', [Tag]),
274 write(Out, Buf2),
275 atom_length(Buf2, FunctorIndent),
276 ( integer(IndentStyle)
277 -> Nindent is Indent + IndentStyle,
278 ( FunctorIndent > IndentStyle
279 -> indent(Out, Nindent, Options)
280 ; true
281 )
282 ; Nindent is Indent + FunctorIndent
283 ),
284 context(Ctx, depth, Depth),
285 NDepth is Depth + 1,
286 modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
287 dec_depth(NCtx0, NCtx),
288 pp_dict_args(Pairs, NCtx, Options),
289 BraceIndent is Nindent - 2, 290 indent(Out, BraceIndent, Options),
291 write(Out, '}')
292 ).
293:- endif. 294pp(Term, Ctx, Options) :- 295 compound(Term),
296 compound_name_arity(Term, Name, Arity),
297 current_op(Prec, Type, Name),
298 match_op(Type, Arity, Kind, Prec, Left, Right),
299 option(operators(true), Options),
300 !,
301 quoted_op(Name, QName),
302 option(output(Out), Options),
303 context(Ctx, indent, Indent),
304 context(Ctx, depth, Depth),
305 context(Ctx, priority, CPrec),
306 NDepth is Depth + 1,
307 modify_context(Ctx, [depth=NDepth], Ctx1),
308 dec_depth(Ctx1, Ctx2),
309 LeftOptions = Ctx2.put(priority, Left),
310 FuncOptions = Ctx2.put(embrace, never),
311 RightOptions = Ctx2.put(priority, Right),
312 ( Kind == prefix
313 -> arg(1, Term, Arg),
314 ( ( space_op(Name)
315 ; need_space(Name, Arg, FuncOptions, RightOptions)
316 )
317 -> Space = ' '
318 ; Space = ''
319 ),
320 ( CPrec >= Prec
321 -> format(atom(Buf), '~w~w', [QName, Space]),
322 atom_length(Buf, AL),
323 NIndent is Indent + AL,
324 write(Out, Buf),
325 modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
326 pp(Arg, Ctx3, Options)
327 ; format(atom(Buf), '(~w', [QName,Space]),
328 atom_length(Buf, AL),
329 NIndent is Indent + AL,
330 write(Out, Buf),
331 modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
332 pp(Arg, Ctx3, Options),
333 format(Out, ')', [])
334 )
335 ; Kind == postfix
336 -> arg(1, Term, Arg),
337 ( ( space_op(Name)
338 ; need_space(Name, Arg, FuncOptions, LeftOptions)
339 )
340 -> Space = ' '
341 ; Space = ''
342 ),
343 ( CPrec >= Prec
344 -> modify_context(Ctx2, [priority=Left], Ctx3),
345 pp(Arg, Ctx3, Options),
346 format(Out, '~w~w', [Space,QName])
347 ; format(Out, '(', []),
348 NIndent is Indent + 1,
349 modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
350 pp(Arg, Ctx3, Options),
351 format(Out, '~w~w)', [Space,QName])
352 )
353 ; arg(1, Term, Arg1),
354 arg(2, Term, Arg2),
355 ( ( space_op(Name)
356 ; need_space(Arg1, Name, LeftOptions, FuncOptions)
357 ; need_space(Name, Arg2, FuncOptions, RightOptions)
358 )
359 -> Space = ' '
360 ; Space = ''
361 ),
362 ( CPrec >= Prec
363 -> modify_context(Ctx2, [priority=Left], Ctx3),
364 pp(Arg1, Ctx3, Options),
365 format(Out, '~w~w~w', [Space,QName,Space]),
366 modify_context(Ctx2, [priority=Right], Ctx4),
367 pp(Arg2, Ctx4, Options)
368 ; format(Out, '(', []),
369 NIndent is Indent + 1,
370 modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
371 pp(Arg1, Ctx3, Options),
372 format(Out, '~w~w~w', [Space,QName,Space]),
373 modify_context(Ctx2, [priority=Right], Ctx4),
374 pp(Arg2, Ctx4, Options),
375 format(Out, ')', [])
376 )
377 ).
378pp(Term, Ctx, Options) :- 379 option(output(Out), Options),
380 option(indent_arguments(IndentStyle), Options),
381 context(Ctx, indent, Indent),
382 ( IndentStyle == false
383 -> pprint(Term, Ctx, Options)
384 ; IndentStyle == auto,
385 print_width(Term, Width, Options),
386 option(right_margin(RM), Options),
387 Indent + Width < RM 388 -> pprint(Term, Ctx, Options)
389 ; compound_name_arguments(Term, Name, Args),
390 format(atom(Buf2), '~q(', [Name]),
391 write(Out, Buf2),
392 atom_length(Buf2, FunctorIndent),
393 ( integer(IndentStyle)
394 -> Nindent is Indent + IndentStyle,
395 ( FunctorIndent > IndentStyle
396 -> indent(Out, Nindent, Options)
397 ; true
398 )
399 ; Nindent is Indent + FunctorIndent
400 ),
401 context(Ctx, depth, Depth),
402 NDepth is Depth + 1,
403 modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
404 dec_depth(NCtx0, NCtx),
405 pp_compound_args(Args, NCtx, Options),
406 write(Out, ')')
407 ).
408
409
410quoted_op(Op, Atom) :-
411 is_solo(Op),
412 !,
413 Atom = Op.
414quoted_op(Op, Q) :-
415 format(atom(Q), '~q', [Op]).
416
417pp_list_elements(_, Ctx, Options) :-
418 context(Ctx, max_depth, 0),
419 !,
420 option(output(Out), Options),
421 write(Out, '...').
422pp_list_elements([H|T], Ctx0, Options) :-
423 dec_depth(Ctx0, Ctx),
424 pp(H, Ctx, Options),
425 ( T == []
426 -> true
427 ; nonvar(T),
428 T = [_|_]
429 -> option(output(Out), Options),
430 write(Out, ','),
431 context(Ctx, indent, Indent),
432 indent(Out, Indent, Options),
433 pp_list_elements(T, Ctx, Options)
434 ; option(output(Out), Options),
435 context(Ctx, indent, Indent),
436 indent(Out, Indent-2, Options),
437 write(Out, '| '),
438 pp(T, Ctx, Options)
439 ).
440
441
442pp_compound_args([], _, _).
443pp_compound_args([H|T], Ctx, Options) :-
444 pp(H, Ctx, Options),
445 ( T == []
446 -> true
447 ; T = [_|_]
448 -> option(output(Out), Options),
449 write(Out, ','),
450 context(Ctx, indent, Indent),
451 indent(Out, Indent, Options),
452 pp_compound_args(T, Ctx, Options)
453 ; option(output(Out), Options),
454 context(Ctx, indent, Indent),
455 indent(Out, Indent-2, Options),
456 write(Out, '| '),
457 pp(T, Ctx, Options)
458 ).
459
460
461:- if(current_predicate(is_dict/1)). 462pp_dict_args([Name-Value|T], Ctx, Options) :-
463 option(output(Out), Options),
464 line_position(Out, Pos0),
465 pp(Name, Ctx, Options),
466 write(Out, ':'),
467 line_position(Out, Pos1),
468 context(Ctx, indent, Indent),
469 Indent2 is Indent + Pos1-Pos0,
470 modify_context(Ctx, [indent=Indent2], Ctx2),
471 pp(Value, Ctx2, Options),
472 ( T == []
473 -> true
474 ; option(output(Out), Options),
475 write(Out, ','),
476 indent(Out, Indent, Options),
477 pp_dict_args(T, Ctx, Options)
478 ).
479:- endif. 480
482
483match_op(fx, 1, prefix, P, _, R) :- R is P - 1.
484match_op(fy, 1, prefix, P, _, P).
485match_op(xf, 1, postfix, P, _, L) :- L is P - 1.
486match_op(yf, 1, postfix, P, P, _).
487match_op(xfx, 2, infix, P, A, A) :- A is P - 1.
488match_op(xfy, 2, infix, P, L, P) :- L is P - 1.
489match_op(yfx, 2, infix, P, P, R) :- R is P - 1.
498indent(Out, Indent, Options) :-
499 option(tab_width(TW), Options, 8),
500 nl(Out),
501 ( TW =:= 0
502 -> tab(Out, Indent)
503 ; Tabs is Indent // TW,
504 Spaces is Indent mod TW,
505 forall(between(1, Tabs, _), put(Out, 9)),
506 tab(Out, Spaces)
507 ).
513print_width(Term, W, Options) :-
514 option(right_margin(RM), Options),
515 ( write_length(Term, W, [max_length(RM)|Options])
516 -> true
517 ; W = RM
518 ).
524pprint(Term, Ctx, Options) :-
525 option(output(Out), Options),
526 pprint(Out, Term, Ctx, Options).
527
528pprint(Out, Term, Ctx, Options) :-
529 option(write_options(WriteOptions), Options),
530 context(Ctx, max_depth, MaxDepth),
531 ( MaxDepth == infinite
532 -> write_term(Out, Term, WriteOptions)
533 ; MaxDepth =< 0
534 -> format(Out, '...', [])
535 ; write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions])
536 ).
537
538
539
548is_op1(Name, Type, Pri, ArgPri, Options) :-
549 operator_module(Module, Options),
550 current_op(Pri, OpType, Module:Name),
551 argpri(OpType, Type, Pri, ArgPri),
552 !.
553
554argpri(fx, prefix, Pri0, Pri) :- Pri is Pri0 - 1.
555argpri(fy, prefix, Pri, Pri).
556argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
557argpri(yf, postfix, Pri, Pri).
563is_op2(Name, LeftPri, Pri, RightPri, Options) :-
564 operator_module(Module, Options),
565 current_op(Pri, Type, Module:Name),
566 infix_argpri(Type, LeftPri, Pri, RightPri),
567 !.
568
569infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
570infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
571infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
579need_space(T1, T2, _, _) :-
580 ( is_solo(T1)
581 ; is_solo(T2)
582 ),
583 !,
584 fail.
585need_space(T1, T2, LeftOptions, RightOptions) :-
586 end_code_type(T1, TypeR, LeftOptions.put(side, right)),
587 end_code_type(T2, TypeL, RightOptions.put(side, left)),
588 \+ no_space(TypeR, TypeL).
589
590no_space(punct, _).
591no_space(_, punct).
592no_space(quote(R), quote(L)) :-
593 !,
594 R \== L.
595no_space(alnum, symbol).
596no_space(symbol, alnum).
603end_code_type(_, Type, Options) :-
604 MaxDepth = Options.max_depth,
605 integer(MaxDepth),
606 Options.depth >= MaxDepth,
607 !,
608 Type = symbol.
609end_code_type(Term, Type, Options) :-
610 primitive(Term, _),
611 !,
612 quote_atomic(Term, S, Options),
613 end_type(S, Type, Options).
614end_code_type(Dict, Type, Options) :-
615 is_dict(Dict, Tag),
616 !,
617 ( Options.side == left
618 -> end_code_type(Tag, Type, Options)
619 ; Type = punct
620 ).
621end_code_type('$VAR'(Var), Type, Options) :-
622 Options.get(numbervars) == true,
623 !,
624 format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
625 end_type(S, Type, Options).
626end_code_type(List, Type, _) :-
627 ( List == []
628 ; List = [_|_]
629 ),
630 !,
631 Type = punct.
632end_code_type(OpTerm, Type, Options) :-
633 compound_name_arity(OpTerm, Name, 1),
634 is_op1(Name, Type, Pri, ArgPri, Options),
635 \+ Options.get(ignore_ops) == true,
636 !,
637 ( Pri > Options.priority
638 -> Type = punct
639 ; ( Type == prefix
640 -> end_code_type(Name, Type, Options)
641 ; arg(1, OpTerm, Arg),
642 arg_options(Options, ArgOptions),
643 end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
644 )
645 ).
646end_code_type(OpTerm, Type, Options) :-
647 compound_name_arity(OpTerm, Name, 2),
648 is_op2(Name, LeftPri, Pri, _RightPri, Options),
649 \+ Options.get(ignore_ops) == true,
650 !,
651 ( Pri > Options.priority
652 -> Type = punct
653 ; arg(1, OpTerm, Arg),
654 arg_options(Options, ArgOptions),
655 end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
656 ).
657end_code_type(Compound, Type, Options) :-
658 compound_name_arity(Compound, Name, _),
659 end_code_type(Name, Type, Options).
660
661end_type(S, Type, Options) :-
662 number(S),
663 !,
664 ( (S < 0 ; S == -0.0),
665 Options.side == left
666 -> Type = symbol
667 ; Type = alnum
668 ).
669end_type(S, Type, Options) :-
670 Options.side == left,
671 !,
672 sub_string(S, 0, 1, _, Start),
673 syntax_type(Start, Type).
674end_type(S, Type, _) :-
675 sub_string(S, _, 1, 0, End),
676 syntax_type(End, Type).
677
678syntax_type("\"", quote(double)) :- !.
679syntax_type("\'", quote(single)) :- !.
680syntax_type("\`", quote(back)) :- !.
681syntax_type(S, Type) :-
682 string_code(1, S, C),
683 ( code_type(C, prolog_identifier_continue)
684 -> Type = alnum
685 ; code_type(C, prolog_symbol)
686 -> Type = symbol
687 ; code_type(C, space)
688 -> Type = layout
689 ; Type = punct
690 ).
691
692is_solo(Var) :-
693 var(Var), !, fail.
694is_solo(',').
695is_solo(';').
696is_solo('!').
703primitive(Term, Type) :- var(Term), !, Type = 'pl-avar'.
704primitive(Term, Type) :- atom(Term), !, Type = 'pl-atom'.
705primitive(Term, Type) :- string(Term), !, Type = 'pl-string'.
706primitive(Term, Type) :- integer(Term), !, Type = 'pl-int'.
707primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
708primitive(Term, Type) :- float(Term), !, Type = 'pl-float'.
714operator_module(Module, Options) :-
715 Module = Options.get(module),
716 !.
717operator_module(TypeIn, _) :-
718 '$module'(TypeIn, TypeIn).
724arg_options(Options, Options.put(depth, NewDepth)) :-
725 NewDepth is Options.depth+1.
726
727quote_atomic(Float, String, Options) :-
728 float(Float),
729 Format = Options.get(float_format),
730 !,
731 format(string(String), Format, [Float]).
732quote_atomic(Plain, Plain, _) :-
733 number(Plain),
734 !.
735quote_atomic(Plain, String, Options) :-
736 Options.get(quoted) == true,
737 !,
738 ( Options.get(embrace) == never
739 -> format(string(String), '~q', [Plain])
740 ; format(string(String), '~W', [Plain, Options])
741 ).
742quote_atomic(Var, String, Options) :-
743 var(Var),
744 !,
745 format(string(String), '~W', [Var, Options]).
746quote_atomic(Plain, Plain, _).
747
748space_op(:-)
Pretty Print Prolog terms
This module is a first start of what should become a full-featured pretty printer for Prolog terms with many options and parameters. Eventually, it should replace portray_clause/1 and various other special-purpose predicates.