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