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]),
  285    (   '$foreign_predicate_source'(Pred, Source)
  286    ->  comment('%   Implemented by ~w~n', [Source])
  287    ;   true
  288    ).
  289list_predicate(Pred, Context, Options) :-
  290    notify_changed(Pred, Context),
  291    list_declarations(Pred, Context),
  292    list_clauses(Pred, Context, Options).
  293
  294decl_term(Pred, Context, Decl) :-
  295    strip_module(Pred, Module, Head),
  296    functor(Head, Name, Arity),
  297    (   hide_module(Module, Context, Head)
  298    ->  Decl = Name/Arity
  299    ;   Decl = Module:Name/Arity
  300    ).
  301
  302
  303decl(thread_local, thread_local).
  304decl(dynamic,      dynamic).
  305decl(volatile,     volatile).
  306decl(multifile,    multifile).
  307decl(public,       public).
  308
  309%!  declaration(:Head, +Module, -Decl) is nondet.
  310%
  311%   True when the directive Decl (without  :-/1)   needs  to  be used to
  312%   restore the state of the predicate Head.
  313%
  314%   @tbd Answer subsumption, dynamic/2 to   deal  with `incremental` and
  315%   abstract(Depth)
  316
  317declaration(Pred, Source, Decl) :-
  318    predicate_property(Pred, tabled),
  319    Pred = M:Head,
  320    (   M:'$table_mode'(Head, Head, _)
  321    ->  decl_term(Pred, Source, Funct),
  322        table_options(Pred, Funct, TableDecl),
  323        Decl = table(TableDecl)
  324    ;   comment('% tabled using answer subsumption~n', []),
  325        fail                                    % TBD
  326    ).
  327declaration(Pred, Source, Decl) :-
  328    decl(Prop, Declname),
  329    predicate_property(Pred, Prop),
  330    decl_term(Pred, Source, Funct),
  331    Decl =.. [ Declname, Funct ].
  332declaration(Pred, Source, Decl) :-
  333    predicate_property(Pred, meta_predicate(Head)),
  334    strip_module(Pred, Module, _),
  335    (   (Module == system; Source == Module)
  336    ->  Decl = meta_predicate(Head)
  337    ;   Decl = meta_predicate(Module:Head)
  338    ),
  339    (   meta_implies_transparent(Head)
  340    ->  !                                   % hide transparent
  341    ;   true
  342    ).
  343declaration(Pred, Source, Decl) :-
  344    predicate_property(Pred, transparent),
  345    decl_term(Pred, Source, PI),
  346    Decl = module_transparent(PI).
  347
  348%!  meta_implies_transparent(+Head) is semidet.
  349%
  350%   True if the meta-declaration Head implies  that the predicate is
  351%   transparent.
  352
  353meta_implies_transparent(Head):-
  354    compound(Head),
  355    arg(_, Head, Arg),
  356    implies_transparent(Arg),
  357    !.
  358
  359implies_transparent(Arg) :-
  360    integer(Arg),
  361    !.
  362implies_transparent(:).
  363implies_transparent(//).
  364implies_transparent(^).
  365
  366table_options(Pred, Decl0, as(Decl0, Options)) :-
  367    findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]),
  368    !,
  369    foldl(table_option, Flags, F0, Options).
  370table_options(_, Decl, Decl).
  371
  372table_option(Flag, X, (Flag,X)).
  373
  374list_declarations(Pred, Source) :-
  375    findall(Decl, declaration(Pred, Source, Decl), Decls),
  376    (   Decls == []
  377    ->  true
  378    ;   write_declarations(Decls, Source),
  379        format('~n', [])
  380    ).
  381
  382
  383write_declarations([], _) :- !.
  384write_declarations([H|T], Module) :-
  385    format(':- ~q.~n', [H]),
  386    write_declarations(T, Module).
  387
  388list_clauses(Pred, Source, Options) :-
  389    strip_module(Pred, Module, Head),
  390    most_general_goal(Head, GenHead),
  391    forall(( rule(Module:GenHead, Rule, Ref),
  392             \+ \+ rule_head(Rule, Head)
  393           ),
  394           list_clause(Module:Rule, Ref, Source, Options)).
  395
  396rule_head((Head0 :- _Body), Head) :- !, Head = Head0.
  397rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0.
  398rule_head((Head0 => _Body), Head) :- !, Head = Head0.
  399rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0.
  400rule_head(Head, Head).
  401
  402%!  list_clause(+Term, +ClauseRef, +ContextModule, +Options)
  403
  404list_clause(_Rule, Ref, _Source, Options) :-
  405    option(source(true), Options),
  406    (   clause_property(Ref, file(File)),
  407        clause_property(Ref, line_count(Line)),
  408        catch(source_clause_string(File, Line, String, Repositioned),
  409              _, fail),
  410        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  411    ->  !,
  412        (   Repositioned == true
  413        ->  comment('% From ~w:~d~n', [ File, Line ])
  414        ;   true
  415        ),
  416        writeln(String)
  417    ;   decompiled
  418    ->  fail
  419    ;   asserta(decompiled),
  420        comment('% From database (decompiled)~n', []),
  421        fail                                    % try next clause
  422    ).
  423list_clause(Module:(Head:-Body), Ref, Source, Options) :-
  424    !,
  425    list_clause(Module:Head, Body, :-, Ref, Source, Options).
  426list_clause(Module:(Head=>Body), Ref, Source, Options) :-
  427    list_clause(Module:Head, Body, =>, Ref, Source, Options).
  428list_clause(Module:Head, Ref, Source, Options) :-
  429    !,
  430    list_clause(Module:Head, true, :-, Ref, Source, Options).
  431
  432list_clause(Module:Head, Body, Neck, Ref, Source, Options) :-
  433    restore_variable_names(Module, Head, Body, Ref, Options),
  434    write_module(Module, Source, Head),
  435    Rule =.. [Neck,Head,Body],
  436    portray_clause(Rule).
  437
  438%!  restore_variable_names(+Module, +Head, +Body, +Ref, +Options) is det.
  439%
  440%   Try to restore the variable names  from   the  source  if the option
  441%   variable_names(source) is true.
  442
  443restore_variable_names(Module, Head, Body, Ref, Options) :-
  444    option(variable_names(source), Options, source),
  445    catch(clause_info(Ref, _, _, _,
  446                      [ head(QHead),
  447                        body(Body),
  448                        variable_names(Bindings)
  449                      ]),
  450          _, true),
  451    unify_head(Module, Head, QHead),
  452    !,
  453    bind_vars(Bindings),
  454    name_other_vars((Head:-Body), Bindings).
  455restore_variable_names(_,_,_,_,_).
  456
  457unify_head(Module, Head, Module:Head) :-
  458    !.
  459unify_head(_, Head, Head) :-
  460    !.
  461unify_head(_, _, _).
  462
  463bind_vars([]) :-
  464    !.
  465bind_vars([Name = Var|T]) :-
  466    ignore(Var = '$VAR'(Name)),
  467    bind_vars(T).
  468
  469%!  name_other_vars(+Term, +Bindings) is det.
  470%
  471%   Give a '$VAR'(N) name to all   remaining variables in Term, avoiding
  472%   clashes with the given variable names.
  473
  474name_other_vars(Term, Bindings) :-
  475    term_singletons(Term, Singletons),
  476    bind_singletons(Singletons),
  477    term_variables(Term, Vars),
  478    name_vars(Vars, 0, Bindings).
  479
  480bind_singletons([]).
  481bind_singletons(['$VAR'('_')|T]) :-
  482    bind_singletons(T).
  483
  484name_vars([], _, _).
  485name_vars([H|T], N, Bindings) :-
  486    between(N, infinite, N2),
  487    var_name(N2, Name),
  488    \+ memberchk(Name=_, Bindings),
  489    !,
  490    H = '$VAR'(N2),
  491    N3 is N2 + 1,
  492    name_vars(T, N3, Bindings).
  493
  494var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  495    L is (I mod 26)+0'A,
  496    N is I // 26,
  497    (   N == 0
  498    ->  char_code(Name, L)
  499    ;   format(atom(Name), '~c~d', [L, N])
  500    ).
  501
  502write_module(Module, Context, Head) :-
  503    hide_module(Module, Context, Head),
  504    !.
  505write_module(Module, _, _) :-
  506    format('~q:', [Module]).
  507
  508hide_module(system, Module, Head) :-
  509    predicate_property(Module:Head, imported_from(M)),
  510    predicate_property(system:Head, imported_from(M)),
  511    !.
  512hide_module(Module, Module, _) :- !.
  513
  514notify_changed(Pred, Context) :-
  515    strip_module(Pred, user, Head),
  516    predicate_property(Head, built_in),
  517    \+ predicate_property(Head, (dynamic)),
  518    !,
  519    decl_term(Pred, Context, Decl),
  520    comment('%   NOTE: system definition has been overruled for ~q~n',
  521            [Decl]).
  522notify_changed(_, _).
  523
  524%!  source_clause_string(+File, +Line, -String, -Repositioned)
  525%
  526%   True when String is the source text for a clause starting at Line in
  527%   File.
  528
  529source_clause_string(File, Line, String, Repositioned) :-
  530    open_source(File, Line, Stream, Repositioned),
  531    stream_property(Stream, position(Start)),
  532    '$raw_read'(Stream, _TextWithoutComments),
  533    stream_property(Stream, position(End)),
  534    stream_position_data(char_count, Start, StartChar),
  535    stream_position_data(char_count, End, EndChar),
  536    Length is EndChar - StartChar,
  537    set_stream_position(Stream, Start),
  538    read_string(Stream, Length, String),
  539    skip_blanks_and_comments(Stream, blank).
  540
  541skip_blanks_and_comments(Stream, _) :-
  542    at_end_of_stream(Stream),
  543    !.
  544skip_blanks_and_comments(Stream, State0) :-
  545    peek_string(Stream, 80, String),
  546    string_chars(String, Chars),
  547    phrase(blanks_and_comments(State0, State), Chars, Rest),
  548    (   Rest == []
  549    ->  read_string(Stream, 80, _),
  550        skip_blanks_and_comments(Stream, State)
  551    ;   length(Chars, All),
  552        length(Rest, RLen),
  553        Skip is All-RLen,
  554        read_string(Stream, Skip, _)
  555    ).
  556
  557blanks_and_comments(State0, State) -->
  558    [C],
  559    { transition(C, State0, State1) },
  560    !,
  561    blanks_and_comments(State1, State).
  562blanks_and_comments(State, State) -->
  563    [].
  564
  565transition(C, blank, blank) :-
  566    char_type(C, space).
  567transition('%', blank, line_comment).
  568transition('\n', line_comment, blank).
  569transition(_, line_comment, line_comment).
  570transition('/', blank, comment_0).
  571transition('/', comment(N), comment(N,/)).
  572transition('*', comment(N,/), comment(N1)) :-
  573    N1 is N + 1.
  574transition('*', comment_0, comment(1)).
  575transition('*', comment(N), comment(N,*)).
  576transition('/', comment(N,*), State) :-
  577    (   N == 1
  578    ->  State = blank
  579    ;   N2 is N - 1,
  580        State = comment(N2)
  581    ).
  582
  583
  584open_source(File, Line, Stream, Repositioned) :-
  585    source_stream(File, Stream, Pos0, Repositioned),
  586    line_count(Stream, Line0),
  587    (   Line >= Line0
  588    ->  Skip is Line - Line0
  589    ;   set_stream_position(Stream, Pos0),
  590        Skip is Line - 1
  591    ),
  592    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  593    (   Skip =\= 0
  594    ->  Repositioned = true
  595    ;   true
  596    ),
  597    forall(between(1, Skip, _),
  598           skip(Stream, 0'\n)).
  599
  600:- thread_local
  601    opened_source/3,
  602    decompiled/0.  603
  604source_stream(File, Stream, Pos0, _) :-
  605    opened_source(File, Stream, Pos0),
  606    !.
  607source_stream(File, Stream, Pos0, true) :-
  608    open(File, read, Stream),
  609    stream_property(Stream, position(Pos0)),
  610    asserta(opened_source(File, Stream, Pos0)).
  611
  612close_sources :-
  613    retractall(decompiled),
  614    forall(retract(opened_source(_,Stream,_)),
  615           close(Stream)).
  616
  617
  618%!  portray_clause(+Clause) is det.
  619%!  portray_clause(+Out:stream, +Clause) is det.
  620%!  portray_clause(+Out:stream, +Clause, +Options) is det.
  621%
  622%   Portray `Clause' on the current output  stream. Layout of the clause
  623%   is to our best standards. Deals   with  control structures and calls
  624%   via meta-call predicates as determined  using the predicate property
  625%   meta_predicate. If Clause contains attributed   variables, these are
  626%   treated as normal variables.
  627%
  628%   Variable names are by default generated using numbervars/4 using the
  629%   option singletons(true). This names the variables  `A`, `B`, ... and
  630%   the singletons `_`. Variables can  be   named  explicitly by binding
  631%   them to a term `'$VAR'(Name)`, where `Name`   is  an atom denoting a
  632%   valid  variable  name  (see   the    option   numbervars(true)  from
  633%   write_term/2) as well  as  by   using  the  variable_names(Bindings)
  634%   option from write_term/2.
  635%
  636%   Options processed in addition to write_term/2 options:
  637%
  638%     - variable_names(+Bindings)
  639%       See above and write_term/2.
  640%     - indent(+Columns)
  641%       Left margin used for the clause.  Default `0`.
  642%     - module(+Module)
  643%       Module used to determine whether a goal resolves to a meta
  644%       predicate.  Default `user`.
  645
  646%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  647%       confusion if the heads relates to other   bodies.  For now it is
  648%       only used for XPCE methods and works just nice.
  649%
  650%       Not really ...  It may confuse the source-level debugger.
  651
  652%portray_clause(Head :- _Body) :-
  653%       user:prolog_list_goal(Head), !.
  654portray_clause(Term) :-
  655    current_output(Out),
  656    portray_clause(Out, Term).
  657
  658portray_clause(Stream, Term) :-
  659    must_be(stream, Stream),
  660    portray_clause(Stream, Term, []).
  661
  662portray_clause(Stream, Term, M:Options) :-
  663    must_be(list, Options),
  664    meta_options(is_meta, M:Options, QOptions),
  665    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  666
  667name_vars_and_portray_clause(Stream, Term, Options) :-
  668    term_attvars(Term, []),
  669    !,
  670    clause_vars(Term, Options),
  671    do_portray_clause(Stream, Term, Options).
  672name_vars_and_portray_clause(Stream, Term, Options) :-
  673    option(variable_names(Bindings), Options),
  674    !,
  675    copy_term_nat(Term+Bindings, Copy+BCopy),
  676    bind_vars(BCopy),
  677    name_other_vars(Copy, BCopy),
  678    do_portray_clause(Stream, Copy, Options).
  679name_vars_and_portray_clause(Stream, Term, Options) :-
  680    copy_term_nat(Term, Copy),
  681    clause_vars(Copy, Options),
  682    do_portray_clause(Stream, Copy, Options).
  683
  684clause_vars(Clause, Options) :-
  685    option(variable_names(Bindings), Options),
  686    !,
  687    bind_vars(Bindings),
  688    name_other_vars(Clause, Bindings).
  689clause_vars(Clause, _) :-
  690    numbervars(Clause, 0, _,
  691               [ singletons(true)
  692               ]).
  693
  694is_meta(portray_goal).
  695
  696do_portray_clause(Out, Var, Options) :-
  697    var(Var),
  698    !,
  699    option(indent(LeftMargin), Options, 0),
  700    indent(Out, LeftMargin),
  701    pprint(Out, Var, 1200, Options).
  702do_portray_clause(Out, (Head :- true), Options) :-
  703    !,
  704    option(indent(LeftMargin), Options, 0),
  705    indent(Out, LeftMargin),
  706    pprint(Out, Head, 1200, Options),
  707    full_stop(Out).
  708do_portray_clause(Out, Term, Options) :-
  709    clause_term(Term, Head, Neck, Body),
  710    !,
  711    option(indent(LeftMargin), Options, 0),
  712    inc_indent(LeftMargin, 1, Indent),
  713    infix_op(Neck, RightPri, LeftPri),
  714    indent(Out, LeftMargin),
  715    pprint(Out, Head, LeftPri, Options),
  716    format(Out, ' ~w', [Neck]),
  717    (   nonvar(Body),
  718        Body = Module:LocalBody,
  719        \+ primitive(LocalBody)
  720    ->  nlindent(Out, Indent),
  721        format(Out, '~q', [Module]),
  722        '$put_token'(Out, :),
  723        nlindent(Out, Indent),
  724        write(Out, '(   '),
  725        inc_indent(Indent, 1, BodyIndent),
  726        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  727        nlindent(Out, Indent),
  728        write(Out, ')')
  729    ;   setting(listing:body_indentation, BodyIndent0),
  730        BodyIndent is LeftMargin+BodyIndent0,
  731        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  732    ),
  733    full_stop(Out).
  734do_portray_clause(Out, (:-Directive), Options) :-
  735    wrapped_list_directive(Directive),
  736    !,
  737    Directive =.. [Name, Arg, List],
  738    option(indent(LeftMargin), Options, 0),
  739    indent(Out, LeftMargin),
  740    format(Out, ':- ~q(', [Name]),
  741    line_position(Out, Indent),
  742    format(Out, '~q,', [Arg]),
  743    nlindent(Out, Indent),
  744    portray_list(List, Indent, Out, Options),
  745    write(Out, ').\n').
  746do_portray_clause(Out, Clause, Options) :-
  747    directive(Clause, Op, Directive),
  748    !,
  749    option(indent(LeftMargin), Options, 0),
  750    indent(Out, LeftMargin),
  751    format(Out, '~w ', [Op]),
  752    DIndent is LeftMargin+3,
  753    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  754    full_stop(Out).
  755do_portray_clause(Out, Fact, Options) :-
  756    option(indent(LeftMargin), Options, 0),
  757    indent(Out, LeftMargin),
  758    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  759    full_stop(Out).
  760
  761clause_term((Head:-Body), Head, :-, Body).
  762clause_term((Head=>Body), Head, =>, Body).
  763clause_term(?=>(Head,Body), Head, ?=>, Body).
  764clause_term((Head-->Body), Head, -->, Body).
  765
  766full_stop(Out) :-
  767    '$put_token'(Out, '.'),
  768    nl(Out).
  769
  770directive((:- Directive), :-, Directive).
  771directive((?- Directive), ?-, Directive).
  772
  773wrapped_list_directive(module(_,_)).
  774%wrapped_list_directive(use_module(_,_)).
  775%wrapped_list_directive(autoload(_,_)).
  776
  777%!  portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
  778%
  779%   Write Term at current indentation. If   DoIndent  is 'indent' we
  780%   must first call nlindent/2 before emitting anything.
  781
  782portray_body(Var, _, _, Pri, Out, Options) :-
  783    var(Var),
  784    !,
  785    pprint(Out, Var, Pri, Options).
  786portray_body(!, _, _, _, Out, _) :-
  787    setting(listing:cut_on_same_line, true),
  788    !,
  789    write(Out, ' !').
  790portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  791    setting(listing:cut_on_same_line, true),
  792    \+ term_needs_braces((_,_), Pri),
  793    !,
  794    write(Out, ' !,'),
  795    portray_body(Clause, Indent, indent, 1000, Out, Options).
  796portray_body(Term, Indent, indent, Pri, Out, Options) :-
  797    !,
  798    nlindent(Out, Indent),
  799    portray_body(Term, Indent, noindent, Pri, Out, Options).
  800portray_body(Or, Indent, _, _, Out, Options) :-
  801    or_layout(Or),
  802    !,
  803    write(Out, '(   '),
  804    portray_or(Or, Indent, 1200, Out, Options),
  805    nlindent(Out, Indent),
  806    write(Out, ')').
  807portray_body(Term, Indent, _, Pri, Out, Options) :-
  808    term_needs_braces(Term, Pri),
  809    !,
  810    write(Out, '( '),
  811    ArgIndent is Indent + 2,
  812    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  813    nlindent(Out, Indent),
  814    write(Out, ')').
  815portray_body(((AB),C), Indent, _, _Pri, Out, Options) :-
  816    nonvar(AB),
  817    AB = (A,B),
  818    !,
  819    infix_op(',', LeftPri, RightPri),
  820    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  821    write(Out, ','),
  822    portray_body((B,C), Indent, indent, RightPri, Out, Options).
  823portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  824    !,
  825    infix_op(',', LeftPri, RightPri),
  826    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  827    write(Out, ','),
  828    portray_body(B, Indent, indent, RightPri, Out, Options).
  829portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  830    !,
  831    write(Out, \+), write(Out, ' '),
  832    prefix_op(\+, ArgPri),
  833    ArgIndent is Indent+3,
  834    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  835portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  836    m_callable(Call),
  837    option(module(M), Options, user),
  838    predicate_property(M:Call, meta_predicate(Meta)),
  839    !,
  840    portray_meta(Out, Call, Meta, Options).
  841portray_body(Clause, _, _, Pri, Out, Options) :-
  842    pprint(Out, Clause, Pri, Options).
  843
  844m_callable(Term) :-
  845    strip_module(Term, _, Plain),
  846    callable(Plain),
  847    Plain \= (_:_).
  848
  849term_needs_braces(Term, Pri) :-
  850    callable(Term),
  851    functor(Term, Name, _Arity),
  852    current_op(OpPri, _Type, Name),
  853    OpPri > Pri,
  854    !.
  855
  856%!  portray_or(+Term, +Indent, +Priority, +Out) is det.
  857
  858portray_or(Term, Indent, Pri, Out, Options) :-
  859    term_needs_braces(Term, Pri),
  860    !,
  861    inc_indent(Indent, 1, NewIndent),
  862    write(Out, '(   '),
  863    portray_or(Term, NewIndent, Out, Options),
  864    nlindent(Out, NewIndent),
  865    write(Out, ')').
  866portray_or(Term, Indent, _Pri, Out, Options) :-
  867    or_layout(Term),
  868    !,
  869    portray_or(Term, Indent, Out, Options).
  870portray_or(Term, Indent, Pri, Out, Options) :-
  871    inc_indent(Indent, 1, NestIndent),
  872    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  873
  874
  875portray_or((If -> Then ; Else), Indent, Out, Options) :-
  876    !,
  877    inc_indent(Indent, 1, NestIndent),
  878    infix_op((->), LeftPri, RightPri),
  879    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  880    nlindent(Out, Indent),
  881    write(Out, '->  '),
  882    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  883    nlindent(Out, Indent),
  884    write(Out, ';   '),
  885    infix_op(;, _LeftPri, RightPri2),
  886    portray_or(Else, Indent, RightPri2, Out, Options).
  887portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  888    !,
  889    inc_indent(Indent, 1, NestIndent),
  890    infix_op((*->), LeftPri, RightPri),
  891    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  892    nlindent(Out, Indent),
  893    write(Out, '*-> '),
  894    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  895    nlindent(Out, Indent),
  896    write(Out, ';   '),
  897    infix_op(;, _LeftPri, RightPri2),
  898    portray_or(Else, Indent, RightPri2, Out, Options).
  899portray_or((If -> Then), Indent, Out, Options) :-
  900    !,
  901    inc_indent(Indent, 1, NestIndent),
  902    infix_op((->), LeftPri, RightPri),
  903    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  904    nlindent(Out, Indent),
  905    write(Out, '->  '),
  906    portray_or(Then, Indent, RightPri, Out, Options).
  907portray_or((If *-> Then), Indent, Out, Options) :-
  908    !,
  909    inc_indent(Indent, 1, NestIndent),
  910    infix_op((->), LeftPri, RightPri),
  911    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  912    nlindent(Out, Indent),
  913    write(Out, '*-> '),
  914    portray_or(Then, Indent, RightPri, Out, Options).
  915portray_or((A;B), Indent, Out, Options) :-
  916    !,
  917    inc_indent(Indent, 1, NestIndent),
  918    infix_op(;, LeftPri, RightPri),
  919    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  920    nlindent(Out, Indent),
  921    write(Out, ';   '),
  922    portray_or(B, Indent, RightPri, Out, Options).
  923portray_or((A|B), Indent, Out, Options) :-
  924    !,
  925    inc_indent(Indent, 1, NestIndent),
  926    infix_op('|', LeftPri, RightPri),
  927    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  928    nlindent(Out, Indent),
  929    write(Out, '|   '),
  930    portray_or(B, Indent, RightPri, Out, Options).
  931
  932
  933%!  infix_op(+Op, -Left, -Right) is semidet.
  934%
  935%   True if Op is an infix operator and Left is the max priority of its
  936%   left hand and Right is the max priority of its right hand.
  937
  938infix_op(Op, Left, Right) :-
  939    current_op(Pri, Assoc, Op),
  940    infix_assoc(Assoc, LeftMin, RightMin),
  941    !,
  942    Left is Pri - LeftMin,
  943    Right is Pri - RightMin.
  944
  945infix_assoc(xfx, 1, 1).
  946infix_assoc(xfy, 1, 0).
  947infix_assoc(yfx, 0, 1).
  948
  949prefix_op(Op, ArgPri) :-
  950    current_op(Pri, Assoc, Op),
  951    pre_assoc(Assoc, ArgMin),
  952    !,
  953    ArgPri is Pri - ArgMin.
  954
  955pre_assoc(fx, 1).
  956pre_assoc(fy, 0).
  957
  958postfix_op(Op, ArgPri) :-
  959    current_op(Pri, Assoc, Op),
  960    post_assoc(Assoc, ArgMin),
  961    !,
  962    ArgPri is Pri - ArgMin.
  963
  964post_assoc(xf, 1).
  965post_assoc(yf, 0).
  966
  967%!  or_layout(@Term) is semidet.
  968%
  969%   True if Term is a control structure for which we want to use clean
  970%   layout.
  971%
  972%   @tbd    Change name.
  973
  974or_layout(Var) :-
  975    var(Var), !, fail.
  976or_layout((_;_)).
  977or_layout((_->_)).
  978or_layout((_*->_)).
  979
  980primitive(G) :-
  981    or_layout(G), !, fail.
  982primitive((_,_)) :- !, fail.
  983primitive(_).
  984
  985
  986%!  portray_meta(+Out, +Call, +MetaDecl, +Options)
  987%
  988%   Portray a meta-call. If Call   contains non-primitive meta-calls
  989%   we put each argument on a line and layout the body. Otherwise we
  990%   simply print the goal.
  991
  992portray_meta(Out, Call, Meta, Options) :-
  993    contains_non_primitive_meta_arg(Call, Meta),
  994    !,
  995    Call =.. [Name|Args],
  996    Meta =.. [_|Decls],
  997    format(Out, '~q(', [Name]),
  998    line_position(Out, Indent),
  999    portray_meta_args(Decls, Args, Indent, Out, Options),
 1000    format(Out, ')', []).
 1001portray_meta(Out, Call, _, Options) :-
 1002    pprint(Out, Call, 999, Options).
 1003
 1004contains_non_primitive_meta_arg(Call, Decl) :-
 1005    arg(I, Call, CA),
 1006    arg(I, Decl, DA),
 1007    integer(DA),
 1008    \+ primitive(CA),
 1009    !.
 1010
 1011portray_meta_args([], [], _, _, _).
 1012portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
 1013    portray_meta_arg(D, A, Out, Options),
 1014    (   DT == []
 1015    ->  true
 1016    ;   format(Out, ',', []),
 1017        nlindent(Out, Indent),
 1018        portray_meta_args(DT, AT, Indent, Out, Options)
 1019    ).
 1020
 1021portray_meta_arg(I, A, Out, Options) :-
 1022    integer(I),
 1023    !,
 1024    line_position(Out, Indent),
 1025    portray_body(A, Indent, noindent, 999, Out, Options).
 1026portray_meta_arg(_, A, Out, Options) :-
 1027    pprint(Out, A, 999, Options).
 1028
 1029%!  portray_list(+List, +Indent, +Out)
 1030%
 1031%   Portray a list like this.  Right side for improper lists
 1032%
 1033%           [ element1,             [ element1
 1034%             element2,     OR      | tail
 1035%           ]                       ]
 1036
 1037portray_list([], _, Out, _) :-
 1038    !,
 1039    write(Out, []).
 1040portray_list(List, Indent, Out, Options) :-
 1041    write(Out, '[ '),
 1042    EIndent is Indent + 2,
 1043    portray_list_elements(List, EIndent, Out, Options),
 1044    nlindent(Out, Indent),
 1045    write(Out, ']').
 1046
 1047portray_list_elements([H|T], EIndent, Out, Options) :-
 1048    pprint(Out, H, 999, Options),
 1049    (   T == []
 1050    ->  true
 1051    ;   nonvar(T), T = [_|_]
 1052    ->  write(Out, ','),
 1053        nlindent(Out, EIndent),
 1054        portray_list_elements(T, EIndent, Out, Options)
 1055    ;   Indent is EIndent - 2,
 1056        nlindent(Out, Indent),
 1057        write(Out, '| '),
 1058        pprint(Out, T, 999, Options)
 1059    ).
 1060
 1061%!  pprint(+Out, +Term, +Priority, +Options)
 1062%
 1063%   Print  Term  at  Priority.  This  also  takes  care  of  several
 1064%   formatting options, in particular:
 1065%
 1066%     * {}(Arg) terms are printed with aligned arguments, assuming
 1067%     that the term is a body-term.
 1068%     * Terms that do not fit on the line are wrapped using
 1069%     pprint_wrapped/3.
 1070%
 1071%   @tbd    Decide when and how to wrap long terms.
 1072
 1073pprint(Out, Term, _, Options) :-
 1074    nonvar(Term),
 1075    Term = {}(Arg),
 1076    line_position(Out, Indent),
 1077    ArgIndent is Indent + 2,
 1078    format(Out, '{ ', []),
 1079    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1080    nlindent(Out, Indent),
 1081    format(Out, '}', []).
 1082pprint(Out, Term, Pri, Options) :-
 1083    (   compound(Term)
 1084    ->  compound_name_arity(Term, _, Arity),
 1085        Arity > 0
 1086    ;   is_dict(Term)
 1087    ),
 1088    \+ nowrap_term(Term),
 1089    line_width(Width),
 1090    Width > 0,
 1091    (   write_length(Term, Len, [max_length(Width)|Options])
 1092    ->  true
 1093    ;   Len = Width
 1094    ),
 1095    line_position(Out, Indent),
 1096    Indent + Len > Width,
 1097    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1098    !,
 1099    pprint_wrapped(Out, Term, Pri, Options).
 1100pprint(Out, Term, Pri, Options) :-
 1101    listing_write_options(Pri, WrtOptions, Options),
 1102    write_term(Out, Term,
 1103               [ blobs(portray),
 1104                 portray_goal(portray_blob)
 1105               | WrtOptions
 1106               ]).
 1107
 1108:- public portray_blob/2. 1109portray_blob(Blob, _Options) :-
 1110    blob(Blob, _),
 1111    \+ atom(Blob),
 1112    !,
 1113    format(string(S), '~q', [Blob]),
 1114    format('~q', ['$BLOB'(S)]).
 1115
 1116nowrap_term('$VAR'(_)) :- !.
 1117nowrap_term(_{}) :- !.                  % empty dict
 1118nowrap_term(Term) :-
 1119    functor(Term, Name, Arity),
 1120    current_op(_, _, Name),
 1121    (   Arity == 2
 1122    ->  infix_op(Name, _, _)
 1123    ;   Arity == 1
 1124    ->  (   prefix_op(Name, _)
 1125        ->  true
 1126        ;   postfix_op(Name, _)
 1127        )
 1128    ).
 1129
 1130
 1131pprint_wrapped(Out, Term, _, Options) :-
 1132    Term = [_|_],
 1133    !,
 1134    line_position(Out, Indent),
 1135    portray_list(Term, Indent, Out, Options).
 1136pprint_wrapped(Out, Dict, _, Options) :-
 1137    is_dict(Dict),
 1138    !,
 1139    dict_pairs(Dict, Tag, Pairs),
 1140    pprint(Out, Tag, 1200, Options),
 1141    format(Out, '{ ', []),
 1142    line_position(Out, Indent),
 1143    pprint_nv(Pairs, Indent, Out, Options),
 1144    nlindent(Out, Indent-2),
 1145    format(Out, '}', []).
 1146pprint_wrapped(Out, Term, _, Options) :-
 1147    Term =.. [Name|Args],
 1148    format(Out, '~q(', [Name]),
 1149    line_position(Out, Indent),
 1150    pprint_args(Args, Indent, Out, Options),
 1151    format(Out, ')', []).
 1152
 1153pprint_args([], _, _, _).
 1154pprint_args([H|T], Indent, Out, Options) :-
 1155    pprint(Out, H, 999, Options),
 1156    (   T == []
 1157    ->  true
 1158    ;   format(Out, ',', []),
 1159        nlindent(Out, Indent),
 1160        pprint_args(T, Indent, Out, Options)
 1161    ).
 1162
 1163
 1164pprint_nv([], _, _, _).
 1165pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1166    pprint(Out, Name, 999, Options),
 1167    format(Out, ':', []),
 1168    pprint(Out, Value, 999, Options),
 1169    (   T == []
 1170    ->  true
 1171    ;   format(Out, ',', []),
 1172        nlindent(Out, Indent),
 1173        pprint_nv(T, Indent, Out, Options)
 1174    ).
 1175
 1176
 1177%!  listing_write_options(+Priority, -WriteOptions) is det.
 1178%
 1179%   WriteOptions are write_term/3 options for writing a term at
 1180%   priority Priority.
 1181
 1182listing_write_options(Pri,
 1183                      [ quoted(true),
 1184                        numbervars(true),
 1185                        priority(Pri),
 1186                        spacing(next_argument)
 1187                      | Options
 1188                      ],
 1189                      Options).
 1190
 1191%!  nlindent(+Out, +Indent)
 1192%
 1193%   Write newline and indent to  column   Indent.  Uses  the setting
 1194%   listing:tab_distance to determine the mapping   between tabs and
 1195%   spaces.
 1196
 1197nlindent(Out, N) :-
 1198    nl(Out),
 1199    indent(Out, N).
 1200
 1201indent(Out, N) :-
 1202    setting(listing:tab_distance, D),
 1203    (   D =:= 0
 1204    ->  tab(Out, N)
 1205    ;   Tab is N // D,
 1206        Space is N mod D,
 1207        put_tabs(Out, Tab),
 1208        tab(Out, Space)
 1209    ).
 1210
 1211put_tabs(Out, N) :-
 1212    N > 0,
 1213    !,
 1214    put(Out, 0'\t),
 1215    NN is N - 1,
 1216    put_tabs(Out, NN).
 1217put_tabs(_, _).
 1218
 1219line_width(Width) :-
 1220    stream_property(current_output, tty(true)),
 1221    catch(tty_size(_Rows, Cols), error(_,_), fail),
 1222    !,
 1223    Width is Cols - 2.
 1224line_width(Width) :-
 1225    setting(listing:line_width, Width),
 1226    !.
 1227line_width(78).
 1228
 1229
 1230%!  inc_indent(+Indent0, +Inc, -Indent)
 1231%
 1232%   Increment the indent with logical steps.
 1233
 1234inc_indent(Indent0, Inc, Indent) :-
 1235    Indent is Indent0 + Inc*4.
 1236
 1237:- multifile
 1238    sandbox:safe_meta/2. 1239
 1240sandbox:safe_meta(listing(What), []) :-
 1241    not_qualified(What).
 1242
 1243not_qualified(Var) :-
 1244    var(Var),
 1245    !.
 1246not_qualified(_:_) :- !, fail.
 1247not_qualified(_).
 1248
 1249
 1250%!  comment(+Format, +Args)
 1251%
 1252%   Emit a comment.
 1253
 1254comment(Format, Args) :-
 1255    stream_property(current_output, tty(true)),
 1256    setting(listing:comment_ansi_attributes, Attributes),
 1257    Attributes \== [],
 1258    !,
 1259    ansi_format(Attributes, Format, Args).
 1260comment(Format, Args) :-
 1261    format(Format, Args)