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