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    @(rule(_, Rule, Ref), Context),
  221    list_clause(Rule, 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    most_general_goal(Head, GenHead),
  380    forall(( rule(Module:GenHead, Rule, Ref),
  381             \+ \+ rule_head(Rule, Head)
  382           ),
  383           list_clause(Module:Rule, Ref, Source, Options)).
  384
  385rule_head((Head0 :- _Body), Head) :- !, Head = Head0.
  386rule_head((Head0,_Cond => _Body), Head) :- !, Head = Head0.
  387rule_head((Head0 => _Body), Head) :- !, Head = Head0.
  388rule_head(?=>(Head0, _Body), Head) :- !, Head = Head0.
  389rule_head(Head, Head).
  390
  391list_clause(_Rule, Ref, _Source, Options) :-
  392    option(source(true), Options),
  393    (   clause_property(Ref, file(File)),
  394        clause_property(Ref, line_count(Line)),
  395        catch(source_clause_string(File, Line, String, Repositioned),
  396              _, fail),
  397        debug(listing(source), 'Read ~w:~d: "~s"~n', [File, Line, String])
  398    ->  !,
  399        (   Repositioned == true
  400        ->  comment('% From ~w:~d~n', [ File, Line ])
  401        ;   true
  402        ),
  403        writeln(String)
  404    ;   decompiled
  405    ->  fail
  406    ;   asserta(decompiled),
  407        comment('% From database (decompiled)~n', []),
  408        fail                                    % try next clause
  409    ).
  410list_clause(Module:(Head:-Body), Ref, Source, Options) :-
  411    !,
  412    list_clause(Module:Head, Body, :-, Ref, Source, Options).
  413list_clause(Module:(Head=>Body), Ref, Source, Options) :-
  414    list_clause(Module:Head, Body, =>, Ref, Source, Options).
  415list_clause(Module:Head, Ref, Source, Options) :-
  416    !,
  417    list_clause(Module:Head, true, :-, Ref, Source, Options).
  418
  419list_clause(Module:Head, Body, Neck, Ref, Source, Options) :-
  420    restore_variable_names(Module, Head, Body, Ref, Options),
  421    write_module(Module, Source, Head),
  422    Rule =.. [Neck,Head,Body],
  423    portray_clause(Rule).
 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.
  430restore_variable_names(Module, Head, Body, Ref, Options) :-
  431    option(variable_names(source), Options, source),
  432    catch(clause_info(Ref, _, _, _,
  433                      [ head(QHead),
  434                        body(Body),
  435                        variable_names(Bindings)
  436                      ]),
  437          _, true),
  438    unify_head(Module, Head, QHead),
  439    !,
  440    bind_vars(Bindings),
  441    name_other_vars((Head:-Body), Bindings).
  442restore_variable_names(_,_,_,_,_).
  443
  444unify_head(Module, Head, Module:Head) :-
  445    !.
  446unify_head(_, Head, Head) :-
  447    !.
  448unify_head(_, _, _).
  449
  450bind_vars([]) :-
  451    !.
  452bind_vars([Name = Var|T]) :-
  453    ignore(Var = '$VAR'(Name)),
  454    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.
  461name_other_vars(Term, Bindings) :-
  462    term_singletons(Term, Singletons),
  463    bind_singletons(Singletons),
  464    term_variables(Term, Vars),
  465    name_vars(Vars, 0, Bindings).
  466
  467bind_singletons([]).
  468bind_singletons(['$VAR'('_')|T]) :-
  469    bind_singletons(T).
  470
  471name_vars([], _, _).
  472name_vars([H|T], N, Bindings) :-
  473    between(N, infinite, N2),
  474    var_name(N2, Name),
  475    \+ memberchk(Name=_, Bindings),
  476    !,
  477    H = '$VAR'(N2),
  478    N3 is N2 + 1,
  479    name_vars(T, N3, Bindings).
  480
  481var_name(I, Name) :-               % must be kept in sync with writeNumberVar()
  482    L is (I mod 26)+0'A,
  483    N is I // 26,
  484    (   N == 0
  485    ->  char_code(Name, L)
  486    ;   format(atom(Name), '~c~d', [L, N])
  487    ).
  488
  489write_module(Module, Context, Head) :-
  490    hide_module(Module, Context, Head),
  491    !.
  492write_module(Module, _, _) :-
  493    format('~q:', [Module]).
  494
  495hide_module(system, Module, Head) :-
  496    predicate_property(Module:Head, imported_from(M)),
  497    predicate_property(system:Head, imported_from(M)),
  498    !.
  499hide_module(Module, Module, _) :- !.
  500
  501notify_changed(Pred, Context) :-
  502    strip_module(Pred, user, Head),
  503    predicate_property(Head, built_in),
  504    \+ predicate_property(Head, (dynamic)),
  505    !,
  506    decl_term(Pred, Context, Decl),
  507    comment('%   NOTE: system definition has been overruled for ~q~n',
  508            [Decl]).
  509notify_changed(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  516source_clause_string(File, Line, String, Repositioned) :-
  517    open_source(File, Line, Stream, Repositioned),
  518    stream_property(Stream, position(Start)),
  519    '$raw_read'(Stream, _TextWithoutComments),
  520    stream_property(Stream, position(End)),
  521    stream_position_data(char_count, Start, StartChar),
  522    stream_position_data(char_count, End, EndChar),
  523    Length is EndChar - StartChar,
  524    set_stream_position(Stream, Start),
  525    read_string(Stream, Length, String),
  526    skip_blanks_and_comments(Stream, blank).
  527
  528skip_blanks_and_comments(Stream, _) :-
  529    at_end_of_stream(Stream),
  530    !.
  531skip_blanks_and_comments(Stream, State0) :-
  532    peek_string(Stream, 80, String),
  533    string_chars(String, Chars),
  534    phrase(blanks_and_comments(State0, State), Chars, Rest),
  535    (   Rest == []
  536    ->  read_string(Stream, 80, _),
  537        skip_blanks_and_comments(Stream, State)
  538    ;   length(Chars, All),
  539        length(Rest, RLen),
  540        Skip is All-RLen,
  541        read_string(Stream, Skip, _)
  542    ).
  543
  544blanks_and_comments(State0, State) -->
  545    [C],
  546    { transition(C, State0, State1) },
  547    !,
  548    blanks_and_comments(State1, State).
  549blanks_and_comments(State, State) -->
  550    [].
  551
  552transition(C, blank, blank) :-
  553    char_type(C, space).
  554transition('%', blank, line_comment).
  555transition('\n', line_comment, blank).
  556transition(_, line_comment, line_comment).
  557transition('/', blank, comment_0).
  558transition('/', comment(N), comment(N,/)).
  559transition('*', comment(N,/), comment(N1)) :-
  560    N1 is N + 1.
  561transition('*', comment_0, comment(1)).
  562transition('*', comment(N), comment(N,*)).
  563transition('/', comment(N,*), State) :-
  564    (   N == 1
  565    ->  State = blank
  566    ;   N2 is N - 1,
  567        State = comment(N2)
  568    ).
  569
  570
  571open_source(File, Line, Stream, Repositioned) :-
  572    source_stream(File, Stream, Pos0, Repositioned),
  573    line_count(Stream, Line0),
  574    (   Line >= Line0
  575    ->  Skip is Line - Line0
  576    ;   set_stream_position(Stream, Pos0),
  577        Skip is Line - 1
  578    ),
  579    debug(listing(source), '~w: skip ~d to ~d', [File, Line0, Line]),
  580    (   Skip =\= 0
  581    ->  Repositioned = true
  582    ;   true
  583    ),
  584    forall(between(1, Skip, _),
  585           skip(Stream, 0'\n)).
  586
  587:- thread_local
  588    opened_source/3,
  589    decompiled/0.  590
  591source_stream(File, Stream, Pos0, _) :-
  592    opened_source(File, Stream, Pos0),
  593    !.
  594source_stream(File, Stream, Pos0, true) :-
  595    open(File, read, Stream),
  596    stream_property(Stream, position(Pos0)),
  597    asserta(opened_source(File, Stream, Pos0)).
  598
  599close_sources :-
  600    retractall(decompiled),
  601    forall(retract(opened_source(_,Stream,_)),
  602           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.
  633%       The prolog_list_goal/1 hook is  a  dubious   as  it  may lead to
  634%       confusion if the heads relates to other   bodies.  For now it is
  635%       only used for XPCE methods and works just nice.
  636%
  637%       Not really ...  It may confuse the source-level debugger.
  638
  639%portray_clause(Head :- _Body) :-
  640%       user:prolog_list_goal(Head), !.
  641portray_clause(Term) :-
  642    current_output(Out),
  643    portray_clause(Out, Term).
  644
  645portray_clause(Stream, Term) :-
  646    must_be(stream, Stream),
  647    portray_clause(Stream, Term, []).
  648
  649portray_clause(Stream, Term, M:Options) :-
  650    must_be(list, Options),
  651    meta_options(is_meta, M:Options, QOptions),
  652    \+ \+ name_vars_and_portray_clause(Stream, Term, QOptions).
  653
  654name_vars_and_portray_clause(Stream, Term, Options) :-
  655    term_attvars(Term, []),
  656    !,
  657    clause_vars(Term, Options),
  658    do_portray_clause(Stream, Term, Options).
  659name_vars_and_portray_clause(Stream, Term, Options) :-
  660    option(variable_names(Bindings), Options),
  661    !,
  662    copy_term_nat(Term+Bindings, Copy+BCopy),
  663    bind_vars(BCopy),
  664    name_other_vars(Copy, BCopy),
  665    do_portray_clause(Stream, Copy, Options).
  666name_vars_and_portray_clause(Stream, Term, Options) :-
  667    copy_term_nat(Term, Copy),
  668    clause_vars(Copy, Options),
  669    do_portray_clause(Stream, Copy, Options).
  670
  671clause_vars(Clause, Options) :-
  672    option(variable_names(Bindings), Options),
  673    !,
  674    bind_vars(Bindings),
  675    name_other_vars(Clause, Bindings).
  676clause_vars(Clause, _) :-
  677    numbervars(Clause, 0, _,
  678               [ singletons(true)
  679               ]).
  680
  681is_meta(portray_goal).
  682
  683do_portray_clause(Out, Var, Options) :-
  684    var(Var),
  685    !,
  686    option(indent(LeftMargin), Options, 0),
  687    indent(Out, LeftMargin),
  688    pprint(Out, Var, 1200, Options).
  689do_portray_clause(Out, (Head :- true), Options) :-
  690    !,
  691    option(indent(LeftMargin), Options, 0),
  692    indent(Out, LeftMargin),
  693    pprint(Out, Head, 1200, Options),
  694    full_stop(Out).
  695do_portray_clause(Out, Term, Options) :-
  696    clause_term(Term, Head, Neck, Body),
  697    !,
  698    option(indent(LeftMargin), Options, 0),
  699    inc_indent(LeftMargin, 1, Indent),
  700    infix_op(Neck, RightPri, LeftPri),
  701    indent(Out, LeftMargin),
  702    pprint(Out, Head, LeftPri, Options),
  703    format(Out, ' ~w', [Neck]),
  704    (   nonvar(Body),
  705        Body = Module:LocalBody,
  706        \+ primitive(LocalBody)
  707    ->  nlindent(Out, Indent),
  708        format(Out, '~q', [Module]),
  709        '$put_token'(Out, :),
  710        nlindent(Out, Indent),
  711        write(Out, '(   '),
  712        inc_indent(Indent, 1, BodyIndent),
  713        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  714        nlindent(Out, Indent),
  715        write(Out, ')')
  716    ;   setting(listing:body_indentation, BodyIndent0),
  717        BodyIndent is LeftMargin+BodyIndent0,
  718        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  719    ),
  720    full_stop(Out).
  721do_portray_clause(Out, (:-Directive), Options) :-
  722    wrapped_list_directive(Directive),
  723    !,
  724    Directive =.. [Name, Arg, List],
  725    option(indent(LeftMargin), Options, 0),
  726    indent(Out, LeftMargin),
  727    format(Out, ':- ~q(', [Name]),
  728    line_position(Out, Indent),
  729    format(Out, '~q,', [Arg]),
  730    nlindent(Out, Indent),
  731    portray_list(List, Indent, Out, Options),
  732    write(Out, ').\n').
  733do_portray_clause(Out, (:-Directive), Options) :-
  734    !,
  735    option(indent(LeftMargin), Options, 0),
  736    indent(Out, LeftMargin),
  737    write(Out, ':- '),
  738    DIndent is LeftMargin+3,
  739    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  740    full_stop(Out).
  741do_portray_clause(Out, Fact, Options) :-
  742    option(indent(LeftMargin), Options, 0),
  743    indent(Out, LeftMargin),
  744    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  745    full_stop(Out).
  746
  747clause_term((Head:-Body), Head, :-, Body).
  748clause_term((Head=>Body), Head, =>, Body).
  749clause_term(?=>(Head,Body), Head, ?=>, Body).
  750clause_term((Head-->Body), Head, -->, Body).
  751
  752full_stop(Out) :-
  753    '$put_token'(Out, '.'),
  754    nl(Out).
  755
  756wrapped_list_directive(module(_,_)).
  757%wrapped_list_directive(use_module(_,_)).
  758%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.
  765portray_body(Var, _, _, Pri, Out, Options) :-
  766    var(Var),
  767    !,
  768    pprint(Out, Var, Pri, Options).
  769portray_body(!, _, _, _, Out, _) :-
  770    setting(listing:cut_on_same_line, true),
  771    !,
  772    write(Out, ' !').
  773portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  774    setting(listing:cut_on_same_line, true),
  775    \+ term_needs_braces((_,_), Pri),
  776    !,
  777    write(Out, ' !,'),
  778    portray_body(Clause, Indent, indent, 1000, Out, Options).
  779portray_body(Term, Indent, indent, Pri, Out, Options) :-
  780    !,
  781    nlindent(Out, Indent),
  782    portray_body(Term, Indent, noindent, Pri, Out, Options).
  783portray_body(Or, Indent, _, _, Out, Options) :-
  784    or_layout(Or),
  785    !,
  786    write(Out, '(   '),
  787    portray_or(Or, Indent, 1200, Out, Options),
  788    nlindent(Out, Indent),
  789    write(Out, ')').
  790portray_body(Term, Indent, _, Pri, Out, Options) :-
  791    term_needs_braces(Term, Pri),
  792    !,
  793    write(Out, '( '),
  794    ArgIndent is Indent + 2,
  795    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  796    nlindent(Out, Indent),
  797    write(Out, ')').
  798portray_body(((AB),C), Indent, _, _Pri, Out, Options) :-
  799    nonvar(AB),
  800    AB = (A,B),
  801    !,
  802    infix_op(',', LeftPri, RightPri),
  803    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  804    write(Out, ','),
  805    portray_body((B,C), Indent, indent, RightPri, Out, Options).
  806portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  807    !,
  808    infix_op(',', LeftPri, RightPri),
  809    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  810    write(Out, ','),
  811    portray_body(B, Indent, indent, RightPri, Out, Options).
  812portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  813    !,
  814    write(Out, \+), write(Out, ' '),
  815    prefix_op(\+, ArgPri),
  816    ArgIndent is Indent+3,
  817    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  818portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  819    m_callable(Call),
  820    option(module(M), Options, user),
  821    predicate_property(M:Call, meta_predicate(Meta)),
  822    !,
  823    portray_meta(Out, Call, Meta, Options).
  824portray_body(Clause, _, _, Pri, Out, Options) :-
  825    pprint(Out, Clause, Pri, Options).
  826
  827m_callable(Term) :-
  828    strip_module(Term, _, Plain),
  829    callable(Plain),
  830    Plain \= (_:_).
  831
  832term_needs_braces(Term, Pri) :-
  833    callable(Term),
  834    functor(Term, Name, _Arity),
  835    current_op(OpPri, _Type, Name),
  836    OpPri > Pri,
  837    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  841portray_or(Term, Indent, Pri, Out, Options) :-
  842    term_needs_braces(Term, Pri),
  843    !,
  844    inc_indent(Indent, 1, NewIndent),
  845    write(Out, '(   '),
  846    portray_or(Term, NewIndent, Out, Options),
  847    nlindent(Out, NewIndent),
  848    write(Out, ')').
  849portray_or(Term, Indent, _Pri, Out, Options) :-
  850    or_layout(Term),
  851    !,
  852    portray_or(Term, Indent, Out, Options).
  853portray_or(Term, Indent, Pri, Out, Options) :-
  854    inc_indent(Indent, 1, NestIndent),
  855    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  856
  857
  858portray_or((If -> Then ; Else), Indent, Out, Options) :-
  859    !,
  860    inc_indent(Indent, 1, NestIndent),
  861    infix_op((->), LeftPri, RightPri),
  862    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  863    nlindent(Out, Indent),
  864    write(Out, '->  '),
  865    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  866    nlindent(Out, Indent),
  867    write(Out, ';   '),
  868    infix_op(;, _LeftPri, RightPri2),
  869    portray_or(Else, Indent, RightPri2, Out, Options).
  870portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  871    !,
  872    inc_indent(Indent, 1, NestIndent),
  873    infix_op((*->), LeftPri, RightPri),
  874    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  875    nlindent(Out, Indent),
  876    write(Out, '*-> '),
  877    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  878    nlindent(Out, Indent),
  879    write(Out, ';   '),
  880    infix_op(;, _LeftPri, RightPri2),
  881    portray_or(Else, Indent, RightPri2, Out, Options).
  882portray_or((If -> Then), Indent, Out, Options) :-
  883    !,
  884    inc_indent(Indent, 1, NestIndent),
  885    infix_op((->), LeftPri, RightPri),
  886    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  887    nlindent(Out, Indent),
  888    write(Out, '->  '),
  889    portray_or(Then, Indent, RightPri, Out, Options).
  890portray_or((If *-> Then), Indent, Out, Options) :-
  891    !,
  892    inc_indent(Indent, 1, NestIndent),
  893    infix_op((->), LeftPri, RightPri),
  894    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  895    nlindent(Out, Indent),
  896    write(Out, '*-> '),
  897    portray_or(Then, Indent, RightPri, Out, Options).
  898portray_or((A;B), Indent, Out, Options) :-
  899    !,
  900    inc_indent(Indent, 1, NestIndent),
  901    infix_op(;, LeftPri, RightPri),
  902    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  903    nlindent(Out, Indent),
  904    write(Out, ';   '),
  905    portray_or(B, Indent, RightPri, Out, Options).
  906portray_or((A|B), Indent, Out, Options) :-
  907    !,
  908    inc_indent(Indent, 1, NestIndent),
  909    infix_op('|', LeftPri, RightPri),
  910    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  911    nlindent(Out, Indent),
  912    write(Out, '|   '),
  913    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.
  921infix_op(Op, Left, Right) :-
  922    current_op(Pri, Assoc, Op),
  923    infix_assoc(Assoc, LeftMin, RightMin),
  924    !,
  925    Left is Pri - LeftMin,
  926    Right is Pri - RightMin.
  927
  928infix_assoc(xfx, 1, 1).
  929infix_assoc(xfy, 1, 0).
  930infix_assoc(yfx, 0, 1).
  931
  932prefix_op(Op, ArgPri) :-
  933    current_op(Pri, Assoc, Op),
  934    pre_assoc(Assoc, ArgMin),
  935    !,
  936    ArgPri is Pri - ArgMin.
  937
  938pre_assoc(fx, 1).
  939pre_assoc(fy, 0).
  940
  941postfix_op(Op, ArgPri) :-
  942    current_op(Pri, Assoc, Op),
  943    post_assoc(Assoc, ArgMin),
  944    !,
  945    ArgPri is Pri - ArgMin.
  946
  947post_assoc(xf, 1).
  948post_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.
  957or_layout(Var) :-
  958    var(Var), !, fail.
  959or_layout((_;_)).
  960or_layout((_->_)).
  961or_layout((_*->_)).
  962
  963primitive(G) :-
  964    or_layout(G), !, fail.
  965primitive((_,_)) :- !, fail.
  966primitive(_).
 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.
  975portray_meta(Out, Call, Meta, Options) :-
  976    contains_non_primitive_meta_arg(Call, Meta),
  977    !,
  978    Call =.. [Name|Args],
  979    Meta =.. [_|Decls],
  980    format(Out, '~q(', [Name]),
  981    line_position(Out, Indent),
  982    portray_meta_args(Decls, Args, Indent, Out, Options),
  983    format(Out, ')', []).
  984portray_meta(Out, Call, _, Options) :-
  985    pprint(Out, Call, 999, Options).
  986
  987contains_non_primitive_meta_arg(Call, Decl) :-
  988    arg(I, Call, CA),
  989    arg(I, Decl, DA),
  990    integer(DA),
  991    \+ primitive(CA),
  992    !.
  993
  994portray_meta_args([], [], _, _, _).
  995portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  996    portray_meta_arg(D, A, Out, Options),
  997    (   DT == []
  998    ->  true
  999    ;   format(Out, ',', []),
 1000        nlindent(Out, Indent),
 1001        portray_meta_args(DT, AT, Indent, Out, Options)
 1002    ).
 1003
 1004portray_meta_arg(I, A, Out, Options) :-
 1005    integer(I),
 1006    !,
 1007    line_position(Out, Indent),
 1008    portray_body(A, Indent, noindent, 999, Out, Options).
 1009portray_meta_arg(_, A, Out, Options) :-
 1010    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
]                       ]
 1020portray_list([], _, Out, _) :-
 1021    !,
 1022    write(Out, []).
 1023portray_list(List, Indent, Out, Options) :-
 1024    write(Out, '[ '),
 1025    EIndent is Indent + 2,
 1026    portray_list_elements(List, EIndent, Out, Options),
 1027    nlindent(Out, Indent),
 1028    write(Out, ']').
 1029
 1030portray_list_elements([H|T], EIndent, Out, Options) :-
 1031    pprint(Out, H, 999, Options),
 1032    (   T == []
 1033    ->  true
 1034    ;   nonvar(T), T = [_|_]
 1035    ->  write(Out, ','),
 1036        nlindent(Out, EIndent),
 1037        portray_list_elements(T, EIndent, Out, Options)
 1038    ;   Indent is EIndent - 2,
 1039        nlindent(Out, Indent),
 1040        write(Out, '| '),
 1041        pprint(Out, T, 999, Options)
 1042    ).
 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.
 1056pprint(Out, Term, _, Options) :-
 1057    nonvar(Term),
 1058    Term = {}(Arg),
 1059    line_position(Out, Indent),
 1060    ArgIndent is Indent + 2,
 1061    format(Out, '{ ', []),
 1062    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
 1063    nlindent(Out, Indent),
 1064    format(Out, '}', []).
 1065pprint(Out, Term, Pri, Options) :-
 1066    (   compound(Term)
 1067    ->  compound_name_arity(Term, _, Arity),
 1068        Arity > 0
 1069    ;   is_dict(Term)
 1070    ),
 1071    \+ nowrap_term(Term),
 1072    setting(listing:line_width, Width),
 1073    Width > 0,
 1074    (   write_length(Term, Len, [max_length(Width)|Options])
 1075    ->  true
 1076    ;   Len = Width
 1077    ),
 1078    line_position(Out, Indent),
 1079    Indent + Len > Width,
 1080    Len > Width/4,                 % ad-hoc rule for deeply nested goals
 1081    !,
 1082    pprint_wrapped(Out, Term, Pri, Options).
 1083pprint(Out, Term, Pri, Options) :-
 1084    listing_write_options(Pri, WrtOptions, Options),
 1085    write_term(Out, Term,
 1086               [ blobs(portray),
 1087                 portray_goal(portray_blob)
 1088               | WrtOptions
 1089               ]).
 1090
 1091portray_blob(Blob, _Options) :-
 1092    blob(Blob, _),
 1093    \+ atom(Blob),
 1094    !,
 1095    format(string(S), '~q', [Blob]),
 1096    format('~q', ['$BLOB'(S)]).
 1097
 1098nowrap_term('$VAR'(_)) :- !.
 1099nowrap_term(_{}) :- !.                  % empty dict
 1100nowrap_term(Term) :-
 1101    functor(Term, Name, Arity),
 1102    current_op(_, _, Name),
 1103    (   Arity == 2
 1104    ->  infix_op(Name, _, _)
 1105    ;   Arity == 1
 1106    ->  (   prefix_op(Name, _)
 1107        ->  true
 1108        ;   postfix_op(Name, _)
 1109        )
 1110    ).
 1111
 1112
 1113pprint_wrapped(Out, Term, _, Options) :-
 1114    Term = [_|_],
 1115    !,
 1116    line_position(Out, Indent),
 1117    portray_list(Term, Indent, Out, Options).
 1118pprint_wrapped(Out, Dict, _, Options) :-
 1119    is_dict(Dict),
 1120    !,
 1121    dict_pairs(Dict, Tag, Pairs),
 1122    pprint(Out, Tag, 1200, Options),
 1123    format(Out, '{ ', []),
 1124    line_position(Out, Indent),
 1125    pprint_nv(Pairs, Indent, Out, Options),
 1126    nlindent(Out, Indent-2),
 1127    format(Out, '}', []).
 1128pprint_wrapped(Out, Term, _, Options) :-
 1129    Term =.. [Name|Args],
 1130    format(Out, '~q(', Name),
 1131    line_position(Out, Indent),
 1132    pprint_args(Args, Indent, Out, Options),
 1133    format(Out, ')', []).
 1134
 1135pprint_args([], _, _, _).
 1136pprint_args([H|T], Indent, Out, Options) :-
 1137    pprint(Out, H, 999, Options),
 1138    (   T == []
 1139    ->  true
 1140    ;   format(Out, ',', []),
 1141        nlindent(Out, Indent),
 1142        pprint_args(T, Indent, Out, Options)
 1143    ).
 1144
 1145
 1146pprint_nv([], _, _, _).
 1147pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1148    pprint(Out, Name, 999, Options),
 1149    format(Out, ':', []),
 1150    pprint(Out, Value, 999, Options),
 1151    (   T == []
 1152    ->  true
 1153    ;   format(Out, ',', []),
 1154        nlindent(Out, Indent),
 1155        pprint_nv(T, Indent, Out, Options)
 1156    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1164listing_write_options(Pri,
 1165                      [ quoted(true),
 1166                        numbervars(true),
 1167                        priority(Pri),
 1168                        spacing(next_argument)
 1169                      | Options
 1170                      ],
 1171                      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.
 1179nlindent(Out, N) :-
 1180    nl(Out),
 1181    indent(Out, N).
 1182
 1183indent(Out, N) :-
 1184    setting(listing:tab_distance, D),
 1185    (   D =:= 0
 1186    ->  tab(Out, N)
 1187    ;   Tab is N // D,
 1188        Space is N mod D,
 1189        put_tabs(Out, Tab),
 1190        tab(Out, Space)
 1191    ).
 1192
 1193put_tabs(Out, N) :-
 1194    N > 0,
 1195    !,
 1196    put(Out, 0'\t),
 1197    NN is N - 1,
 1198    put_tabs(Out, NN).
 1199put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1206inc_indent(Indent0, Inc, Indent) :-
 1207    Indent is Indent0 + Inc*4.
 1208
 1209:- multifile
 1210    sandbox:safe_meta/2. 1211
 1212sandbox:safe_meta(listing(What), []) :-
 1213    not_qualified(What).
 1214
 1215not_qualified(Var) :-
 1216    var(Var),
 1217    !.
 1218not_qualified(_:_) :- !, fail.
 1219not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1226comment(Format, Args) :-
 1227    stream_property(current_output, tty(true)),
 1228    setting(listing:comment_ansi_attributes, Attributes),
 1229    Attributes \== [],
 1230    !,
 1231    ansi_format(Attributes, Format, Args).
 1232comment(Format, Args) :-
 1233    format(Format, Args)