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