37
38:- module(prolog_pretty_print,
39 [ print_term/2 40 ]). 41:- autoload(library(option),
42 [merge_options/3, select_option/3, select_option/4,
43 option/2, option/3]). 44:- autoload(library(error), [must_be/2]).
63:- predicate_options(print_term/2, 2,
64 [ output(stream),
65 right_margin(integer),
66 left_margin(integer),
67 tab_width(integer),
68 indent_arguments(integer),
69 auto_indent_arguments(integer),
70 operators(boolean),
71 write_options(list),
72 fullstop(boolean),
73 nl(boolean)
74 ]).
133print_term(Term, Options) :-
134 combine_options(Options, Options1),
135 \+ \+ print_term_2(Term, Options1).
136
137combine_options(Options0, Options) :-
138 defaults(Defs0),
139 select_option(write_options(WrtDefs), Defs0, Defs),
140 select_option(write_options(WrtUser), Options0, Options1, []),
141 ( option(ignore_ops(_), WrtUser)
142 -> WrtUser1 = WrtUser
143 ; option(operators(Ops), Options0)
144 -> must_be(boolean, Ops),
145 neg(Ops, IgnoreOps),
146 WrtUser1 = [ignore_ops(IgnoreOps)|WrtUser]
147 ; WrtUser1 = WrtUser
148 ),
149 merge_options(WrtUser1, WrtDefs, WrtOpts),
150 merge_options(Options1, Defs, Options2),
151 Options3 = [write_options(WrtOpts)|Options2],
152 default_margin(Options3, Options).
153
154neg(true, false).
155neg(false, true).
156
157print_term_2(Term, Options) :-
158 prepare_term(Term, Template, Cycles, Constraints),
159 option(write_options(WrtOpts), Options),
160 option(max_depth(MaxDepth), WrtOpts, infinite),
161
162 dict_create(Context, #, [max_depth(MaxDepth)|Options]),
163 pp(Template, Context, Options),
164 print_extra(Cycles, Context, 'where', Options),
165 print_extra(Constraints, Context, 'with constraints', Options),
166 ( option(fullstop(true), Options)
167 -> option(output(Out), Options),
168 put_char(Out, '.')
169 ; true
170 ),
171 ( option(nl(true), Options)
172 -> option(output(Out2), Options),
173 nl(Out2)
174 ; true
175 ).
176
([], _, _, _) :- !.
178print_extra(List, Context, Comment, Options) :-
179 option(output(Out), Options),
180 format(Out, ', % ~w', [Comment]),
181 context(Context, indent, Indent),
182 NewIndent is Indent+4,
183 modify_context(Context, [indent=NewIndent], Context1),
184 print_extra_2(List, Context1, Options).
185
([H|T], Context, Options) :-
187 option(output(Out), Options),
188 context(Context, indent, Indent),
189 indent(Out, Indent, Options),
190 pp(H, Context, Options),
191 ( T == []
192 -> true
193 ; format(Out, ',', []),
194 print_extra_2(T, Context, Options)
195 ).
203prepare_term(Term, Template, Cycles, Constraints) :-
204 term_attvars(Term, []),
205 !,
206 Constraints = [],
207 '$factorize_term'(Term, Template, Factors),
208 bind_non_cycles(Factors, 1, Cycles),
209 numbervars(Template+Cycles+Constraints, 0, _,
210 [singletons(true)]).
211prepare_term(Term, Template, Cycles, Constraints) :-
212 copy_term(Term, Copy, Constraints),
213 '$factorize_term'(Copy, Template, Factors),
214 bind_non_cycles(Factors, 1, Cycles),
215 numbervars(Template+Cycles+Constraints, 0, _,
216 [singletons(true)]).
217
218
219bind_non_cycles([], _, []).
220bind_non_cycles([V=Term|T], I, L) :-
221 unify_with_occurs_check(V, Term),
222 !,
223 bind_non_cycles(T, I, L).
224bind_non_cycles([H|T0], I, [H|T]) :-
225 H = ('$VAR'(Name)=_),
226 atom_concat('_S', I, Name),
227 I2 is I + 1,
228 bind_non_cycles(T0, I2, T).
229
230
231defaults([ output(user_output),
232 depth(0),
233 indent_arguments(auto),
234 auto_indent_arguments(4),
235 write_options([ quoted(true),
236 numbervars(true),
237 portray(true),
238 attributes(portray)
239 ]),
240 priority(1200)
241 ]).
242
243default_margin(Options0, Options) :-
244 default_right_margin(Options0, Options1),
245 default_indent(Options1, Options).
246
247default_right_margin(Options0, Options) :-
248 option(right_margin(Margin), Options0),
249 !,
250 ( var(Margin)
251 -> tty_right_margin(Options0, Margin)
252 ; true
253 ),
254 Options = Options0.
255default_right_margin(Options0, [right_margin(Margin)|Options0]) :-
256 tty_right_margin(Options0, Margin).
257
258tty_right_margin(Options, Margin) :-
259 option(output(Output), Options),
260 stream_property(Output, tty(true)),
261 catch(tty_size(_Rows, Columns), error(_,_), fail),
262 !,
263 Margin is Columns - 8.
264tty_right_margin(_, 72).
265
266default_indent(Options0, Options) :-
267 option(output(Output), Options0),
268 ( stream_property(Output, position(Pos))
269 -> stream_position_data(line_position, Pos, Column)
270 ; Column = 0
271 ),
272 option(left_margin(LM), Options0, Column),
273 Options = [indent(LM)|Options0].
274
275
276 279
280context(Ctx, Name, Value) :-
281 get_dict(Name, Ctx, Value).
282
283modify_context(Ctx0, Mapping, Ctx) :-
284 Ctx = Ctx0.put(Mapping).
285
286dec_depth(Ctx, Ctx) :-
287 context(Ctx, max_depth, infinite),
288 !.
289dec_depth(Ctx0, Ctx) :-
290 ND is Ctx0.max_depth - 1,
291 Ctx = Ctx0.put(max_depth, ND).
292
293
294 297
298pp(Primitive, Ctx, Options) :-
299 ( atomic(Primitive)
300 ; var(Primitive)
301 ; Primitive = '$VAR'(Var),
302 ( integer(Var)
303 ; atom(Var)
304 )
305 ),
306 !,
307 pprint(Primitive, Ctx, Options).
308pp(Portray, _Ctx, Options) :-
309 option(write_options(WriteOptions), Options),
310 option(portray(true), WriteOptions),
311 option(output(Out), Options),
312 with_output_to(Out, user:portray(Portray)),
313 !.
314pp(List, Ctx, Options) :-
315 List = [_|_],
316 !,
317 context(Ctx, indent, Indent),
318 context(Ctx, depth, Depth),
319 option(output(Out), Options),
320 option(indent_arguments(IndentStyle), Options),
321 ( ( IndentStyle == false
322 -> true
323 ; IndentStyle == auto,
324 print_width(List, Width, Options),
325 option(right_margin(RM), Options),
326 Indent + Width < RM
327 )
328 -> pprint(List, Ctx, Options)
329 ; format(Out, '[ ', []),
330 Nindent is Indent + 2,
331 NDepth is Depth + 1,
332 modify_context(Ctx, [indent=Nindent, depth=NDepth, priority=999], NCtx),
333 pp_list_elements(List, NCtx, Options),
334 indent(Out, Indent, Options),
335 format(Out, ']', [])
336 ).
337pp(Dict, Ctx, Options) :-
338 is_dict(Dict),
339 !,
340 dict_pairs(Dict, Tag, Pairs),
341 option(output(Out), Options),
342 option(indent_arguments(IndentStyle), Options),
343 context(Ctx, indent, Indent),
344 ( IndentStyle == false ; Pairs == []
345 -> pprint(Dict, Ctx, Options)
346 ; IndentStyle == auto,
347 print_width(Dict, Width, Options),
348 option(right_margin(RM), Options),
349 Indent + Width < RM 350 -> pprint(Dict, Ctx, Options)
351 ; option(write_options(WrtOpts), Options),
352 compound_indent(Out, '~W{ '-[Tag,WrtOpts], Indent, Nindent, Options),
353 context(Ctx, depth, Depth),
354 NDepth is Depth + 1,
355 modify_context(Ctx, [indent=Nindent, depth=NDepth], NCtx0),
356 dec_depth(NCtx0, NCtx),
357 pp_dict_args(Pairs, NCtx, Options),
358 BraceIndent is Nindent - 2, 359 indent(Out, BraceIndent, Options),
360 write(Out, '}')
361 ).
362pp(Term, Ctx, Options) :- 363 compound(Term),
364 compound_name_arity(Term, Name, Arity),
365 current_op(Prec, Type, Name),
366 match_op(Type, Arity, Kind, Prec, Left, Right),
367 option(write_options(WrtOptions), Options, []),
368 option(ignore_ops(false), WrtOptions, false),
369 !,
370 quoted_op(Name, QName),
371 option(output(Out), Options),
372 context(Ctx, indent, Indent),
373 context(Ctx, depth, Depth),
374 context(Ctx, priority, CPrec),
375 NDepth is Depth + 1,
376 modify_context(Ctx, [depth=NDepth], Ctx1),
377 dec_depth(Ctx1, Ctx2),
378 LeftOptions = Ctx2.put(priority, Left),
379 FuncOptions = Ctx2.put(embrace, never),
380 RightOptions = Ctx2.put(priority, Right),
381 ( Kind == prefix
382 -> arg(1, Term, Arg),
383 ( ( space_op(Name)
384 ; need_space(Name, Arg, FuncOptions, RightOptions)
385 )
386 -> Space = ' '
387 ; Space = ''
388 ),
389 ( CPrec >= Prec
390 -> format(atom(Buf), '~w~w', [QName, Space]),
391 atom_length(Buf, AL),
392 NIndent is Indent + AL,
393 write(Out, Buf),
394 modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
395 pp(Arg, Ctx3, Options)
396 ; format(atom(Buf), '(~w~w', [QName,Space]),
397 atom_length(Buf, AL),
398 NIndent is Indent + AL,
399 write(Out, Buf),
400 modify_context(Ctx2, [indent=NIndent, priority=Right], Ctx3),
401 pp(Arg, Ctx3, Options),
402 format(Out, ')', [])
403 )
404 ; Kind == postfix
405 -> arg(1, Term, Arg),
406 ( ( space_op(Name)
407 ; need_space(Name, Arg, FuncOptions, LeftOptions)
408 )
409 -> Space = ' '
410 ; Space = ''
411 ),
412 ( CPrec >= Prec
413 -> modify_context(Ctx2, [priority=Left], Ctx3),
414 pp(Arg, Ctx3, Options),
415 format(Out, '~w~w', [Space,QName])
416 ; format(Out, '(', []),
417 NIndent is Indent + 1,
418 modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
419 pp(Arg, Ctx3, Options),
420 format(Out, '~w~w)', [Space,QName])
421 )
422 ; arg(1, Term, Arg1), 423 arg(2, Term, Arg2),
424 ( print_width(Term, Width, Options),
425 option(right_margin(RM), Options),
426 Indent + Width < RM
427 -> ToWide = false,
428 ( ( space_op(Name)
429 ; need_space(Arg1, Name, LeftOptions, FuncOptions)
430 ; need_space(Name, Arg2, FuncOptions, RightOptions)
431 )
432 -> Space = ' '
433 ; Space = ''
434 )
435 ; ToWide = true,
436 ( ( is_solo(Name)
437 ; space_op(Name)
438 )
439 -> Space = ''
440 ; Space = ' '
441 )
442 ),
443 ( CPrec >= Prec
444 -> ( ToWide == true,
445 infix_list(Term, Name, List),
446 List == [_,_|_]
447 -> Pri is min(Left,Right),
448 modify_context(Ctx2, [space=Space, priority=Pri], Ctx3),
449 pp_infix_list(List, QName, 2, Ctx3, Options)
450 ; modify_context(Ctx2, [priority=Left], Ctx3),
451 pp(Arg1, Ctx3, Options),
452 format(Out, '~w~w~w', [Space,QName,Space]),
453 line_position(Out, NIndent),
454 modify_context(Ctx2, [priority=Right, indent=NIndent], Ctx4),
455 pp(Arg2, Ctx4, Options)
456 )
457 ; ( ToWide == true,
458 infix_list(Term, Name, List),
459 List = [_,_|_]
460 -> Pri is min(Left,Right),
461 format(Out, '( ', []),
462 NIndent is Indent + 2,
463 modify_context(Ctx2,
464 [space=Space, indent=NIndent, priority=Pri],
465 Ctx3),
466 pp_infix_list(List, QName, 0, Ctx3, Options),
467 indent(Out, Indent, Options),
468 format(Out, ')', [])
469 ; format(Out, '(', []),
470 NIndent is Indent + 1,
471 modify_context(Ctx2, [indent=NIndent, priority=Left], Ctx3),
472 pp(Arg1, Ctx3, Options),
473 format(Out, '~w~w~w', [Space,QName,Space]),
474 modify_context(Ctx2, [priority=Right], Ctx4),
475 pp(Arg2, Ctx4, Options),
476 format(Out, ')', [])
477 )
478 )
479 ).
480pp(Term, Ctx, Options) :- 481 option(output(Out), Options),
482 option(indent_arguments(IndentStyle), Options),
483 context(Ctx, indent, Indent),
484 ( IndentStyle == false
485 -> pprint(Term, Ctx, Options)
486 ; IndentStyle == auto,
487 print_width(Term, Width, Options),
488 option(right_margin(RM), Options),
489 Indent + Width < RM 490 -> pprint(Term, Ctx, Options)
491 ; compound_name_arguments(Term, Name, Args),
492 option(write_options(WrtOpts), Options),
493 compound_indent(Out, '~W('-[Name,WrtOpts], Indent, Nindent, Options),
494 context(Ctx, depth, Depth),
495 NDepth is Depth + 1,
496 modify_context(Ctx,
497 [indent=Nindent, depth=NDepth, priority=999],
498 NCtx0),
499 dec_depth(NCtx0, NCtx),
500 pp_compound_args(Args, NCtx, Options),
501 write(Out, ')')
502 ).
503
504compound_indent(Out, Format-Args, Indent, Nindent, Options) :-
505 option(indent_arguments(IndentStyle), Options),
506 format(string(Buf2), Format, Args),
507 write(Out, Buf2),
508 atom_length(Buf2, FunctorIndent),
509 ( IndentStyle == auto,
510 option(auto_indent_arguments(IndentArgs), Options),
511 IndentArgs > 0,
512 FunctorIndent > IndentArgs*2
513 -> true
514 ; IndentArgs = IndentStyle
515 ),
516 ( integer(IndentArgs)
517 -> Nindent is Indent + IndentArgs,
518 ( FunctorIndent > IndentArgs
519 -> indent(Out, Nindent, Options)
520 ; true
521 )
522 ; Nindent is Indent + FunctorIndent
523 ).
524
525
526quoted_op(Op, Atom) :-
527 is_solo(Op),
528 !,
529 Atom = Op.
530quoted_op(Op, Q) :-
531 format(atom(Q), '~q', [Op]).
539infix_list(Term, Op, List) :-
540 phrase(infix_list(Term, Op), List).
541
542infix_list(Term, Op) -->
543 { compound(Term),
544 compound_name_arity(Term, Op, 2)
545 },
546 ( {current_op(_Pri, xfy, Op)}
547 -> { arg(1, Term, H),
548 arg(2, Term, Term2)
549 },
550 [H],
551 infix_list(Term2, Op)
552 ; {current_op(_Pri, yfx, Op)}
553 -> { arg(1, Term, Term2),
554 arg(2, Term, T)
555 },
556 infix_list(Term2, Op),
557 [T]
558 ).
559infix_list(Term, Op) -->
560 {atom(Op)}, 561 [Term].
562
563pp_infix_list([H|T], QName, IncrIndent, Ctx, Options) =>
564 pp(H, Ctx, Options),
565 context(Ctx, space, Space),
566 ( T == []
567 -> true
568 ; option(output(Out), Options),
569 format(Out, '~w~w', [Space,QName]),
570 context(Ctx, indent, Indent),
571 NIndent is Indent+IncrIndent,
572 indent(Out, NIndent, Options),
573 modify_context(Ctx, [indent=NIndent], Ctx2),
574 pp_infix_list(T, QName, 0, Ctx2, Options)
575 ).
582pp_list_elements(_, Ctx, Options) :-
583 context(Ctx, max_depth, 0),
584 !,
585 option(output(Out), Options),
586 write(Out, '...').
587pp_list_elements([H|T], Ctx0, Options) :-
588 dec_depth(Ctx0, Ctx),
589 pp(H, Ctx, Options),
590 ( T == []
591 -> true
592 ; nonvar(T),
593 T = [_|_]
594 -> option(output(Out), Options),
595 write(Out, ','),
596 context(Ctx, indent, Indent),
597 indent(Out, Indent, Options),
598 pp_list_elements(T, Ctx, Options)
599 ; option(output(Out), Options),
600 context(Ctx, indent, Indent),
601 indent(Out, Indent-2, Options),
602 write(Out, '| '),
603 pp(T, Ctx, Options)
604 ).
605
606
607pp_compound_args([], _, _).
608pp_compound_args([H|T], Ctx, Options) :-
609 pp(H, Ctx, Options),
610 ( T == []
611 -> true
612 ; T = [_|_]
613 -> option(output(Out), Options),
614 write(Out, ','),
615 context(Ctx, indent, Indent),
616 indent(Out, Indent, Options),
617 pp_compound_args(T, Ctx, Options)
618 ; option(output(Out), Options),
619 context(Ctx, indent, Indent),
620 indent(Out, Indent-2, Options),
621 write(Out, '| '),
622 pp(T, Ctx, Options)
623 ).
624
625
626:- if(current_predicate(is_dict/1)). 627pp_dict_args([Name-Value|T], Ctx, Options) :-
628 option(output(Out), Options),
629 line_position(Out, Pos0),
630 pp(Name, Ctx, Options),
631 write(Out, ': '),
632 line_position(Out, Pos1),
633 context(Ctx, indent, Indent),
634 Indent2 is Indent + Pos1-Pos0,
635 modify_context(Ctx, [indent=Indent2], Ctx2),
636 pp(Value, Ctx2, Options),
637 ( T == []
638 -> true
639 ; option(output(Out), Options),
640 write(Out, ','),
641 indent(Out, Indent, Options),
642 pp_dict_args(T, Ctx, Options)
643 ).
644:- endif. 645
647
648match_op(fx, 1, prefix, P, _, R) :- R is P - 1.
649match_op(fy, 1, prefix, P, _, P).
650match_op(xf, 1, postfix, P, L, _) :- L is P - 1.
651match_op(yf, 1, postfix, P, P, _).
652match_op(xfx, 2, infix, P, A, A) :- A is P - 1.
653match_op(xfy, 2, infix, P, L, P) :- L is P - 1.
654match_op(yfx, 2, infix, P, P, R) :- R is P - 1.
663indent(Out, Indent, Options) :-
664 option(tab_width(TW), Options, 8),
665 nl(Out),
666 ( TW =:= 0
667 -> tab(Out, Indent)
668 ; Tabs is Indent // TW,
669 Spaces is Indent mod TW,
670 forall(between(1, Tabs, _), put(Out, 9)),
671 tab(Out, Spaces)
672 ).
678print_width(Term, W, Options) :-
679 option(right_margin(RM), Options),
680 option(write_options(WOpts), Options),
681 ( catch(write_length(Term, W, [max_length(RM)|WOpts]),
682 error(_,_), fail) 683 -> true 684 ; W = RM
685 ).
691pprint(Term, Ctx, Options) :-
692 option(output(Out), Options),
693 pprint(Out, Term, Ctx, Options).
694
695pprint(Out, Term, Ctx, Options) :-
696 option(write_options(WriteOptions), Options),
697 context(Ctx, max_depth, MaxDepth),
698 ( MaxDepth == infinite
699 -> write_term(Out, Term, WriteOptions)
700 ; MaxDepth =< 0
701 -> format(Out, '...', [])
702 ; write_term(Out, Term, [max_depth(MaxDepth)|WriteOptions])
703 ).
704
705
706
715is_op1(Name, Type, Pri, ArgPri, Options) :-
716 operator_module(Module, Options),
717 current_op(Pri, OpType, Module:Name),
718 argpri(OpType, Type, Pri, ArgPri),
719 !.
720
721argpri(fx, prefix, Pri0, Pri) :- Pri is Pri0 - 1.
722argpri(fy, prefix, Pri, Pri).
723argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
724argpri(yf, postfix, Pri, Pri).
730is_op2(Name, LeftPri, Pri, RightPri, Options) :-
731 operator_module(Module, Options),
732 current_op(Pri, Type, Module:Name),
733 infix_argpri(Type, LeftPri, Pri, RightPri),
734 !.
735
736infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
737infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
738infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
746need_space(T1, T2, _, _) :-
747 ( is_solo(T1)
748 ; is_solo(T2)
749 ),
750 !,
751 fail.
752need_space(T1, T2, LeftOptions, RightOptions) :-
753 end_code_type(T1, TypeR, LeftOptions.put(side, right)),
754 end_code_type(T2, TypeL, RightOptions.put(side, left)),
755 \+ no_space(TypeR, TypeL).
756
757no_space(punct, _).
758no_space(_, punct).
759no_space(quote(R), quote(L)) :-
760 !,
761 R \== L.
762no_space(alnum, symbol).
763no_space(symbol, alnum).
770end_code_type(_, Type, Options) :-
771 MaxDepth = Options.max_depth,
772 integer(MaxDepth),
773 Options.depth >= MaxDepth,
774 !,
775 Type = symbol.
776end_code_type(Term, Type, Options) :-
777 primitive(Term, _),
778 !,
779 quote_atomic(Term, S, Options),
780 end_type(S, Type, Options).
781end_code_type(Dict, Type, Options) :-
782 is_dict(Dict, Tag),
783 !,
784 ( Options.side == left
785 -> end_code_type(Tag, Type, Options)
786 ; Type = punct
787 ).
788end_code_type('$VAR'(Var), Type, Options) :-
789 Options.get(numbervars) == true,
790 !,
791 format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
792 end_type(S, Type, Options).
793end_code_type(List, Type, _) :-
794 ( List == []
795 ; List = [_|_]
796 ),
797 !,
798 Type = punct.
799end_code_type(OpTerm, Type, Options) :-
800 compound_name_arity(OpTerm, Name, 1),
801 is_op1(Name, OpType, Pri, ArgPri, Options),
802 \+ Options.get(ignore_ops) == true,
803 !,
804 ( Pri > Options.priority
805 -> Type = punct
806 ; op_or_arg(OpType, Options.side, OpArg),
807 ( OpArg == op
808 -> end_code_type(Name, Type, Options)
809 ; arg(1, OpTerm, Arg),
810 arg_options(Options, ArgOptions),
811 end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
812 )
813 ).
814end_code_type(OpTerm, Type, Options) :-
815 compound_name_arity(OpTerm, Name, 2),
816 is_op2(Name, LeftPri, Pri, _RightPri, Options),
817 \+ Options.get(ignore_ops) == true,
818 !,
819 ( Pri > Options.priority
820 -> Type = punct
821 ; arg(1, OpTerm, Arg),
822 arg_options(Options, ArgOptions),
823 end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
824 ).
825end_code_type(Compound, Type, Options) :-
826 compound_name_arity(Compound, Name, _),
827 end_code_type(Name, Type, Options).
828
829op_or_arg(prefix, left, op).
830op_or_arg(prefix, right, arg).
831op_or_arg(postfix, left, arg).
832op_or_arg(postfix, right, op).
833
834
835
836end_type(S, Type, Options) :-
837 number(S),
838 !,
839 ( (S < 0 ; S == -0.0),
840 Options.side == left
841 -> Type = symbol
842 ; Type = alnum
843 ).
844end_type(S, Type, Options) :-
845 Options.side == left,
846 !,
847 left_type(S, Type).
848end_type(S, Type, _) :-
849 right_type(S, Type).
850
851left_type(S, Type), atom(S) =>
852 sub_atom(S, 0, 1, _, Start),
853 syntax_type(Start, Type).
854left_type(S, Type), string(S) =>
855 sub_string(S, 0, 1, _, Start),
856 syntax_type(Start, Type).
857left_type(S, Type), blob(S, _) =>
858 syntax_type("<", Type).
859
860right_type(S, Type), atom(S) =>
861 sub_atom(S, _, 1, 0, End),
862 syntax_type(End, Type).
863right_type(S, Type), string(S) =>
864 sub_string(S, _, 1, 0, End),
865 syntax_type(End, Type).
866right_type(S, Type), blob(S, _) =>
867 syntax_type(")", Type).
868
869syntax_type("\"", quote(double)) :- !.
870syntax_type("\'", quote(single)) :- !.
871syntax_type("\`", quote(back)) :- !.
872syntax_type(S, Type) :-
873 string_code(1, S, C),
874 ( code_type(C, prolog_identifier_continue)
875 -> Type = alnum
876 ; code_type(C, prolog_symbol)
877 -> Type = symbol
878 ; code_type(C, space)
879 -> Type = layout
880 ; Type = punct
881 ).
882
883is_solo(Var) :-
884 var(Var), !, fail.
885is_solo(',').
886is_solo(';').
887is_solo('!').
894primitive(Term, Type) :- var(Term), !, Type = 'pl-avar'.
895primitive(Term, Type) :- atom(Term), !, Type = 'pl-atom'.
896primitive(Term, Type) :- blob(Term,_), !, Type = 'pl-blob'.
897primitive(Term, Type) :- string(Term), !, Type = 'pl-string'.
898primitive(Term, Type) :- integer(Term), !, Type = 'pl-int'.
899primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
900primitive(Term, Type) :- float(Term), !, Type = 'pl-float'.
906operator_module(Module, Options) :-
907 Module = Options.get(module),
908 !.
909operator_module(TypeIn, _) :-
910 '$current_typein_module'(TypeIn).
916arg_options(Options, Options.put(depth, NewDepth)) :-
917 NewDepth is Options.depth+1.
918
919quote_atomic(Float, String, Options) :-
920 float(Float),
921 Format = Options.get(float_format),
922 !,
923 format(string(String), Format, [Float]).
924quote_atomic(Plain, Plain, _) :-
925 number(Plain),
926 !.
927quote_atomic(Plain, String, Options) :-
928 Options.get(quoted) == true,
929 !,
930 ( Options.get(embrace) == never
931 -> format(string(String), '~q', [Plain])
932 ; format(string(String), '~W', [Plain, Options])
933 ).
934quote_atomic(Var, String, Options) :-
935 var(Var),
936 !,
937 format(string(String), '~W', [Var, Options]).
938quote_atomic(Plain, Plain, _).
939
940space_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.