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