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