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

Variable names are by default generated using numbervars/4 using the option singletons(true). This names the variables A, B, ... and the singletons _. Variables can be named explicitly by binding them to a term '$VAR'(Name), where Name is an atom denoting a valid variable name (see the option numbervars(true) from write_term/2) as well as by using the variable_names(Bindings) option from write_term/2.

Options processed in addition to write_term/2 options:

variable_names(+Bindings)
See above and write_term/2.
indent(+Columns)
Left margin used for the clause. Default 0.
module(+Module)
Module used to determine whether a goal resolves to a meta predicate. Default user.
  634%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  635%       confusion if the heads relates to other   bodies.  For now it is
  636%       only used for XPCE methods and works just nice.
  637%
  638%       Not really ...  It may confuse the source-level debugger.
  639
  640%portray_clause(Head :- _Body) :-
  641%       user:prolog_list_goal(Head), !.
  642portray_clause(Term) :-
  643    current_output(Out),
  644    portray_clause(Out, Term).
  645
  646portray_clause(Stream, Term) :-
  647    must_be(stream, Stream),
  648    portray_clause(Stream, Term, []).
  649
  650portray_clause(Stream, Term, M:Options) :-
  651    must_be(list, Options),
  652    meta_options(is_meta, M:Options, QOptions),
  653    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  654
  655name_vars_and_portray_clause(Stream, Term, Options) :-
  656    term_attvars(Term, []),
  657    !,
  658    clause_vars(Term, Options),
  659    do_portray_clause(Stream, Term, Options).
  660name_vars_and_portray_clause(Stream, Term, Options) :-
  661    option(variable_names(Bindings), Options),
  662    !,
  663    copy_term_nat(Term+Bindings, Copy+BCopy),
  664    bind_vars(BCopy),
  665    name_other_vars(Copy, BCopy),
  666    do_portray_clause(Stream, Copy, Options).
  667name_vars_and_portray_clause(Stream, Term, Options) :-
  668    copy_term_nat(Term, Copy),
  669    clause_vars(Copy, Options),
  670    do_portray_clause(Stream, Copy, Options).
  671
  672clause_vars(Clause, Options) :-
  673    option(variable_names(Bindings), Options),
  674    !,
  675    bind_vars(Bindings),
  676    name_other_vars(Clause, Bindings).
  677clause_vars(Clause, _) :-
  678    numbervars(Clause, 0, _,
  679               [ singletons(true)
  680               ]).
  681
  682is_meta(portray_goal).
  683
  684do_portray_clause(Out, Var, Options) :-
  685    var(Var),
  686    !,
  687    option(indent(LeftMargin), Options, 0),
  688    indent(Out, LeftMargin),
  689    pprint(Out, Var, 1200, Options).
  690do_portray_clause(Out, (Head :- true), Options) :-
  691    !,
  692    option(indent(LeftMargin), Options, 0),
  693    indent(Out, LeftMargin),
  694    pprint(Out, Head, 1200, Options),
  695    full_stop(Out).
  696do_portray_clause(Out, Term, Options) :-
  697    clause_term(Term, Head, Neck, Body),
  698    !,
  699    option(indent(LeftMargin), Options, 0),
  700    inc_indent(LeftMargin, 1, Indent),
  701    infix_op(Neck, RightPri, LeftPri),
  702    indent(Out, LeftMargin),
  703    pprint(Out, Head, LeftPri, Options),
  704    format(Out, ' ~w', [Neck]),
  705    (   nonvar(Body),
  706        Body = Module:LocalBody,
  707        \+ primitive(LocalBody)
  708    ->  nlindent(Out, Indent),
  709        format(Out, '~q', [Module]),
  710        '$put_token'(Out, :),
  711        nlindent(Out, Indent),
  712        write(Out, '(   '),
  713        inc_indent(Indent, 1, BodyIndent),
  714        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  715        nlindent(Out, Indent),
  716        write(Out, ')')
  717    ;   setting(listing:body_indentation, BodyIndent0),
  718        BodyIndent is LeftMargin+BodyIndent0,
  719        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  720    ),
  721    full_stop(Out).
  722do_portray_clause(Out, (:-Directive), Options) :-
  723    wrapped_list_directive(Directive),
  724    !,
  725    Directive =.. [Name, Arg, List],
  726    option(indent(LeftMargin), Options, 0),
  727    indent(Out, LeftMargin),
  728    format(Out, ':- ~q(', [Name]),
  729    line_position(Out, Indent),
  730    format(Out, '~q,', [Arg]),
  731    nlindent(Out, Indent),
  732    portray_list(List, Indent, Out, Options),
  733    write(Out, ').\n').
  734do_portray_clause(Out, (:-Directive), Options) :-
  735    !,
  736    option(indent(LeftMargin), Options, 0),
  737    indent(Out, LeftMargin),
  738    write(Out, ':- '),
  739    DIndent is LeftMargin+3,
  740    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  741    full_stop(Out).
  742do_portray_clause(Out, Fact, Options) :-
  743    option(indent(LeftMargin), Options, 0),
  744    indent(Out, LeftMargin),
  745    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  746    full_stop(Out).
  747
  748clause_term((Head:-Body), Head, :-, Body).
  749clause_term((Head=>Body), Head, =>, Body).
  750clause_term(?=>(Head,Body), Head, ?=>, Body).
  751clause_term((Head-->Body), Head, -->, Body).
  752
  753full_stop(Out) :-
  754    '$put_token'(Out, '.'),
  755    nl(Out).
  756
  757wrapped_list_directive(module(_,_)).
  758%wrapped_list_directive(use_module(_,_)).
  759%wrapped_list_directive(autoload(_,_)).
 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.
  766portray_body(Var, _, _, Pri, Out, Options) :-
  767    var(Var),
  768    !,
  769    pprint(Out, Var, Pri, Options).
  770portray_body(!, _, _, _, Out, _) :-
  771    setting(listing:cut_on_same_line, true),
  772    !,
  773    write(Out, ' !').
  774portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  775    setting(listing:cut_on_same_line, true),
  776    \+ term_needs_braces((_,_), Pri),
  777    !,
  778    write(Out, ' !,'),
  779    portray_body(Clause, Indent, indent, 1000, Out, Options).
  780portray_body(Term, Indent, indent, Pri, Out, Options) :-
  781    !,
  782    nlindent(Out, Indent),
  783    portray_body(Term, Indent, noindent, Pri, Out, Options).
  784portray_body(Or, Indent, _, _, Out, Options) :-
  785    or_layout(Or),
  786    !,
  787    write(Out, '(   '),
  788    portray_or(Or, Indent, 1200, Out, Options),
  789    nlindent(Out, Indent),
  790    write(Out, ')').
  791portray_body(Term, Indent, _, Pri, Out, Options) :-
  792    term_needs_braces(Term, Pri),
  793    !,
  794    write(Out, '( '),
  795    ArgIndent is Indent + 2,
  796    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  797    nlindent(Out, Indent),
  798    write(Out, ')').
  799portray_body(((AB),C), Indent, _, _Pri, Out, Options) :-
  800    nonvar(AB),
  801    AB = (A,B),
  802    !,
  803    infix_op(',', LeftPri, RightPri),
  804    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  805    write(Out, ','),
  806    portray_body((B,C), Indent, indent, RightPri, Out, Options).
  807portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  808    !,
  809    infix_op(',', LeftPri, RightPri),
  810    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  811    write(Out, ','),
  812    portray_body(B, Indent, indent, RightPri, Out, Options).
  813portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  814    !,
  815    write(Out, \+), write(Out, ' '),
  816    prefix_op(\+, ArgPri),
  817    ArgIndent is Indent+3,
  818    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  819portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  820    m_callable(Call),
  821    option(module(M), Options, user),
  822    predicate_property(M:Call, meta_predicate(Meta)),
  823    !,
  824    portray_meta(Out, Call, Meta, Options).
  825portray_body(Clause, _, _, Pri, Out, Options) :-
  826    pprint(Out, Clause, Pri, Options).
  827
  828m_callable(Term) :-
  829    strip_module(Term, _, Plain),
  830    callable(Plain),
  831    Plain \= (_:_).
  832
  833term_needs_braces(Term, Pri) :-
  834    callable(Term),
  835    functor(Term, Name, _Arity),
  836    current_op(OpPri, _Type, Name),
  837    OpPri > Pri,
  838    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  842portray_or(Term, Indent, Pri, Out, Options) :-
  843    term_needs_braces(Term, Pri),
  844    !,
  845    inc_indent(Indent, 1, NewIndent),
  846    write(Out, '(   '),
  847    portray_or(Term, NewIndent, Out, Options),
  848    nlindent(Out, NewIndent),
  849    write(Out, ')').
  850portray_or(Term, Indent, _Pri, Out, Options) :-
  851    or_layout(Term),
  852    !,
  853    portray_or(Term, Indent, Out, Options).
  854portray_or(Term, Indent, Pri, Out, Options) :-
  855    inc_indent(Indent, 1, NestIndent),
  856    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  857
  858
  859portray_or((If -> Then ; Else), Indent, Out, Options) :-
  860    !,
  861    inc_indent(Indent, 1, NestIndent),
  862    infix_op((->), LeftPri, RightPri),
  863    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  864    nlindent(Out, Indent),
  865    write(Out, '->  '),
  866    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  867    nlindent(Out, Indent),
  868    write(Out, ';   '),
  869    infix_op(;, _LeftPri, RightPri2),
  870    portray_or(Else, Indent, RightPri2, Out, Options).
  871portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  872    !,
  873    inc_indent(Indent, 1, NestIndent),
  874    infix_op((*->), LeftPri, RightPri),
  875    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  876    nlindent(Out, Indent),
  877    write(Out, '*-> '),
  878    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  879    nlindent(Out, Indent),
  880    write(Out, ';   '),
  881    infix_op(;, _LeftPri, RightPri2),
  882    portray_or(Else, Indent, RightPri2, Out, Options).
  883portray_or((If -> Then), Indent, Out, Options) :-
  884    !,
  885    inc_indent(Indent, 1, NestIndent),
  886    infix_op((->), LeftPri, RightPri),
  887    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  888    nlindent(Out, Indent),
  889    write(Out, '->  '),
  890    portray_or(Then, Indent, RightPri, Out, Options).
  891portray_or((If *-> Then), Indent, Out, Options) :-
  892    !,
  893    inc_indent(Indent, 1, NestIndent),
  894    infix_op((->), LeftPri, RightPri),
  895    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  896    nlindent(Out, Indent),
  897    write(Out, '*-> '),
  898    portray_or(Then, Indent, RightPri, Out, Options).
  899portray_or((A;B), Indent, Out, Options) :-
  900    !,
  901    inc_indent(Indent, 1, NestIndent),
  902    infix_op(;, LeftPri, RightPri),
  903    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  904    nlindent(Out, Indent),
  905    write(Out, ';   '),
  906    portray_or(B, Indent, RightPri, Out, Options).
  907portray_or((A|B), Indent, Out, Options) :-
  908    !,
  909    inc_indent(Indent, 1, NestIndent),
  910    infix_op('|', LeftPri, RightPri),
  911    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  912    nlindent(Out, Indent),
  913    write(Out, '|   '),
  914    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.
  922infix_op(Op, Left, Right) :-
  923    current_op(Pri, Assoc, Op),
  924    infix_assoc(Assoc, LeftMin, RightMin),
  925    !,
  926    Left is Pri - LeftMin,
  927    Right is Pri - RightMin.
  928
  929infix_assoc(xfx, 1, 1).
  930infix_assoc(xfy, 1, 0).
  931infix_assoc(yfx, 0, 1).
  932
  933prefix_op(Op, ArgPri) :-
  934    current_op(Pri, Assoc, Op),
  935    pre_assoc(Assoc, ArgMin),
  936    !,
  937    ArgPri is Pri - ArgMin.
  938
  939pre_assoc(fx, 1).
  940pre_assoc(fy, 0).
  941
  942postfix_op(Op, ArgPri) :-
  943    current_op(Pri, Assoc, Op),
  944    post_assoc(Assoc, ArgMin),
  945    !,
  946    ArgPri is Pri - ArgMin.
  947
  948post_assoc(xf, 1).
  949post_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.
  958or_layout(Var) :-
  959    var(Var), !, fail.
  960or_layout((_;_)).
  961or_layout((_->_)).
  962or_layout((_*->_)).
  963
  964primitive(G) :-
  965    or_layout(G), !, fail.
  966primitive((_,_)) :- !, fail.
  967primitive(_).
 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.
  976portray_meta(Out, Call, Meta, Options) :-
  977    contains_non_primitive_meta_arg(Call, Meta),
  978    !,
  979    Call =.. [Name|Args],
  980    Meta =.. [_|Decls],
  981    format(Out, '~q(', [Name]),
  982    line_position(Out, Indent),
  983    portray_meta_args(Decls, Args, Indent, Out, Options),
  984    format(Out, ')', []).
  985portray_meta(Out, Call, _, Options) :-
  986    pprint(Out, Call, 999, Options).
  987
  988contains_non_primitive_meta_arg(Call, Decl) :-
  989    arg(I, Call, CA),
  990    arg(I, Decl, DA),
  991    integer(DA),
  992    \+ primitive(CA),
  993    !.
  994
  995portray_meta_args([], [], _, _, _).
  996portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  997    portray_meta_arg(D, A, Out, Options),
  998    (   DT == []
  999    ->  true
 1000    ;   format(Out, ',', []),
 1001        nlindent(Out, Indent),
 1002        portray_meta_args(DT, AT, Indent, Out, Options)
 1003    ).
 1004
 1005portray_meta_arg(I, A, Out, Options) :-
 1006    integer(I),
 1007    !,
 1008    line_position(Out, Indent),
 1009    portray_body(A, Indent, noindent, 999, Out, Options).
 1010portray_meta_arg(_, A, Out, Options) :-
 1011    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
]                       ]
 1021portray_list([], _, Out, _) :-
 1022    !,
 1023    write(Out, []).
 1024portray_list(List, Indent, Out, Options) :-
 1025    write(Out, '[ '),
 1026    EIndent is Indent + 2,
 1027    portray_list_elements(List, EIndent, Out, Options),
 1028    nlindent(Out, Indent),
 1029    write(Out, ']').
 1030
 1031portray_list_elements([H|T], EIndent, Out, Options) :-
 1032    pprint(Out, H, 999, Options),
 1033    (   T == []
 1034    ->  true
 1035    ;   nonvar(T), T = [_|_]
 1036    ->  write(Out, ','),
 1037        nlindent(Out, EIndent),
 1038        portray_list_elements(T, EIndent, Out, Options)
 1039    ;   Indent is EIndent - 2,
 1040        nlindent(Out, Indent),
 1041        write(Out, '| '),
 1042        pprint(Out, T, 999, Options)
 1043    ).
 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.
 1057pprint(Out, Term, _, Options) :-
 1058    nonvar(Term),
 1059    Term = {}(Arg),
 1060    line_position(Out, Indent),
 1061    ArgIndent is Indent + 2,
 1062    format(Out, '{ ', []),
 1063    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1064    nlindent(Out, Indent),
 1065    format(Out, '}', []).
 1066pprint(Out, Term, Pri, Options) :-
 1067    (   compound(Term)
 1068    ->  compound_name_arity(Term, _, Arity),
 1069        Arity > 0
 1070    ;   is_dict(Term)
 1071    ),
 1072    \+ nowrap_term(Term),
 1073    setting(listing:line_width, Width),
 1074    Width > 0,
 1075    (   write_length(Term, Len, [max_length(Width)|Options])
 1076    ->  true
 1077    ;   Len = Width
 1078    ),
 1079    line_position(Out, Indent),
 1080    Indent + Len > Width,
 1081    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1082    !,
 1083    pprint_wrapped(Out, Term, Pri, Options).
 1084pprint(Out, Term, Pri, Options) :-
 1085    listing_write_options(Pri, WrtOptions, Options),
 1086    write_term(Out, Term,
 1087               [ blobs(portray),
 1088                 portray_goal(portray_blob)
 1089               | WrtOptions
 1090               ]).
 1091
 1092portray_blob(Blob, _Options) :-
 1093    blob(Blob, _),
 1094    \+ atom(Blob),
 1095    !,
 1096    format(string(S), '~q', [Blob]),
 1097    format('~q', ['$BLOB'(S)]).
 1098
 1099nowrap_term('$VAR'(_)) :- !.
 1100nowrap_term(_{}) :- !.                  % empty dict
 1101nowrap_term(Term) :-
 1102    functor(Term, Name, Arity),
 1103    current_op(_, _, Name),
 1104    (   Arity == 2
 1105    ->  infix_op(Name, _, _)
 1106    ;   Arity == 1
 1107    ->  (   prefix_op(Name, _)
 1108        ->  true
 1109        ;   postfix_op(Name, _)
 1110        )
 1111    ).
 1112
 1113
 1114pprint_wrapped(Out, Term, _, Options) :-
 1115    Term = [_|_],
 1116    !,
 1117    line_position(Out, Indent),
 1118    portray_list(Term, Indent, Out, Options).
 1119pprint_wrapped(Out, Dict, _, Options) :-
 1120    is_dict(Dict),
 1121    !,
 1122    dict_pairs(Dict, Tag, Pairs),
 1123    pprint(Out, Tag, 1200, Options),
 1124    format(Out, '{ ', []),
 1125    line_position(Out, Indent),
 1126    pprint_nv(Pairs, Indent, Out, Options),
 1127    nlindent(Out, Indent-2),
 1128    format(Out, '}', []).
 1129pprint_wrapped(Out, Term, _, Options) :-
 1130    Term =.. [Name|Args],
 1131    format(Out, '~q(', [Name]),
 1132    line_position(Out, Indent),
 1133    pprint_args(Args, Indent, Out, Options),
 1134    format(Out, ')', []).
 1135
 1136pprint_args([], _, _, _).
 1137pprint_args([H|T], Indent, Out, Options) :-
 1138    pprint(Out, H, 999, Options),
 1139    (   T == []
 1140    ->  true
 1141    ;   format(Out, ',', []),
 1142        nlindent(Out, Indent),
 1143        pprint_args(T, Indent, Out, Options)
 1144    ).
 1145
 1146
 1147pprint_nv([], _, _, _).
 1148pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1149    pprint(Out, Name, 999, Options),
 1150    format(Out, ':', []),
 1151    pprint(Out, Value, 999, Options),
 1152    (   T == []
 1153    ->  true
 1154    ;   format(Out, ',', []),
 1155        nlindent(Out, Indent),
 1156        pprint_nv(T, Indent, Out, Options)
 1157    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1165listing_write_options(Pri,
 1166                      [ quoted(true),
 1167                        numbervars(true),
 1168                        priority(Pri),
 1169                        spacing(next_argument)
 1170                      | Options
 1171                      ],
 1172                      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.
 1180nlindent(Out, N) :-
 1181    nl(Out),
 1182    indent(Out, N).
 1183
 1184indent(Out, N) :-
 1185    setting(listing:tab_distance, D),
 1186    (   D =:= 0
 1187    ->  tab(Out, N)
 1188    ;   Tab is N // D,
 1189        Space is N mod D,
 1190        put_tabs(Out, Tab),
 1191        tab(Out, Space)
 1192    ).
 1193
 1194put_tabs(Out, N) :-
 1195    N > 0,
 1196    !,
 1197    put(Out, 0'\t),
 1198    NN is N - 1,
 1199    put_tabs(Out, NN).
 1200put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1207inc_indent(Indent0, Inc, Indent) :-
 1208    Indent is Indent0 + Inc*4.
 1209
 1210:- multifile
 1211    sandbox:safe_meta/2. 1212
 1213sandbox:safe_meta(listing(What), []) :-
 1214    not_qualified(What).
 1215
 1216not_qualified(Var) :-
 1217    var(Var),
 1218    !.
 1219not_qualified(_:_) :- !, fail.
 1220not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1227comment(Format, Args) :-
 1228    stream_property(current_output, tty(true)),
 1229    setting(listing:comment_ansi_attributes, Attributes),
 1230    Attributes \== [],
 1231    !,
 1232    ansi_format(Attributes, Format, Args).
 1233comment(Format, Args) :-
 1234    format(Format, Args)