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