View source with raw 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

List programs and pretty print clauses

This module implements listing code from the internal representation in a human readable format.

Layout can be customized using library(settings). The effective settings can be listed using list_settings/1 as illustrated below. Settings can be changed using set_setting/2.

?- list_settings(listing).
========================================================================
Name                      Value (*=modified) Comment
========================================================================
listing:body_indentation  4              Indentation used goals in the body
listing:tab_distance      0              Distance between tab-stops.
...
To be done
- More settings, support Coding Guidelines for Prolog and make the suggestions there the default.
- Provide persistent user customization */
  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').
 listing
Lists all predicates defined in the calling module. Imported predicates are not listed. To list the content of the module mymodule, use one of the calls below.
?- mymodule:listing.
?- listing(mymodule:_).
  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    ).
 listing(:What) is det
 listing(:What, +Options) is det
List matching clauses. What is either a plain specification or a list of specifications. Plain specifications are:

The following options are defined:

variable_names(+How)
One of source (default) or generated. If source, for each clause that is associated to a source location the system tries to restore the original variable names. This may fail if macro expansion is not reversible or the term cannot be read due to different operator declarations. In that case variable names are generated.
source(+Bool)
If true (default false), extract the lines from the source files that produced the clauses, i.e., list the original source text rather than the decompiled clauses. Each set of contiguous clauses is preceded by a comment that indicates the file and line of origin. Clauses that cannot be related to source code are decompiled where the comment indicates the decompiled state. This is notably practical for collecting the state of multifile predicates. For example:
?- listing(file_search_path, [source(true)]).
  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).
 list_predicates(:Preds:list(pi), :Spec, +Options) is det
  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).
 declaration(:Head, +Module, -Decl) is nondet
True when the directive Decl (without :-/1) needs to be used to restore the state of the predicate Head.
To be done
- Answer subsumption, dynamic/2 to deal with incremental and abstract(Depth)
  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).
 meta_implies_transparent(+Head) is semidet
True if the meta-declaration Head implies that the predicate is transparent.
  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    generalise_term(Head, GenHead),
  380    forall(( clause(Module:GenHead, Body, Ref),
  381             \+ GenHead \= Head
  382           ),
  383           list_clause(Module:GenHead, Body, Ref, Source, Options)).
  384
  385generalise_term(Head, Gen) :-
  386    compound(Head),
  387    !,
  388    compound_name_arity(Head, Name, Arity),
  389    compound_name_arity(Gen,  Name, Arity).
  390generalise_term(Head, Head).
  391
  392list_clause(_Head, _Body, Ref, _Source, Options) :-
  393    option(source(true), Options),
  394    (   clause_property(Ref, file(File)),
  395        clause_property(Ref, line_count(Line)),
  396        catch(source_clause_string(File, Line, String, Repositioned),
  397              _, fail),
  398        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  399    ->  !,
  400        (   Repositioned == true
  401        ->  comment('% From ~w:~d~n', [ File, Line ])
  402        ;   true
  403        ),
  404        writeln(String)
  405    ;   decompiled
  406    ->  fail
  407    ;   asserta(decompiled),
  408        comment('% From database (decompiled)~n', []),
  409        fail                                    % try next clause
  410    ).
  411list_clause(Module:Head, Body, Ref, Source, Options) :-
  412    restore_variable_names(Module, Head, Body, Ref, Options),
  413    write_module(Module, Source, Head),
  414    portray_clause((Head:-Body)).
 restore_variable_names(+Module, +Head, +Body, +Ref, +Options) is det
Try to restore the variable names from the source if the option variable_names(source) is true.
  421restore_variable_names(Module, Head, Body, Ref, Options) :-
  422    option(variable_names(source), Options, source),
  423    catch(clause_info(Ref, _, _, _,
  424                      [ head(QHead),
  425                        body(Body),
  426                        variable_names(Bindings)
  427                      ]),
  428          _, true),
  429    unify_head(Module, Head, QHead),
  430    !,
  431    bind_vars(Bindings),
  432    name_other_vars((Head:-Body), Bindings).
  433restore_variable_names(_,_,_,_,_).
  434
  435unify_head(Module, Head, Module:Head) :-
  436    !.
  437unify_head(_, Head, Head) :-
  438    !.
  439unify_head(_, _, _).
  440
  441bind_vars([]) :-
  442    !.
  443bind_vars([Name = Var|T]) :-
  444    ignore(Var = '$VAR'(Name)),
  445    bind_vars(T).
 name_other_vars(+Term, +Bindings) is det
Give a '$VAR'(N) name to all remaining variables in Term, avoiding clashes with the given variable names.
  452name_other_vars(Term, Bindings) :-
  453    term_singletons(Term, Singletons),
  454    bind_singletons(Singletons),
  455    term_variables(Term, Vars),
  456    name_vars(Vars, 0, Bindings).
  457
  458bind_singletons([]).
  459bind_singletons(['$VAR'('_')|T]) :-
  460    bind_singletons(T).
  461
  462name_vars([], _, _).
  463name_vars([H|T], N, Bindings) :-
  464    between(N, infinite, N2),
  465    var_name(N2, Name),
  466    \+ memberchk(Name=_, Bindings),
  467    !,
  468    H = '$VAR'(N2),
  469    N3 is N2 + 1,
  470    name_vars(T, N3, Bindings).
  471
  472var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  473    L is (I mod 26)+0'A,
  474    N is I // 26,
  475    (   N == 0
  476    ->  char_code(Name, L)
  477    ;   format(atom(Name), '~c~d', [L, N])
  478    ).
  479
  480write_module(Module, Context, Head) :-
  481    hide_module(Module, Context, Head),
  482    !.
  483write_module(Module, _, _) :-
  484    format('~q:', [Module]).
  485
  486hide_module(system, Module, Head) :-
  487    predicate_property(Module:Head, imported_from(M)),
  488    predicate_property(system:Head, imported_from(M)),
  489    !.
  490hide_module(Module, Module, _) :- !.
  491
  492notify_changed(Pred, Context) :-
  493    strip_module(Pred, user, Head),
  494    predicate_property(Head, built_in),
  495    \+ predicate_property(Head, (dynamic)),
  496    !,
  497    decl_term(Pred, Context, Decl),
  498    comment('%   NOTE: system definition has been overruled for ~q~n',
  499            [Decl]).
  500notify_changed(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  507source_clause_string(File, Line, String, Repositioned) :-
  508    open_source(File, Line, Stream, Repositioned),
  509    stream_property(Stream, position(Start)),
  510    '$raw_read'(Stream, _TextWithoutComments),
  511    stream_property(Stream, position(End)),
  512    stream_position_data(char_count, Start, StartChar),
  513    stream_position_data(char_count, End, EndChar),
  514    Length is EndChar - StartChar,
  515    set_stream_position(Stream, Start),
  516    read_string(Stream, Length, String),
  517    skip_blanks_and_comments(Stream, blank).
  518
  519skip_blanks_and_comments(Stream, _) :-
  520    at_end_of_stream(Stream),
  521    !.
  522skip_blanks_and_comments(Stream, State0) :-
  523    peek_string(Stream, 80, String),
  524    string_chars(String, Chars),
  525    phrase(blanks_and_comments(State0, State), Chars, Rest),
  526    (   Rest == []
  527    ->  read_string(Stream, 80, _),
  528        skip_blanks_and_comments(Stream, State)
  529    ;   length(Chars, All),
  530        length(Rest, RLen),
  531        Skip is All-RLen,
  532        read_string(Stream, Skip, _)
  533    ).
  534
  535blanks_and_comments(State0, State) -->
  536    [C],
  537    { transition(C, State0, State1) },
  538    !,
  539    blanks_and_comments(State1, State).
  540blanks_and_comments(State, State) -->
  541    [].
  542
  543transition(C, blank, blank) :-
  544    char_type(C, space).
  545transition('%', blank, line_comment).
  546transition('\n', line_comment, blank).
  547transition(_, line_comment, line_comment).
  548transition('/', blank, comment_0).
  549transition('/', comment(N), comment(N,/)).
  550transition('*', comment(N,/), comment(N1)) :-
  551    N1 is N + 1.
  552transition('*', comment_0, comment(1)).
  553transition('*', comment(N), comment(N,*)).
  554transition('/', comment(N,*), State) :-
  555    (   N == 1
  556    ->  State = blank
  557    ;   N2 is N - 1,
  558        State = comment(N2)
  559    ).
  560
  561
  562open_source(File, Line, Stream, Repositioned) :-
  563    source_stream(File, Stream, Pos0, Repositioned),
  564    line_count(Stream, Line0),
  565    (   Line >= Line0
  566    ->  Skip is Line - Line0
  567    ;   set_stream_position(Stream, Pos0),
  568        Skip is Line - 1
  569    ),
  570    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  571    (   Skip =\= 0
  572    ->  Repositioned = true
  573    ;   true
  574    ),
  575    forall(between(1, Skip, _),
  576           skip(Stream, 0'\n)).
  577
  578:- thread_local
  579    opened_source/3,
  580    decompiled/0.  581
  582source_stream(File, Stream, Pos0, _) :-
  583    opened_source(File, Stream, Pos0),
  584    !.
  585source_stream(File, Stream, Pos0, true) :-
  586    open(File, read, Stream),
  587    stream_property(Stream, position(Pos0)),
  588    asserta(opened_source(File, Stream, Pos0)).
  589
  590close_sources :-
  591    retractall(decompiled),
  592    forall(retract(opened_source(_,Stream,_)),
  593           close(Stream)).
 portray_clause(+Clause) is det
 portray_clause(+Out:stream, +Clause) is det
 portray_clause(+Out:stream, +Clause, +Options) is det
Portray `Clause' on the current output stream. Layout of the clause is to our best standards. Deals with control structures and calls via meta-call predicates as determined using the predicate property meta_predicate. If Clause contains attributed variables, these are treated as normal variables.

Variable names are by default generated using numbervars/4 using the option singletons(true). This names the variables A, B, ... and the singletons _. Variables can be named explicitly by binding them to a term '$VAR'(Name), where Name is an atom denoting a valid variable name (see the option numbervars(true) from write_term/2) as well as by using the variable_names(Bindings) option from write_term/2.

Options processed in addition to write_term/2 options:

variable_names(+Bindings)
See above and write_term/2.
indent(+Columns)
Left margin used for the clause. Default 0.
module(+Module)
Module used to determine whether a goal resolves to a meta predicate. Default user.
  624%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  625%       confusion if the heads relates to other   bodies.  For now it is
  626%       only used for XPCE methods and works just nice.
  627%
  628%       Not really ...  It may confuse the source-level debugger.
  629
  630%portray_clause(Head :- _Body) :-
  631%       user:prolog_list_goal(Head), !.
  632portray_clause(Term) :-
  633    current_output(Out),
  634    portray_clause(Out, Term).
  635
  636portray_clause(Stream, Term) :-
  637    must_be(stream, Stream),
  638    portray_clause(Stream, Term, []).
  639
  640portray_clause(Stream, Term, M:Options) :-
  641    must_be(list, Options),
  642    meta_options(is_meta, M:Options, QOptions),
  643    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  644
  645name_vars_and_portray_clause(Stream, Term, Options) :-
  646    term_attvars(Term, []),
  647    !,
  648    clause_vars(Term, Options),
  649    do_portray_clause(Stream, Term, Options).
  650name_vars_and_portray_clause(Stream, Term, Options) :-
  651    option(variable_names(Bindings), Options),
  652    !,
  653    copy_term_nat(Term+Bindings, Copy+BCopy),
  654    bind_vars(BCopy),
  655    name_other_vars(Copy, BCopy),
  656    do_portray_clause(Stream, Copy, Options).
  657name_vars_and_portray_clause(Stream, Term, Options) :-
  658    copy_term_nat(Term, Copy),
  659    clause_vars(Copy, Options),
  660    do_portray_clause(Stream, Copy, Options).
  661
  662clause_vars(Clause, Options) :-
  663    option(variable_names(Bindings), Options),
  664    !,
  665    bind_vars(Bindings),
  666    name_other_vars(Clause, Bindings).
  667clause_vars(Clause, _) :-
  668    numbervars(Clause, 0, _,
  669               [ singletons(true)
  670               ]).
  671
  672is_meta(portray_goal).
  673
  674do_portray_clause(Out, Var, Options) :-
  675    var(Var),
  676    !,
  677    option(indent(LeftMargin), Options, 0),
  678    indent(Out, LeftMargin),
  679    pprint(Out, Var, 1200, Options).
  680do_portray_clause(Out, (Head :- true), Options) :-
  681    !,
  682    option(indent(LeftMargin), Options, 0),
  683    indent(Out, LeftMargin),
  684    pprint(Out, Head, 1200, Options),
  685    full_stop(Out).
  686do_portray_clause(Out, Term, Options) :-
  687    clause_term(Term, Head, Neck, Body),
  688    !,
  689    option(indent(LeftMargin), Options, 0),
  690    inc_indent(LeftMargin, 1, Indent),
  691    infix_op(Neck, RightPri, LeftPri),
  692    indent(Out, LeftMargin),
  693    pprint(Out, Head, LeftPri, Options),
  694    format(Out, ' ~w', [Neck]),
  695    (   nonvar(Body),
  696        Body = Module:LocalBody,
  697        \+ primitive(LocalBody)
  698    ->  nlindent(Out, Indent),
  699        format(Out, '~q', [Module]),
  700        '$put_token'(Out, :),
  701        nlindent(Out, Indent),
  702        write(Out, '(   '),
  703        inc_indent(Indent, 1, BodyIndent),
  704        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  705        nlindent(Out, Indent),
  706        write(Out, ')')
  707    ;   setting(listing:body_indentation, BodyIndent0),
  708        BodyIndent is LeftMargin+BodyIndent0,
  709        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  710    ),
  711    full_stop(Out).
  712do_portray_clause(Out, (:-Directive), Options) :-
  713    wrapped_list_directive(Directive),
  714    !,
  715    Directive =.. [Name, Arg, List],
  716    option(indent(LeftMargin), Options, 0),
  717    indent(Out, LeftMargin),
  718    format(Out, ':- ~q(', [Name]),
  719    line_position(Out, Indent),
  720    format(Out, '~q,', [Arg]),
  721    nlindent(Out, Indent),
  722    portray_list(List, Indent, Out, Options),
  723    write(Out, ').\n').
  724do_portray_clause(Out, (:-Directive), Options) :-
  725    !,
  726    option(indent(LeftMargin), Options, 0),
  727    indent(Out, LeftMargin),
  728    write(Out, ':- '),
  729    DIndent is LeftMargin+3,
  730    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  731    full_stop(Out).
  732do_portray_clause(Out, Fact, Options) :-
  733    option(indent(LeftMargin), Options, 0),
  734    indent(Out, LeftMargin),
  735    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  736    full_stop(Out).
  737
  738clause_term((Head:-Body), Head, :-, Body).
  739clause_term((Head-->Body), Head, -->, Body).
  740
  741full_stop(Out) :-
  742    '$put_token'(Out, '.'),
  743    nl(Out).
  744
  745wrapped_list_directive(module(_,_)).
  746%wrapped_list_directive(use_module(_,_)).
  747%wrapped_list_directive(autoload(_,_)).
 portray_body(+Term, +Indent, +DoIndent, +Priority, +Out, +Options)
Write Term at current indentation. If DoIndent is 'indent' we must first call nlindent/2 before emitting anything.
  754portray_body(Var, _, _, Pri, Out, Options) :-
  755    var(Var),
  756    !,
  757    pprint(Out, Var, Pri, Options).
  758portray_body(!, _, _, _, Out, _) :-
  759    setting(listing:cut_on_same_line, true),
  760    !,
  761    write(Out, ' !').
  762portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  763    setting(listing:cut_on_same_line, true),
  764    \+ term_needs_braces((_,_), Pri),
  765    !,
  766    write(Out, ' !,'),
  767    portray_body(Clause, Indent, indent, 1000, Out, Options).
  768portray_body(Term, Indent, indent, Pri, Out, Options) :-
  769    !,
  770    nlindent(Out, Indent),
  771    portray_body(Term, Indent, noindent, Pri, Out, Options).
  772portray_body(Or, Indent, _, _, Out, Options) :-
  773    or_layout(Or),
  774    !,
  775    write(Out, '(   '),
  776    portray_or(Or, Indent, 1200, Out, Options),
  777    nlindent(Out, Indent),
  778    write(Out, ')').
  779portray_body(Term, Indent, _, Pri, Out, Options) :-
  780    term_needs_braces(Term, Pri),
  781    !,
  782    write(Out, '( '),
  783    ArgIndent is Indent + 2,
  784    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  785    nlindent(Out, Indent),
  786    write(Out, ')').
  787portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  788    !,
  789    infix_op(',', LeftPri, RightPri),
  790    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  791    write(Out, ','),
  792    portray_body(B, Indent, indent, RightPri, Out, Options).
  793portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  794    !,
  795    write(Out, \+), write(Out, ' '),
  796    prefix_op(\+, ArgPri),
  797    ArgIndent is Indent+3,
  798    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  799portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  800    m_callable(Call),
  801    option(module(M), Options, user),
  802    predicate_property(M:Call, meta_predicate(Meta)),
  803    !,
  804    portray_meta(Out, Call, Meta, Options).
  805portray_body(Clause, _, _, Pri, Out, Options) :-
  806    pprint(Out, Clause, Pri, Options).
  807
  808m_callable(Term) :-
  809    strip_module(Term, _, Plain),
  810    callable(Plain),
  811    Plain \= (_:_).
  812
  813term_needs_braces(Term, Pri) :-
  814    callable(Term),
  815    functor(Term, Name, _Arity),
  816    current_op(OpPri, _Type, Name),
  817    OpPri > Pri,
  818    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  822portray_or(Term, Indent, Pri, Out, Options) :-
  823    term_needs_braces(Term, Pri),
  824    !,
  825    inc_indent(Indent, 1, NewIndent),
  826    write(Out, '(   '),
  827    portray_or(Term, NewIndent, Out, Options),
  828    nlindent(Out, NewIndent),
  829    write(Out, ')').
  830portray_or(Term, Indent, _Pri, Out, Options) :-
  831    or_layout(Term),
  832    !,
  833    portray_or(Term, Indent, Out, Options).
  834portray_or(Term, Indent, Pri, Out, Options) :-
  835    inc_indent(Indent, 1, NestIndent),
  836    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  837
  838
  839portray_or((If -> Then ; Else), Indent, Out, Options) :-
  840    !,
  841    inc_indent(Indent, 1, NestIndent),
  842    infix_op((->), LeftPri, RightPri),
  843    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  844    nlindent(Out, Indent),
  845    write(Out, '->  '),
  846    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  847    nlindent(Out, Indent),
  848    write(Out, ';   '),
  849    infix_op(;, _LeftPri, RightPri2),
  850    portray_or(Else, Indent, RightPri2, Out, Options).
  851portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  852    !,
  853    inc_indent(Indent, 1, NestIndent),
  854    infix_op((*->), LeftPri, RightPri),
  855    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  856    nlindent(Out, Indent),
  857    write(Out, '*-> '),
  858    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  859    nlindent(Out, Indent),
  860    write(Out, ';   '),
  861    infix_op(;, _LeftPri, RightPri2),
  862    portray_or(Else, Indent, RightPri2, Out, Options).
  863portray_or((If -> Then), Indent, Out, Options) :-
  864    !,
  865    inc_indent(Indent, 1, NestIndent),
  866    infix_op((->), LeftPri, RightPri),
  867    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  868    nlindent(Out, Indent),
  869    write(Out, '->  '),
  870    portray_or(Then, Indent, RightPri, Out, Options).
  871portray_or((If *-> Then), Indent, Out, Options) :-
  872    !,
  873    inc_indent(Indent, 1, NestIndent),
  874    infix_op((->), LeftPri, RightPri),
  875    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  876    nlindent(Out, Indent),
  877    write(Out, '*-> '),
  878    portray_or(Then, Indent, RightPri, Out, Options).
  879portray_or((A;B), Indent, Out, Options) :-
  880    !,
  881    inc_indent(Indent, 1, NestIndent),
  882    infix_op(;, LeftPri, RightPri),
  883    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  884    nlindent(Out, Indent),
  885    write(Out, ';   '),
  886    portray_or(B, Indent, RightPri, Out, Options).
  887portray_or((A|B), Indent, Out, Options) :-
  888    !,
  889    inc_indent(Indent, 1, NestIndent),
  890    infix_op('|', LeftPri, RightPri),
  891    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  892    nlindent(Out, Indent),
  893    write(Out, '|   '),
  894    portray_or(B, Indent, RightPri, Out, Options).
 infix_op(+Op, -Left, -Right) is semidet
True if Op is an infix operator and Left is the max priority of its left hand and Right is the max priority of its right hand.
  902infix_op(Op, Left, Right) :-
  903    current_op(Pri, Assoc, Op),
  904    infix_assoc(Assoc, LeftMin, RightMin),
  905    !,
  906    Left is Pri - LeftMin,
  907    Right is Pri - RightMin.
  908
  909infix_assoc(xfx, 1, 1).
  910infix_assoc(xfy, 1, 0).
  911infix_assoc(yfx, 0, 1).
  912
  913prefix_op(Op, ArgPri) :-
  914    current_op(Pri, Assoc, Op),
  915    pre_assoc(Assoc, ArgMin),
  916    !,
  917    ArgPri is Pri - ArgMin.
  918
  919pre_assoc(fx, 1).
  920pre_assoc(fy, 0).
  921
  922postfix_op(Op, ArgPri) :-
  923    current_op(Pri, Assoc, Op),
  924    post_assoc(Assoc, ArgMin),
  925    !,
  926    ArgPri is Pri - ArgMin.
  927
  928post_assoc(xf, 1).
  929post_assoc(yf, 0).
 or_layout(@Term) is semidet
True if Term is a control structure for which we want to use clean layout.
To be done
- Change name.
  938or_layout(Var) :-
  939    var(Var), !, fail.
  940or_layout((_;_)).
  941or_layout((_->_)).
  942or_layout((_*->_)).
  943
  944primitive(G) :-
  945    or_layout(G), !, fail.
  946primitive((_,_)) :- !, fail.
  947primitive(_).
 portray_meta(+Out, +Call, +MetaDecl, +Options)
Portray a meta-call. If Call contains non-primitive meta-calls we put each argument on a line and layout the body. Otherwise we simply print the goal.
  956portray_meta(Out, Call, Meta, Options) :-
  957    contains_non_primitive_meta_arg(Call, Meta),
  958    !,
  959    Call =.. [Name|Args],
  960    Meta =.. [_|Decls],
  961    format(Out, '~q(', [Name]),
  962    line_position(Out, Indent),
  963    portray_meta_args(Decls, Args, Indent, Out, Options),
  964    format(Out, ')', []).
  965portray_meta(Out, Call, _, Options) :-
  966    pprint(Out, Call, 999, Options).
  967
  968contains_non_primitive_meta_arg(Call, Decl) :-
  969    arg(I, Call, CA),
  970    arg(I, Decl, DA),
  971    integer(DA),
  972    \+ primitive(CA),
  973    !.
  974
  975portray_meta_args([], [], _, _, _).
  976portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  977    portray_meta_arg(D, A, Out, Options),
  978    (   DT == []
  979    ->  true
  980    ;   format(Out, ',', []),
  981        nlindent(Out, Indent),
  982        portray_meta_args(DT, AT, Indent, Out, Options)
  983    ).
  984
  985portray_meta_arg(I, A, Out, Options) :-
  986    integer(I),
  987    !,
  988    line_position(Out, Indent),
  989    portray_body(A, Indent, noindent, 999, Out, Options).
  990portray_meta_arg(_, A, Out, Options) :-
  991    pprint(Out, A, 999, Options).
 portray_list(+List, +Indent, +Out)
Portray a list like this. Right side for improper lists
[ element1,             [ element1
  element2,     OR      | tail
]                       ]
 1001portray_list([], _, Out, _) :-
 1002    !,
 1003    write(Out, []).
 1004portray_list(List, Indent, Out, Options) :-
 1005    write(Out, '[ '),
 1006    EIndent is Indent + 2,
 1007    portray_list_elements(List, EIndent, Out, Options),
 1008    nlindent(Out, Indent),
 1009    write(Out, ']').
 1010
 1011portray_list_elements([H|T], EIndent, Out, Options) :-
 1012    pprint(Out, H, 999, Options),
 1013    (   T == []
 1014    ->  true
 1015    ;   nonvar(T), T = [_|_]
 1016    ->  write(Out, ','),
 1017        nlindent(Out, EIndent),
 1018        portray_list_elements(T, EIndent, Out, Options)
 1019    ;   Indent is EIndent - 2,
 1020        nlindent(Out, Indent),
 1021        write(Out, '| '),
 1022        pprint(Out, T, 999, Options)
 1023    ).
 pprint(+Out, +Term, +Priority, +Options)
Print Term at Priority. This also takes care of several formatting options, in particular:
To be done
- Decide when and how to wrap long terms.
 1037pprint(Out, Term, _, Options) :-
 1038    nonvar(Term),
 1039    Term = {}(Arg),
 1040    line_position(Out, Indent),
 1041    ArgIndent is Indent + 2,
 1042    format(Out, '{ ', []),
 1043    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1044    nlindent(Out, Indent),
 1045    format(Out, '}', []).
 1046pprint(Out, Term, Pri, Options) :-
 1047    (   compound(Term)
 1048    ->  compound_name_arity(Term, _, Arity),
 1049        Arity > 0
 1050    ;   is_dict(Term)
 1051    ),
 1052    \+ nowrap_term(Term),
 1053    setting(listing:line_width, Width),
 1054    Width > 0,
 1055    (   write_length(Term, Len, [max_length(Width)|Options])
 1056    ->  true
 1057    ;   Len = Width
 1058    ),
 1059    line_position(Out, Indent),
 1060    Indent + Len > Width,
 1061    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1062    !,
 1063    pprint_wrapped(Out, Term, Pri, Options).
 1064pprint(Out, Term, Pri, Options) :-
 1065    listing_write_options(Pri, WrtOptions, Options),
 1066    write_term(Out, Term, WrtOptions).
 1067
 1068nowrap_term('$VAR'(_)) :- !.
 1069nowrap_term(_{}) :- !.                  % empty dict
 1070nowrap_term(Term) :-
 1071    functor(Term, Name, Arity),
 1072    current_op(_, _, Name),
 1073    (   Arity == 2
 1074    ->  infix_op(Name, _, _)
 1075    ;   Arity == 1
 1076    ->  (   prefix_op(Name, _)
 1077        ->  true
 1078        ;   postfix_op(Name, _)
 1079        )
 1080    ).
 1081
 1082
 1083pprint_wrapped(Out, Term, _, Options) :-
 1084    Term = [_|_],
 1085    !,
 1086    line_position(Out, Indent),
 1087    portray_list(Term, Indent, Out, Options).
 1088pprint_wrapped(Out, Dict, _, Options) :-
 1089    is_dict(Dict),
 1090    !,
 1091    dict_pairs(Dict, Tag, Pairs),
 1092    pprint(Out, Tag, 1200, Options),
 1093    format(Out, '{ ', []),
 1094    line_position(Out, Indent),
 1095    pprint_nv(Pairs, Indent, Out, Options),
 1096    nlindent(Out, Indent-2),
 1097    format(Out, '}', []).
 1098pprint_wrapped(Out, Term, _, Options) :-
 1099    Term =.. [Name|Args],
 1100    format(Out, '~q(', Name),
 1101    line_position(Out, Indent),
 1102    pprint_args(Args, Indent, Out, Options),
 1103    format(Out, ')', []).
 1104
 1105pprint_args([], _, _, _).
 1106pprint_args([H|T], Indent, Out, Options) :-
 1107    pprint(Out, H, 999, Options),
 1108    (   T == []
 1109    ->  true
 1110    ;   format(Out, ',', []),
 1111        nlindent(Out, Indent),
 1112        pprint_args(T, Indent, Out, Options)
 1113    ).
 1114
 1115
 1116pprint_nv([], _, _, _).
 1117pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1118    pprint(Out, Name, 999, Options),
 1119    format(Out, ':', []),
 1120    pprint(Out, Value, 999, Options),
 1121    (   T == []
 1122    ->  true
 1123    ;   format(Out, ',', []),
 1124        nlindent(Out, Indent),
 1125        pprint_nv(T, Indent, Out, Options)
 1126    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1134listing_write_options(Pri,
 1135                      [ quoted(true),
 1136                        numbervars(true),
 1137                        priority(Pri),
 1138                        spacing(next_argument)
 1139                      | Options
 1140                      ],
 1141                      Options).
 nlindent(+Out, +Indent)
Write newline and indent to column Indent. Uses the setting listing:tab_distance to determine the mapping between tabs and spaces.
 1149nlindent(Out, N) :-
 1150    nl(Out),
 1151    indent(Out, N).
 1152
 1153indent(Out, N) :-
 1154    setting(listing:tab_distance, D),
 1155    (   D =:= 0
 1156    ->  tab(Out, N)
 1157    ;   Tab is N // D,
 1158        Space is N mod D,
 1159        put_tabs(Out, Tab),
 1160        tab(Out, Space)
 1161    ).
 1162
 1163put_tabs(Out, N) :-
 1164    N > 0,
 1165    !,
 1166    put(Out, 0'\t),
 1167    NN is N - 1,
 1168    put_tabs(Out, NN).
 1169put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1176inc_indent(Indent0, Inc, Indent) :-
 1177    Indent is Indent0 + Inc*4.
 1178
 1179:- multifile
 1180    sandbox:safe_meta/2. 1181
 1182sandbox:safe_meta(listing(What), []) :-
 1183    not_qualified(What).
 1184
 1185not_qualified(Var) :-
 1186    var(Var),
 1187    !.
 1188not_qualified(_:_) :- !, fail.
 1189not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1196comment(Format, Args) :-
 1197    stream_property(current_output, tty(true)),
 1198    setting(listing:comment_ansi_attributes, Attributes),
 1199    Attributes \== [],
 1200    !,
 1201    ansi_format(Attributes, Format, Args).
 1202comment(Format, Args) :-
 1203    format(Format, Args)