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(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

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 */
   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').
 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:_).
  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    ).
 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)]).
  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).
 list_predicates(:Preds:list(pi), :Spec, +Options) is det
  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).
 meta_implies_transparent(+Head) is semidet
True if the meta-declaration Head implies that the predicate is transparent.
  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)).
 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.
  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    ignore(Var = '$VAR'(Name)),
  404    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.
  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(_, _).
 source_clause_string(+File, +Line, -String, -Repositioned)
True when String is the source text for a clause starting at Line in File.
  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)).
 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. As the actual variable names are not available we use A, B, ... Deals with ';', '|', '->' 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.

If Options is provided, the option-list is passed to write_term/3 that does the final writing of arguments.

  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    option(indent(LeftMargin), Options, 0),
  601    indent(Out, LeftMargin),
  602    pprint(Out, Var, 1200, Options).
  603do_portray_clause(Out, (Head :- true), Options) :-
  604    !,
  605    option(indent(LeftMargin), Options, 0),
  606    indent(Out, LeftMargin),
  607    pprint(Out, Head, 1200, Options),
  608    full_stop(Out).
  609do_portray_clause(Out, Term, Options) :-
  610    clause_term(Term, Head, Neck, Body),
  611    !,
  612    option(indent(LeftMargin), Options, 0),
  613    inc_indent(LeftMargin, 1, Indent),
  614    infix_op(Neck, RightPri, LeftPri),
  615    indent(Out, LeftMargin),
  616    pprint(Out, Head, LeftPri, Options),
  617    format(Out, ' ~w', [Neck]),
  618    (   nonvar(Body),
  619        Body = Module:LocalBody,
  620        \+ primitive(LocalBody)
  621    ->  nlindent(Out, Indent),
  622        format(Out, '~q', [Module]),
  623        '$put_token'(Out, :),
  624        nlindent(Out, Indent),
  625        write(Out, '(   '),
  626        inc_indent(Indent, 1, BodyIndent),
  627        portray_body(LocalBody, BodyIndent, noindent, 1200, Out, Options),
  628        nlindent(Out, Indent),
  629        write(Out, ')')
  630    ;   setting(listing:body_indentation, BodyIndent0),
  631        BodyIndent is LeftMargin+BodyIndent0,
  632        portray_body(Body, BodyIndent, indent, RightPri, Out, Options)
  633    ),
  634    full_stop(Out).
  635do_portray_clause(Out, (:-use_module(File, Imports)), Options) :-
  636    length(Imports, Len),
  637    Len > 3,
  638    !,
  639    option(indent(LeftMargin), Options, 0),
  640    indent(Out, LeftMargin),
  641    ListIndent is LeftMargin+14,
  642    format(Out, ':- use_module(~q,', [File]),
  643    portray_list(Imports, ListIndent, Out, Options),
  644    write(Out, ').\n').
  645do_portray_clause(Out, (:-module(Module, Exports)), Options) :-
  646    !,
  647    option(indent(LeftMargin), Options, 0),
  648    indent(Out, LeftMargin),
  649    ModuleIndent is LeftMargin+10,
  650    format(Out, ':- module(~q,', [Module]),
  651    portray_list(Exports, ModuleIndent, Out, Options),
  652    write(Out, ').\n').
  653do_portray_clause(Out, (:-Directive), Options) :-
  654    !,
  655    option(indent(LeftMargin), Options, 0),
  656    indent(Out, LeftMargin),
  657    write(Out, ':- '),
  658    DIndent is LeftMargin+3,
  659    portray_body(Directive, DIndent, noindent, 1199, Out, Options),
  660    full_stop(Out).
  661do_portray_clause(Out, Fact, Options) :-
  662    option(indent(LeftMargin), Options, 0),
  663    indent(Out, LeftMargin),
  664    portray_body(Fact, LeftMargin, noindent, 1200, Out, Options),
  665    full_stop(Out).
  666
  667clause_term((Head:-Body), Head, :-, Body).
  668clause_term((Head-->Body), Head, -->, Body).
  669
  670full_stop(Out) :-
  671    '$put_token'(Out, '.'),
  672    nl(Out).
 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.
  680portray_body(Var, _, _, Pri, Out, Options) :-
  681    var(Var),
  682    !,
  683    pprint(Out, Var, Pri, Options).
  684portray_body(!, _, _, _, Out, _) :-
  685    setting(listing:cut_on_same_line, true),
  686    !,
  687    write(Out, ' !').
  688portray_body((!, Clause), Indent, _, Pri, Out, Options) :-
  689    setting(listing:cut_on_same_line, true),
  690    \+ term_needs_braces((_,_), Pri),
  691    !,
  692    write(Out, ' !,'),
  693    portray_body(Clause, Indent, indent, 1000, Out, Options).
  694portray_body(Term, Indent, indent, Pri, Out, Options) :-
  695    !,
  696    nlindent(Out, Indent),
  697    portray_body(Term, Indent, noindent, Pri, Out, Options).
  698portray_body(Or, Indent, _, _, Out, Options) :-
  699    or_layout(Or),
  700    !,
  701    write(Out, '(   '),
  702    portray_or(Or, Indent, 1200, Out, Options),
  703    nlindent(Out, Indent),
  704    write(Out, ')').
  705portray_body(Term, Indent, _, Pri, Out, Options) :-
  706    term_needs_braces(Term, Pri),
  707    !,
  708    write(Out, '( '),
  709    ArgIndent is Indent + 2,
  710    portray_body(Term, ArgIndent, noindent, 1200, Out, Options),
  711    nlindent(Out, Indent),
  712    write(Out, ')').
  713portray_body((A,B), Indent, _, _Pri, Out, Options) :-
  714    !,
  715    infix_op(',', LeftPri, RightPri),
  716    portray_body(A, Indent, noindent, LeftPri, Out, Options),
  717    write(Out, ','),
  718    portray_body(B, Indent, indent, RightPri, Out, Options).
  719portray_body(\+(Goal), Indent, _, _Pri, Out, Options) :-
  720    !,
  721    write(Out, \+), write(Out, ' '),
  722    prefix_op(\+, ArgPri),
  723    ArgIndent is Indent+3,
  724    portray_body(Goal, ArgIndent, noindent, ArgPri, Out, Options).
  725portray_body(Call, _, _, _, Out, Options) :- % requires knowledge on the module!
  726    m_callable(Call),
  727    option(module(M), Options, user),
  728    predicate_property(M:Call, meta_predicate(Meta)),
  729    !,
  730    portray_meta(Out, Call, Meta, Options).
  731portray_body(Clause, _, _, Pri, Out, Options) :-
  732    pprint(Out, Clause, Pri, Options).
  733
  734m_callable(Term) :-
  735    strip_module(Term, _, Plain),
  736    callable(Plain),
  737    Plain \= (_:_).
  738
  739term_needs_braces(Term, Pri) :-
  740    callable(Term),
  741    functor(Term, Name, _Arity),
  742    current_op(OpPri, _Type, Name),
  743    OpPri > Pri,
  744    !.
 portray_or(+Term, +Indent, +Priority, +Out) is det
  748portray_or(Term, Indent, Pri, Out, Options) :-
  749    term_needs_braces(Term, Pri),
  750    !,
  751    inc_indent(Indent, 1, NewIndent),
  752    write(Out, '(   '),
  753    portray_or(Term, NewIndent, Out, Options),
  754    nlindent(Out, NewIndent),
  755    write(Out, ')').
  756portray_or(Term, Indent, _Pri, Out, Options) :-
  757    or_layout(Term),
  758    !,
  759    portray_or(Term, Indent, Out, Options).
  760portray_or(Term, Indent, Pri, Out, Options) :-
  761    inc_indent(Indent, 1, NestIndent),
  762    portray_body(Term, NestIndent, noindent, Pri, Out, Options).
  763
  764
  765portray_or((If -> Then ; Else), Indent, Out, Options) :-
  766    !,
  767    inc_indent(Indent, 1, NestIndent),
  768    infix_op((->), LeftPri, RightPri),
  769    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  770    nlindent(Out, Indent),
  771    write(Out, '->  '),
  772    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  773    nlindent(Out, Indent),
  774    write(Out, ';   '),
  775    infix_op(;, _LeftPri, RightPri2),
  776    portray_or(Else, Indent, RightPri2, Out, Options).
  777portray_or((If *-> Then ; Else), Indent, Out, Options) :-
  778    !,
  779    inc_indent(Indent, 1, NestIndent),
  780    infix_op((*->), LeftPri, RightPri),
  781    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  782    nlindent(Out, Indent),
  783    write(Out, '*-> '),
  784    portray_body(Then, NestIndent, noindent, RightPri, Out, Options),
  785    nlindent(Out, Indent),
  786    write(Out, ';   '),
  787    infix_op(;, _LeftPri, RightPri2),
  788    portray_or(Else, Indent, RightPri2, Out, Options).
  789portray_or((If -> Then), Indent, Out, Options) :-
  790    !,
  791    inc_indent(Indent, 1, NestIndent),
  792    infix_op((->), LeftPri, RightPri),
  793    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  794    nlindent(Out, Indent),
  795    write(Out, '->  '),
  796    portray_or(Then, Indent, RightPri, Out, Options).
  797portray_or((If *-> Then), Indent, Out, Options) :-
  798    !,
  799    inc_indent(Indent, 1, NestIndent),
  800    infix_op((->), LeftPri, RightPri),
  801    portray_body(If, NestIndent, noindent, LeftPri, Out, Options),
  802    nlindent(Out, Indent),
  803    write(Out, '*-> '),
  804    portray_or(Then, Indent, RightPri, Out, Options).
  805portray_or((A;B), Indent, Out, Options) :-
  806    !,
  807    inc_indent(Indent, 1, NestIndent),
  808    infix_op(;, LeftPri, RightPri),
  809    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  810    nlindent(Out, Indent),
  811    write(Out, ';   '),
  812    portray_or(B, Indent, RightPri, Out, Options).
  813portray_or((A|B), Indent, Out, Options) :-
  814    !,
  815    inc_indent(Indent, 1, NestIndent),
  816    infix_op('|', LeftPri, RightPri),
  817    portray_body(A, NestIndent, noindent, LeftPri, Out, Options),
  818    nlindent(Out, Indent),
  819    write(Out, '|   '),
  820    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.
  828infix_op(Op, Left, Right) :-
  829    current_op(Pri, Assoc, Op),
  830    infix_assoc(Assoc, LeftMin, RightMin),
  831    !,
  832    Left is Pri - LeftMin,
  833    Right is Pri - RightMin.
  834
  835infix_assoc(xfx, 1, 1).
  836infix_assoc(xfy, 1, 0).
  837infix_assoc(yfx, 0, 1).
  838
  839prefix_op(Op, ArgPri) :-
  840    current_op(Pri, Assoc, Op),
  841    pre_assoc(Assoc, ArgMin),
  842    !,
  843    ArgPri is Pri - ArgMin.
  844
  845pre_assoc(fx, 1).
  846pre_assoc(fy, 0).
  847
  848postfix_op(Op, ArgPri) :-
  849    current_op(Pri, Assoc, Op),
  850    post_assoc(Assoc, ArgMin),
  851    !,
  852    ArgPri is Pri - ArgMin.
  853
  854post_assoc(xf, 1).
  855post_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.
  864or_layout(Var) :-
  865    var(Var), !, fail.
  866or_layout((_;_)).
  867or_layout((_->_)).
  868or_layout((_*->_)).
  869
  870primitive(G) :-
  871    or_layout(G), !, fail.
  872primitive((_,_)) :- !, fail.
  873primitive(_).
 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.
  882portray_meta(Out, Call, Meta, Options) :-
  883    contains_non_primitive_meta_arg(Call, Meta),
  884    !,
  885    Call =.. [Name|Args],
  886    Meta =.. [_|Decls],
  887    format(Out, '~q(', [Name]),
  888    line_position(Out, Indent),
  889    portray_meta_args(Decls, Args, Indent, Out, Options),
  890    format(Out, ')', []).
  891portray_meta(Out, Call, _, Options) :-
  892    pprint(Out, Call, 999, Options).
  893
  894contains_non_primitive_meta_arg(Call, Decl) :-
  895    arg(I, Call, CA),
  896    arg(I, Decl, DA),
  897    integer(DA),
  898    \+ primitive(CA),
  899    !.
  900
  901portray_meta_args([], [], _, _, _).
  902portray_meta_args([D|DT], [A|AT], Indent, Out, Options) :-
  903    portray_meta_arg(D, A, Out, Options),
  904    (   DT == []
  905    ->  true
  906    ;   format(Out, ',', []),
  907        nlindent(Out, Indent),
  908        portray_meta_args(DT, AT, Indent, Out, Options)
  909    ).
  910
  911portray_meta_arg(I, A, Out, Options) :-
  912    integer(I),
  913    !,
  914    line_position(Out, Indent),
  915    portray_body(A, Indent, noindent, 999, Out, Options).
  916portray_meta_arg(_, A, Out, Options) :-
  917    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
]                       ]
  927portray_list([], _, Out, _) :-
  928    !,
  929    write(Out, []).
  930portray_list(List, Indent, Out, Options) :-
  931    nlindent(Out, Indent),
  932    write(Out, '[ '),
  933    EIndent is Indent + 2,
  934    portray_list_elements(List, EIndent, Out, Options),
  935    nlindent(Out, Indent),
  936    write(Out, ']').
  937
  938portray_list_elements([H|T], EIndent, Out, Options) :-
  939    pprint(Out, H, 999, Options),
  940    (   T == []
  941    ->  true
  942    ;   nonvar(T), T = [_|_]
  943    ->  write(Out, ','),
  944        nlindent(Out, EIndent),
  945        portray_list_elements(T, EIndent, Out, Options)
  946    ;   Indent is EIndent - 2,
  947        nlindent(Out, Indent),
  948        write(Out, '| '),
  949        pprint(Out, T, 999, Options)
  950    ).
 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.
  964pprint(Out, Term, _, Options) :-
  965    nonvar(Term),
  966    Term = {}(Arg),
  967    line_position(Out, Indent),
  968    ArgIndent is Indent + 2,
  969    format(Out, '{ ', []),
  970    portray_body(Arg, ArgIndent, noident, 1000, Out, Options),
  971    nlindent(Out, Indent),
  972    format(Out, '}', []).
  973pprint(Out, Term, Pri, Options) :-
  974    (   compound(Term)
  975    ->  compound_name_arity(Term, _, Arity),
  976        Arity > 0
  977    ;   is_dict(Term)
  978    ),
  979    \+ nowrap_term(Term),
  980    setting(listing:line_width, Width),
  981    Width > 0,
  982    (   write_length(Term, Len, [max_length(Width)|Options])
  983    ->  true
  984    ;   Len = Width
  985    ),
  986    line_position(Out, Indent),
  987    Indent + Len > Width,
  988    Len > Width/4,                 % ad-hoc rule for deeply nested goals
  989    !,
  990    pprint_wrapped(Out, Term, Pri, Options).
  991pprint(Out, Term, Pri, Options) :-
  992    listing_write_options(Pri, WrtOptions, Options),
  993    write_term(Out, Term, WrtOptions).
  994
  995nowrap_term('$VAR'(_)) :- !.
  996nowrap_term(_{}) :- !.                  % empty dict
  997nowrap_term(Term) :-
  998    functor(Term, Name, Arity),
  999    current_op(_, _, Name),
 1000    (   Arity == 2
 1001    ->  infix_op(Name, _, _)
 1002    ;   Arity == 1
 1003    ->  (   prefix_op(Name, _)
 1004        ->  true
 1005        ;   postfix_op(Name, _)
 1006        )
 1007    ).
 1008
 1009
 1010pprint_wrapped(Out, Term, _, Options) :-
 1011    Term = [_|_],
 1012    !,
 1013    line_position(Out, Indent),
 1014    portray_list(Term, Indent, Out, Options).
 1015pprint_wrapped(Out, Dict, _, Options) :-
 1016    is_dict(Dict),
 1017    !,
 1018    dict_pairs(Dict, Tag, Pairs),
 1019    pprint(Out, Tag, 1200, Options),
 1020    format(Out, '{ ', []),
 1021    line_position(Out, Indent),
 1022    pprint_nv(Pairs, Indent, Out, Options),
 1023    nlindent(Out, Indent-2),
 1024    format(Out, '}', []).
 1025pprint_wrapped(Out, Term, _, Options) :-
 1026    Term =.. [Name|Args],
 1027    format(Out, '~q(', Name),
 1028    line_position(Out, Indent),
 1029    pprint_args(Args, Indent, Out, Options),
 1030    format(Out, ')', []).
 1031
 1032pprint_args([], _, _, _).
 1033pprint_args([H|T], Indent, Out, Options) :-
 1034    pprint(Out, H, 999, Options),
 1035    (   T == []
 1036    ->  true
 1037    ;   format(Out, ',', []),
 1038        nlindent(Out, Indent),
 1039        pprint_args(T, Indent, Out, Options)
 1040    ).
 1041
 1042
 1043pprint_nv([], _, _, _).
 1044pprint_nv([Name-Value|T], Indent, Out, Options) :-
 1045    pprint(Out, Name, 999, Options),
 1046    format(Out, ':', []),
 1047    pprint(Out, Value, 999, Options),
 1048    (   T == []
 1049    ->  true
 1050    ;   format(Out, ',', []),
 1051        nlindent(Out, Indent),
 1052        pprint_nv(T, Indent, Out, Options)
 1053    ).
 listing_write_options(+Priority, -WriteOptions) is det
WriteOptions are write_term/3 options for writing a term at priority Priority.
 1061listing_write_options(Pri,
 1062                      [ quoted(true),
 1063                        numbervars(true),
 1064                        priority(Pri),
 1065                        spacing(next_argument)
 1066                      | Options
 1067                      ],
 1068                      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.
 1076nlindent(Out, N) :-
 1077    nl(Out),
 1078    indent(Out, N).
 1079
 1080indent(Out, N) :-
 1081    setting(listing:tab_distance, D),
 1082    (   D =:= 0
 1083    ->  tab(Out, N)
 1084    ;   Tab is N // D,
 1085        Space is N mod D,
 1086        put_tabs(Out, Tab),
 1087        tab(Out, Space)
 1088    ).
 1089
 1090put_tabs(Out, N) :-
 1091    N > 0,
 1092    !,
 1093    put(Out, 0'\t),
 1094    NN is N - 1,
 1095    put_tabs(Out, NN).
 1096put_tabs(_, _).
 inc_indent(+Indent0, +Inc, -Indent)
Increment the indent with logical steps.
 1103inc_indent(Indent0, Inc, Indent) :-
 1104    Indent is Indent0 + Inc*4.
 1105
 1106:- multifile
 1107    sandbox:safe_meta/2. 1108
 1109sandbox:safe_meta(listing(What), []) :-
 1110    not_qualified(What).
 1111
 1112not_qualified(Var) :-
 1113    var(Var),
 1114    !.
 1115not_qualified(_:_) :- !, fail.
 1116not_qualified(_).
 comment(+Format, +Args)
Emit a comment.
 1123comment(Format, Args) :-
 1124    stream_property(current_output, tty(true)),
 1125    setting(listing:comment_ansi_attributes, Attributes),
 1126    Attributes \== [],
 1127    !,
 1128    ansi_format(Attributes, Format, Args).
 1129comment(Format, Args) :-
 1130    format(Format, Args)