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
   72
   73/** <module> List programs and pretty print clauses
   74
   75This module implements listing code from  the internal representation in
   76a human readable format.
   77
   78    * listing/0 lists a module.
   79    * listing/1 lists a predicate or matching clause
   80    * listing/2 lists a predicate or matching clause with options
   81    * portray_clause/2 pretty-prints a clause-term
   82
   83Layout can be customized using library(settings). The effective settings
   84can be listed using list_settings/1 as   illustrated below. Settings can
   85be changed using set_setting/2.
   86
   87    ==
   88    ?- list_settings(listing).
   89    ========================================================================
   90    Name                      Value (*=modified) Comment
   91    ========================================================================
   92    listing:body_indentation  4              Indentation used goals in the body
   93    listing:tab_distance      0              Distance between tab-stops.
   94    ...
   95    ==
   96
   97@tbd    More settings, support _|Coding Guidelines for Prolog|_ and make
   98        the suggestions there the default.
   99@tbd    Provide persistent user customization
  100*/
  101
  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').  112
  113
  114%!  listing
  115%
  116%   Lists all predicates defined  in   the  calling module. Imported
  117%   predicates are not listed. To  list   the  content of the module
  118%   `mymodule`, use one of the calls below.
  119%
  120%     ```
  121%     ?- mymodule:listing.
  122%     ?- listing(mymodule:_).
  123%     ```
  124
  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    ).
  145
  146
  147%!  listing(:What) is det.
  148%!  listing(:What, +Options) is det.
  149%
  150%   List matching clauses. What is either a plain specification or a
  151%   list of specifications. Plain specifications are:
  152%
  153%     * Predicate indicator (Name/Arity or Name//Arity)
  154%     Lists the indicated predicate.  This also outputs relevant
  155%     _declarations_, such as multifile/1 or dynamic/1.
  156%
  157%     * A _Head_ term.  In this case, only clauses whose head
  158%     unify with _Head_ are listed.  This is illustrated in the
  159%     query below that only lists the first clause of append/3.
  160%
  161%       ==
  162%       ?- listing(append([], _, _)).
  163%       lists:append([], L, L).
  164%       ==
  165%
  166%     * A clause reference as obtained for example from nth_clause/3.
  167%
  168%    The following options are defined:
  169%
  170%      - variable_names(+How)
  171%      One of `source` (default) or `generated`.  If `source`, for each
  172%      clause that is associated to a source location the system tries
  173%      to restore the original variable names.  This may fail if macro
  174%      expansion is not reversible or the term cannot be read due to
  175%      different operator declarations.  In that case variable names
  176%      are generated.
  177%
  178%      - source(+Bool)
  179%      If `true` (default `false`), extract the lines from the source
  180%      files that produced the clauses, i.e., list the original source
  181%      text rather than the _decompiled_ clauses. Each set of contiguous
  182%      clauses is preceded by a comment that indicates the file and
  183%      line of origin.  Clauses that cannot be related to source code
  184%      are decompiled where the comment indicates the decompiled state.
  185%      This is notably practical for collecting the state of _multifile_
  186%      predicates.  For example:
  187%
  188%         ```
  189%         ?- listing(file_search_path, [source(true)]).
  190%         ```
  191
  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).
  229
  230%!  list_predicates(:Preds:list(pi), :Spec, +Options) is det.
  231
  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).
  304
  305%!  declaration(:Head, +Module, -Decl) is nondet.
  306%
  307%   True when the directive Decl (without  :-/1)   needs  to  be used to
  308%   restore the state of the predicate Head.
  309%
  310%   @tbd Answer subsumption, dynamic/2 to   deal  with `incremental` and
  311%   abstract(Depth)
  312
  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).
  343
  344%!  meta_implies_transparent(+Head) is semidet.
  345%
  346%   True if the meta-declaration Head implies  that the predicate is
  347%   transparent.
  348
  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).
  397
  398%!  list_clause(+Term, +ClauseRef, +ContextModule, +Options)
  399
  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).
  433
  434%!  restore_variable_names(+Module, +Head, +Body, +Ref, +Options) is det.
  435%
  436%   Try to restore the variable names  from   the  source  if the option
  437%   variable_names(source) is true.
  438
  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).
  464
  465%!  name_other_vars(+Term, +Bindings) is det.
  466%
  467%   Give a '$VAR'(N) name to all   remaining variables in Term, avoiding
  468%   clashes with the given variable names.
  469
  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(_, _).
  519
  520%!  source_clause_string(+File, +Line, -String, -Repositioned)
  521%
  522%   True when String is the source text for a clause starting at Line in
  523%   File.
  524
  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)).
  612
  613
  614%!  portray_clause(+Clause) is det.
  615%!  portray_clause(+Out:stream, +Clause) is det.
  616%!  portray_clause(+Out:stream, +Clause, +Options) is det.
  617%
  618%   Portray `Clause' on the current output  stream. Layout of the clause
  619%   is to our best standards. Deals   with  control structures and calls
  620%   via meta-call predicates as determined  using the predicate property
  621%   meta_predicate. If Clause contains attributed   variables, these are
  622%   treated as normal variables.
  623%
  624%   Variable names are by default generated using numbervars/4 using the
  625%   option singletons(true). This names the variables  `A`, `B`, ... and
  626%   the singletons `_`. Variables can  be   named  explicitly by binding
  627%   them to a term `'$VAR'(Name)`, where `Name`   is  an atom denoting a
  628%   valid  variable  name  (see   the    option   numbervars(true)  from
  629%   write_term/2) as well  as  by   using  the  variable_names(Bindings)
  630%   option from write_term/2.
  631%
  632%   Options processed in addition to write_term/2 options:
  633%
  634%     - variable_names(+Bindings)
  635%       See above and write_term/2.
  636%     - indent(+Columns)
  637%       Left margin used for the clause.  Default `0`.
  638%     - module(+Module)
  639%       Module used to determine whether a goal resolves to a meta
  640%       predicate.  Default `user`.
  641
  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(_,_)).
  772
  773%!  portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
  774%
  775%   Write Term at current indentation. If   DoIndent  is 'indent' we
  776%   must first call nlindent/2 before emitting anything.
  777
  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    !.
  851
  852%!  portray_or(+Term, +Indent, +Priority, +Out) is det.
  853
  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).
  927
  928
  929%!  infix_op(+Op, -Left, -Right) is semidet.
  930%
  931%   True if Op is an infix operator and Left is the max priority of its
  932%   left hand and Right is the max priority of its right hand.
  933
  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).
  962
  963%!  or_layout(@Term) is semidet.
  964%
  965%   True if Term is a control structure for which we want to use clean
  966%   layout.
  967%
  968%   @tbd    Change name.
  969
  970or_layout(Var) :-
  971    var(Var), !, fail.
  972or_layout((_;_)).
  973or_layout((_->_)).
  974or_layout((_*->_)).
  975
  976primitive(G) :-
  977    or_layout(G), !, fail.
  978primitive((_,_)) :- !, fail.
  979primitive(_).
  980
  981
  982%!  portray_meta(+Out, +Call, +MetaDecl, +Options)
  983%
  984%   Portray a meta-call. If Call   contains non-primitive meta-calls
  985%   we put each argument on a line and layout the body. Otherwise we
  986%   simply print the goal.
  987
  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).
 1024
 1025%!  portray_list(+List, +Indent, +Out)
 1026%
 1027%   Portray a list like this.  Right side for improper lists
 1028%
 1029%           [ element1,             [ element1
 1030%             element2,     OR      | tail
 1031%           ]                       ]
 1032
 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    ).
 1056
 1057%!  pprint(+Out, +Term, +Priority, +Options)
 1058%
 1059%   Print  Term  at  Priority.  This  also  takes  care  of  several
 1060%   formatting options, in particular:
 1061%
 1062%     * {}(Arg) terms are printed with aligned arguments, assuming
 1063%     that the term is a body-term.
 1064%     * Terms that do not fit on the line are wrapped using
 1065%     pprint_wrapped/3.
 1066%
 1067%   @tbd    Decide when and how to wrap long terms.
 1068
 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    ).
 1170
 1171
 1172%!  listing_write_options(+Priority, -WriteOptions) is det.
 1173%
 1174%   WriteOptions are write_term/3 options for writing a term at
 1175%   priority Priority.
 1176
 1177listing_write_options(Pri,
 1178                      [ quoted(true),
 1179                        numbervars(true),
 1180                        priority(Pri),
 1181                        spacing(next_argument)
 1182                      | Options
 1183                      ],
 1184                      Options).
 1185
 1186%!  nlindent(+Out, +Indent)
 1187%
 1188%   Write newline and indent to  column   Indent.  Uses  the setting
 1189%   listing:tab_distance to determine the mapping   between tabs and
 1190%   spaces.
 1191
 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(_, _).
 1213
 1214
 1215%!  inc_indent(+Indent0, +Inc, -Indent)
 1216%
 1217%   Increment the indent with logical steps.
 1218
 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(_).
 1233
 1234
 1235%!  comment(+Format, +Args)
 1236%
 1237%   Emit a comment.
 1238
 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)