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(settings),[setting/4,setting/2]).   46
   47:- autoload(library(ansi_term),[ansi_format/3]).   48:- autoload(library(apply),[foldl/4]).   49:- autoload(library(debug),[debug/3]).   50:- autoload(library(error),[instantiation_error/1,must_be/2]).   51:- autoload(library(lists),[member/2]).   52:- autoload(library(option),[option/2,option/3,meta_options/3]).   53:- autoload(library(prolog_clause),[clause_info/5]).   54
   55:- set_prolog_flag(generate_debug_info, false).   56
   57:- module_transparent
   58    listing/0.   59:- meta_predicate
   60    listing(:),
   61    listing(:, +),
   62    portray_clause(+,+,:).   63
   64:- predicate_options(portray_clause/3, 3, [pass_to(system:write_term/3, 3)]).   65
   66:- multifile
   67    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 */
   98:- setting(listing:body_indentation, nonneg, 4,
   99           'Indentation used goals in the body').  100:- setting(listing:tab_distance, nonneg, 0,
  101           'Distance between tab-stops.  0 uses only spaces').  102:- setting(listing:cut_on_same_line, boolean, false,
  103           'Place cuts (!) on the same line').  104:- setting(listing:line_width, nonneg, 78,
  105           'Width of a line.  0 is infinite').  106:- setting(listing:comment_ansi_attributes, list, [fg(green)],
  107           '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:_).
  121listing :-
  122    context_module(Context),
  123    list_module(Context, []).
  124
  125list_module(Module, Options) :-
  126    (   current_predicate(_, Module:Pred),
  127        \+ predicate_property(Module:Pred, imported_from(_)),
  128        strip_module(Pred, _Module, Head),
  129        functor(Head, Name, _Arity),
  130        (   (   predicate_property(Module:Pred, built_in)
  131            ;   sub_atom(Name, 0, _, _, $)
  132            )
  133        ->  current_prolog_flag(access_level, system)
  134        ;   true
  135        ),
  136        nl,
  137        list_predicate(Module:Head, Module, Options),
  138        fail
  139    ;   true
  140    ).
 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)]).
  186listing(Spec) :-
  187    listing(Spec, []).
  188
  189listing(Spec, Options) :-
  190    call_cleanup(
  191        listing_(Spec, Options),
  192        close_sources).
  193
  194listing_(M:Spec, Options) :-
  195    var(Spec),
  196    !,
  197    list_module(M, Options).
  198listing_(M:List, Options) :-
  199    is_list(List),
  200    !,
  201    forall(member(Spec, List),
  202           listing_(M:Spec, Options)).
  203listing_(X, Options) :-
  204    (   prolog:locate_clauses(X, ClauseRefs)
  205    ->  strip_module(X, Context, _),
  206        list_clauserefs(ClauseRefs, Context, Options)
  207    ;   '$find_predicate'(X, Preds),
  208        list_predicates(Preds, X, Options)
  209    ).
  210
  211list_clauserefs([], _, _) :- !.
  212list_clauserefs([H|T], Context, Options) :-
  213    !,
  214    list_clauserefs(H, Context, Options),
  215    list_clauserefs(T, Context, Options).
  216list_clauserefs(Ref, Context, Options) :-
  217    @(clause(Head, Body, Ref), Context),
  218    list_clause(Head, Body, Ref, Context, Options).
 list_predicates(:Preds:list(pi), :Spec, +Options) is det
  222list_predicates(PIs, Context:X, Options) :-
  223    member(PI, PIs),
  224    pi_to_head(PI, Pred),
  225    unify_args(Pred, X),
  226    list_define(Pred, DefPred),
  227    list_predicate(DefPred, Context, Options),
  228    nl,
  229    fail.
  230list_predicates(_, _, _).
  231
  232list_define(Head, LoadModule:Head) :-
  233    compound(Head),
  234    Head \= (_:_),
  235    functor(Head, Name, Arity),
  236    '$find_library'(_, Name, Arity, LoadModule, Library),
  237    !,
  238    use_module(Library, []).
  239list_define(M:Pred, DefM:Pred) :-
  240    '$define_predicate'(M:Pred),
  241    (   predicate_property(M:Pred, imported_from(DefM))
  242    ->  true
  243    ;   DefM = M
  244    ).
  245
  246pi_to_head(PI, _) :-
  247    var(PI),
  248    !,
  249    instantiation_error(PI).
  250pi_to_head(M:PI, M:Head) :-
  251    !,
  252    pi_to_head(PI, Head).
  253pi_to_head(Name/Arity, Head) :-
  254    functor(Head, Name, Arity).
  255
  256
  257%       Unify the arguments of the specification with the given term,
  258%       so we can partially instantate the head.
  259
  260unify_args(_, _/_) :- !.                % Name/arity spec
  261unify_args(X, X) :- !.
  262unify_args(_:X, X) :- !.
  263unify_args(_, _).
  264
  265list_predicate(Pred, Context, _) :-
  266    predicate_property(Pred, undefined),
  267    !,
  268    decl_term(Pred, Context, Decl),
  269    comment('%   Undefined: ~q~n', [Decl]).
  270list_predicate(Pred, Context, _) :-
  271    predicate_property(Pred, foreign),
  272    !,
  273    decl_term(Pred, Context, Decl),
  274    comment('%   Foreign: ~q~n', [Decl]).
  275list_predicate(Pred, Context, Options) :-
  276    notify_changed(Pred, Context),
  277    list_declarations(Pred, Context),
  278    list_clauses(Pred, Context, Options).
  279
  280decl_term(Pred, Context, Decl) :-
  281    strip_module(Pred, Module, Head),
  282    functor(Head, Name, Arity),
  283    (   hide_module(Module, Context, Head)
  284    ->  Decl = Name/Arity
  285    ;   Decl = Module:Name/Arity
  286    ).
  287
  288
  289decl(thread_local, thread_local).
  290decl(dynamic,      dynamic).
  291decl(volatile,     volatile).
  292decl(multifile,    multifile).
  293decl(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)
  303declaration(Pred, Source, Decl) :-
  304    predicate_property(Pred, tabled),
  305    Pred = M:Head,
  306    (   M:'$table_mode'(Head, Head, _)
  307    ->  decl_term(Pred, Source, Funct),
  308        table_options(Pred, Funct, TableDecl),
  309        Decl = table(TableDecl)
  310    ;   comment('% tabled using answer subsumption~n', []),
  311        fail                                    % TBD
  312    ).
  313declaration(Pred, Source, Decl) :-
  314    decl(Prop, Declname),
  315    predicate_property(Pred, Prop),
  316    decl_term(Pred, Source, Funct),
  317    Decl =.. [ Declname, Funct ].
  318declaration(Pred, Source, Decl) :-
  319    predicate_property(Pred, meta_predicate(Head)),
  320    strip_module(Pred, Module, _),
  321    (   (Module == system; Source == Module)
  322    ->  Decl = meta_predicate(Head)
  323    ;   Decl = meta_predicate(Module:Head)
  324    ),
  325    (   meta_implies_transparent(Head)
  326    ->  !                                   % hide transparent
  327    ;   true
  328    ).
  329declaration(Pred, Source, Decl) :-
  330    predicate_property(Pred, transparent),
  331    decl_term(Pred, Source, PI),
  332    Decl = module_transparent(PI).
 meta_implies_transparent(+Head) is semidet
True if the meta-declaration Head implies that the predicate is transparent.
  339meta_implies_transparent(Head):-
  340    compound(Head),
  341    arg(_, Head, Arg),
  342    implies_transparent(Arg),
  343    !.
  344
  345implies_transparent(Arg) :-
  346    integer(Arg),
  347    !.
  348implies_transparent(:).
  349implies_transparent(//).
  350implies_transparent(^).
  351
  352table_options(Pred, Decl0, as(Decl0, Options)) :-
  353    findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]),
  354    !,
  355    foldl(table_option, Flags, F0, Options).
  356table_options(_, Decl, Decl).
  357
  358table_option(Flag, X, (Flag,X)).
  359
  360list_declarations(Pred, Source) :-
  361    findall(Decl, declaration(Pred, Source, Decl), Decls),
  362    (   Decls == []
  363    ->  true
  364    ;   write_declarations(Decls, Source),
  365        format('~n', [])
  366    ).
  367
  368
  369write_declarations([], _) :- !.
  370write_declarations([H|T], Module) :-
  371    format(':- ~q.~n', [H]),
  372    write_declarations(T, Module).
  373
  374list_clauses(Pred, Source, Options) :-
  375    strip_module(Pred, Module, Head),
  376    forall(clause(Pred, Body, Ref),
  377           list_clause(Module:Head, Body, Ref, Source, Options)).
  378
  379list_clause(_Head, _Body, Ref, _Source, Options) :-
  380    option(source(true), Options),
  381    (   clause_property(Ref, file(File)),
  382        clause_property(Ref, line_count(Line)),
  383        catch(source_clause_string(File, Line, String, Repositioned),
  384              _, fail),
  385        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  386    ->  !,
  387        (   Repositioned == true
  388        ->  comment('% From ~w:~d~n', [ File, Line ])
  389        ;   true
  390        ),
  391        writeln(String)
  392    ;   decompiled
  393    ->  fail
  394    ;   asserta(decompiled),
  395        comment('% From database (decompiled)~n', []),
  396        fail                                    % try next clause
  397    ).
  398list_clause(Module:Head, Body, Ref, Source, Options) :-
  399    restore_variable_names(Module, Head, Body, Ref, Options),
  400    write_module(Module, Source, Head),
  401    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.
  408restore_variable_names(Module, Head, Body, Ref, Options) :-
  409    option(variable_names(source), Options, source),
  410    catch(clause_info(Ref, _, _, _,
  411                      [ head(QHead),
  412                        body(Body),
  413                        variable_names(Bindings)
  414                      ]),
  415          _, true),
  416    unify_head(Module, Head, QHead),
  417    !,
  418    bind_vars(Bindings),
  419    name_other_vars((Head:-Body), Bindings).
  420restore_variable_names(_,_,_,_,_).
  421
  422unify_head(Module, Head, Module:Head) :-
  423    !.
  424unify_head(_, Head, Head) :-
  425    !.
  426unify_head(_, _, _).
  427
  428bind_vars([]) :-
  429    !.
  430bind_vars([Name = Var|T]) :-
  431    ignore(Var = '$VAR'(Name)),
  432    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.
  439name_other_vars(Term, Bindings) :-
  440    term_singletons(Term, Singletons),
  441    bind_singletons(Singletons),
  442    term_variables(Term, Vars),
  443    name_vars(Vars, 0, Bindings).
  444
  445bind_singletons([]).
  446bind_singletons(['$VAR'('_')|T]) :-
  447    bind_singletons(T).
  448
  449name_vars([], _, _).
  450name_vars([H|T], N, Bindings) :-
  451    between(N, infinite, N2),
  452    var_name(N2, Name),
  453    \+ memberchk(Name=_, Bindings),
  454    !,
  455    H = '$VAR'(N2),
  456    N3 is N2 + 1,
  457    name_vars(T, N3, Bindings).
  458
  459var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  460    L is (I mod 26)+0'A,
  461    N is I // 26,
  462    (   N == 0
  463    ->  char_code(Name, L)
  464    ;   format(atom(Name), '~c~d', [L, N])
  465    ).
  466
  467write_module(Module, Context, Head) :-
  468    hide_module(Module, Context, Head),
  469    !.
  470write_module(Module, _, _) :-
  471    format('~q:', [Module]).
  472
  473hide_module(system, Module, Head) :-
  474    predicate_property(Module:Head, imported_from(M)),
  475    predicate_property(system:Head, imported_from(M)),
  476    !.
  477hide_module(Module, Module, _) :- !.
  478
  479notify_changed(Pred, Context) :-
  480    strip_module(Pred, user, Head),
  481    predicate_property(Head, built_in),
  482    \+ predicate_property(Head, (dynamic)),
  483    !,
  484    decl_term(Pred, Context, Decl),
  485    comment('%   NOTE: system definition has been overruled for ~q~n',
  486            [Decl]).
  487notify_changed(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  494source_clause_string(File, Line, String, Repositioned) :-
  495    open_source(File, Line, Stream, Repositioned),
  496    stream_property(Stream, position(Start)),
  497    '$raw_read'(Stream, _TextWithoutComments),
  498    stream_property(Stream, position(End)),
  499    stream_position_data(char_count, Start, StartChar),
  500    stream_position_data(char_count, End, EndChar),
  501    Length is EndChar - StartChar,
  502    set_stream_position(Stream, Start),
  503    read_string(Stream, Length, String),
  504    skip_blanks_and_comments(Stream, blank).
  505
  506skip_blanks_and_comments(Stream, _) :-
  507    at_end_of_stream(Stream),
  508    !.
  509skip_blanks_and_comments(Stream, State0) :-
  510    peek_string(Stream, 80, String),
  511    string_chars(String, Chars),
  512    phrase(blanks_and_comments(State0, State), Chars, Rest),
  513    (   Rest == []
  514    ->  read_string(Stream, 80, _),
  515        skip_blanks_and_comments(Stream, State)
  516    ;   length(Chars, All),
  517        length(Rest, RLen),
  518        Skip is All-RLen,
  519        read_string(Stream, Skip, _)
  520    ).
  521
  522blanks_and_comments(State0, State) -->
  523    [C],
  524    { transition(C, State0, State1) },
  525    !,
  526    blanks_and_comments(State1, State).
  527blanks_and_comments(State, State) -->
  528    [].
  529
  530transition(C, blank, blank) :-
  531    char_type(C, space).
  532transition('%', blank, line_comment).
  533transition('\n', line_comment, blank).
  534transition(_, line_comment, line_comment).
  535transition('/', blank, comment_0).
  536transition('/', comment(N), comment(N,/)).
  537transition('*', comment(N,/), comment(N1)) :-
  538    N1 is N + 1.
  539transition('*', comment_0, comment(1)).
  540transition('*', comment(N), comment(N,*)).
  541transition('/', comment(N,*), State) :-
  542    (   N == 1
  543    ->  State = blank
  544    ;   N2 is N - 1,
  545        State = comment(N2)
  546    ).
  547
  548
  549open_source(File, Line, Stream, Repositioned) :-
  550    source_stream(File, Stream, Pos0, Repositioned),
  551    line_count(Stream, Line0),
  552    (   Line >= Line0
  553    ->  Skip is Line - Line0
  554    ;   set_stream_position(Stream, Pos0),
  555        Skip is Line - 1
  556    ),
  557    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  558    (   Skip =\= 0
  559    ->  Repositioned = true
  560    ;   true
  561    ),
  562    forall(between(1, Skip, _),
  563           skip(Stream, 0'\n)).
  564
  565:- thread_local
  566    opened_source/3,
  567    decompiled/0.  568
  569source_stream(File, Stream, Pos0, _) :-
  570    opened_source(File, Stream, Pos0),
  571    !.
  572source_stream(File, Stream, Pos0, true) :-
  573    open(File, read, Stream),
  574    stream_property(Stream, position(Pos0)),
  575    asserta(opened_source(File, Stream, Pos0)).
  576
  577close_sources :-
  578    retractall(decompiled),
  579    forall(retract(opened_source(_,Stream,_)),
  580           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.

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