1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2001-2019, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_listing,
   38        [ listing/0,
   39          listing/1,			% :Spec
   40          listing/2,                    % :Spec, +Options
   41          portray_clause/1,             % +Clause
   42          portray_clause/2,             % +Stream, +Clause
   43          portray_clause/3              % +Stream, +Clause, +Options
   44        ]).   45:- use_module(library(settings),[setting/4,setting/2]).   46
   47:- autoload(library(ansi_term),[ansi_format/3]).   48:- autoload(library(apply),[foldl/4]).   49:- autoload(library(debug),[debug/3]).   50:- autoload(library(error),[instantiation_error/1,must_be/2]).   51:- autoload(library(lists),[member/2]).   52:- autoload(library(option),[option/2,option/3,meta_options/3]).   53:- autoload(library(prolog_clause),[clause_info/5]).   54:- autoload(library(prolog_code), [most_general_goal/2]).   55
   56%:- set_prolog_flag(generate_debug_info, false).
   57
   58:- module_transparent
   59    listing/0.   60:- meta_predicate
   61    listing(:),
   62    listing(:, +),
   63    portray_clause(+,+,:).   64
   65:- predicate_options(portray_clause/3, 3,
   66                     [ indent(nonneg),
   67                       pass_to(system:write_term/3, 3)
   68                     ]).   69
   70:- multifile
   71    prolog:locate_clauses/2.        % +Spec, -ClauseRefList
   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%    The following options are defined:
  167%
  168%      - variable_names(+How)
  169%      One of `source` (default) or `generated`.  If `source`, for each
  170%      clause that is associated to a source location the system tries
  171%      to restore the original variable names.  This may fail if macro
  172%      expansion is not reversible or the term cannot be read due to
  173%      different operator declarations.  In that case variable names
  174%      are generated.
  175%
  176%      - source(+Bool)
  177%      If `true` (default `false`), extract the lines from the source
  178%      files that produced the clauses, i.e., list the original source
  179%      text rather than the _decompiled_ clauses. Each set of contiguous
  180%      clauses is preceded by a comment that indicates the file and
  181%      line of origin.  Clauses that cannot be related to source code
  182%      are decompiled where the comment indicates the decompiled state.
  183%      This is notably practical for collecting the state of _multifile_
  184%      predicates.  For example:
  185%
  186%         ```
  187%         ?- listing(file_search_path, [source(true)]).
  188%         ```
  189
  190listing(Spec) :-
  191    listing(Spec, []).
  192
  193listing(Spec, Options) :-
  194    call_cleanup(
  195        listing_(Spec, Options),
  196        close_sources).
  197
  198listing_(M:Spec, Options) :-
  199    var(Spec),
  200    !,
  201    list_module(M, Options).
  202listing_(M:List, Options) :-
  203    is_list(List),
  204    !,
  205    forall(member(Spec, List),
  206           listing_(M:Spec, Options)).
  207listing_(X, Options) :-
  208    (   prolog:locate_clauses(X, ClauseRefs)
  209    ->  strip_module(X, Context, _),
  210        list_clauserefs(ClauseRefs, Context, Options)
  211    ;   '$find_predicate'(X, Preds),
  212        list_predicates(Preds, X, Options)
  213    ).
  214
  215list_clauserefs([], _, _) :- !.
  216list_clauserefs([H|T], Context, Options) :-
  217    !,
  218    list_clauserefs(H, Context, Options),
  219    list_clauserefs(T, Context, Options).
  220list_clauserefs(Ref, Context, Options) :-
  221    @(rule(_, Rule, Ref), Context),
  222    list_clause(Rule, Ref, Context, Options).
  223
  224%!  list_predicates(:Preds:list(pi), :Spec, +Options) is det.
  225
  226list_predicates(PIs, Context:X, Options) :-
  227    member(PI, PIs),
  228    pi_to_head(PI, Pred),
  229    unify_args(Pred, X),
  230    list_define(Pred, DefPred),
  231    list_predicate(DefPred, Context, Options),
  232    nl,
  233    fail.
  234list_predicates(_, _, _).
  235
  236list_define(Head, LoadModule:Head) :-
  237    compound(Head),
  238    Head \= (_:_),
  239    functor(Head, Name, Arity),
  240    '$find_library'(_, Name, Arity, LoadModule, Library),
  241    !,
  242    use_module(Library, []).
  243list_define(M:Pred, DefM:Pred) :-
  244    '$define_predicate'(M:Pred),
  245    (   predicate_property(M:Pred, imported_from(DefM))
  246    ->  true
  247    ;   DefM = M
  248    ).
  249
  250pi_to_head(PI, _) :-
  251    var(PI),
  252    !,
  253    instantiation_error(PI).
  254pi_to_head(M:PI, M:Head) :-
  255    !,
  256    pi_to_head(PI, Head).
  257pi_to_head(Name/Arity, Head) :-
  258    functor(Head, Name, Arity).
  259
  260
  261%       Unify the arguments of the specification with the given term,
  262%       so we can partially instantate the head.
  263
  264unify_args(_, _/_) :- !.                % Name/arity spec
  265unify_args(X, X) :- !.
  266unify_args(_:X, X) :- !.
  267unify_args(_, _).
  268
  269list_predicate(Pred, Context, _) :-
  270    predicate_property(Pred, undefined),
  271    !,
  272    decl_term(Pred, Context, Decl),
  273    comment('%   Undefined: ~q~n', [Decl]).
  274list_predicate(Pred, Context, _) :-
  275    predicate_property(Pred, foreign),
  276    !,
  277    decl_term(Pred, Context, Decl),
  278    comment('%   Foreign: ~q~n', [Decl]).
  279list_predicate(Pred, Context, Options) :-
  280    notify_changed(Pred, Context),
  281    list_declarations(Pred, Context),
  282    list_clauses(Pred, Context, Options).
  283
  284decl_term(Pred, Context, Decl) :-
  285    strip_module(Pred, Module, Head),
  286    functor(Head, Name, Arity),
  287    (   hide_module(Module, Context, Head)
  288    ->  Decl = Name/Arity
  289    ;   Decl = Module:Name/Arity
  290    ).
  291
  292
  293decl(thread_local, thread_local).
  294decl(dynamic,      dynamic).
  295decl(volatile,     volatile).
  296decl(multifile,    multifile).
  297decl(public,       public).
  298
  299%!  declaration(:Head, +Module, -Decl) is nondet.
  300%
  301%   True when the directive Decl (without  :-/1)   needs  to  be used to
  302%   restore the state of the predicate Head.
  303%
  304%   @tbd Answer subsumption, dynamic/2 to   deal  with `incremental` and
  305%   abstract(Depth)
  306
  307declaration(Pred, Source, Decl) :-
  308    predicate_property(Pred, tabled),
  309    Pred = M:Head,
  310    (   M:'$table_mode'(Head, Head, _)
  311    ->  decl_term(Pred, Source, Funct),
  312        table_options(Pred, Funct, TableDecl),
  313        Decl = table(TableDecl)
  314    ;   comment('% tabled using answer subsumption~n', []),
  315        fail                                    % TBD
  316    ).
  317declaration(Pred, Source, Decl) :-
  318    decl(Prop, Declname),
  319    predicate_property(Pred, Prop),
  320    decl_term(Pred, Source, Funct),
  321    Decl =.. [ Declname, Funct ].
  322declaration(Pred, Source, Decl) :-
  323    predicate_property(Pred, meta_predicate(Head)),
  324    strip_module(Pred, Module, _),
  325    (   (Module == system; Source == Module)
  326    ->  Decl = meta_predicate(Head)
  327    ;   Decl = meta_predicate(Module:Head)
  328    ),
  329    (   meta_implies_transparent(Head)
  330    ->  !                                   % hide transparent
  331    ;   true
  332    ).
  333declaration(Pred, Source, Decl) :-
  334    predicate_property(Pred, transparent),
  335    decl_term(Pred, Source, PI),
  336    Decl = module_transparent(PI).
  337
  338%!  meta_implies_transparent(+Head) is semidet.
  339%
  340%   True if the meta-declaration Head implies  that the predicate is
  341%   transparent.
  342
  343meta_implies_transparent(Head):-
  344    compound(Head),
  345    arg(_, Head, Arg),
  346    implies_transparent(Arg),
  347    !.
  348
  349implies_transparent(Arg) :-
  350    integer(Arg),
  351    !.
  352implies_transparent(:).
  353implies_transparent(//).
  354implies_transparent(^).
  355
  356table_options(Pred, Decl0, as(Decl0, Options)) :-
  357    findall(Flag, predicate_property(Pred, tabled(Flag)), [F0|Flags]),
  358    !,
  359    foldl(table_option, Flags, F0, Options).
  360table_options(_, Decl, Decl).
  361
  362table_option(Flag, X, (Flag,X)).
  363
  364list_declarations(Pred, Source) :-
  365    findall(Decl, declaration(Pred, Source, Decl), Decls),
  366    (   Decls == []
  367    ->  true
  368    ;   write_declarations(Decls, Source),
  369        format('~n', [])
  370    ).
  371
  372
  373write_declarations([], _) :- !.
  374write_declarations([H|T], Module) :-
  375    format(':- ~q.~n', [H]),
  376    write_declarations(T, Module).
  377
  378list_clauses(Pred, Source, Options) :-
  379    strip_module(Pred, Module, Head),
  380    most_general_goal(Head, GenHead),
  381    forall(( rule(Module:GenHead, Rule, Ref),
  382             \+ \+ rule_head(Rule, Head)
  383           ),
  384           list_clause(Module:Rule, Ref, Source, Options)).
  385
  386rule_head((Head0 :- _Body), Head) :- !, Head = Head0.
  387rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0.
  388rule_head((Head0 => _Body), Head) :- !, Head = Head0.
  389rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0.
  390rule_head(Head, Head).
  391
  392list_clause(_Rule, Ref, _Source, Options) :-
  393    option(source(true), Options),
  394    (   clause_property(Ref, file(File)),
  395        clause_property(Ref, line_count(Line)),
  396        catch(source_clause_string(File, Line, String, Repositioned),
  397              _, fail),
  398        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  399    ->  !,
  400        (   Repositioned == true
  401        ->  comment('% From ~w:~d~n', [ File, Line ])
  402        ;   true
  403        ),
  404        writeln(String)
  405    ;   decompiled
  406    ->  fail
  407    ;   asserta(decompiled),
  408        comment('% From database (decompiled)~n', []),
  409        fail                                    % try next clause
  410    ).
  411list_clause(Module:(Head:-Body), Ref, Source, Options) :-
  412    !,
  413    list_clause(Module:Head, Body, :-, Ref, Source, Options).
  414list_clause(Module:(Head=>Body), Ref, Source, Options) :-
  415    list_clause(Module:Head, Body, =>, Ref, Source, Options).
  416list_clause(Module:Head, Ref, Source, Options) :-
  417    !,
  418    list_clause(Module:Head, true, :-, Ref, Source, Options).
  419
  420list_clause(Module:Head, Body, Neck, Ref, Source, Options) :-
  421    restore_variable_names(Module, Head, Body, Ref, Options),
  422    write_module(Module, Source, Head),
  423    Rule =.. [Neck,Head,Body],
  424    portray_clause(Rule).
  425
  426%!  restore_variable_names(+Module, +Head, +Body, +Ref, +Options) is det.
  427%
  428%   Try to restore the variable names  from   the  source  if the option
  429%   variable_names(source) is true.
  430
  431restore_variable_names(Module, Head, Body, Ref, Options) :-
  432    option(variable_names(source), Options, source),
  433    catch(clause_info(Ref, _, _, _,
  434                      [ head(QHead),
  435                        body(Body),
  436                        variable_names(Bindings)
  437                      ]),
  438          _, true),
  439    unify_head(Module, Head, QHead),
  440    !,
  441    bind_vars(Bindings),
  442    name_other_vars((Head:-Body), Bindings).
  443restore_variable_names(_,_,_,_,_).
  444
  445unify_head(Module, Head, Module:Head) :-
  446    !.
  447unify_head(_, Head, Head) :-
  448    !.
  449unify_head(_, _, _).
  450
  451bind_vars([]) :-
  452    !.
  453bind_vars([Name = Var|T]) :-
  454    ignore(Var = '$VAR'(Name)),
  455    bind_vars(T).
  456
  457%!  name_other_vars(+Term, +Bindings) is det.
  458%
  459%   Give a '$VAR'(N) name to all   remaining variables in Term, avoiding
  460%   clashes with the given variable names.
  461
  462name_other_vars(Term, Bindings) :-
  463    term_singletons(Term, Singletons),
  464    bind_singletons(Singletons),
  465    term_variables(Term, Vars),
  466    name_vars(Vars, 0, Bindings).
  467
  468bind_singletons([]).
  469bind_singletons(['$VAR'('_')|T]) :-
  470    bind_singletons(T).
  471
  472name_vars([], _, _).
  473name_vars([H|T], N, Bindings) :-
  474    between(N, infinite, N2),
  475    var_name(N2, Name),
  476    \+ memberchk(Name=_, Bindings),
  477    !,
  478    H = '$VAR'(N2),
  479    N3 is N2 + 1,
  480    name_vars(T, N3, Bindings).
  481
  482var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  483    L is (I mod 26)+0'A,
  484    N is I // 26,
  485    (   N == 0
  486    ->  char_code(Name, L)
  487    ;   format(atom(Name), '~c~d', [L, N])
  488    ).
  489
  490write_module(Module, Context, Head) :-
  491    hide_module(Module, Context, Head),
  492    !.
  493write_module(Module, _, _) :-
  494    format('~q:', [Module]).
  495
  496hide_module(system, Module, Head) :-
  497    predicate_property(Module:Head, imported_from(M)),
  498    predicate_property(system:Head, imported_from(M)),
  499    !.
  500hide_module(Module, Module, _) :- !.
  501
  502notify_changed(Pred, Context) :-
  503    strip_module(Pred, user, Head),
  504    predicate_property(Head, built_in),
  505    \+ predicate_property(Head, (dynamic)),
  506    !,
  507    decl_term(Pred, Context, Decl),
  508    comment('%   NOTE: system definition has been overruled for ~q~n',
  509            [Decl]).
  510notify_changed(_, _).
  511
  512%!  source_clause_string(+File, +Line, -String, -Repositioned)
  513%
  514%   True when String is the source text for a clause starting at Line in
  515%   File.
  516
  517source_clause_string(File, Line, String, Repositioned) :-
  518    open_source(File, Line, Stream, Repositioned),
  519    stream_property(Stream, position(Start)),
  520    '$raw_read'(Stream, _TextWithoutComments),
  521    stream_property(Stream, position(End)),
  522    stream_position_data(char_count, Start, StartChar),
  523    stream_position_data(char_count, End, EndChar),
  524    Length is EndChar - StartChar,
  525    set_stream_position(Stream, Start),
  526    read_string(Stream, Length, String),
  527    skip_blanks_and_comments(Stream, blank).
  528
  529skip_blanks_and_comments(Stream, _) :-
  530    at_end_of_stream(Stream),
  531    !.
  532skip_blanks_and_comments(Stream, State0) :-
  533    peek_string(Stream, 80, String),
  534    string_chars(String, Chars),
  535    phrase(blanks_and_comments(State0, State), Chars, Rest),
  536    (   Rest == []
  537    ->  read_string(Stream, 80, _),
  538        skip_blanks_and_comments(Stream, State)
  539    ;   length(Chars, All),
  540        length(Rest, RLen),
  541        Skip is All-RLen,
  542        read_string(Stream, Skip, _)
  543    ).
  544
  545blanks_and_comments(State0, State) -->
  546    [C],
  547    { transition(C, State0, State1) },
  548    !,
  549    blanks_and_comments(State1, State).
  550blanks_and_comments(State, State) -->
  551    [].
  552
  553transition(C, blank, blank) :-
  554    char_type(C, space).
  555transition('%', blank, line_comment).
  556transition('\n', line_comment, blank).
  557transition(_, line_comment, line_comment).
  558transition('/', blank, comment_0).
  559transition('/', comment(N), comment(N,/)).
  560transition('*', comment(N,/), comment(N1)) :-
  561    N1 is N + 1.
  562transition('*', comment_0, comment(1)).
  563transition('*', comment(N), comment(N,*)).
  564transition('/', comment(N,*), State) :-
  565    (   N == 1
  566    ->  State = blank
  567    ;   N2 is N - 1,
  568        State = comment(N2)
  569    ).
  570
  571
  572open_source(File, Line, Stream, Repositioned) :-
  573    source_stream(File, Stream, Pos0, Repositioned),
  574    line_count(Stream, Line0),
  575    (   Line >= Line0
  576    ->  Skip is Line - Line0
  577    ;   set_stream_position(Stream, Pos0),
  578        Skip is Line - 1
  579    ),
  580    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  581    (   Skip =\= 0
  582    ->  Repositioned = true
  583    ;   true
  584    ),
  585    forall(between(1, Skip, _),
  586           skip(Stream, 0'\n)).
  587
  588:- thread_local
  589    opened_source/3,
  590    decompiled/0.  591
  592source_stream(File, Stream, Pos0, _) :-
  593    opened_source(File, Stream, Pos0),
  594    !.
  595source_stream(File, Stream, Pos0, true) :-
  596    open(File, read, Stream),
  597    stream_property(Stream, position(Pos0)),
  598    asserta(opened_source(File, Stream, Pos0)).
  599
  600close_sources :-
  601    retractall(decompiled),
  602    forall(retract(opened_source(_,Stream,_)),
  603           close(Stream)).
  604
  605
  606%!  portray_clause(+Clause) is det.
  607%!  portray_clause(+Out:stream, +Clause) is det.
  608%!  portray_clause(+Out:stream, +Clause, +Options) is det.
  609%
  610%   Portray `Clause' on the current output  stream. Layout of the clause
  611%   is to our best standards. Deals   with  control structures and calls
  612%   via meta-call predicates as determined  using the predicate property
  613%   meta_predicate. If Clause contains attributed   variables, these are
  614%   treated as normal variables.
  615%
  616%   Variable names are by default generated using numbervars/4 using the
  617%   option singletons(true). This names the variables  `A`, `B`, ... and
  618%   the singletons `_`. Variables can  be   named  explicitly by binding
  619%   them to a term `'$VAR'(Name)`, where `Name`   is  an atom denoting a
  620%   valid  variable  name  (see   the    option   numbervars(true)  from
  621%   write_term/2) as well  as  by   using  the  variable_names(Bindings)
  622%   option from write_term/2.
  623%
  624%   Options processed in addition to write_term/2 options:
  625%
  626%     - variable_names(+Bindings)
  627%       See above and write_term/2.
  628%     - indent(+Columns)
  629%       Left margin used for the clause.  Default `0`.
  630%     - module(+Module)
  631%       Module used to determine whether a goal resolves to a meta
  632%       predicate.  Default `user`.
  633
  634%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  635%       confusion if the heads relates to other   bodies.  For now it is
  636%       only used for XPCE methods and works just nice.
  637%
  638%       Not really ...  It may confuse the source-level debugger.
  639
  640%portray_clause(Head :- _Body) :-
  641%       user:prolog_list_goal(Head), !.
  642portray_clause(Term) :-
  643    current_output(Out),
  644    portray_clause(Out, Term).
  645
  646portray_clause(Stream, Term) :-
  647    must_be(stream, Stream),
  648    portray_clause(Stream, Term, []).
  649
  650portray_clause(Stream, Term, M:Options) :-
  651    must_be(list, Options),
  652    meta_options(is_meta, M:Options, QOptions),
  653    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  654
  655name_vars_and_portray_clause(Stream, Term, Options) :-
  656    term_attvars(Term, []),
  657    !,
  658    clause_vars(Term, Options),
  659    do_portray_clause(Stream, Term, Options).
  660name_vars_and_portray_clause(Stream, Term, Options) :-
  661    option(variable_names(Bindings), Options),
  662    !,
  663    copy_term_nat(Term+Bindings, Copy+BCopy),
  664    bind_vars(BCopy),
  665    name_other_vars(Copy, BCopy),
  666    do_portray_clause(Stream, Copy, Options).
  667name_vars_and_portray_clause(Stream, Term, Options) :-
  668    copy_term_nat(Term, Copy),
  669    clause_vars(Copy, Options),
  670    do_portray_clause(Stream, Copy, Options).
  671
  672clause_vars(Clause, Options) :-
  673    option(variable_names(Bindings), Options),
  674    !,
  675    bind_vars(Bindings),
  676    name_other_vars(Clause, Bindings).
  677clause_vars(Clause, _) :-
  678    numbervars(Clause, 0, _,
  679               [ singletons(true)
  680               ]).
  681
  682is_meta(portray_goal).
  683
  684do_portray_clause(Out, Var, Options) :-
  685    var(Var),
  686    !,
  687    option(indent(LeftMargin), Options, 0),
  688    indent(Out, LeftMargin),
  689    pprint(Out, Var, 1200, Options).
  690do_portray_clause(Out, (Head :- true), Options) :-
  691    !,
  692    option(indent(LeftMargin), Options, 0),
  693    indent(Out, LeftMargin),
  694    pprint(Out, Head, 1200, Options),
  695    full_stop(Out).
  696do_portray_clause(Out, Term, Options) :-
  697    clause_term(Term, Head, Neck, Body),
  698    !,
  699    option(indent(LeftMargin), Options, 0),
  700    inc_indent(LeftMargin, 1, Indent),
  701    infix_op(Neck, RightPri, LeftPri),
  702    indent(Out, LeftMargin),
  703    pprint(Out, Head, LeftPri, Options),
  704    format(Out, ' ~w', [Neck]),
  705    (   nonvar(Body),
  706        Body = Module:LocalBody,
  707        \+ primitive(LocalBody)
  708    ->  nlindent(Out, Indent),
  709        format(Out, '~q', [Module]),
  710        '$put_token'(Out, :),
  711        nlindent(Out, Indent),
  712        write(Out, '(   '),
  713        inc_indent(Indent, 1, BodyIndent),
  714        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  715        nlindent(Out, Indent),
  716        write(Out, ')')
  717    ;   setting(listing:body_indentation, BodyIndent0),
  718        BodyIndent is LeftMargin+BodyIndent0,
  719        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  720    ),
  721    full_stop(Out).
  722do_portray_clause(Out, (:-Directive), Options) :-
  723    wrapped_list_directive(Directive),
  724    !,
  725    Directive =.. [Name, Arg, List],
  726    option(indent(LeftMargin), Options, 0),
  727    indent(Out, LeftMargin),
  728    format(Out, ':- ~q(', [Name]),
  729    line_position(Out, Indent),
  730    format(Out, '~q,', [Arg]),
  731    nlindent(Out, Indent),
  732    portray_list(List, Indent, Out, Options),
  733    write(Out, ').\n').
  734do_portray_clause(Out, (:-Directive), Options) :-
  735    !,
  736    option(indent(LeftMargin), Options, 0),
  737    indent(Out, LeftMargin),
  738    write(Out, ':- '),
  739    DIndent is LeftMargin+3,
  740    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  741    full_stop(Out).
  742do_portray_clause(Out, Fact, Options) :-
  743    option(indent(LeftMargin), Options, 0),
  744    indent(Out, LeftMargin),
  745    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  746    full_stop(Out).
  747
  748clause_term((Head:-Body), Head, :-, Body).
  749clause_term((Head=>Body), Head, =>, Body).
  750clause_term(?=>(Head,Body), Head, ?=>, Body).
  751clause_term((Head-->Body), Head, -->, Body).
  752
  753full_stop(Out) :-
  754    '$put_token'(Out, '.'),
  755    nl(Out).
  756
  757wrapped_list_directive(module(_,_)).
  758%wrapped_list_directive(use_module(_,_)).
  759%wrapped_list_directive(autoload(_,_)).
  760
  761%!  portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
  762%
  763%   Write Term at current indentation. If   DoIndent  is 'indent' we
  764%   must first call nlindent/2 before emitting anything.
  765
  766portray_body(Var, _, _, Pri, Out, Options) :-
  767    var(Var),
  768    !,
  769    pprint(Out, Var, Pri, Options).
  770portray_body(!, _, _, _, Out, _) :-
  771    setting(listing:cut_on_same_line, true),
  772    !,
  773    write(Out, ' !').
  774portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  775    setting(listing:cut_on_same_line, true),
  776    \+ term_needs_braces((_,_), Pri),
  777    !,
  778    write(Out, ' !,'),
  779    portray_body(Clause, Indent, indent, 1000, Out, Options).
  780portray_body(Term, Indent, indent, Pri, Out, Options) :-
  781    !,
  782    nlindent(Out, Indent),
  783    portray_body(Term, Indent, noindent, Pri, Out, Options).
  784portray_body(Or, Indent, _, _, Out, Options) :-
  785    or_layout(Or),
  786    !,
  787    write(Out, '(   '),
  788    portray_or(Or, Indent, 1200, Out, Options),
  789    nlindent(Out, Indent),
  790    write(Out, ')').
  791portray_body(Term, Indent, _, Pri, Out, Options) :-
  792    term_needs_braces(Term, Pri),
  793    !,
  794    write(Out, '( '),
  795    ArgIndent is Indent + 2,
  796    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  797    nlindent(Out, Indent),
  798    write(Out, ')').
  799portray_body(((AB),C), Indent, _, _Pri, Out, Options) :-
  800    nonvar(AB),
  801    AB = (A,B),
  802    !,
  803    infix_op(',', LeftPri, RightPri),
  804    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  805    write(Out, ','),
  806    portray_body((B,C), Indent, indent, RightPri, Out, Options).
  807portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  808    !,
  809    infix_op(',', LeftPri, RightPri),
  810    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  811    write(Out, ','),
  812    portray_body(B, Indent, indent, RightPri, Out, Options).
  813portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  814    !,
  815    write(Out, \+), write(Out, ' '),
  816    prefix_op(\+, ArgPri),
  817    ArgIndent is Indent+3,
  818    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  819portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  820    m_callable(Call),
  821    option(module(M), Options, user),
  822    predicate_property(M:Call, meta_predicate(Meta)),
  823    !,
  824    portray_meta(Out, Call, Meta, Options).
  825portray_body(Clause, _, _, Pri, Out, Options) :-
  826    pprint(Out, Clause, Pri, Options).
  827
  828m_callable(Term) :-
  829    strip_module(Term, _, Plain),
  830    callable(Plain),
  831    Plain \= (_:_).
  832
  833term_needs_braces(Term, Pri) :-
  834    callable(Term),
  835    functor(Term, Name, _Arity),
  836    current_op(OpPri, _Type, Name),
  837    OpPri > Pri,
  838    !.
  839
  840%!  portray_or(+Term, +Indent, +Priority, +Out) is det.
  841
  842portray_or(Term, Indent, Pri, Out, Options) :-
  843    term_needs_braces(Term, Pri),
  844    !,
  845    inc_indent(Indent, 1, NewIndent),
  846    write(Out, '(   '),
  847    portray_or(Term, NewIndent, Out, Options),
  848    nlindent(Out, NewIndent),
  849    write(Out, ')').
  850portray_or(Term, Indent, _Pri, Out, Options) :-
  851    or_layout(Term),
  852    !,
  853    portray_or(Term, Indent, Out, Options).
  854portray_or(Term, Indent, Pri, Out, Options) :-
  855    inc_indent(Indent, 1, NestIndent),
  856    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  857
  858
  859portray_or((If -> Then ; Else), Indent, Out, Options) :-
  860    !,
  861    inc_indent(Indent, 1, NestIndent),
  862    infix_op((->), LeftPri, RightPri),
  863    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  864    nlindent(Out, Indent),
  865    write(Out, '->  '),
  866    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  867    nlindent(Out, Indent),
  868    write(Out, ';   '),
  869    infix_op(;, _LeftPri, RightPri2),
  870    portray_or(Else, Indent, RightPri2, Out, Options).
  871portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  872    !,
  873    inc_indent(Indent, 1, NestIndent),
  874    infix_op((*->), LeftPri, RightPri),
  875    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  876    nlindent(Out, Indent),
  877    write(Out, '*-> '),
  878    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  879    nlindent(Out, Indent),
  880    write(Out, ';   '),
  881    infix_op(;, _LeftPri, RightPri2),
  882    portray_or(Else, Indent, RightPri2, Out, Options).
  883portray_or((If -> Then), Indent, Out, Options) :-
  884    !,
  885    inc_indent(Indent, 1, NestIndent),
  886    infix_op((->), LeftPri, RightPri),
  887    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  888    nlindent(Out, Indent),
  889    write(Out, '->  '),
  890    portray_or(Then, Indent, RightPri, Out, Options).
  891portray_or((If *-> Then), Indent, Out, Options) :-
  892    !,
  893    inc_indent(Indent, 1, NestIndent),
  894    infix_op((->), LeftPri, RightPri),
  895    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  896    nlindent(Out, Indent),
  897    write(Out, '*-> '),
  898    portray_or(Then, Indent, RightPri, Out, Options).
  899portray_or((A;B), Indent, Out, Options) :-
  900    !,
  901    inc_indent(Indent, 1, NestIndent),
  902    infix_op(;, LeftPri, RightPri),
  903    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  904    nlindent(Out, Indent),
  905    write(Out, ';   '),
  906    portray_or(B, Indent, RightPri, Out, Options).
  907portray_or((A|B), Indent, Out, Options) :-
  908    !,
  909    inc_indent(Indent, 1, NestIndent),
  910    infix_op('|', LeftPri, RightPri),
  911    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  912    nlindent(Out, Indent),
  913    write(Out, '|   '),
  914    portray_or(B, Indent, RightPri, Out, Options).
  915
  916
  917%!  infix_op(+Op, -Left, -Right) is semidet.
  918%
  919%   True if Op is an infix operator and Left is the max priority of its
  920%   left hand and Right is the max priority of its right hand.
  921
  922infix_op(Op, Left, Right) :-
  923    current_op(Pri, Assoc, Op),
  924    infix_assoc(Assoc, LeftMin, RightMin),
  925    !,
  926    Left is Pri - LeftMin,
  927    Right is Pri - RightMin.
  928
  929infix_assoc(xfx, 1, 1).
  930infix_assoc(xfy, 1, 0).
  931infix_assoc(yfx, 0, 1).
  932
  933prefix_op(Op, ArgPri) :-
  934    current_op(Pri, Assoc, Op),
  935    pre_assoc(Assoc, ArgMin),
  936    !,
  937    ArgPri is Pri - ArgMin.
  938
  939pre_assoc(fx, 1).
  940pre_assoc(fy, 0).
  941
  942postfix_op(Op, ArgPri) :-
  943    current_op(Pri, Assoc, Op),
  944    post_assoc(Assoc, ArgMin),
  945    !,
  946    ArgPri is Pri - ArgMin.
  947
  948post_assoc(xf, 1).
  949post_assoc(yf, 0).
  950
  951%!  or_layout(@Term) is semidet.
  952%
  953%   True if Term is a control structure for which we want to use clean
  954%   layout.
  955%
  956%   @tbd    Change name.
  957
  958or_layout(Var) :-
  959    var(Var), !, fail.
  960or_layout((_;_)).
  961or_layout((_->_)).
  962or_layout((_*->_)).
  963
  964primitive(G) :-
  965    or_layout(G), !, fail.
  966primitive((_,_)) :- !, fail.
  967primitive(_).
  968
  969
  970%!  portray_meta(+Out, +Call, +MetaDecl, +Options)
  971%
  972%   Portray a meta-call. If Call   contains non-primitive meta-calls
  973%   we put each argument on a line and layout the body. Otherwise we
  974%   simply print the goal.
  975
  976portray_meta(Out, Call, Meta, Options) :-
  977    contains_non_primitive_meta_arg(Call, Meta),
  978    !,
  979    Call =.. [Name|Args],
  980    Meta =.. [_|Decls],
  981    format(Out, '~q(', [Name]),
  982    line_position(Out, Indent),
  983    portray_meta_args(Decls, Args, Indent, Out, Options),
  984    format(Out, ')', []).
  985portray_meta(Out, Call, _, Options) :-
  986    pprint(Out, Call, 999, Options).
  987
  988contains_non_primitive_meta_arg(Call, Decl) :-
  989    arg(I, Call, CA),
  990    arg(I, Decl, DA),
  991    integer(DA),
  992    \+ primitive(CA),
  993    !.
  994
  995portray_meta_args([], [], _, _, _).
  996portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  997    portray_meta_arg(D, A, Out, Options),
  998    (   DT == []
  999    ->  true
 1000    ;   format(Out, ',', []),
 1001        nlindent(Out, Indent),
 1002        portray_meta_args(DT, AT, Indent, Out, Options)
 1003    ).
 1004
 1005portray_meta_arg(I, A, Out, Options) :-
 1006    integer(I),
 1007    !,
 1008    line_position(Out, Indent),
 1009    portray_body(A, Indent, noindent, 999, Out, Options).
 1010portray_meta_arg(_, A, Out, Options) :-
 1011    pprint(Out, A, 999, Options).
 1012
 1013%!  portray_list(+List, +Indent, +Out)
 1014%
 1015%   Portray a list like this.  Right side for improper lists
 1016%
 1017%           [ element1,             [ element1
 1018%             element2,     OR      | tail
 1019%           ]                       ]
 1020
 1021portray_list([], _, Out, _) :-
 1022    !,
 1023    write(Out, []).
 1024portray_list(List, Indent, Out, Options) :-
 1025    write(Out, '[ '),
 1026    EIndent is Indent + 2,
 1027    portray_list_elements(List, EIndent, Out, Options),
 1028    nlindent(Out, Indent),
 1029    write(Out, ']').
 1030
 1031portray_list_elements([H|T], EIndent, Out, Options) :-
 1032    pprint(Out, H, 999, Options),
 1033    (   T == []
 1034    ->  true
 1035    ;   nonvar(T), T = [_|_]
 1036    ->  write(Out, ','),
 1037        nlindent(Out, EIndent),
 1038        portray_list_elements(T, EIndent, Out, Options)
 1039    ;   Indent is EIndent - 2,
 1040        nlindent(Out, Indent),
 1041        write(Out, '| '),
 1042        pprint(Out, T, 999, Options)
 1043    ).
 1044
 1045%!  pprint(+Out, +Term, +Priority, +Options)
 1046%
 1047%   Print  Term  at  Priority.  This  also  takes  care  of  several
 1048%   formatting options, in particular:
 1049%
 1050%     * {}(Arg) terms are printed with aligned arguments, assuming
 1051%     that the term is a body-term.
 1052%     * Terms that do not fit on the line are wrapped using
 1053%     pprint_wrapped/3.
 1054%
 1055%   @tbd    Decide when and how to wrap long terms.
 1056
 1057pprint(Out, Term, _, Options) :-
 1058    nonvar(Term),
 1059    Term = {}(Arg),
 1060    line_position(Out, Indent),
 1061    ArgIndent is Indent + 2,
 1062    format(Out, '{ ', []),
 1063    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1064    nlindent(Out, Indent),
 1065    format(Out, '}', []).
 1066pprint(Out, Term, Pri, Options) :-
 1067    (   compound(Term)
 1068    ->  compound_name_arity(Term, _, Arity),
 1069        Arity > 0
 1070    ;   is_dict(Term)
 1071    ),
 1072    \+ nowrap_term(Term),
 1073    setting(listing:line_width, Width),
 1074    Width > 0,
 1075    (   write_length(Term, Len, [max_length(Width)|Options])
 1076    ->  true
 1077    ;   Len = Width
 1078    ),
 1079    line_position(Out, Indent),
 1080    Indent + Len > Width,
 1081    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1082    !,
 1083    pprint_wrapped(Out, Term, Pri, Options).
 1084pprint(Out, Term, Pri, Options) :-
 1085    listing_write_options(Pri, WrtOptions, Options),
 1086    write_term(Out, Term,
 1087               [ blobs(portray),
 1088                 portray_goal(portray_blob)
 1089               | WrtOptions
 1090               ]).
 1091
 1092portray_blob(Blob, _Options) :-
 1093    blob(Blob, _),
 1094    \+ atom(Blob),
 1095    !,
 1096    format(string(S), '~q', [Blob]),
 1097    format('~q', ['$BLOB'(S)]).
 1098
 1099nowrap_term('$VAR'(_)) :- !.
 1100nowrap_term(_{}) :- !.                  % empty dict
 1101nowrap_term(Term) :-
 1102    functor(Term, Name, Arity),
 1103    current_op(_, _, Name),
 1104    (   Arity == 2
 1105    ->  infix_op(Name, _, _)
 1106    ;   Arity == 1
 1107    ->  (   prefix_op(Name, _)
 1108        ->  true
 1109        ;   postfix_op(Name, _)
 1110        )
 1111    ).
 1112
 1113
 1114pprint_wrapped(Out, Term, _, Options) :-
 1115    Term = [_|_],
 1116    !,
 1117    line_position(Out, Indent),
 1118    portray_list(Term, Indent, Out, Options).
 1119pprint_wrapped(Out, Dict, _, Options) :-
 1120    is_dict(Dict),
 1121    !,
 1122    dict_pairs(Dict, Tag, Pairs),
 1123    pprint(Out, Tag, 1200, Options),
 1124    format(Out, '{ ', []),
 1125    line_position(Out, Indent),
 1126    pprint_nv(Pairs, Indent, Out, Options),
 1127    nlindent(Out, Indent-2),
 1128    format(Out, '}', []).
 1129pprint_wrapped(Out, Term, _, Options) :-
 1130    Term =.. [Name|Args],
 1131    format(Out, '~q(', [Name]),
 1132    line_position(Out, Indent),
 1133    pprint_args(Args, Indent, Out, Options),
 1134    format(Out, ')', []).
 1135
 1136pprint_args([], _, _, _).
 1137pprint_args([H|T], Indent, Out, Options) :-
 1138    pprint(Out, H, 999, Options),
 1139    (   T == []
 1140    ->  true
 1141    ;   format(Out, ',', []),
 1142        nlindent(Out, Indent),
 1143        pprint_args(T, Indent, Out, Options)
 1144    ).
 1145
 1146
 1147pprint_nv([], _, _, _).
 1148pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1149    pprint(Out, Name, 999, Options),
 1150    format(Out, ':', []),
 1151    pprint(Out, Value, 999, Options),
 1152    (   T == []
 1153    ->  true
 1154    ;   format(Out, ',', []),
 1155        nlindent(Out, Indent),
 1156        pprint_nv(T, Indent, Out, Options)
 1157    ).
 1158
 1159
 1160%!  listing_write_options(+Priority, -WriteOptions) is det.
 1161%
 1162%   WriteOptions are write_term/3 options for writing a term at
 1163%   priority Priority.
 1164
 1165listing_write_options(Pri,
 1166                      [ quoted(true),
 1167                        numbervars(true),
 1168                        priority(Pri),
 1169                        spacing(next_argument)
 1170                      | Options
 1171                      ],
 1172                      Options).
 1173
 1174%!  nlindent(+Out, +Indent)
 1175%
 1176%   Write newline and indent to  column   Indent.  Uses  the setting
 1177%   listing:tab_distance to determine the mapping   between tabs and
 1178%   spaces.
 1179
 1180nlindent(Out, N) :-
 1181    nl(Out),
 1182    indent(Out, N).
 1183
 1184indent(Out, N) :-
 1185    setting(listing:tab_distance, D),
 1186    (   D =:= 0
 1187    ->  tab(Out, N)
 1188    ;   Tab is N // D,
 1189        Space is N mod D,
 1190        put_tabs(Out, Tab),
 1191        tab(Out, Space)
 1192    ).
 1193
 1194put_tabs(Out, N) :-
 1195    N > 0,
 1196    !,
 1197    put(Out, 0'\t),
 1198    NN is N - 1,
 1199    put_tabs(Out, NN).
 1200put_tabs(_, _).
 1201
 1202
 1203%!  inc_indent(+Indent0, +Inc, -Indent)
 1204%
 1205%   Increment the indent with logical steps.
 1206
 1207inc_indent(Indent0, Inc, Indent) :-
 1208    Indent is Indent0 + Inc*4.
 1209
 1210:- multifile
 1211    sandbox:safe_meta/2. 1212
 1213sandbox:safe_meta(listing(What), []) :-
 1214    not_qualified(What).
 1215
 1216not_qualified(Var) :-
 1217    var(Var),
 1218    !.
 1219not_qualified(_:_) :- !, fail.
 1220not_qualified(_).
 1221
 1222
 1223%!  comment(+Format, +Args)
 1224%
 1225%   Emit a comment.
 1226
 1227comment(Format, Args) :-
 1228    stream_property(current_output, tty(true)),
 1229    setting(listing:comment_ansi_attributes, Attributes),
 1230    Attributes \== [],
 1231    !,
 1232    ansi_format(Attributes, Format, Args).
 1233comment(Format, Args) :-
 1234    format(Format, Args)