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