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:- use_module(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)]).
  192listing(Spec) :-
  193    listing(Spec, []).
  194
  195listing(Spec, Options) :-
  196    call_cleanup(
  197        listing_(Spec, Options),
  198        close_sources).
  199
  200listing_(M:Spec, Options) :-
  201    var(Spec),
  202    !,
  203    list_module(M, Options).
  204listing_(M:List, Options) :-
  205    is_list(List),
  206    !,
  207    forall(member(Spec, List),
  208           listing_(M:Spec, Options)).
  209listing_(M:CRef, Options) :-
  210    blob(CRef, clause),
  211    !,
  212    list_clauserefs([CRef], M, Options).
  213listing_(X, Options) :-
  214    (   prolog:locate_clauses(X, ClauseRefs)
  215    ->  strip_module(X, Context, _),
  216        list_clauserefs(ClauseRefs, Context, Options)
  217    ;   '$find_predicate'(X, Preds),
  218        list_predicates(Preds, X, Options)
  219    ).
  220
  221list_clauserefs([], _, _) :- !.
  222list_clauserefs([H|T], Context, Options) :-
  223    !,
  224    list_clauserefs(H, Context, Options),
  225    list_clauserefs(T, Context, Options).
  226list_clauserefs(Ref, Context, Options) :-
  227    @(rule(M:_, Rule, Ref), Context),
  228    list_clause(M:Rule, Ref, Context, Options).
 list_predicates(:Preds:list(pi), :Spec, +Options) is det
  232list_predicates(PIs, Context:X, Options) :-
  233    member(PI, PIs),
  234    pi_to_head(PI, Pred),
  235    unify_args(Pred, X),
  236    list_define(Pred, DefPred),
  237    list_predicate(DefPred, Context, Options),
  238    nl,
  239    fail.
  240list_predicates(_, _, _).
  241
  242list_define(Head, LoadModule:Head) :-
  243    compound(Head),
  244    Head \= (_:_),
  245    functor(Head, Name, Arity),
  246    '$find_library'(_, Name, Arity, LoadModule, Library),
  247    !,
  248    use_module(Library, []).
  249list_define(M:Pred, DefM:Pred) :-
  250    '$define_predicate'(M:Pred),
  251    (   predicate_property(M:Pred, imported_from(DefM))
  252    ->  true
  253    ;   DefM = M
  254    ).
  255
  256pi_to_head(PI, _) :-
  257    var(PI),
  258    !,
  259    instantiation_error(PI).
  260pi_to_head(M:PI, M:Head) :-
  261    !,
  262    pi_to_head(PI, Head).
  263pi_to_head(Name/Arity, Head) :-
  264    functor(Head, Name, Arity).
  265
  266
  267%       Unify the arguments of the specification with the given term,
  268%       so we can partially instantate the head.
  269
  270unify_args(_, _/_) :- !.                % Name/arity spec
  271unify_args(X, X) :- !.
  272unify_args(_:X, X) :- !.
  273unify_args(_, _).
  274
  275list_predicate(Pred, Context, _) :-
  276    predicate_property(Pred, undefined),
  277    !,
  278    decl_term(Pred, Context, Decl),
  279    comment('%   Undefined: ~q~n', [Decl]).
  280list_predicate(Pred, Context, _) :-
  281    predicate_property(Pred, foreign),
  282    !,
  283    decl_term(Pred, Context, Decl),
  284    comment('%   Foreign: ~q~n', [Decl]).
  285list_predicate(Pred, Context, Options) :-
  286    notify_changed(Pred, Context),
  287    list_declarations(Pred, Context),
  288    list_clauses(Pred, Context, Options).
  289
  290decl_term(Pred, Context, Decl) :-
  291    strip_module(Pred, Module, Head),
  292    functor(Head, Name, Arity),
  293    (   hide_module(Module, Context, Head)
  294    ->  Decl = Name/Arity
  295    ;   Decl = Module:Name/Arity
  296    ).
  297
  298
  299decl(thread_local, thread_local).
  300decl(dynamic,      dynamic).
  301decl(volatile,     volatile).
  302decl(multifile,    multifile).
  303decl(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)
  313declaration(Pred, Source, Decl) :-
  314    predicate_property(Pred, tabled),
  315    Pred = M:Head,
  316    (   M:'$table_mode'(Head, Head, _)
  317    ->  decl_term(Pred, Source, Funct),
  318        table_options(Pred, Funct, TableDecl),
  319        Decl = table(TableDecl)
  320    ;   comment('% tabled using answer subsumption~n', []),
  321        fail                                    % TBD
  322    ).
  323declaration(Pred, Source, Decl) :-
  324    decl(Prop, Declname),
  325    predicate_property(Pred, Prop),
  326    decl_term(Pred, Source, Funct),
  327    Decl =.. [ Declname, Funct ].
  328declaration(Pred, Source, Decl) :-
  329    predicate_property(Pred, meta_predicate(Head)),
  330    strip_module(Pred, Module, _),
  331    (   (Module == system; Source == Module)
  332    ->  Decl = meta_predicate(Head)
  333    ;   Decl = meta_predicate(Module:Head)
  334    ),
  335    (   meta_implies_transparent(Head)
  336    ->  !                                   % hide transparent
  337    ;   true
  338    ).
  339declaration(Pred, Source, Decl) :-
  340    predicate_property(Pred, transparent),
  341    decl_term(Pred, Source, PI),
  342    Decl = module_transparent(PI).
 meta_implies_transparent(+Head) is semidet
True if the meta-declaration Head implies that the predicate is transparent.
  349meta_implies_transparent(Head):-
  350    compound(Head),
  351    arg(_, Head, Arg),
  352    implies_transparent(Arg),
  353    !.
  354
  355implies_transparent(Arg) :-
  356    integer(Arg),
  357    !.
  358implies_transparent(:).
  359implies_transparent(//).
  360implies_transparent(^).
  361
  362table_options(Pred, Decl0, as(Decl0, Options)) :-
  363    findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]),
  364    !,
  365    foldl(table_option, Flags, F0, Options).
  366table_options(_, Decl, Decl).
  367
  368table_option(Flag, X, (Flag,X)).
  369
  370list_declarations(Pred, Source) :-
  371    findall(Decl, declaration(Pred, Source, Decl), Decls),
  372    (   Decls == []
  373    ->  true
  374    ;   write_declarations(Decls, Source),
  375        format('~n', [])
  376    ).
  377
  378
  379write_declarations([], _) :- !.
  380write_declarations([H|T], Module) :-
  381    format(':- ~q.~n', [H]),
  382    write_declarations(T, Module).
  383
  384list_clauses(Pred, Source, Options) :-
  385    strip_module(Pred, Module, Head),
  386    most_general_goal(Head, GenHead),
  387    forall(( rule(Module:GenHead, Rule, Ref),
  388             \+ \+ rule_head(Rule, Head)
  389           ),
  390           list_clause(Module:Rule, Ref, Source, Options)).
  391
  392rule_head((Head0 :- _Body), Head) :- !, Head = Head0.
  393rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0.
  394rule_head((Head0 => _Body), Head) :- !, Head = Head0.
  395rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0.
  396rule_head(Head, Head).
 list_clause(+Term, +ClauseRef, +ContextModule, +Options)
  400list_clause(_Rule, Ref, _Source, Options) :-
  401    option(source(true), Options),
  402    (   clause_property(Ref, file(File)),
  403        clause_property(Ref, line_count(Line)),
  404        catch(source_clause_string(File, Line, String, Repositioned),
  405              _, fail),
  406        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  407    ->  !,
  408        (   Repositioned == true
  409        ->  comment('% From ~w:~d~n', [ File, Line ])
  410        ;   true
  411        ),
  412        writeln(String)
  413    ;   decompiled
  414    ->  fail
  415    ;   asserta(decompiled),
  416        comment('% From database (decompiled)~n', []),
  417        fail                                    % try next clause
  418    ).
  419list_clause(Module:(Head:-Body), Ref, Source, Options) :-
  420    !,
  421    list_clause(Module:Head, Body, :-, Ref, Source, Options).
  422list_clause(Module:(Head=>Body), Ref, Source, Options) :-
  423    list_clause(Module:Head, Body, =>, Ref, Source, Options).
  424list_clause(Module:Head, Ref, Source, Options) :-
  425    !,
  426    list_clause(Module:Head, true, :-, Ref, Source, Options).
  427
  428list_clause(Module:Head, Body, Neck, Ref, Source, Options) :-
  429    restore_variable_names(Module, Head, Body, Ref, Options),
  430    write_module(Module, Source, Head),
  431    Rule =.. [Neck,Head,Body],
  432    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.
  439restore_variable_names(Module, Head, Body, Ref, Options) :-
  440    option(variable_names(source), Options, source),
  441    catch(clause_info(Ref, _, _, _,
  442                      [ head(QHead),
  443                        body(Body),
  444                        variable_names(Bindings)
  445                      ]),
  446          _, true),
  447    unify_head(Module, Head, QHead),
  448    !,
  449    bind_vars(Bindings),
  450    name_other_vars((Head:-Body), Bindings).
  451restore_variable_names(_,_,_,_,_).
  452
  453unify_head(Module, Head, Module:Head) :-
  454    !.
  455unify_head(_, Head, Head) :-
  456    !.
  457unify_head(_, _, _).
  458
  459bind_vars([]) :-
  460    !.
  461bind_vars([Name = Var|T]) :-
  462    ignore(Var = '$VAR'(Name)),
  463    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.
  470name_other_vars(Term, Bindings) :-
  471    term_singletons(Term, Singletons),
  472    bind_singletons(Singletons),
  473    term_variables(Term, Vars),
  474    name_vars(Vars, 0, Bindings).
  475
  476bind_singletons([]).
  477bind_singletons(['$VAR'('_')|T]) :-
  478    bind_singletons(T).
  479
  480name_vars([], _, _).
  481name_vars([H|T], N, Bindings) :-
  482    between(N, infinite, N2),
  483    var_name(N2, Name),
  484    \+ memberchk(Name=_, Bindings),
  485    !,
  486    H = '$VAR'(N2),
  487    N3 is N2 + 1,
  488    name_vars(T, N3, Bindings).
  489
  490var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  491    L is (I mod 26)+0'A,
  492    N is I // 26,
  493    (   N == 0
  494    ->  char_code(Name, L)
  495    ;   format(atom(Name), '~c~d', [L, N])
  496    ).
  497
  498write_module(Module, Context, Head) :-
  499    hide_module(Module, Context, Head),
  500    !.
  501write_module(Module, _, _) :-
  502    format('~q:', [Module]).
  503
  504hide_module(system, Module, Head) :-
  505    predicate_property(Module:Head, imported_from(M)),
  506    predicate_property(system:Head, imported_from(M)),
  507    !.
  508hide_module(Module, Module, _) :- !.
  509
  510notify_changed(Pred, Context) :-
  511    strip_module(Pred, user, Head),
  512    predicate_property(Head, built_in),
  513    \+ predicate_property(Head, (dynamic)),
  514    !,
  515    decl_term(Pred, Context, Decl),
  516    comment('%   NOTE: system definition has been overruled for ~q~n',
  517            [Decl]).
  518notify_changed(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  525source_clause_string(File, Line, String, Repositioned) :-
  526    open_source(File, Line, Stream, Repositioned),
  527    stream_property(Stream, position(Start)),
  528    '$raw_read'(Stream, _TextWithoutComments),
  529    stream_property(Stream, position(End)),
  530    stream_position_data(char_count, Start, StartChar),
  531    stream_position_data(char_count, End, EndChar),
  532    Length is EndChar - StartChar,
  533    set_stream_position(Stream, Start),
  534    read_string(Stream, Length, String),
  535    skip_blanks_and_comments(Stream, blank).
  536
  537skip_blanks_and_comments(Stream, _) :-
  538    at_end_of_stream(Stream),
  539    !.
  540skip_blanks_and_comments(Stream, State0) :-
  541    peek_string(Stream, 80, String),
  542    string_chars(String, Chars),
  543    phrase(blanks_and_comments(State0, State), Chars, Rest),
  544    (   Rest == []
  545    ->  read_string(Stream, 80, _),
  546        skip_blanks_and_comments(Stream, State)
  547    ;   length(Chars, All),
  548        length(Rest, RLen),
  549        Skip is All-RLen,
  550        read_string(Stream, Skip, _)
  551    ).
  552
  553blanks_and_comments(State0, State) -->
  554    [C],
  555    { transition(C, State0, State1) },
  556    !,
  557    blanks_and_comments(State1, State).
  558blanks_and_comments(State, State) -->
  559    [].
  560
  561transition(C, blank, blank) :-
  562    char_type(C, space).
  563transition('%', blank, line_comment).
  564transition('\n', line_comment, blank).
  565transition(_, line_comment, line_comment).
  566transition('/', blank, comment_0).
  567transition('/', comment(N), comment(N,/)).
  568transition('*', comment(N,/), comment(N1)) :-
  569    N1 is N + 1.
  570transition('*', comment_0, comment(1)).
  571transition('*', comment(N), comment(N,*)).
  572transition('/', comment(N,*), State) :-
  573    (   N == 1
  574    ->  State = blank
  575    ;   N2 is N - 1,
  576        State = comment(N2)
  577    ).
  578
  579
  580open_source(File, Line, Stream, Repositioned) :-
  581    source_stream(File, Stream, Pos0, Repositioned),
  582    line_count(Stream, Line0),
  583    (   Line >= Line0
  584    ->  Skip is Line - Line0
  585    ;   set_stream_position(Stream, Pos0),
  586        Skip is Line - 1
  587    ),
  588    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  589    (   Skip =\= 0
  590    ->  Repositioned = true
  591    ;   true
  592    ),
  593    forall(between(1, Skip, _),
  594           skip(Stream, 0'\n)).
  595
  596:- thread_local
  597    opened_source/3,
  598    decompiled/0.  599
  600source_stream(File, Stream, Pos0, _) :-
  601    opened_source(File, Stream, Pos0),
  602    !.
  603source_stream(File, Stream, Pos0, true) :-
  604    open(File, read, Stream),
  605    stream_property(Stream, position(Pos0)),
  606    asserta(opened_source(File, Stream, Pos0)).
  607
  608close_sources :-
  609    retractall(decompiled),
  610    forall(retract(opened_source(_,Stream,_)),
  611           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.
  642%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  643%       confusion if the heads relates to other   bodies.  For now it is
  644%       only used for XPCE methods and works just nice.
  645%
  646%       Not really ...  It may confuse the source-level debugger.
  647
  648%portray_clause(Head :- _Body) :-
  649%       user:prolog_list_goal(Head), !.
  650portray_clause(Term) :-
  651    current_output(Out),
  652    portray_clause(Out, Term).
  653
  654portray_clause(Stream, Term) :-
  655    must_be(stream, Stream),
  656    portray_clause(Stream, Term, []).
  657
  658portray_clause(Stream, Term, M:Options) :-
  659    must_be(list, Options),
  660    meta_options(is_meta, M:Options, QOptions),
  661    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  662
  663name_vars_and_portray_clause(Stream, Term, Options) :-
  664    term_attvars(Term, []),
  665    !,
  666    clause_vars(Term, Options),
  667    do_portray_clause(Stream, Term, Options).
  668name_vars_and_portray_clause(Stream, Term, Options) :-
  669    option(variable_names(Bindings), Options),
  670    !,
  671    copy_term_nat(Term+Bindings, Copy+BCopy),
  672    bind_vars(BCopy),
  673    name_other_vars(Copy, BCopy),
  674    do_portray_clause(Stream, Copy, Options).
  675name_vars_and_portray_clause(Stream, Term, Options) :-
  676    copy_term_nat(Term, Copy),
  677    clause_vars(Copy, Options),
  678    do_portray_clause(Stream, Copy, Options).
  679
  680clause_vars(Clause, Options) :-
  681    option(variable_names(Bindings), Options),
  682    !,
  683    bind_vars(Bindings),
  684    name_other_vars(Clause, Bindings).
  685clause_vars(Clause, _) :-
  686    numbervars(Clause, 0, _,
  687               [ singletons(true)
  688               ]).
  689
  690is_meta(portray_goal).
  691
  692do_portray_clause(Out, Var, Options) :-
  693    var(Var),
  694    !,
  695    option(indent(LeftMargin), Options, 0),
  696    indent(Out, LeftMargin),
  697    pprint(Out, Var, 1200, Options).
  698do_portray_clause(Out, (Head :- true), Options) :-
  699    !,
  700    option(indent(LeftMargin), Options, 0),
  701    indent(Out, LeftMargin),
  702    pprint(Out, Head, 1200, Options),
  703    full_stop(Out).
  704do_portray_clause(Out, Term, Options) :-
  705    clause_term(Term, Head, Neck, Body),
  706    !,
  707    option(indent(LeftMargin), Options, 0),
  708    inc_indent(LeftMargin, 1, Indent),
  709    infix_op(Neck, RightPri, LeftPri),
  710    indent(Out, LeftMargin),
  711    pprint(Out, Head, LeftPri, Options),
  712    format(Out, ' ~w', [Neck]),
  713    (   nonvar(Body),
  714        Body = Module:LocalBody,
  715        \+ primitive(LocalBody)
  716    ->  nlindent(Out, Indent),
  717        format(Out, '~q', [Module]),
  718        '$put_token'(Out, :),
  719        nlindent(Out, Indent),
  720        write(Out, '(   '),
  721        inc_indent(Indent, 1, BodyIndent),
  722        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  723        nlindent(Out, Indent),
  724        write(Out, ')')
  725    ;   setting(listing:body_indentation, BodyIndent0),
  726        BodyIndent is LeftMargin+BodyIndent0,
  727        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  728    ),
  729    full_stop(Out).
  730do_portray_clause(Out, (:-Directive), Options) :-
  731    wrapped_list_directive(Directive),
  732    !,
  733    Directive =.. [Name, Arg, List],
  734    option(indent(LeftMargin), Options, 0),
  735    indent(Out, LeftMargin),
  736    format(Out, ':- ~q(', [Name]),
  737    line_position(Out, Indent),
  738    format(Out, '~q,', [Arg]),
  739    nlindent(Out, Indent),
  740    portray_list(List, Indent, Out, Options),
  741    write(Out, ').\n').
  742do_portray_clause(Out, Clause, Options) :-
  743    directive(Clause, Op, Directive),
  744    !,
  745    option(indent(LeftMargin), Options, 0),
  746    indent(Out, LeftMargin),
  747    format(Out, '~w ', [Op]),
  748    DIndent is LeftMargin+3,
  749    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  750    full_stop(Out).
  751do_portray_clause(Out, Fact, Options) :-
  752    option(indent(LeftMargin), Options, 0),
  753    indent(Out, LeftMargin),
  754    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  755    full_stop(Out).
  756
  757clause_term((Head:-Body), Head, :-, Body).
  758clause_term((Head=>Body), Head, =>, Body).
  759clause_term(?=>(Head,Body), Head, ?=>, Body).
  760clause_term((Head-->Body), Head, -->, Body).
  761
  762full_stop(Out) :-
  763    '$put_token'(Out, '.'),
  764    nl(Out).
  765
  766directive((:- Directive), :-, Directive).
  767directive((?- Directive), ?-, Directive).
  768
  769wrapped_list_directive(module(_,_)).
  770%wrapped_list_directive(use_module(_,_)).
  771%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.
  778portray_body(Var, _, _, Pri, Out, Options) :-
  779    var(Var),
  780    !,
  781    pprint(Out, Var, Pri, Options).
  782portray_body(!, _, _, _, Out, _) :-
  783    setting(listing:cut_on_same_line, true),
  784    !,
  785    write(Out, ' !').
  786portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  787    setting(listing:cut_on_same_line, true),
  788    \+ term_needs_braces((_,_), Pri),
  789    !,
  790    write(Out, ' !,'),
  791    portray_body(Clause, Indent, indent, 1000, Out, Options).
  792portray_body(Term, Indent, indent, Pri, Out, Options) :-
  793    !,
  794    nlindent(Out, Indent),
  795    portray_body(Term, Indent, noindent, Pri, Out, Options).
  796portray_body(Or, Indent, _, _, Out, Options) :-
  797    or_layout(Or),
  798    !,
  799    write(Out, '(   '),
  800    portray_or(Or, Indent, 1200, Out, Options),
  801    nlindent(Out, Indent),
  802    write(Out, ')').
  803portray_body(Term, Indent, _, Pri, Out, Options) :-
  804    term_needs_braces(Term, Pri),
  805    !,
  806    write(Out, '( '),
  807    ArgIndent is Indent + 2,
  808    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  809    nlindent(Out, Indent),
  810    write(Out, ')').
  811portray_body(((AB),C), Indent, _, _Pri, Out, Options) :-
  812    nonvar(AB),
  813    AB = (A,B),
  814    !,
  815    infix_op(',', LeftPri, RightPri),
  816    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  817    write(Out, ','),
  818    portray_body((B,C), Indent, indent, RightPri, Out, Options).
  819portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  820    !,
  821    infix_op(',', LeftPri, RightPri),
  822    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  823    write(Out, ','),
  824    portray_body(B, Indent, indent, RightPri, Out, Options).
  825portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  826    !,
  827    write(Out, \+), write(Out, ' '),
  828    prefix_op(\+, ArgPri),
  829    ArgIndent is Indent+3,
  830    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  831portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  832    m_callable(Call),
  833    option(module(M), Options, user),
  834    predicate_property(M:Call, meta_predicate(Meta)),
  835    !,
  836    portray_meta(Out, Call, Meta, Options).
  837portray_body(Clause, _, _, Pri, Out, Options) :-
  838    pprint(Out, Clause, Pri, Options).
  839
  840m_callable(Term) :-
  841    strip_module(Term, _, Plain),
  842    callable(Plain),
  843    Plain \= (_:_).
  844
  845term_needs_braces(Term, Pri) :-
  846    callable(Term),
  847    functor(Term, Name, _Arity),
  848    current_op(OpPri, _Type, Name),
  849    OpPri > Pri,
  850    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  854portray_or(Term, Indent, Pri, Out, Options) :-
  855    term_needs_braces(Term, Pri),
  856    !,
  857    inc_indent(Indent, 1, NewIndent),
  858    write(Out, '(   '),
  859    portray_or(Term, NewIndent, Out, Options),
  860    nlindent(Out, NewIndent),
  861    write(Out, ')').
  862portray_or(Term, Indent, _Pri, Out, Options) :-
  863    or_layout(Term),
  864    !,
  865    portray_or(Term, Indent, Out, Options).
  866portray_or(Term, Indent, Pri, Out, Options) :-
  867    inc_indent(Indent, 1, NestIndent),
  868    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  869
  870
  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 ; Else), 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_body(Then, NestIndent, noindent, RightPri, Out, Options),
  891    nlindent(Out, Indent),
  892    write(Out, ';   '),
  893    infix_op(;, _LeftPri, RightPri2),
  894    portray_or(Else, Indent, RightPri2, Out, Options).
  895portray_or((If -> Then), Indent, Out, Options) :-
  896    !,
  897    inc_indent(Indent, 1, NestIndent),
  898    infix_op((->), LeftPri, RightPri),
  899    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  900    nlindent(Out, Indent),
  901    write(Out, '->  '),
  902    portray_or(Then, Indent, RightPri, Out, Options).
  903portray_or((If *-> Then), Indent, Out, Options) :-
  904    !,
  905    inc_indent(Indent, 1, NestIndent),
  906    infix_op((->), LeftPri, RightPri),
  907    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  908    nlindent(Out, Indent),
  909    write(Out, '*-> '),
  910    portray_or(Then, Indent, RightPri, Out, Options).
  911portray_or((A;B), Indent, Out, Options) :-
  912    !,
  913    inc_indent(Indent, 1, NestIndent),
  914    infix_op(;, LeftPri, RightPri),
  915    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  916    nlindent(Out, Indent),
  917    write(Out, ';   '),
  918    portray_or(B, Indent, RightPri, Out, Options).
  919portray_or((A|B), Indent, Out, Options) :-
  920    !,
  921    inc_indent(Indent, 1, NestIndent),
  922    infix_op('|', LeftPri, RightPri),
  923    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  924    nlindent(Out, Indent),
  925    write(Out, '|   '),
  926    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.
  934infix_op(Op, Left, Right) :-
  935    current_op(Pri, Assoc, Op),
  936    infix_assoc(Assoc, LeftMin, RightMin),
  937    !,
  938    Left is Pri - LeftMin,
  939    Right is Pri - RightMin.
  940
  941infix_assoc(xfx, 1, 1).
  942infix_assoc(xfy, 1, 0).
  943infix_assoc(yfx, 0, 1).
  944
  945prefix_op(Op, ArgPri) :-
  946    current_op(Pri, Assoc, Op),
  947    pre_assoc(Assoc, ArgMin),
  948    !,
  949    ArgPri is Pri - ArgMin.
  950
  951pre_assoc(fx, 1).
  952pre_assoc(fy, 0).
  953
  954postfix_op(Op, ArgPri) :-
  955    current_op(Pri, Assoc, Op),
  956    post_assoc(Assoc, ArgMin),
  957    !,
  958    ArgPri is Pri - ArgMin.
  959
  960post_assoc(xf, 1).
  961post_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.
  970or_layout(Var) :-
  971    var(Var), !, fail.
  972or_layout((_;_)).
  973or_layout((_->_)).
  974or_layout((_*->_)).
  975
  976primitive(G) :-
  977    or_layout(G), !, fail.
  978primitive((_,_)) :- !, fail.
  979primitive(_).
 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.
  988portray_meta(Out, Call, Meta, Options) :-
  989    contains_non_primitive_meta_arg(Call, Meta),
  990    !,
  991    Call =.. [Name|Args],
  992    Meta =.. [_|Decls],
  993    format(Out, '~q(', [Name]),
  994    line_position(Out, Indent),
  995    portray_meta_args(Decls, Args, Indent, Out, Options),
  996    format(Out, ')', []).
  997portray_meta(Out, Call, _, Options) :-
  998    pprint(Out, Call, 999, Options).
  999
 1000contains_non_primitive_meta_arg(Call, Decl) :-
 1001    arg(I, Call, CA),
 1002    arg(I, Decl, DA),
 1003    integer(DA),
 1004    \+ primitive(CA),
 1005    !.
 1006
 1007portray_meta_args([], [], _, _, _).
 1008portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
 1009    portray_meta_arg(D, A, Out, Options),
 1010    (   DT == []
 1011    ->  true
 1012    ;   format(Out, ',', []),
 1013        nlindent(Out, Indent),
 1014        portray_meta_args(DT, AT, Indent, Out, Options)
 1015    ).
 1016
 1017portray_meta_arg(I, A, Out, Options) :-
 1018    integer(I),
 1019    !,
 1020    line_position(Out, Indent),
 1021    portray_body(A, Indent, noindent, 999, Out, Options).
 1022portray_meta_arg(_, A, Out, Options) :-
 1023    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
]                       ]
 1033portray_list([], _, Out, _) :-
 1034    !,
 1035    write(Out, []).
 1036portray_list(List, Indent, Out, Options) :-
 1037    write(Out, '[ '),
 1038    EIndent is Indent + 2,
 1039    portray_list_elements(List, EIndent, Out, Options),
 1040    nlindent(Out, Indent),
 1041    write(Out, ']').
 1042
 1043portray_list_elements([H|T], EIndent, Out, Options) :-
 1044    pprint(Out, H, 999, Options),
 1045    (   T == []
 1046    ->  true
 1047    ;   nonvar(T), T = [_|_]
 1048    ->  write(Out, ','),
 1049        nlindent(Out, EIndent),
 1050        portray_list_elements(T, EIndent, Out, Options)
 1051    ;   Indent is EIndent - 2,
 1052        nlindent(Out, Indent),
 1053        write(Out, '| '),
 1054        pprint(Out, T, 999, Options)
 1055    ).
 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.
 1069pprint(Out, Term, _, Options) :-
 1070    nonvar(Term),
 1071    Term = {}(Arg),
 1072    line_position(Out, Indent),
 1073    ArgIndent is Indent + 2,
 1074    format(Out, '{ ', []),
 1075    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1076    nlindent(Out, Indent),
 1077    format(Out, '}', []).
 1078pprint(Out, Term, Pri, Options) :-
 1079    (   compound(Term)
 1080    ->  compound_name_arity(Term, _, Arity),
 1081        Arity > 0
 1082    ;   is_dict(Term)
 1083    ),
 1084    \+ nowrap_term(Term),
 1085    setting(listing:line_width, Width),
 1086    Width > 0,
 1087    (   write_length(Term, Len, [max_length(Width)|Options])
 1088    ->  true
 1089    ;   Len = Width
 1090    ),
 1091    line_position(Out, Indent),
 1092    Indent + Len > Width,
 1093    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1094    !,
 1095    pprint_wrapped(Out, Term, Pri, Options).
 1096pprint(Out, Term, Pri, Options) :-
 1097    listing_write_options(Pri, WrtOptions, Options),
 1098    write_term(Out, Term,
 1099               [ blobs(portray),
 1100                 portray_goal(portray_blob)
 1101               | WrtOptions
 1102               ]).
 1103
 1104portray_blob(Blob, _Options) :-
 1105    blob(Blob, _),
 1106    \+ atom(Blob),
 1107    !,
 1108    format(string(S), '~q', [Blob]),
 1109    format('~q', ['$BLOB'(S)]).
 1110
 1111nowrap_term('$VAR'(_)) :- !.
 1112nowrap_term(_{}) :- !.                  % empty dict
 1113nowrap_term(Term) :-
 1114    functor(Term, Name, Arity),
 1115    current_op(_, _, Name),
 1116    (   Arity == 2
 1117    ->  infix_op(Name, _, _)
 1118    ;   Arity == 1
 1119    ->  (   prefix_op(Name, _)
 1120        ->  true
 1121        ;   postfix_op(Name, _)
 1122        )
 1123    ).
 1124
 1125
 1126pprint_wrapped(Out, Term, _, Options) :-
 1127    Term = [_|_],
 1128    !,
 1129    line_position(Out, Indent),
 1130    portray_list(Term, Indent, Out, Options).
 1131pprint_wrapped(Out, Dict, _, Options) :-
 1132    is_dict(Dict),
 1133    !,
 1134    dict_pairs(Dict, Tag, Pairs),
 1135    pprint(Out, Tag, 1200, Options),
 1136    format(Out, '{ ', []),
 1137    line_position(Out, Indent),
 1138    pprint_nv(Pairs, Indent, Out, Options),
 1139    nlindent(Out, Indent-2),
 1140    format(Out, '}', []).
 1141pprint_wrapped(Out, Term, _, Options) :-
 1142    Term =.. [Name|Args],
 1143    format(Out, '~q(', [Name]),
 1144    line_position(Out, Indent),
 1145    pprint_args(Args, Indent, Out, Options),
 1146    format(Out, ')', []).
 1147
 1148pprint_args([], _, _, _).
 1149pprint_args([H|T], Indent, Out, Options) :-
 1150    pprint(Out, H, 999, Options),
 1151    (   T == []
 1152    ->  true
 1153    ;   format(Out, ',', []),
 1154        nlindent(Out, Indent),
 1155        pprint_args(T, Indent, Out, Options)
 1156    ).
 1157
 1158
 1159pprint_nv([], _, _, _).
 1160pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1161    pprint(Out, Name, 999, Options),
 1162    format(Out, ':', []),
 1163    pprint(Out, Value, 999, Options),
 1164    (   T == []
 1165    ->  true
 1166    ;   format(Out, ',', []),
 1167        nlindent(Out, Indent),
 1168        pprint_nv(T, Indent, Out, Options)
 1169    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1177listing_write_options(Pri,
 1178                      [ quoted(true),
 1179                        numbervars(true),
 1180                        priority(Pri),
 1181                        spacing(next_argument)
 1182                      | Options
 1183                      ],
 1184                      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.
 1192nlindent(Out, N) :-
 1193    nl(Out),
 1194    indent(Out, N).
 1195
 1196indent(Out, N) :-
 1197    setting(listing:tab_distance, D),
 1198    (   D =:= 0
 1199    ->  tab(Out, N)
 1200    ;   Tab is N // D,
 1201        Space is N mod D,
 1202        put_tabs(Out, Tab),
 1203        tab(Out, Space)
 1204    ).
 1205
 1206put_tabs(Out, N) :-
 1207    N > 0,
 1208    !,
 1209    put(Out, 0'\t),
 1210    NN is N - 1,
 1211    put_tabs(Out, NN).
 1212put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1219inc_indent(Indent0, Inc, Indent) :-
 1220    Indent is Indent0 + Inc*4.
 1221
 1222:- multifile
 1223    sandbox:safe_meta/2. 1224
 1225sandbox:safe_meta(listing(What), []) :-
 1226    not_qualified(What).
 1227
 1228not_qualified(Var) :-
 1229    var(Var),
 1230    !.
 1231not_qualified(_:_) :- !, fail.
 1232not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1239comment(Format, Args) :-
 1240    stream_property(current_output, tty(true)),
 1241    setting(listing:comment_ansi_attributes, Attributes),
 1242    Attributes \== [],
 1243    !,
 1244    ansi_format(Attributes, Format, Args).
 1245comment(Format, Args) :-
 1246    format(Format, Args)