View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2001-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_listing,
   38        [ listing/0,
   39          listing/1,			% :Spec
   40          listing/2,                    % :Spec, +Options
   41          portray_clause/1,             % +Clause
   42          portray_clause/2,             % +Stream, +Clause
   43          portray_clause/3              % +Stream, +Clause, +Options
   44        ]).   45:- use_module(library(lists)).   46:- use_module(library(apply)).   47:- use_module(library(settings)).   48:- use_module(library(option)).   49:- use_module(library(error)).   50:- use_module(library(debug)).   51:- use_module(library(ansi_term)).   52:- use_module(library(prolog_clause)).   53:- set_prolog_flag(generate_debug_info, false).   54
   55:- module_transparent
   56    listing/0.   57:- meta_predicate
   58    listing(:),
   59    listing(:, +),
   60    portray_clause(+,+,:).   61
   62:- predicate_options(portray_clause/3, 3, [pass_to(system:write_term/3, 3)]).   63
   64:- multifile
   65    prolog:locate_clauses/2.        % +Spec, -ClauseRefList

List programs and pretty print clauses

This module implements listing code from the internal representation in a human readable format.

Layout can be customized using library(settings). The effective settings can be listed using list_settings/1 as illustrated below. Settings can be changed using set_setting/2.

?- list_settings(listing).
========================================================================
Name                      Value (*=modified) Comment
========================================================================
listing:body_indentation  4              Indentation used goals in the body
listing:tab_distance      0              Distance between tab-stops.
...
To be done
- More settings, support Coding Guidelines for Prolog and make the suggestions there the default.
- Provide persistent user customization */
   96:- setting(listing:body_indentation, nonneg, 4,
   97           'Indentation used goals in the body').   98:- setting(listing:tab_distance, nonneg, 0,
   99           'Distance between tab-stops.  0 uses only spaces').  100:- setting(listing:cut_on_same_line, boolean, false,
  101           'Place cuts (!) on the same line').  102:- setting(listing:line_width, nonneg, 78,
  103           'Width of a line.  0 is infinite').  104:- setting(listing:comment_ansi_attributes, list, [fg(green)],
  105           'ansi_format/3 attributes to print comments').
 listing
Lists all predicates defined in the calling module. Imported predicates are not listed. To list the content of the module mymodule, use one of the calls below.
?- mymodule:listing.
?- listing(mymodule:_).
  119listing :-
  120    context_module(Context),
  121    list_module(Context, []).
  122
  123list_module(Module, Options) :-
  124    (   current_predicate(_, Module:Pred),
  125        \+ predicate_property(Module:Pred, imported_from(_)),
  126        strip_module(Pred, _Module, Head),
  127        functor(Head, Name, _Arity),
  128        (   (   predicate_property(Module:Pred, built_in)
  129            ;   sub_atom(Name, 0, _, _, $)
  130            )
  131        ->  current_prolog_flag(access_level, system)
  132        ;   true
  133        ),
  134        nl,
  135        list_predicate(Module:Head, Module, Options),
  136        fail
  137    ;   true
  138    ).
 listing(:What) is det
 listing(:What, +Options) is det
List matching clauses. What is either a plain specification or a list of specifications. Plain specifications are:

The following options are defined:

variable_names(+How)
One of source (default) or generated. If source, for each clause that is associated to a source location the system tries to restore the original variable names. This may fail if macro expansion is not reversible or the term cannot be read due to different operator declarations. In that case variable names are generated.
source(+Bool)
If true (default false), extract the lines from the source files that produced the clauses, i.e., list the original source text rather than the decompiled clauses. Each set of contiguous clauses is preceded by a comment that indicates the file and line of origin. Clauses that cannot be related to source code are decompiled where the comment indicates the decompiled state. This is notably practical for collecting the state of multifile predicates. For example:
?- listing(file_search_path, [source(true)]).
  184listing(Spec) :-
  185    listing(Spec, []).
  186
  187listing(Spec, Options) :-
  188    call_cleanup(
  189        listing_(Spec, Options),
  190        close_sources).
  191
  192listing_(M:Spec, Options) :-
  193    var(Spec),
  194    !,
  195    list_module(M, Options).
  196listing_(M:List, Options) :-
  197    is_list(List),
  198    !,
  199    forall(member(Spec, List),
  200           listing_(M:Spec, Options)).
  201listing_(X, Options) :-
  202    (   prolog:locate_clauses(X, ClauseRefs)
  203    ->  strip_module(X, Context, _),
  204        list_clauserefs(ClauseRefs, Context, Options)
  205    ;   '$find_predicate'(X, Preds),
  206        list_predicates(Preds, X, Options)
  207    ).
  208
  209list_clauserefs([], _, _) :- !.
  210list_clauserefs([H|T], Context, Options) :-
  211    !,
  212    list_clauserefs(H, Context, Options),
  213    list_clauserefs(T, Context, Options).
  214list_clauserefs(Ref, Context, Options) :-
  215    @(clause(Head, Body, Ref), Context),
  216    list_clause(Head, Body, Ref, Context, Options).
 list_predicates(:Preds:list(pi), :Spec, +Options) is det
  220list_predicates(PIs, Context:X, Options) :-
  221    member(PI, PIs),
  222    pi_to_head(PI, Pred),
  223    unify_args(Pred, X),
  224    list_define(Pred, DefPred),
  225    list_predicate(DefPred, Context, Options),
  226    nl,
  227    fail.
  228list_predicates(_, _, _).
  229
  230list_define(Head, LoadModule:Head) :-
  231    compound(Head),
  232    Head \= (_:_),
  233    functor(Head, Name, Arity),
  234    '$find_library'(_, Name, Arity, LoadModule, Library),
  235    !,
  236    use_module(Library, []).
  237list_define(M:Pred, DefM:Pred) :-
  238    '$define_predicate'(M:Pred),
  239    (   predicate_property(M:Pred, imported_from(DefM))
  240    ->  true
  241    ;   DefM = M
  242    ).
  243
  244pi_to_head(PI, _) :-
  245    var(PI),
  246    !,
  247    instantiation_error(PI).
  248pi_to_head(M:PI, M:Head) :-
  249    !,
  250    pi_to_head(PI, Head).
  251pi_to_head(Name/Arity, Head) :-
  252    functor(Head, Name, Arity).
  253
  254
  255%       Unify the arguments of the specification with the given term,
  256%       so we can partially instantate the head.
  257
  258unify_args(_, _/_) :- !.                % Name/arity spec
  259unify_args(X, X) :- !.
  260unify_args(_:X, X) :- !.
  261unify_args(_, _).
  262
  263list_predicate(Pred, Context, _) :-
  264    predicate_property(Pred, undefined),
  265    !,
  266    decl_term(Pred, Context, Decl),
  267    comment('%   Undefined: ~q~n', [Decl]).
  268list_predicate(Pred, Context, _) :-
  269    predicate_property(Pred, foreign),
  270    !,
  271    decl_term(Pred, Context, Decl),
  272    comment('%   Foreign: ~q~n', [Decl]).
  273list_predicate(Pred, Context, Options) :-
  274    notify_changed(Pred, Context),
  275    list_declarations(Pred, Context),
  276    list_clauses(Pred, Context, Options).
  277
  278decl_term(Pred, Context, Decl) :-
  279    strip_module(Pred, Module, Head),
  280    functor(Head, Name, Arity),
  281    (   hide_module(Module, Context, Head)
  282    ->  Decl = Name/Arity
  283    ;   Decl = Module:Name/Arity
  284    ).
  285
  286
  287decl(thread_local, thread_local).
  288decl(dynamic,      dynamic).
  289decl(volatile,     volatile).
  290decl(multifile,    multifile).
  291decl(public,       public).
 declaration(:Head, +Module, -Decl) is nondet
True when the directive Decl (without :-/1) needs to be used to restore the state of the predicate Head.
To be done
- Answer subsumption, dynamic/2 to deal with incremental and abstract(Depth)
  301declaration(Pred, Source, Decl) :-
  302    predicate_property(Pred, tabled),
  303    Pred = M:Head,
  304    (   M:'$table_mode'(Head, Head, _)
  305    ->  decl_term(Pred, Source, Funct),
  306        table_options(Pred, Funct, TableDecl),
  307        Decl = table(TableDecl)
  308    ;   comment('% tabled using answer subsumption', []),
  309        fail                                    % TBD
  310    ).
  311declaration(Pred, Source, Decl) :-
  312    decl(Prop, Declname),
  313    predicate_property(Pred, Prop),
  314    decl_term(Pred, Source, Funct),
  315    Decl =.. [ Declname, Funct ].
  316declaration(Pred, Source, Decl) :-
  317    predicate_property(Pred, meta_predicate(Head)),
  318    strip_module(Pred, Module, _),
  319    (   (Module == system; Source == Module)
  320    ->  Decl = meta_predicate(Head)
  321    ;   Decl = meta_predicate(Module:Head)
  322    ),
  323    (   meta_implies_transparent(Head)
  324    ->  !                                   % hide transparent
  325    ;   true
  326    ).
  327declaration(Pred, Source, Decl) :-
  328    predicate_property(Pred, transparent),
  329    decl_term(Pred, Source, PI),
  330    Decl = module_transparent(PI).
 meta_implies_transparent(+Head) is semidet
True if the meta-declaration Head implies that the predicate is transparent.
  337meta_implies_transparent(Head):-
  338    compound(Head),
  339    arg(_, Head, Arg),
  340    implies_transparent(Arg),
  341    !.
  342
  343implies_transparent(Arg) :-
  344    integer(Arg),
  345    !.
  346implies_transparent(:).
  347implies_transparent(//).
  348implies_transparent(^).
  349
  350table_options(Pred, Decl0, as(Decl0, Options)) :-
  351    findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]),
  352    !,
  353    foldl(table_option, Flags, F0, Options).
  354table_options(_, Decl, Decl).
  355
  356table_option(Flag, X, (Flag,X)).
  357
  358list_declarations(Pred, Source) :-
  359    findall(Decl, declaration(Pred, Source, Decl), Decls),
  360    (   Decls == []
  361    ->  true
  362    ;   write_declarations(Decls, Source),
  363        format('~n', [])
  364    ).
  365
  366
  367write_declarations([], _) :- !.
  368write_declarations([H|T], Module) :-
  369    format(':- ~q.~n', [H]),
  370    write_declarations(T, Module).
  371
  372list_clauses(Pred, Source, Options) :-
  373    strip_module(Pred, Module, Head),
  374    forall(clause(Pred, Body, Ref),
  375           list_clause(Module:Head, Body, Ref, Source, Options)).
  376
  377list_clause(_Head, _Body, Ref, _Source, Options) :-
  378    option(source(true), Options),
  379    (   clause_property(Ref, file(File)),
  380        clause_property(Ref, line_count(Line)),
  381        catch(source_clause_string(File, Line, String, Repositioned),
  382              _, fail),
  383        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  384    ->  !,
  385        (   Repositioned == true
  386        ->  comment('% From ~w:~d~n', [ File, Line ])
  387        ;   true
  388        ),
  389        writeln(String)
  390    ;   decompiled
  391    ->  fail
  392    ;   asserta(decompiled),
  393        comment('% From database (decompiled)~n', []),
  394        fail                                    % try next clause
  395    ).
  396list_clause(Module:Head, Body, Ref, Source, Options) :-
  397    restore_variable_names(Module, Head, Body, Ref, Options),
  398    write_module(Module, Source, Head),
  399    portray_clause((Head:-Body)).
 restore_variable_names(+Module, +Head, +Body, +Ref, +Options) is det
Try to restore the variable names from the source if the option variable_names(source) is true.
  406restore_variable_names(Module, Head, Body, Ref, Options) :-
  407    option(variable_names(source), Options, source),
  408    catch(clause_info(Ref, _, _, _,
  409                      [ head(QHead),
  410                        body(Body),
  411                        variable_names(Bindings)
  412                      ]),
  413          _, true),
  414    unify_head(Module, Head, QHead),
  415    !,
  416    bind_vars(Bindings),
  417    name_other_vars((Head:-Body), Bindings).
  418restore_variable_names(_,_,_,_,_).
  419
  420unify_head(Module, Head, Module:Head) :-
  421    !.
  422unify_head(_, Head, Head) :-
  423    !.
  424unify_head(_, _, _).
  425
  426bind_vars([]) :-
  427    !.
  428bind_vars([Name = Var|T]) :-
  429    ignore(Var = '$VAR'(Name)),
  430    bind_vars(T).
 name_other_vars(+Term, +Bindings) is det
Give a '$VAR'(N) name to all remaining variables in Term, avoiding clashes with the given variable names.
  437name_other_vars(Term, Bindings) :-
  438    term_singletons(Term, Singletons),
  439    bind_singletons(Singletons),
  440    term_variables(Term, Vars),
  441    name_vars(Vars, 0, Bindings).
  442
  443bind_singletons([]).
  444bind_singletons(['$VAR'('_')|T]) :-
  445    bind_singletons(T).
  446
  447name_vars([], _, _).
  448name_vars([H|T], N, Bindings) :-
  449    between(N, infinite, N2),
  450    var_name(N2, Name),
  451    \+ memberchk(Name=_, Bindings),
  452    !,
  453    H = '$VAR'(N2),
  454    N3 is N2 + 1,
  455    name_vars(T, N3, Bindings).
  456
  457var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  458    L is (I mod 26)+0'A,
  459    N is I // 26,
  460    (   N == 0
  461    ->  char_code(Name, L)
  462    ;   format(atom(Name), '~c~d', [L, N])
  463    ).
  464
  465write_module(Module, Context, Head) :-
  466    hide_module(Module, Context, Head),
  467    !.
  468write_module(Module, _, _) :-
  469    format('~q:', [Module]).
  470
  471hide_module(system, Module, Head) :-
  472    predicate_property(Module:Head, imported_from(M)),
  473    predicate_property(system:Head, imported_from(M)),
  474    !.
  475hide_module(Module, Module, _) :- !.
  476
  477notify_changed(Pred, Context) :-
  478    strip_module(Pred, user, Head),
  479    predicate_property(Head, built_in),
  480    \+ predicate_property(Head, (dynamic)),
  481    !,
  482    decl_term(Pred, Context, Decl),
  483    comment('%   NOTE: system definition has been overruled for ~q~n',
  484            [Decl]).
  485notify_changed(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  492source_clause_string(File, Line, String, Repositioned) :-
  493    open_source(File, Line, Stream, Repositioned),
  494    stream_property(Stream, position(Start)),
  495    '$raw_read'(Stream, _TextWithoutComments),
  496    stream_property(Stream, position(End)),
  497    stream_position_data(char_count, Start, StartChar),
  498    stream_position_data(char_count, End, EndChar),
  499    Length is EndChar - StartChar,
  500    set_stream_position(Stream, Start),
  501    read_string(Stream, Length, String),
  502    skip_blanks_and_comments(Stream, blank).
  503
  504skip_blanks_and_comments(Stream, _) :-
  505    at_end_of_stream(Stream),
  506    !.
  507skip_blanks_and_comments(Stream, State0) :-
  508    peek_string(Stream, 80, String),
  509    string_chars(String, Chars),
  510    phrase(blanks_and_comments(State0, State), Chars, Rest),
  511    (   Rest == []
  512    ->  read_string(Stream, 80, _),
  513        skip_blanks_and_comments(Stream, State)
  514    ;   length(Chars, All),
  515        length(Rest, RLen),
  516        Skip is All-RLen,
  517        read_string(Stream, Skip, _)
  518    ).
  519
  520blanks_and_comments(State0, State) -->
  521    [C],
  522    { transition(C, State0, State1) },
  523    !,
  524    blanks_and_comments(State1, State).
  525blanks_and_comments(State, State) -->
  526    [].
  527
  528transition(C, blank, blank) :-
  529    char_type(C, space).
  530transition('%', blank, line_comment).
  531transition('\n', line_comment, blank).
  532transition(_, line_comment, line_comment).
  533transition('/', blank, comment_0).
  534transition('/', comment(N), comment(N,/)).
  535transition('*', comment(N,/), comment(N1)) :-
  536    N1 is N + 1.
  537transition('*', comment_0, comment(1)).
  538transition('*', comment(N), comment(N,*)).
  539transition('/', comment(N,*), State) :-
  540    (   N == 1
  541    ->  State = blank
  542    ;   N2 is N - 1,
  543        State = comment(N2)
  544    ).
  545
  546
  547open_source(File, Line, Stream, Repositioned) :-
  548    source_stream(File, Stream, Pos0, Repositioned),
  549    line_count(Stream, Line0),
  550    (   Line >= Line0
  551    ->  Skip is Line - Line0
  552    ;   set_stream_position(Stream, Pos0),
  553        Skip is Line - 1
  554    ),
  555    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  556    (   Skip =\= 0
  557    ->  Repositioned = true
  558    ;   true
  559    ),
  560    forall(between(1, Skip, _),
  561           skip(Stream, 0'\n)).
  562
  563:- thread_local
  564    opened_source/3,
  565    decompiled/0.  566
  567source_stream(File, Stream, Pos0, _) :-
  568    opened_source(File, Stream, Pos0),
  569    !.
  570source_stream(File, Stream, Pos0, true) :-
  571    open(File, read, Stream),
  572    stream_property(Stream, position(Pos0)),
  573    asserta(opened_source(File, Stream, Pos0)).
  574
  575close_sources :-
  576    retractall(decompiled),
  577    forall(retract(opened_source(_,Stream,_)),
  578           close(Stream)).
 portray_clause(+Clause) is det
 portray_clause(+Out:stream, +Clause) is det
 portray_clause(+Out:stream, +Clause, +Options) is det
Portray `Clause' on the current output stream. Layout of the clause is to our best standards. As the actual variable names are not available we use A, B, ... Deals with ';', '|', '->' and calls via meta-call predicates as determined using the predicate property meta_predicate. If Clause contains attributed variables, these are treated as normal variables.

If Options is provided, the option-list is passed to write_term/3 that does the final writing of arguments.

  595%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  596%       confusion if the heads relates to other   bodies.  For now it is
  597%       only used for XPCE methods and works just nice.
  598%
  599%       Not really ...  It may confuse the source-level debugger.
  600
  601%portray_clause(Head :- _Body) :-
  602%       user:prolog_list_goal(Head), !.
  603portray_clause(Term) :-
  604    current_output(Out),
  605    portray_clause(Out, Term).
  606
  607portray_clause(Stream, Term) :-
  608    must_be(stream, Stream),
  609    portray_clause(Stream, Term, []).
  610
  611portray_clause(Stream, Term, M:Options) :-
  612    must_be(list, Options),
  613    meta_options(is_meta, M:Options, QOptions),
  614    \+ \+ ( copy_term_nat(Term, Copy),
  615            numbervars(Copy, 0, _,
  616                       [ singletons(true)
  617                       ]),
  618            do_portray_clause(Stream, Copy, QOptions)
  619          ).
  620
  621is_meta(portray_goal).
  622
  623do_portray_clause(Out, Var, Options) :-
  624    var(Var),
  625    !,
  626    option(indent(LeftMargin), Options, 0),
  627    indent(Out, LeftMargin),
  628    pprint(Out, Var, 1200, Options).
  629do_portray_clause(Out, (Head :- true), Options) :-
  630    !,
  631    option(indent(LeftMargin), Options, 0),
  632    indent(Out, LeftMargin),
  633    pprint(Out, Head, 1200, Options),
  634    full_stop(Out).
  635do_portray_clause(Out, Term, Options) :-
  636    clause_term(Term, Head, Neck, Body),
  637    !,
  638    option(indent(LeftMargin), Options, 0),
  639    inc_indent(LeftMargin, 1, Indent),
  640    infix_op(Neck, RightPri, LeftPri),
  641    indent(Out, LeftMargin),
  642    pprint(Out, Head, LeftPri, Options),
  643    format(Out, ' ~w', [Neck]),
  644    (   nonvar(Body),
  645        Body = Module:LocalBody,
  646        \+ primitive(LocalBody)
  647    ->  nlindent(Out, Indent),
  648        format(Out, '~q', [Module]),
  649        '$put_token'(Out, :),
  650        nlindent(Out, Indent),
  651        write(Out, '(   '),
  652        inc_indent(Indent, 1, BodyIndent),
  653        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  654        nlindent(Out, Indent),
  655        write(Out, ')')
  656    ;   setting(listing:body_indentation, BodyIndent0),
  657        BodyIndent is LeftMargin+BodyIndent0,
  658        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  659    ),
  660    full_stop(Out).
  661do_portray_clause(Out, (:-use_module(File, Imports)), Options) :-
  662    length(Imports, Len),
  663    Len > 3,
  664    !,
  665    option(indent(LeftMargin), Options, 0),
  666    indent(Out, LeftMargin),
  667    ListIndent is LeftMargin+14,
  668    format(Out, ':- use_module(~q,', [File]),
  669    portray_list(Imports, ListIndent, Out, Options),
  670    write(Out, ').\n').
  671do_portray_clause(Out, (:-module(Module, Exports)), Options) :-
  672    !,
  673    option(indent(LeftMargin), Options, 0),
  674    indent(Out, LeftMargin),
  675    ModuleIndent is LeftMargin+10,
  676    format(Out, ':- module(~q,', [Module]),
  677    portray_list(Exports, ModuleIndent, Out, Options),
  678    write(Out, ').\n').
  679do_portray_clause(Out, (:-Directive), Options) :-
  680    !,
  681    option(indent(LeftMargin), Options, 0),
  682    indent(Out, LeftMargin),
  683    write(Out, ':- '),
  684    DIndent is LeftMargin+3,
  685    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  686    full_stop(Out).
  687do_portray_clause(Out, Fact, Options) :-
  688    option(indent(LeftMargin), Options, 0),
  689    indent(Out, LeftMargin),
  690    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  691    full_stop(Out).
  692
  693clause_term((Head:-Body), Head, :-, Body).
  694clause_term((Head-->Body), Head, -->, Body).
  695
  696full_stop(Out) :-
  697    '$put_token'(Out, '.'),
  698    nl(Out).
 portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
Write Term at current indentation. If DoIndent is 'indent' we must first call nlindent/2 before emitting anything.
  706portray_body(Var, _, _, Pri, Out, Options) :-
  707    var(Var),
  708    !,
  709    pprint(Out, Var, Pri, Options).
  710portray_body(!, _, _, _, Out, _) :-
  711    setting(listing:cut_on_same_line, true),
  712    !,
  713    write(Out, ' !').
  714portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  715    setting(listing:cut_on_same_line, true),
  716    \+ term_needs_braces((_,_), Pri),
  717    !,
  718    write(Out, ' !,'),
  719    portray_body(Clause, Indent, indent, 1000, Out, Options).
  720portray_body(Term, Indent, indent, Pri, Out, Options) :-
  721    !,
  722    nlindent(Out, Indent),
  723    portray_body(Term, Indent, noindent, Pri, Out, Options).
  724portray_body(Or, Indent, _, _, Out, Options) :-
  725    or_layout(Or),
  726    !,
  727    write(Out, '(   '),
  728    portray_or(Or, Indent, 1200, Out, Options),
  729    nlindent(Out, Indent),
  730    write(Out, ')').
  731portray_body(Term, Indent, _, Pri, Out, Options) :-
  732    term_needs_braces(Term, Pri),
  733    !,
  734    write(Out, '( '),
  735    ArgIndent is Indent + 2,
  736    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  737    nlindent(Out, Indent),
  738    write(Out, ')').
  739portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  740    !,
  741    infix_op(',', LeftPri, RightPri),
  742    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  743    write(Out, ','),
  744    portray_body(B, Indent, indent, RightPri, Out, Options).
  745portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  746    !,
  747    write(Out, \+), write(Out, ' '),
  748    prefix_op(\+, ArgPri),
  749    ArgIndent is Indent+3,
  750    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  751portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  752    m_callable(Call),
  753    option(module(M), Options, user),
  754    predicate_property(M:Call, meta_predicate(Meta)),
  755    !,
  756    portray_meta(Out, Call, Meta, Options).
  757portray_body(Clause, _, _, Pri, Out, Options) :-
  758    pprint(Out, Clause, Pri, Options).
  759
  760m_callable(Term) :-
  761    strip_module(Term, _, Plain),
  762    callable(Plain),
  763    Plain \= (_:_).
  764
  765term_needs_braces(Term, Pri) :-
  766    callable(Term),
  767    functor(Term, Name, _Arity),
  768    current_op(OpPri, _Type, Name),
  769    OpPri > Pri,
  770    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  774portray_or(Term, Indent, Pri, Out, Options) :-
  775    term_needs_braces(Term, Pri),
  776    !,
  777    inc_indent(Indent, 1, NewIndent),
  778    write(Out, '(   '),
  779    portray_or(Term, NewIndent, Out, Options),
  780    nlindent(Out, NewIndent),
  781    write(Out, ')').
  782portray_or(Term, Indent, _Pri, Out, Options) :-
  783    or_layout(Term),
  784    !,
  785    portray_or(Term, Indent, Out, Options).
  786portray_or(Term, Indent, Pri, Out, Options) :-
  787    inc_indent(Indent, 1, NestIndent),
  788    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  789
  790
  791portray_or((If -> Then ; Else), Indent, Out, Options) :-
  792    !,
  793    inc_indent(Indent, 1, NestIndent),
  794    infix_op((->), LeftPri, RightPri),
  795    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  796    nlindent(Out, Indent),
  797    write(Out, '->  '),
  798    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  799    nlindent(Out, Indent),
  800    write(Out, ';   '),
  801    infix_op(;, _LeftPri, RightPri2),
  802    portray_or(Else, Indent, RightPri2, Out, Options).
  803portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  804    !,
  805    inc_indent(Indent, 1, NestIndent),
  806    infix_op((*->), LeftPri, RightPri),
  807    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  808    nlindent(Out, Indent),
  809    write(Out, '*-> '),
  810    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  811    nlindent(Out, Indent),
  812    write(Out, ';   '),
  813    infix_op(;, _LeftPri, RightPri2),
  814    portray_or(Else, Indent, RightPri2, Out, Options).
  815portray_or((If -> Then), Indent, Out, Options) :-
  816    !,
  817    inc_indent(Indent, 1, NestIndent),
  818    infix_op((->), LeftPri, RightPri),
  819    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  820    nlindent(Out, Indent),
  821    write(Out, '->  '),
  822    portray_or(Then, Indent, RightPri, Out, Options).
  823portray_or((If *-> Then), Indent, Out, Options) :-
  824    !,
  825    inc_indent(Indent, 1, NestIndent),
  826    infix_op((->), LeftPri, RightPri),
  827    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  828    nlindent(Out, Indent),
  829    write(Out, '*-> '),
  830    portray_or(Then, Indent, RightPri, Out, Options).
  831portray_or((A;B), Indent, Out, Options) :-
  832    !,
  833    inc_indent(Indent, 1, NestIndent),
  834    infix_op(;, LeftPri, RightPri),
  835    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  836    nlindent(Out, Indent),
  837    write(Out, ';   '),
  838    portray_or(B, Indent, RightPri, Out, Options).
  839portray_or((A|B), Indent, Out, Options) :-
  840    !,
  841    inc_indent(Indent, 1, NestIndent),
  842    infix_op('|', LeftPri, RightPri),
  843    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  844    nlindent(Out, Indent),
  845    write(Out, '|   '),
  846    portray_or(B, Indent, RightPri, Out, Options).
 infix_op(+Op, -Left, -Right) is semidet
True if Op is an infix operator and Left is the max priority of its left hand and Right is the max priority of its right hand.
  854infix_op(Op, Left, Right) :-
  855    current_op(Pri, Assoc, Op),
  856    infix_assoc(Assoc, LeftMin, RightMin),
  857    !,
  858    Left is Pri - LeftMin,
  859    Right is Pri - RightMin.
  860
  861infix_assoc(xfx, 1, 1).
  862infix_assoc(xfy, 1, 0).
  863infix_assoc(yfx, 0, 1).
  864
  865prefix_op(Op, ArgPri) :-
  866    current_op(Pri, Assoc, Op),
  867    pre_assoc(Assoc, ArgMin),
  868    !,
  869    ArgPri is Pri - ArgMin.
  870
  871pre_assoc(fx, 1).
  872pre_assoc(fy, 0).
  873
  874postfix_op(Op, ArgPri) :-
  875    current_op(Pri, Assoc, Op),
  876    post_assoc(Assoc, ArgMin),
  877    !,
  878    ArgPri is Pri - ArgMin.
  879
  880post_assoc(xf, 1).
  881post_assoc(yf, 0).
 or_layout(@Term) is semidet
True if Term is a control structure for which we want to use clean layout.
To be done
- Change name.
  890or_layout(Var) :-
  891    var(Var), !, fail.
  892or_layout((_;_)).
  893or_layout((_->_)).
  894or_layout((_*->_)).
  895
  896primitive(G) :-
  897    or_layout(G), !, fail.
  898primitive((_,_)) :- !, fail.
  899primitive(_).
 portray_meta(+Out, +Call, +MetaDecl, +Options)
Portray a meta-call. If Call contains non-primitive meta-calls we put each argument on a line and layout the body. Otherwise we simply print the goal.
  908portray_meta(Out, Call, Meta, Options) :-
  909    contains_non_primitive_meta_arg(Call, Meta),
  910    !,
  911    Call =.. [Name|Args],
  912    Meta =.. [_|Decls],
  913    format(Out, '~q(', [Name]),
  914    line_position(Out, Indent),
  915    portray_meta_args(Decls, Args, Indent, Out, Options),
  916    format(Out, ')', []).
  917portray_meta(Out, Call, _, Options) :-
  918    pprint(Out, Call, 999, Options).
  919
  920contains_non_primitive_meta_arg(Call, Decl) :-
  921    arg(I, Call, CA),
  922    arg(I, Decl, DA),
  923    integer(DA),
  924    \+ primitive(CA),
  925    !.
  926
  927portray_meta_args([], [], _, _, _).
  928portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  929    portray_meta_arg(D, A, Out, Options),
  930    (   DT == []
  931    ->  true
  932    ;   format(Out, ',', []),
  933        nlindent(Out, Indent),
  934        portray_meta_args(DT, AT, Indent, Out, Options)
  935    ).
  936
  937portray_meta_arg(I, A, Out, Options) :-
  938    integer(I),
  939    !,
  940    line_position(Out, Indent),
  941    portray_body(A, Indent, noindent, 999, Out, Options).
  942portray_meta_arg(_, A, Out, Options) :-
  943    pprint(Out, A, 999, Options).
 portray_list(+List, +Indent, +Out)
Portray a list like this. Right side for improper lists
[ element1,             [ element1
  element2,     OR      | tail
]                       ]
  953portray_list([], _, Out, _) :-
  954    !,
  955    write(Out, []).
  956portray_list(List, Indent, Out, Options) :-
  957    nlindent(Out, Indent),
  958    write(Out, '[ '),
  959    EIndent is Indent + 2,
  960    portray_list_elements(List, EIndent, Out, Options),
  961    nlindent(Out, Indent),
  962    write(Out, ']').
  963
  964portray_list_elements([H|T], EIndent, Out, Options) :-
  965    pprint(Out, H, 999, Options),
  966    (   T == []
  967    ->  true
  968    ;   nonvar(T), T = [_|_]
  969    ->  write(Out, ','),
  970        nlindent(Out, EIndent),
  971        portray_list_elements(T, EIndent, Out, Options)
  972    ;   Indent is EIndent - 2,
  973        nlindent(Out, Indent),
  974        write(Out, '| '),
  975        pprint(Out, T, 999, Options)
  976    ).
 pprint(+Out, +Term, +Priority, +Options)
Print Term at Priority. This also takes care of several formatting options, in particular:
To be done
- Decide when and how to wrap long terms.
  990pprint(Out, Term, _, Options) :-
  991    nonvar(Term),
  992    Term = {}(Arg),
  993    line_position(Out, Indent),
  994    ArgIndent is Indent + 2,
  995    format(Out, '{ ', []),
  996    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
  997    nlindent(Out, Indent),
  998    format(Out, '}', []).
  999pprint(Out, Term, Pri, Options) :-
 1000    (   compound(Term)
 1001    ->  compound_name_arity(Term, _, Arity),
 1002        Arity > 0
 1003    ;   is_dict(Term)
 1004    ),
 1005    \+ nowrap_term(Term),
 1006    setting(listing:line_width, Width),
 1007    Width > 0,
 1008    (   write_length(Term, Len, [max_length(Width)|Options])
 1009    ->  true
 1010    ;   Len = Width
 1011    ),
 1012    line_position(Out, Indent),
 1013    Indent + Len > Width,
 1014    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1015    !,
 1016    pprint_wrapped(Out, Term, Pri, Options).
 1017pprint(Out, Term, Pri, Options) :-
 1018    listing_write_options(Pri, WrtOptions, Options),
 1019    write_term(Out, Term, WrtOptions).
 1020
 1021nowrap_term('$VAR'(_)) :- !.
 1022nowrap_term(_{}) :- !.                  % empty dict
 1023nowrap_term(Term) :-
 1024    functor(Term, Name, Arity),
 1025    current_op(_, _, Name),
 1026    (   Arity == 2
 1027    ->  infix_op(Name, _, _)
 1028    ;   Arity == 1
 1029    ->  (   prefix_op(Name, _)
 1030        ->  true
 1031        ;   postfix_op(Name, _)
 1032        )
 1033    ).
 1034
 1035
 1036pprint_wrapped(Out, Term, _, Options) :-
 1037    Term = [_|_],
 1038    !,
 1039    line_position(Out, Indent),
 1040    portray_list(Term, Indent, Out, Options).
 1041pprint_wrapped(Out, Dict, _, Options) :-
 1042    is_dict(Dict),
 1043    !,
 1044    dict_pairs(Dict, Tag, Pairs),
 1045    pprint(Out, Tag, 1200, Options),
 1046    format(Out, '{ ', []),
 1047    line_position(Out, Indent),
 1048    pprint_nv(Pairs, Indent, Out, Options),
 1049    nlindent(Out, Indent-2),
 1050    format(Out, '}', []).
 1051pprint_wrapped(Out, Term, _, Options) :-
 1052    Term =.. [Name|Args],
 1053    format(Out, '~q(', Name),
 1054    line_position(Out, Indent),
 1055    pprint_args(Args, Indent, Out, Options),
 1056    format(Out, ')', []).
 1057
 1058pprint_args([], _, _, _).
 1059pprint_args([H|T], Indent, Out, Options) :-
 1060    pprint(Out, H, 999, Options),
 1061    (   T == []
 1062    ->  true
 1063    ;   format(Out, ',', []),
 1064        nlindent(Out, Indent),
 1065        pprint_args(T, Indent, Out, Options)
 1066    ).
 1067
 1068
 1069pprint_nv([], _, _, _).
 1070pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1071    pprint(Out, Name, 999, Options),
 1072    format(Out, ':', []),
 1073    pprint(Out, Value, 999, Options),
 1074    (   T == []
 1075    ->  true
 1076    ;   format(Out, ',', []),
 1077        nlindent(Out, Indent),
 1078        pprint_nv(T, Indent, Out, Options)
 1079    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1087listing_write_options(Pri,
 1088                      [ quoted(true),
 1089                        numbervars(true),
 1090                        priority(Pri),
 1091                        spacing(next_argument)
 1092                      | Options
 1093                      ],
 1094                      Options).
 nlindent(+Out, +Indent)
Write newline and indent to column Indent. Uses the setting listing:tab_distance to determine the mapping between tabs and spaces.
 1102nlindent(Out, N) :-
 1103    nl(Out),
 1104    indent(Out, N).
 1105
 1106indent(Out, N) :-
 1107    setting(listing:tab_distance, D),
 1108    (   D =:= 0
 1109    ->  tab(Out, N)
 1110    ;   Tab is N // D,
 1111        Space is N mod D,
 1112        put_tabs(Out, Tab),
 1113        tab(Out, Space)
 1114    ).
 1115
 1116put_tabs(Out, N) :-
 1117    N > 0,
 1118    !,
 1119    put(Out, 0'\t),
 1120    NN is N - 1,
 1121    put_tabs(Out, NN).
 1122put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1129inc_indent(Indent0, Inc, Indent) :-
 1130    Indent is Indent0 + Inc*4.
 1131
 1132:- multifile
 1133    sandbox:safe_meta/2. 1134
 1135sandbox:safe_meta(listing(What), []) :-
 1136    not_qualified(What).
 1137
 1138not_qualified(Var) :-
 1139    var(Var),
 1140    !.
 1141not_qualified(_:_) :- !, fail.
 1142not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1149comment(Format, Args) :-
 1150    stream_property(current_output, tty(true)),
 1151    setting(listing:comment_ansi_attributes, Attributes),
 1152    Attributes \== [],
 1153    !,
 1154    ansi_format(Attributes, Format, Args).
 1155comment(Format, Args) :-
 1156    format(Format, Args)