1/*  Part of Refactoring Tools for SWI-Prolog
    2
    3    Author:        Edison Mera
    4    E-mail:        efmera@gmail.com
    5    WWW:           https://github.com/edisonm/refactor
    6    Copyright (C): 2013, Process Design Center, Breda, The Netherlands.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(ref_replace,
   36          [replace/5,
   37           op(100,xfy,($@)),
   38           op(100,xfy,(@@))
   39          ]).

   59:- use_module(library(apply)).   60:- use_module(library(codesio)).   61:- use_module(library(lists)).   62:- use_module(library(occurs)).   63:- use_module(library(option)).   64:- use_module(library(pairs)).   65:- use_module(library(settings)).   66:- use_module(library(atomics_string)).   67:- use_module(library(solution_sequences)).   68:- use_module(library(neck)).   69:- use_module(library(term_size)).   70:- use_module(library(prolog_source), []). % expand/4
   71:- use_module(library(readutil)).   72:- use_module(library(fix_termpos)).   73:- use_module(library(mapnargs)).   74:- use_module(library(ref_changes)).   75:- use_module(library(ref_context)).   76:- use_module(library(ref_msgtype)).   77:- use_module(library(ref_message)).   78:- use_module(library(seek_text)).   79:- use_module(library(term_info)).   80:- use_module(library(sequence_list)).   81:- use_module(library(clambda)).   82:- use_module(library(mapilist)).   83:- use_module(library(linearize)).   84:- use_module(library(substitute)).   85:- use_module(library(subpos_utils)).   86:- use_module(library(transpose)).   87:- use_module(library(option_utils)).   88:- use_module(library(countsols)).   89:- use_module(library(conc_forall)).   90
   91:- init_expansors.   92
   93:- thread_local
   94    command_db/1.   95
   96:- multifile
   97    prolog:xref_open_source/2.  % +SourceId, -Stream
   98
   99:- thread_local
  100    rportray_pos/2,
  101    ref_position/3,
  102    rportray_skip/0.  103
  104:- meta_predicate
  105    apply_commands(?, +, +, ?, +, +, +, +, 5),
  106    fixpoint_file(+, +, 0 ),
  107    reindent(+, +, 0 ),
  108    replace(+, ?, ?, 0, :),
  109    rportray_list(+, +, 2, +, +),
  110    with_context(?, ?, ?, ?, -, ?, ?, ?, ?, ?, ?, ?, ?, 0, ?),
  111    with_cond_braces_2(4, ?, ?, ?, ?, ?, ?),
  112    with_counters(0, +),
  113    with_styles(0, +),
  114    with_output_to_string(-, 0 ),
  115    with_output_to_string(-, 0, 0 ),
  116    with_output_to_string(-, -, -, 0, 0 ).

 replace(+Level, +Pattern, +Into, :Expander, :Options) is det

Given a Level of operation, in all terms of the source code that subsumes Pattern, replace each Pattern with Into, provided that Expander succeeds. Expander can be used to finalize the shape of Into as well as to veto the expansion (if fails). The Options argument is used to control the behavior and scope of the replacement.

The predicate is efficient enough to be used also as a walker to capture all matches of Term, by printing a message and failing. For example:

replace(
    sent,
    (:-use_module(X)), _,
    (refactor_message(information, format("~w", [X])), fail),
    [file(F)])

will display all the occurrences of use_module/1 declarations in the file F. This would be useful for some complex refactoring scenarios.

The levels of operations stablishes where to look for matching terms, and could take one of the following values:

• goal Look for terms that match a given goal. This is implemented using the source reader
• term Look for sub-terms in a given read term recursivelly.
• sent Look for a matching term
• head Look for matching clause heads
• head_rec In a clause head, look for matching terms recursivelly
• body Look for a matching clause body
• body_rec In a clause body, look for matching terms recursivelly

  If level is sent, some special cases of Term are used to control its behavior:

• [] Adds an extra sentence at the top of the file.
• end_of_file Adds an extra sentence at the bottom of the file.
• [_|_] Replace list of sentences
• '$NODOT'(X) Print X but without the ending dot

  The term Into could contain certain hacks to control its behavior, as follows:

• X @@ Y Print the term X with the surroundings of Y (comments, etc.). This is useful to preserve comments in Y, if Y is going to dissapear in the transformed code.
• X $@ Y Print the term X following the format of Y.
• $@(X) Ignore automatic formatting following the pattern
• $$(X) Use write_term for X, this will ignore automatic formatting following the pattern and the special terms.
• '$G'(Into, Goal) Hook to execute Goal over the transformation generated by Into.
• '$NOOP'(X) Just Ignore, but process X to get possible expected side effects (for instance, '$G'/2 hacks).
• '$BODY'(X, Offset) Print X as if it where the body of a clause, that is, by introducing a new line per each conjunction and indentation starting at Offset position, plus extra characters if required.
• '$BODY'(X) Like '$BODY'(X, 0)
• '$BODYB'(X, Offset) Like '$BODY', but adding braces if required
• '$BODYB'(X) Like '$BODYB'(X, 0)
• '$CLAUSE'(X, Offset) Print X as if it where a clause, starting indentation at Offset position
• '$CLAUSE'(X) Like '$CLAUSE'(X, 0)
• '$LIST'(L) Print each element of L
• '$APP'(L1, L2) Print the result of append(L1, L2, L), but preserving the formats of L1 and L2 Note that if you use append/3 directly, the format of L1 will be lost
• '$LISTC'(L) Print each element of L in a way similar to portray_clause, but skip the dot and new line for the last element
• '$LISTC.NL'(L) Print each element of L in a way similar to portray_clause followed by a dot and a new line. If Level is sent, the tool will add this automatically if the replacement is a list, and in the case of an empty list, the sentence will be removed
• '$LIST,'(L) Print each element of L placing a comma between them
• '$LIST,_'(L) Print each element of L followed by a comma
• '$LIST,NL'(L) Print each element of L followed by a comma and a new line
• '$LISTNL'(L) Print each element of L followed by a new line.
• '$LIST.NL'(L) Print each element of L followed by a dot and a new line without clause layout
• '$TEXT'(T, N) Write T with higest priority and no quoted, byasing N characters to the right
• '$TEXT'(T) like '$TEXT'(T, 0)
• '$TEXTQ'(T, N) Like '$TEXT'(T, N) but quoted
• '$TEXTQ'(T) like '$TEXTQ'(T, 0)
• '$PRETXT'(Txt, T) Write Txt before T
• '$POSTXT'(T, Txt) Write Txt after T
• '$POS'(Name, Term) Preserves the current write position in Name, for further usage in hacks that have Offset as argument
• '$OUTPOS' In an Offset expression, is replaced by the current write position. For example:

  '$TEXT'(T,'$OUTPOS')

  is equivalent to:

  '$POS'(my_outpos, '$TEXT'(T, my_outpos))

• '$SEEK'(T, O) Seek O in the current output before to print T.
• '$TAB'(T, O) Print as many spaces as needed to make O the current write position

  Specific options for this predicate are:

• fixpoint(+Value) States that the replacement should be applied recursively, until no more modifications are caused by the replacement.

  Value=decreasing is the default, meaning that the recursion stops if the transformed term contains more terms that could potentially match. If the level is a non recursive one (see level_rec/2), such value is equivalent to none.

  Value=file means that the recursion is performed over the hole file.

  Value=term means that the recursion is performed over the transformed term.

  Value=true means that the recursion is applied up to reach the fixpoint without decreasing control. If Level is a non recursive one, the recursion is performed over the hole file, otherwise the recursion is only applied over the transformed term.

  Value=none don't apply the fixpoint algorithm.

• decrease_metric(:Metric) is a predicate of arity 3 of the form predicate(+Term, +Pattern, -Size) to define the metric used to perform the decreasing control (by default pattern_size/3).
• line(-Line) Unifies Line with the line number of the sentence being refactorized.
• clause(+Ref) Apply the refactoring to the clause refered by Ref.
• max_tries(MaxTries) Apply no more than MaxTries changes
• conj_width(+ConjWidth) Print several conjunctions in the same line, provided that they don't surpasses ConjWidth columns. Default is 160
• term_width(+TermWidth) Split long terms so that when printed, they don't surpasses TermWidth columns. Default is 160
• list_width(+ListWidth) Split long lists so that when printed, they don't surpasses ListWidth columns. Default is 160
• linearize(+Linearize) Linearize is a subset of [vars, atms], which will linearize the term to avoid bounded variables or atoms. In some refactoring scenarios this is important if we want to avoid ambiguities. For instance, supose that you want to replayce f(A, B), by f(B, A), but if one of the matching terms is f(X, X), the change will not be performed, even if the two arguments have different layouts. To avoid this we should use the option linearize([vars]). Default is [].
• sentence(-SentPattern) Unifies SentPattern with the sentence being processed. This is useful in some refactoring scenarios.
• expand(Expand) Apply the program transformation to let the goal_expansion hook in ref_replace.pl be called. It only have sense if the expansion level is goal, in such level the default value is yes, otherwise is no.
• expanded(Expanded) Unifies Expanded with the current sentence after the expansion has been applied (if applicable)
• cleanup_attributes(CleanupAttributes) Remove attributes that could potentially be present in the sentence being refactorized, in particular, if level is goal the term could contain the attribute '$var_info'. Default value is yes.
• max_changes(Max) Maximum number of changes performed by the refactoring.
• vars_prefix(Prefix) Prefix added to new variables. Default 'V'
• file(AFile) Unifies AFile with the file being reinstantiated. If AFile is instantiated on call of the predicate, limits the refactoring to such file.
• loaded(loaded) if Loaded is false (default), refactor non loaded files too.
• subterm_boundary(+Boundary) Processed by fix_termpos/2 to stablish the boundaries of the subterms.

  Options processed by read_term/2:

• variable_names(-VNL) Variable names
• comments(-Comments) Comments
• syntax_errors(SE) Default error
• subterm_positions(-SentPos) Subterm positions
• term_position(-Pos) Term position

  Other options are processed by the predicate option_module_files/2 and allows to select the files or modules that are going to be modified.

  412replace(Level, Patt, Into, Expander, MOptions) :-

  414    meta_options(replace_meta_option, MOptions, Options),
  415    with_styles(with_counters(do_replace(Level, Patt, Into, Expander, Options),
  416                              Options), [-singleton])

  416.
  417
  418replace_meta_option(decrease_metric).
  419
  420curr_style(Style, CurrStyle) :-
  421    arg(1, Style, Name),
  422    ( style_check(?(Name))
  423    ->CurrStyle = +Name
  424    ; CurrStyle = -Name
  425    ).
  426
  427with_styles(Goal, StyleL) :-
  428    maplist(curr_style, StyleL, OldStyleL),
  429    setup_call_cleanup(maplist(style_check, StyleL),
  430                       Goal,
  431                       maplist(style_check, OldStyleL)).
  432
  433% Note: To avoid this hook be applied more than once, we record the positions
  434% already refactorized in ref_position/3.
  435
  436remove_attribute(Attr, Var) :-
  437    del_attr(Var, Attr).
  438
  439:- public do_goal_expansion/2.  440
  441do_goal_expansion(Term, TermPos) :-
  442    compound(TermPos),
  443    arg(1, TermPos, From),
  444    arg(2, TermPos, To),
  445    nonvar(From),
  446    nonvar(To),
  447    refactor_context(file, File),
  448    \+ ref_position(File, From, To),
  449    assertz(ref_position(File, From, To)),
  450    term_variables(Term, Vars),
  451    ( refactor_context(cleanup_attributes, yes)
  452    ->maplist(remove_attribute('$var_info'), Vars)
  453    ; true
  454    ),
  455    refactor_context(goal_args, ga(Pattern, Into, Expander)),
  456    '$current_source_module'(M),
  457    b_getval('$variable_names', VNL),
  458    with_varnames(
  459        forall(substitute_term_norec(sub, M, Term, TermPos, 999, data(Pattern, Into, Expander, TermPos), Command),
  460               assertz(command_db(Command))),
  461        VNL).
  462
  463do_replace(Level, Patt, Into, Expander, Options) :-
  464    setup_call_cleanup(
  465        prepare_level(Level, Ref),
  466        apply_ec_term_level(Level, Patt, Into, Expander, Options),
  467        cleanup_level(Level, Ref)).
  468
  469prepare_level(goal, Ref) :-
  470    !,
  471    asserta((system:goal_expansion(G, P, _, _) :-
  472                 once(do_goal_expansion(G, P)),fail), Ref).
  473prepare_level(_, _).
  474
  475cleanup_level(goal, Ref) :- !,
  476    erase(Ref),
  477    retractall(ref_position(_, _, _)).
  478cleanup_level(_, _).
  479
  480with_counters(Goal, Options1) :-
  481    foldl(select_option_default,
  482          [max_tries(MaxTries)-MaxTries],
  483          Options1, Options),
  484    with_refactor_context(
  485        ( Goal,
  486          refactor_context(count, Count),
  487          refactor_context(tries, Tries),
  488          foldl(select_option_default,
  489                [changes(Count)-Count,
  490                 tries(Tries)  -Tries],
  491                Options, _),
  492          message_type(Type),
  493          print_message(Type,
  494                        format("~w changes of ~w attempts", [Count, Tries]))
  495        ),
  496        [max_tries],
  497        [MaxTries]
  498    ).
  499
  500param_module_file(clause(CRef), M, File) :-
  501    clause_property(CRef, file(File)),
  502    clause_property(CRef, module(M)).
  503param_module_file(mfiled(MFileD), M, File) :-
  504    get_dict(M1, MFileD, FileD),
  505    ( M1 = (-)
  506    ->true
  507    ; M = M1
  508    ),
  509    get_dict(File, FileD, _).
  510
  511apply_ec_term_level(Level, Patt, Into, Expander, Options1) :-
  512    (Level = goal -> DExpand=yes ; DExpand = no),
  513    (Level = sent -> SentPattern = Patt ; true), % speed up
  514    option(module(M), Options1, M),
  515    foldl(select_option_default,
  516          [max_tries(MaxTries)-MaxTries,
  517           syntax_errors(SE)-error,
  518           subterm_positions(SentPos)-SentPos,
  519           term_position(Pos)-Pos,
  520           conj_width(ConjWidth)-160, % In (_,_), try to wrap lines
  521           term_width(TermWidth)-160, % In terms, try to wrap lines
  522           list_width(ListWidth)-160, % In lists, try to wrap lines
  523           linearize(Linearize)-[],
  524           sentence(SentPattern)-SentPattern,
  525           comments(Comments)-Comments,
  526           expand(Expand)-DExpand,
  527           expanded(Expanded)-Expanded,
  528           cleanup_attributes(CleanupAttributes)-yes,
  529           fixpoint(FixPoint)-decreasing,
  530           max_changes(Max)-Max,
  531           variable_names(VNL)-VNL,
  532           vars_prefix(Prefix)-'V',
  533           file(AFile)-AFile,
  534            % By default refactor even non loaded files
  535           loaded(Loaded)-false
  536          ],
  537          Options1, Options2),
  538    ( option(clause(CRef), Options2)
  539    ->MFileParam = clause(CRef),
  540      clause_property(CRef, line_count(Line)),
  541      merge_options([line(Line)], Options2, Options3)
  542    ; option_module_files([loaded(Loaded), file(AFile)|Options2], MFileD),
  543      MFileParam = mfiled(MFileD),
  544      Options3 = Options2
  545    ),
  546    Options = [syntax_errors(SE),
  547               subterm_positions(SentPos),
  548               term_position(Pos),
  549               variable_names(VNL),
  550               conj_width(ConjWidth),
  551               term_width(TermWidth),
  552               list_width(ListWidth),
  553               comments(Comments)|Options3],
  554    ignore(( var(AFile),
  555             File = AFile
  556           )),
  557    setup_call_cleanup(
  558        ( '$current_source_module'(OldM)
  559          % freeze(M, '$set_source_module'(_, M))
  560        ),
  561        process_sentences(
  562            MFileParam, FixPoint, Max, SentPattern, Options, CleanupAttributes, M, File, Expanded, Expand, Pos,
  563            ga(Patt, Into, Expander), Linearize, MaxTries, Prefix, Level, data(Patt, Into, Expander, SentPos)),
  564        '$set_source_module'(_, OldM)).
  565
  566param_module_file_sorted(MFileParam, M, File) :-
  567    order_by([desc(Size)],
  568             ( param_module_file(MFileParam, M, File),
  569               ignore(catch(size_file(File, Size), _, Size = 0 ))
  570             )).
  571
  572process_sentences(
  573    MFileParam, FixPoint, Max, SentPattern, Options, CleanupAttributes, M, File, Expanded, Expand,
  574    Pos, GoalArgs, Linearize, MaxTries, Prefix, Level, Data) :-
  575    index_change(Index),
  576    ini_counter(0, STries),
  577    ini_counter(0, SCount),
  578    option(concurrent(Conc), Options, true),
  579    cond_forall(
  580        Conc,
  581        param_module_file_sorted(MFileParam, M, File),
  582        process_sentence_file(
  583            Index, FixPoint, Max, SentPattern, Options, CleanupAttributes,
  584            M, File, Expanded, Expand, Pos, GoalArgs, Linearize, MaxTries,
  585            Prefix, Level, Data, Tries, Count),
  586        ( inc_counter(STries, Tries, _),
  587          inc_counter(SCount, Count, _)
  588        )),
  589    STries = count(Tries),
  590    SCount = count(Count),
  591    set_refactor_context(tries, Tries),
  592    set_refactor_context(count, Count).
  593
  594fixpoint_file(none, _, Goal) :- ignore(Goal).
  595fixpoint_file(true, Max, Goal) :-
  596    repeat,
  597      set_refactor_context(modified, false),
  598      ignore(Goal),
  599      refactor_context(count, Count),
  600      ( nonvar(Max),
  601        Count >= Max
  602      ->!
  603      ; true
  604      ),
  605      ( refactor_context(modified, false)
  606      ->!
  607      ; print_message(informational,
  608                      format("Restarting expansion", [])),
  609        fail
  610      ).
  611
  612rec_fixpoint_file(rec,   P, F) :- rec_ff(P, F).
  613rec_fixpoint_file(norec, P, F) :- norec_ff(P, F).
  614
  615rec_ff(decreasing, none).
  616rec_ff(file,       true).
  617rec_ff(term,       none).
  618rec_ff(true,       none).
  619rec_ff(none,       none).
  620
  621norec_ff(decreasing, none).
  622norec_ff(file,       true).
  623norec_ff(term,       none).
  624norec_ff(true,       true).
  625norec_ff(none,       none).
  626
  627process_sentence_file(Index, FixPoint, Max, SentPattern, Options, CleanupAttributes,
  628                      M, File, Expanded, Expand, Pos, GoalArgs,
  629                      Linearize, MaxTries, Prefix, Level, Data, Tries, Count) :-
  630    maplist(set_refactor_context,
  631            [bindings, cleanup_attributes, comments, expanded, file, goal_args, modified,
  632             tries, count, max_tries, options, pos, prefix, sent_pattern, sentence, subpos],
  633            [Bindings, CleanupAttributes,  Comments, Expanded, File, GoalArgs,  false,
  634             0,     0,     MaxTries,  Options, Pos, Prefix, SentPattern,  Sent,     SentPos]),
  635    \+ \+ ( option(comments(Comments),  Options, Comments),
  636            option(subterm_positions(SentPos), Options, SentPos),
  637            option(variable_names(VNL), Options, VNL),
  638            option(term_position(Pos), Options, Pos),
  639            level_rec(Level, Rec),
  640            rec_fixpoint_file(Rec, FixPoint, FPFile),
  641            fixpoint_file(FPFile, Max,
  642                          apply_commands(
  643                              Index, File, Level, M, Rec, FixPoint, Max, Pos,
  644                              gen_module_command(
  645                                  SentPattern, Options, Expand, SentPos, Expanded,
  646                                  Linearize, Sent, VNL, Bindings, Data)))
  647          ),
  648    refactor_context(tries, Tries),
  649    refactor_context(count, Count).
  650
  651binding_varname(VNL, Var=Term) -->
  652    ( { atomic(Term),
  653        Term \= [],
  654        atomic_concat('_Atm_', Term, Name)
  655      ; member(Name=Var1, VNL),
  656        Var1==Term
  657      }
  658    ->[Name=Var]
  659    ; []
  660    ).
  661
  662gen_module_command(SentPattern, Options, Expand, SentPos, Expanded, Linearize,
  663                   Sent, VNL, Bindings, Data, Level, M, In, Text, Command) :-
  664    ref_fetch_term_info(SentPattern, RawSent, In, Options, Once),
  665    b_setval('$variable_names', VNL),
  666    set_refactor_context(text, Text),
  667    expand_if_required(Expand, M, RawSent, SentPos, In, Expanded),
  668    make_linear_if_required(RawSent, Linearize, Sent, Bindings),
  669    foldl(binding_varname(VNL), Bindings, RVNL, VNL),
  670    S = solved(no),
  671    ( true
  672    ; arg(1, S, yes)
  673    ->cond_cut_once(Once),
  674      fail
  675    ),
  676    set_refactor_context(variable_names, RVNL),
  677    substitute_term_level(Level, M, Sent, SentPos, 1200, Data, Command),
  678    nb_setarg(1, S, yes).
  679
  680cond_cut_once(once).
  681cond_cut_once(mult(CP)) :- prolog_cut_to(CP).
  682
  683ref_fetch_term_info(SentPattern, Sent, In, Options, once) :-
  684    nonvar(SentPattern),
  685    memberchk(SentPattern, [[], end_of_file]),
  686    !,
  687    ref_term_info_file(SentPattern, Sent, In, Options).
  688ref_fetch_term_info(SentPattern, Sent, In, Options, mult(CP)) :-
  689    repeat,
  690      prolog_current_choice(CP),
  691      ( fetch_term_info(SentPattern, Sent, Options, In)
  692      ; !,
  693        fail
  694      ).
  695
  696ref_term_info_file(end_of_file, end_of_file, In, Options) :-
  697    seek(In, 0, eof, Size),
  698    ref_term_null_option(Size, In, Options).
  699ref_term_info_file([], [], In, Options) :-
  700    seek(In, 0, bof, 0),
  701    ref_term_null_option(0, In, Options).
  702
  703ref_term_null_option(Size, In, Options) :-
  704    option(comments([]), Options),
  705    option(subterm_positions(Size-Size), Options),
  706    stream_property(In, position(Pos)),
  707    option(term_position(Pos), Options),
  708    option(variable_names([]), Options).
  709
  710expand_if_required(Expand, M, Sent, SentPos, In, Expanded) :-
  711    ( Expand = no
  712    ->Expanded = Sent
  713    ; '$expand':expand_terms(prolog_source:expand, Sent, SentPos, In, Expanded)
  714    ),
  715    ignore(( '$set_source_module'(CM, CM),
  716             M = CM
  717           )),
  718    prolog_source:update_state(Sent, Expanded, M).
  719
  720make_linear_if_required(Sent, Linearize, Linear, Bindings) :-
  721    foldl(linearize, Linearize, Sent-Bindings, Linear-[]).
  722
  723linearize(Which, Sent-Bindings1, Linear-Bindings) :-
  724    linearize(Which, Sent, Linear, Bindings1, Bindings).
  725
  726prolog:xref_open_source(File, Fd) :-
  727    nb_current(ti_open_source, yes),
  728    !,
  729    ( pending_change(_, File, Text)
  730    ->true
  731    ; read_file_to_string(File, Text, [])
  732    ),
  733    open_codes_stream(Text, Fd).
  734    % set_refactor_context(text, Text). % NOTE: update_state/2 has the side effect of
  735                                     % modify refactor_text
  736
  737substitute_term_level(goal, _, _, _, _, _, Cmd) :-
  738    retract(command_db(Cmd)).
  739substitute_term_level(term, M, Sent, SentPos, Priority, Data, Cmd) :-
  740    substitute_term_rec(M, Sent, SentPos, Priority, Data, Cmd).
  741substitute_term_level(sent, M, Sent, SentPos, Priority, Data, Cmd) :-
  742    substitute_term_norec(top, M, Sent, SentPos, Priority, Data, Cmd).
  743substitute_term_level(head, M, Sent, SentPos, Priority, Data, Cmd) :-
  744    substitute_term_head(norec, M, Sent, SentPos, Priority, Data, Cmd).
  745substitute_term_level(head_rec, M, Sent, SentPos, Priority, Data, Cmd) :-
  746    substitute_term_head(rec, M, Sent, SentPos, Priority, Data, Cmd).
  747substitute_term_level(body, M, Sent, SentPos, _, Data, Cmd) :-
  748    substitute_term_body(norec, M, Sent, SentPos, Data, Cmd).
  749substitute_term_level(body_rec, M, Sent, SentPos, _, Data, Cmd) :-
  750    substitute_term_body(rec, M, Sent, SentPos, Data, Cmd).
  751
  752substitute_term_body(Rec, M, Sent, parentheses_term_position(_, _, TermPos), Data, Cmd) :-
  753    !,
  754    substitute_term_body(Rec, M, Sent, TermPos, Data, Cmd).
  755substitute_term_body(Rec, M, (_ :- Body), term_position(_, _, _, _, [_, BodyPos]), Data,
  756                     Cmd) :-
  757    term_priority((_ :- Body), M, 2, Priority),
  758    substitute_term(Rec, sub, M, Body, BodyPos, Priority, Data, Cmd).
  759substitute_term_body(Rec, M, (_ --> Body), term_position(_, _, _, _, [_, BodyPos]), Data,
  760                     Cmd) :-
  761    term_priority((_ --> Body), M, 2, Priority),
  762    substitute_term(Rec, sub, M, Body, BodyPos, Priority, Data, Cmd).
  763
  764substitute_term_head(Rec, M, Clause, parentheses_term_position(_, _, TermPos), Priority,
  765                     Data, Cmd) :-
  766    !,
  767    substitute_term_head(Rec, M, Clause, TermPos, Priority, Data, Cmd).
  768substitute_term_head(Rec, M, Clause, TermPos, Priority, Data, Cmd) :-
  769    ( ( Clause = (MHead :- _)
  770      ; Clause = (MHead --> _)
  771      )
  772    ->( nonvar(MHead),
  773        MHead = IM:Head
  774      ->term_priority(IM:Head, M, 2, HPriority),
  775        term_position(_, _, _, _, [MHPos, _]) = TermPos,
  776        mhead_pos(MHPos, HeadPos)
  777      ; Head = MHead,
  778        term_priority(Clause, M, 1, HPriority),
  779        term_position(_, _, _, _, [HeadPos, _]) = TermPos
  780      )
  781    ; Clause \= (:- _),
  782      Head = Clause,
  783      HPriority = Priority,
  784      HeadPos = TermPos
  785    ),
  786    substitute_term(Rec, sub, M, Head, HeadPos, HPriority, Data, Cmd).
  787
  788mhead_pos(parentheses_term_position(_, _, Pos), HPos) :- !, mhead_pos(Pos, HPos).
  789mhead_pos(term_position(_, _, _, _, [_, HPos]), HPos).
  790
  791substitute_term(rec, _, M, Term, TermPos, Priority, Data, Cmd) :-
  792    substitute_term_rec(M, Term, TermPos, Priority, Data, Cmd).
  793substitute_term(norec, Level, M, Term, TermPos, Priority, Data, Cmd) :-
  794    substitute_term_norec(Level, M, Term, TermPos, Priority, Data, Cmd).
  795
  796%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  797% ANCILLARY PREDICATES:
  798%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  799
  800level_rec(goal,     norec).
  801level_rec(term,     rec).
  802level_rec(sent,     norec).
  803level_rec(head,     norec).
  804level_rec(head_rec, rec).
  805level_rec(body,     norec).
  806level_rec(body_rec, rec).
  807
  808rec_fixpoint_term(norec, _, not).
  809rec_fixpoint_term(rec,   P, F) :- rec_ft(P, F).
  810
  811rec_ft(decreasing, dec).
  812rec_ft(file,       not).
  813rec_ft(term,       rec).
  814rec_ft(true,       rec).
  815rec_ft(none,       not).
  816rec_ft(false,      not).
  817
  818% This is weird due to the operators
  819apply_commands(Index, File, Level, M, Rec, FixPoint, Max, Pos, GenModuleCommand) :-
  820    ( pending_change(_, File, Text1)
  821    ->true
  822    ; exists_file(File)
  823    ->read_file_to_string(File, Text1, [])
  824    ; Text1 = ""
  825    ),
  826    rec_fixpoint_term(Rec, FixPoint, FPTerm),
  827    with_refactor_context(
  828        with_source_file(
  829            File, In,
  830            apply_commands_stream(
  831                FPTerm, GenModuleCommand, File, Level, M, nocs, Max, Pos, In, Text1, Text)),
  832        [file], [File]),
  833    ( Text1 \= Text
  834    ->nb_set_refactor_context(modified, true),
  835      save_change(Index, File-Text)
  836    ; true
  837    ).
  838
  839decreasing_recursion(nocs, _).
  840decreasing_recursion(subst(_, _, _, _, S1),
  841                     subst(_, _, _, _, S2)) :-
  842    freeze(S2, S1 > S2).
  843
  844do_recursion(dec(G), C, G, C).
  845do_recursion(rec(G), _, G, nocs).
  846
  847rec_command_info(not, _, not).
  848rec_command_info(rec, G, rec(C)) :- copy_term(G, C).
  849rec_command_info(dec, G, dec(C)) :- copy_term(G, C).
  850
  851increase_counter(Count1) :-
  852    refactor_context(count, Count),
  853    succ(Count, Count1),
  854    nb_set_refactor_context(count, Count1).
  855
  856fix_exception(error(Error, stream(_,  Line, Row, Pos)), File,
  857              error(Error, file(File, Line, Row, Pos))) :- !.
  858fix_exception(E, _, E).
  859
  860do_genmcmd(GenModuleCommand, File, Level, M, CS, Max, In, Text, Command) :-
  861    decreasing_recursion(CS, Command),
  862    catch(call(GenModuleCommand, Level, M, In, Text, Command),
  863          E1,
  864          ( fix_exception(E1, File, E),
  865            print_message(error, E),
  866            fail
  867          )),
  868    increase_counter(Count1),
  869    ( nonvar(Max),
  870      Count1 >= Max
  871    ->!
  872    ; true
  873    ).
  874
  875:- thread_local subtext_db/2.  876
  877apply_commands_stream(FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text) :-
  878    retractall(subtext_db(_, _)),
  879    apply_commands_stream(1, FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text).
  880
  881apply_commands_stream(RecNo, FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text) :-
  882    IPosText = ipt(0 ),
  883    rec_command_info(FPTerm, GenModuleCommand, CI),
  884    ignore(
  885        forall(
  886            do_genmcmd(GenModuleCommand, File, Level, M, CS, Max, In, Text1, Command),
  887            apply_commands_stream_each(
  888                RecNo, FPTerm, File, CI, M, Max, Pos, Command, Text1, IPosText))),
  889    IPosText = ipt(Pos1),
  890    sub_string(Text1, Pos1, _, 0, Text3),
  891    findall(SubText, retract(subtext_db(RecNo, SubText)), TextL, [Text3]),
  892    atomics_to_string(TextL, Text).
  893
  894apply_commands_stream_each(RecNo1, FPTerm, File, CI, M, Max, Pos1, Command, Text, IPosText) :-
  895    apply_change(Text, M, Command, FromToPText1),
  896    ( do_recursion(CI, Command, GenModuleCommand, CS),
  897      FromToPText1 = t(From, To, PasteText1),
  898      get_out_pos(Text, Pos1, From, LPos),
  899      line_pos(LPos, atom(LeftText)),
  900      atomics_to_string([LeftText, PasteText1], Text1),
  901      setup_call_cleanup(
  902          ( atomics_to_string([Text1, "."], TextS),
  903            open_codes_stream(TextS, In),
  904            stream_property(In, position(Pos3)),
  905            succ(RecNo1, RecNo)
  906          ),
  907          with_refactor_context(
  908              apply_commands_stream(RecNo, FPTerm, GenModuleCommand, File,
  909                                    term, M, CS, Max, Pos3, In, Text1, Text2),
  910              [text], [TextS]),
  911          close(In))
  912    ->atomics_string([LeftText, PasteText2], Text2),
  913      FromToPText = t(From, To, PasteText2)
  914    ; FromToPText = FromToPText1
  915    ),
  916    string_concat_to(RecNo1, Text, FromToPText, IPosText).
  917
  918get_out_pos(Text, Pos, From, LPos) :-
  919    stream_position_data(line_position, Pos, LPos1),
  920    stream_position_data(char_count, Pos, Pos1),
  921    Length is max(0, From-Pos1),
  922    sub_string(Text, Pos1, Length, _, Text2),
  923    with_output_to(atom(_),
  924                   ( line_pos(LPos1),
  925                     format("~s", [Text2]),
  926                     stream_property(current_output, position(Pos2)),
  927                     stream_position_data(line_position, Pos2, LPos)
  928                   )).
  929
  930/* This was too slow --EMM
  931get_out_pos(RText, Pos-Text1, From, LPos) :-
  932    Length is max(0, From - Pos),
  933    sub_string(RText, Pos, Length, _, Text2),
  934    string_concat(Text1, Text2, Text3),
  935    textpos_line(Text3, From, LPos).
  936*/
  937
  938string_concat_to(RecNo, Text, t(From, To, Text2), IPos) :-
  939    IPos = ipt(Pos),
  940    Length is max(0, From - Pos),
  941    sub_string(Text, Pos, Length, _, Text1),
  942    nb_setarg(1, IPos, To),
  943    assertz(subtext_db(RecNo, Text1)),
  944    ignore(space_succ_operators(RecNo, Text1, Text2)),
  945    assertz(subtext_db(RecNo, Text2)).

 space_succ_operators(+RecNo, +Text1, +Text2) is semidet

Adds an extra space to avoid melting of successive operators

  950space_succ_operators(RecNo, Text1, Text2) :-
  951    sub_string(Text1, _, 1, 0, Char1),
  952    sub_string(Text2, 0, 1, _, Char2),
  953    char_type(Char1, prolog_symbol),
  954    char_type(Char2, prolog_symbol),
  955    assertz(subtext_db(RecNo, " ")).
  956
  957gen_new_variable_name(VNL, Prefix, Count, Name) :-
  958    atom_concat(Prefix, Count, Name),
  959    \+ member(Name=_, VNL), !.
  960gen_new_variable_name(VNL, Prefix, Count1, Name) :-
  961    succ(Count1, Count),
  962    gen_new_variable_name(VNL, Prefix, Count, Name).
  963
  964will_occurs(Var, Sent, Pattern, Into, VNL, T) :-
  965    findall(N,
  966            ( member(Name=Var1, VNL),
  967              Name \= '_',
  968              Var==Var1
  969            ->member(Name=Var2, VNL),
  970              will_occurs(Var2, Sent, Pattern, Into, N)
  971            ; will_occurs(Var,  Sent, Pattern, Into, N)
  972            ), NL),
  973    sum_list(NL, T).
  974
  975will_occurs(Var, Sent, Pattern, Into, N) :-
  976    occurrences_of_var(Var, Sent, SN),
  977    occurrences_of_var(Var, Pattern, PN),
  978    occurrences_of_var(Var, Into, IN),
  979    N is SN-PN+IN.
  980
  981gen_new_variable_names([], _, _, _, _, _, _, VNL, VNL).
  982gen_new_variable_names([Var|VarL], [Name1|NameL], Prefix, Count1,
  983                       Sent, Pattern, Into, VNL1, VNL) :-
  984    ( nonvar(Name1)
  985    ->VNL2 = VNL1,
  986      Count = Count1
  987    ; will_occurs(Var, Sent, Pattern, Into, VNL1, N),
  988      N > 1
  989    ->gen_new_variable_name(VNL1, Prefix, Count1, Name),
  990      succ(Count1, Count),
  991      VNL2 = [Name=Var|VNL1]
  992    ; VNL2 = ['_'=Var|VNL1],
  993      Count = Count1
  994    ),
  995    gen_new_variable_names(VarL, NameL, Prefix, Count, Sent, Pattern, Into, VNL2, VNL).
  996
  997level_1_term(V) :- var(V), !, fail.
  998level_1_term('$RM').
  999level_1_term('$C'(_, Into)) :- level_1_term(Into).
 1000level_1_term('$TEXT'(_)).
 1001level_1_term('$TEXT'(_, _)).
 1002level_1_term('$TEXTQ'(_)).
 1003level_1_term('$TEXTQ'(_, _)).
 1004level_1_term('$LISTC'(_)).
 1005level_1_term('$LISTC.NL'(_)).
 1006
 1007apply_change(Text, M, subst(TermPos, Options, Term, Into, _),
 1008             t(From, To, PasteText)) :-
 1009    ( level_1_term(Into)
 1010    ->ITermPos = TermPos
 1011    ; get_innerpos(TermPos, ITermPos)
 1012    ),
 1013    arg(1, ITermPos, From),
 1014    arg(2, ITermPos, To1),
 1015    call_cleanup(
 1016        with_output_to_string(
 1017            PasteText,
 1018            with_from(
 1019                with_termpos(
 1020                    print_expansion_1(Into, Term, ITermPos,
 1021                                      [ module(M),
 1022                                        text(Text)
 1023                                        |Options
 1024                                      ], Text, To1, To),
 1025                    TermPos),
 1026                From)
 1027        ),
 1028        retractall(rportray_pos(_, _))).
 1029
 1030wr_options([portray_goal(ref_replace:rportray),
 1031            spacing(next_argument),
 1032            numbervars(true),
 1033            quoted(true),
 1034            partial(true),
 1035            character_escapes(false)]).
 1036
 1037call_expander(Expander, TermPos, Pattern, Into) :-
 1038    refactor_context(tries, Tries),
 1039    refactor_context(max_tries, MaxTries),
 1040    ( nonvar(MaxTries)
 1041    ->Tries < MaxTries
 1042    ; true
 1043    ),
 1044    succ(Tries, Tries1),
 1045    nb_set_refactor_context(tries, Tries1),
 1046    with_refactor_context(catch(once(Expander), Error,
 1047                              ( refactor_message(error, Error),
 1048                                fail
 1049                              )),
 1050                        [termpos, pattern, into],
 1051                        [TermPos, Pattern, Into]).
 1052
 1053special_term(top, Term1, Into1, Into7, Into) :-
 1054    ( nonvar(Into1),
 1055      escape_term(Into1)
 1056    ->Into = Into7
 1057    ; nonvar(Term1),
 1058      memberchk(Term1, [[], end_of_file])
 1059    ->( \+ is_list(Into1)
 1060      ->List = [Into7]
 1061      ; List = Into7
 1062      ),
 1063      Into = '$LISTC.NL'(List)
 1064    ; var(Into1)
 1065    ->Into = Into7
 1066    ; is_list(Into1),
 1067      same_length(Into1, Term1)
 1068    ->Into = Into7
 1069    ; Into1 = [_|_]
 1070    ->Into = '$LISTC'(Into7)
 1071    ; Into1 = []
 1072    ->Into = '$RM'
 1073    ; Into1 = '$C'(C, [])
 1074    ->Into = '$C'(C, '$RM')
 1075    ; Into = Into7
 1076    ).
 1077special_term(sub_cw, _, _, Term, Term).
 1078special_term(sub,    _, _, Term, Term).
 1079
 1080trim_hacks(Term, Trim) :-
 1081    substitute(trim_hack, Term, Trim).
 1082
 1083trim_hack(Term, Trim) :-
 1084    nonvar(Term),
 1085    do_trim_hack(Term, Trim1),
 1086    trim_hacks(Trim1, Trim).
 1087
 1088do_trim_hack('$@'(Term, _), Term).
 1089do_trim_hack('@@'(Term, _), Term).
 1090do_trim_hack('$C'(_, Term), Term).
 1091do_trim_hack(\\(Term), Term).
 1092do_trim_hack('$NOOP'(_), '').
 1093
 1094remove_hacks(H, T) :-
 1095    trim_hacks(H, S),
 1096    deref_substitution(S, T).
 1097
 1098match_vars_with_names(VNL1, Var, Name) :-
 1099    ignore(( member(Name=Var1, VNL1),
 1100             Var == Var1
 1101           )).
 1102
 1103gen_new_variable_names(Sent, Term, Into, VNL, NewVNL) :-
 1104    refactor_context(prefix, Prefix),
 1105    refactor_context(variable_names, VNL1),
 1106    trim_hacks(Into, TInto),
 1107    term_variables(TInto, VarL),
 1108    maplist(match_vars_with_names(VNL1), VarL, NameL),
 1109    gen_new_variable_names(VarL, NameL, Prefix, 1, Sent, Term, TInto, VNL1, VNL),
 1110    once(append(NewVNL, VNL1, VNL)).
 1111
 1112check_bindings(Sent, Sent2, Options) :-
 1113    ( Sent=@=Sent2
 1114    ->true
 1115    ; option(show_left_bindings(Show), Options, false),
 1116      ( Show = true
 1117      ->refactor_message(warning, format("Bindings occurs: ~w \\=@= ~w.", [Sent2, Sent]))
 1118      ; true
 1119      )
 1120    ).
 1121
 1122:- public
 1123       pattern_size/3. 1124
 1125pattern_size(Term, Pattern, Size) :-
 1126    findall(S,
 1127            ( sub_term(Sub, Term),
 1128              subsumes_term(Pattern, Sub),
 1129              term_size(Sub, S)
 1130            ), SL),
 1131    sum_list(SL, Size).
 1132
 1133fix_subtermpos(Pattern, _, _, _, _) :-
 1134    nonvar(Pattern),
 1135    memberchk(Pattern, [[], end_of_file]), !.
 1136fix_subtermpos(_, Into, Sub, TermPos, Options) :-
 1137    fix_subtermpos(Sub, Into, TermPos, Options).
 1138
 1139fix_subtermpos(sub_cw, _,    _, _). % Do nothing
 1140fix_subtermpos(sub,    _,    TermPos, Options) :-
 1141    fix_subtermpos(TermPos, Options).
 1142fix_subtermpos(top,    Into, TermPos, Options) :-
 1143    ( Into \= [_|_]
 1144    ->fix_termpos(   TermPos, Options)
 1145    ; fix_subtermpos(TermPos, Options)
 1146    ).

 substitute_term_norec(+Sub, +M, +Term, +Priority, +Pattern, +Into, :Expander, +TermPos, SentPos, Cmd) is nondet

Non-recursive version of substitute_term_rec/6.

 1152substitute_term_norec(Sub, M, Term, TermPos1, Priority,
 1153                      data(Pattern1, Into1, Expander, SentPos),
 1154                      subst(TTermPos1, SubstOptions, Term, Into, Size)) :-
 1155    wr_options(WriteOptions),
 1156    refactor_context(sentence,     Sent),
 1157    refactor_context(sent_pattern, SentPattern),
 1158    subsumes_term(SentPattern-Pattern1, Sent-Term),
 1159    refactor_context(options, Options),
 1160    merge_options([priority(Priority),
 1161                   variable_names(VNL),
 1162                   new_variable_names(NewVNL)
 1163                   |WriteOptions], Options, SubstOptions),
 1164    option(decrease_metric(Metric), Options, ref_replace:pattern_size),
 1165    call(Metric, Term, Pattern1, Size),
 1166    with_context(Sub, M, Term, TermPos1, TTermPos1, Priority, Sent, SentPos, Pattern1, Into1, Into, VNL, NewVNL, Expander, Options).
 1167
 1168val_subs(V, S) -->
 1169    ( {var(S)}
 1170    ->{V=S}
 1171    ; [V=S]
 1172    ).
 1173
 1174with_context(Sub, M, Term1, TermPos1, TTermPos1, Priority, Sent1, SentPos1, Pattern1, Into1, Into, VNL, NewVNL, Expander1, Options) :-
 1175    % Suffix numbers in variables should refer to:
 1176    % 1: Term changes during Expander1 execution
 1177    % 2: Substitutions instead of unifications in Into2 due to Term changes in (1)
 1178    % 3: The raw Term, as read from the file
 1179    % 4: Pattern changes during Expander1 execution
 1180    % 5: Original pattern
 1181    refactor_context(sent_pattern, SentPattern1),
 1182    copy_term(SentPattern1-Pattern1-Into1, _Sent5-Term5-Into5),
 1183    copy_term(SentPattern1-Pattern1-Into1, _Sent4-Term4-Into4),
 1184    Pattern1 = Term1,
 1185    SentPattern1 = Sent1,
 1186    term_variables(Sent1-Term1-Into1, Vars1),
 1187    copy_term(Sent1-Term1-Into1-Vars1, Sent3-Term3-Into3-Vars3),
 1188    call_expander(Expander1, TermPos1, Term4, Into4),
 1189    Term2 = Term3,
 1190    foldl(val_subs, Vars3, Vars1, ValSubs, []),
 1191    substitute_values(ValSubs, Into3, Into2),
 1192    check_bindings(Sent1, Sent3, Options),
 1193    gen_new_variable_names(Sent1, Term1, Into1, VNL, NewVNL),
 1194    trim_fake_pos(TermPos1, TTermPos1, N),
 1195    substitute_value(TermPos1, TTermPos1, SentPos1, TSentPos1),
 1196    trim_fake_args_ll(N, [[   _, Term2, Into2],
 1197                          [orig, Term5, Into5],
 1198                          [pexp, Term4, Into4],
 1199                          %[rawt, Term3, Into3], % Not needed since it is implicit in (2)
 1200                          [texp, Term2, Into2]],
 1201                      [[_, TTerm1, TInto1]|SpecTermIntoLL]),
 1202    /* Note: fix_subtermpos/5 is a very expensive predicate, due to that we
 1203       delay its execution until its result be really needed, and we only
 1204       apply it to the subterm positions being affected by the refactoring.
 1205       The predicate performs destructive assignment (as in imperative
 1206       languages), modifying term position once the predicate is called */
 1207    fix_subtermpos(TTerm1, TInto1, Sub, TSentPos1, Options),
 1208    set_refactor_context(subpos, TSentPos1),
 1209    replace_subterm_locations(NewVNL, SpecTermIntoLL, TTerm1, TInto1, M, TTermPos1, Priority, TInto7),
 1210    special_term(Sub, TTerm1, TInto1, TInto7, Into).
 1211
 1212sleq(Term, Into, Term) :- Term == Into.
 1213
 1214subterm_location_same_term([], Term1, Term2, Term1) :-
 1215    same_term(Term1, Term2),
 1216    !.
 1217subterm_location_same_term([N|L], Term1, Term2, SubTerm) :-
 1218    compound(Term1),
 1219    arg(N, Term1, SubTerm1),
 1220    arg(N, Term2, SubTerm2),
 1221    subterm_location_same_term(L, SubTerm1, SubTerm2, SubTerm).
 1222
 1223:- thread_local partial_path_db/1. 1224
 1225is_scanneable(Term) :-
 1226    compound(Term),
 1227    \+ memberchk(Term, ['$@'(_), '$$'(_), '$G'(_, _)]).
 1228
 1229find_term_path([Spec, Term2, Into2],
 1230               [Spec2, TermLoc2, IntoLoc2, ArgLoc2, SubLoc2],
 1231               [Spec1, TermLoc1, IntoLoc1, ArgLoc1, SubLoc1]) :-
 1232    ( Into2 \== Term2,
 1233      location_subterm_un(IntoLoc2, Into2, is_scanneable, Sub2),
 1234      location_subterm_eq(TermLoc2, Term2, Sub2),
 1235      ArgLoc1 = SubLoc1,
 1236      ( ArgLoc2 = []
 1237      ->Spec1 = Spec2
 1238      ; Spec1 = Spec
 1239      )
 1240    ; ArgLoc2 = [],
 1241      SubLoc2 = [],
 1242      Spec1 = Spec2
 1243    ),
 1244    append(IntoLoc2, SubLoc1, IntoLoc1),
 1245    append(TermLoc2, ArgLoc1, TermLoc1).
 1246
 1247curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size) :-
 1248    retractall(partial_path_db(_)),
 1249    foldl(find_term_path, SpecTermIntoLL,
 1250          [orig, TermLoc, IntoLoc, TermLoc, IntoLoc], [Spec1, TermLoc1, IntoLoc1, _, _]),
 1251    once(location_subterm_un(IntoLoc1, Into1, is_scanneable, Sub1)),
 1252    \+ partial_path_db(IntoLoc1),
 1253    % Next check avoids things like [A|[]] being printed:
 1254    \+ ( memberchk(Spec1, [rawt, texp]),
 1255         Sub1 == []
 1256       ),
 1257    subterm_location(sleq(Arg1, Sub1), Term1, TermLoc1),
 1258    append(IntoLoc1, _, PIntoLoc1),
 1259    assertz(partial_path_db(PIntoLoc1)),
 1260    findall([Ord1, ArgLoc],
 1261            ( subterm_location_same_term(ArgLoc, Arg1, Sub1, ToRep),
 1262              term_size(ToRep, Size1),
 1263              Ord1 is -Size1
 1264            ), ArgLocLU),
 1265    sort(ArgLocLU, ArgLocLL),
 1266    transpose(ArgLocLL, [[Ord1|_], ArgLocL]),
 1267    Size is -Ord1.
 1268
 1269replace_subterm_locations(VNL, SpecTermIntoLL, Term1, Into1, M, TermPos, Priority, Into) :-
 1270    findall(([TermLoc1, IntoLoc1]-ArgLocL),
 1271            order_by([desc(Size)],
 1272                     curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size)),
 1273            TermLocArgLocLL),
 1274    foldl(perform_replacement(VNL, M, TermPos, Priority, Term1, Into1), TermLocArgLocLL, Into1-[], Into-VL),
 1275    maplist(collapse_bindings, VL).
 1276
 1277collapse_bindings(A=B) :- ignore(A=B).
 1278
 1279perform_replacement(VNL, M, TermPos, Priority1, Term1, Into1, [TermLoc, IntoLoc]-ArgLocL, TInto1-VL1, TInto-[Var1=Rep1|VL1]) :-
 1280    % location_subterm_un(TermLoc, Term1, Sub1),
 1281    location_subterm_un(IntoLoc, Into1, Arg1),
 1282    subpos_location(TermLoc, TermPos, SubPos),
 1283    foldl(perform_replacement_2(VNL, SubPos, Arg1), ArgLocL, RepU, []),
 1284    sort(RepU, RepL),
 1285    ( append(L1, [E], TermLoc),
 1286      location_subterm_un(L1, Term1, TP),
 1287      term_priority(TP, M, E, Priority)
 1288    ->true
 1289    ; Priority = Priority1
 1290    ),
 1291    compound(SubPos),
 1292    arg(1, SubPos, From),
 1293    arg(2, SubPos, To),
 1294    From \= To,
 1295    get_innerpos(SubPos, ISubPos),
 1296    Rep1 = '$sb'(SubPos, ISubPos, RepL, Priority, Arg1),
 1297    replace_at_subterm_location(IntoLoc, Var1, TInto1, TInto),
 1298    !.
 1299perform_replacement(_, _, _, _, _, _, _, IntoVL, IntoVL).
 1300
 1301get_innerpos(OSubPos, ISubPos) :-
 1302    OSubPos =.. [F, OFrom, OTo|Args],
 1303    term_innerpos(OFrom, OTo, IFrom, ITo),
 1304    !,
 1305    ISubPos =.. [F, IFrom, ITo|Args].
 1306get_innerpos(SubPos, SubPos).
 1307
 1308replace_at_subterm_location([], Rep, _, Rep).
 1309replace_at_subterm_location([N|L], Rep, Term1, Term2) :-
 1310    compound(Term1),
 1311    compound_name_arguments(Term1, Name, Args1),
 1312    length([_|Left], N),
 1313    append(Left, [Arg1|Right], Args1),
 1314    append(Left, [Arg2|Right], Args2),
 1315    compound_name_arguments(Term2, Name, Args2),
 1316    replace_at_subterm_location(L, Rep, Arg1, Arg2).
 1317
 1318perform_replacement_2(VNL, SubPos, Arg1, ArgLoc) -->
 1319    { subpos_location(ArgLoc, SubPos, ArgPos),
 1320      location_subterm_un(ArgLoc, Arg1, ToRep1)
 1321    },
 1322    ( {var(ToRep1)}
 1323    ->( { member(Name = Var, VNL),
 1324          ToRep1 == Var
 1325        }
 1326      ->['$sb'(ArgPos, '$VAR'(Name))]
 1327      ; []
 1328      )
 1329    ; []
 1330    ).
 1331
 1332fake_pos(T-T).

 trim_fake_pos(+TermPos, -Pos, -N)

remove fake arguments that would be added by dcg

 1337trim_fake_pos(Pos1, Pos, N) :-
 1338    ( nonvar(Pos1),
 1339      Pos1 = term_position(F, T, FF, FT, PosL1),
 1340      nonvar(PosL1)
 1341    ->partition(fake_pos, PosL1, FakePosL, PosL),
 1342      length(FakePosL, N),
 1343      Pos = term_position(F, T, FF, FT, PosL)
 1344    ; Pos = Pos1,
 1345      N = 0
 1346    ).
 1347
 1348trim_fake_args_ll(N, L, T) :-
 1349    maplist(trim_fake_args_l(N), L, T).
 1350
 1351trim_fake_args_l(N, [E|L], [E|T]) :-
 1352    maplist(trim_fake_args(N), L, T).
 1353
 1354trim_fake_args(N, Term1, Term) :-
 1355    ( N > 0,
 1356      Term1 =.. ATerm1,
 1357      length(TE, N),
 1358      append(ATerm, TE, ATerm1),
 1359      Term =.. ATerm
 1360    ->true
 1361    ; Term = Term1
 1362    ).

 substitute_term_rec(+Module, +Term, +TermPos, +Priority, +Data, -Cmd) is nondet

True when Cmd contains a substitution for Pattern by Into in SrcTerm, where Data = data(Pattern, Into, Expander, SentPos). This predicate must be cautious about handling bindings:

• Overall bindings do not affect further substitutions because they are managed by findall/3 in do_replace/6.
• Pattern must not be instantiated by either unification with SrcTerm or the execution of Expander. This is needed for substitute_term/7 to find the correct replacements.

  To avoid binding Pattern, we need to copy Pattern and Into while maintaining sharing with Expander. Next, we can safely unify Pattern with the SrcTerm.

 1379substitute_term_rec(M, Term, TermPos, Priority, Data, Cmd) :-
 1380    substitute_term_norec(sub, M, Term, TermPos, Priority, Data, Cmd),
 1381    !.
 1382substitute_term_rec(M, Term, TermPos, _, Data, Cmd) :-
 1383    substitute_term_into(TermPos, M, Term, Data, Cmd).
 1384
 1385substitute_term_into(brace_term_position(_, _, Pos), M, {Term}, Data, Cmd) :-
 1386    substitute_term_rec(M, Term, Pos, 1200, Data, Cmd).
 1387substitute_term_into(parentheses_term_position(_, _, Pos), M, Term, Data, Cmd) :-
 1388    substitute_term_rec(M, Term, Pos, 1200, Data, Cmd).
 1389substitute_term_into(term_position(_, _, _, _, PosL), M, Term, Data, Cmd) :-
 1390    substitute_term_args(PosL, M, Term, Data, Cmd).
 1391substitute_term_into(Pos, M, Term, Data, Cmd) :-
 1392    member(Pos, [list_position(_, _, _, _),
 1393                 sub_list_position(_, _, _, _, _, _, _)]),
 1394    neck,
 1395    substitute_term_list(Pos, M, Term, Data, Cmd).
 1396substitute_term_into(dict_position(_, _, _, _, PosL), M, Term, Data, Cmd) :-
 1397    member(Pos, PosL),
 1398    substitute_term_pair(M, Term, Pos, Data, Cmd).
 1399
 1400substitute_term_pair(M, Term, key_value_position(_, _, _, _, Key, PosK, PosV), Data, Cmd) :-
 1401    ( substitute_term_rec(M, Key, PosK, 999, Data, Cmd)
 1402    ; substitute_term_rec(M, Term.Key, PosV, 999, Data, Cmd)
 1403    ).
 1404
 1405:- use_module(library(listing), []). 1406
 1407term_priority(Term, M, N, Priority) :-
 1408    compound(Term),
 1409    term_priority_gnd(Term, M, N, PrG),
 1410    ( arg(N, Term, Arg),
 1411      term_needs_braces(M:Arg, PrG)
 1412    ->Priority = 999
 1413    ; Priority = PrG
 1414    ).
 1415
 1416term_priority_gnd(Term, M, N, PrG) :-
 1417    functor(Term, F, A),
 1418    ( ( A == 1
 1419      ->( prolog_listing:prefix_op(M:F, PrG) -> true
 1420        ; prolog_listing:postfix_op(M:F, PrG) -> true
 1421        )
 1422      ; A == 2
 1423      ->prolog_listing:infix_op(M:F, Left, Right),
 1424        ( N==1 -> PrG = Left
 1425        ; N==2 -> PrG = Right
 1426        )
 1427      )
 1428    ->true
 1429    ; term_priority((_, _), user, 1, PrG)
 1430    ).
 1431
 1432substitute_term_args(PAL, M, Term, Data, Cmd) :-
 1433    nth1(N, PAL, PA),
 1434    arg(N, Term, Arg),
 1435    term_priority(Term, M, N, Priority),
 1436    substitute_term_rec(M, Arg, PA, Priority, Data, Cmd).
 1437
 1438substitute_term_list(Pos, M, [Elem|Tail], Data, Cmd) :-
 1439    STo = s(1),
 1440    order_by([asc(From)],
 1441             ( member(Loc-Term, [1-Elem, 2-Tail]),
 1442               subpos_location([Loc], Pos, SubPos),
 1443               term_priority([_|_], M, Loc, Priority),
 1444               substitute_term_rec(M, Term, SubPos, Priority, Data, Cmd),
 1445               arg(1, Cmd, TermPos),
 1446               arg(1, TermPos, From)
 1447             )),
 1448    % Trick to avoid overlap:
 1449    arg(1, STo, To1),
 1450    To1 =< From,
 1451    arg(2, TermPos, To),
 1452    nb_setarg(1, STo, To).
 1453
 1454compound_positions(Line1, Pos2, Pos1, Pos) :- Line1 =< 1, !, Pos is Pos1+Pos2.
 1455compound_positions(_, Pos, _, Pos).
 1456
 1457get_output_position(Pos) :-
 1458    ( refactor_context(from, From)
 1459    ->true
 1460    ; From = 0
 1461    ),
 1462    get_output_position(From, Pos).
 1463
 1464get_output_position(From, Pos) :-
 1465    refactor_context(text, Text),
 1466    textpos_line(Text, From, Pos1),
 1467    stream_property(current_output, position(StrPos)),
 1468    stream_position_data(line_count, StrPos, Line1),
 1469    stream_position_data(line_position, StrPos, Pos2),
 1470    compound_positions(Line1, Pos2, Pos1, Pos).
 1471
 1472write_term_dot_nl(Term, OptL) :-
 1473    write_term(Term, OptL),
 1474    write('.\n').
 1475
 1476rportray_clause(Clause, OptL) :- rportray_clause(Clause, 0, OptL).
 1477
 1478% We can not use portray_clause/3 because it does not handle the hooks
 1479% portray_clause_(OptL, Clause) :-
 1480%     portray_clause(current_output, Clause, OptL).
 1481
 1482rportray_clause(C, Pos, OptL1) :-
 1483    option(module(M), OptL1),
 1484    stream_property(current_output, position(SPos1)),
 1485    merge_options([portray_clause(false), partial(false)], OptL1, OptL2),
 1486    write(''),
 1487    write_term(C, OptL2),
 1488    stream_property(current_output, position(SPos2)),
 1489    ( nonvar(C),
 1490      ( stream_position_data(line_count, SPos1, Line1),
 1491        stream_position_data(line_count, SPos2, Line2),
 1492        Line1 \= Line2
 1493      ; stream_position_data(line_position, SPos2, Pos2),
 1494        Pos2 > 80
 1495      )
 1496    ->set_stream_position(current_output, SPos1),
 1497      ( option(priority(CPri), OptL1),
 1498        term_needs_braces(C, M, CPri)
 1499      ->Display = yes,
 1500        succ(Pos, BPos)
 1501      ; Display = no,
 1502        BPos = Pos
 1503      ),
 1504      cond_display(Display, '('),
 1505      merge_options([portray_clause(true)], OptL1, OptL3),
 1506      ( memberchk(C, [(H :- B), (H --> B)])
 1507      ->write(''),
 1508        write_term(H, OptL3),
 1509        functor(C, Neck, _),
 1510        write(' '),
 1511        writeln(Neck),
 1512        line_pos(4+BPos),
 1513        term_priority((_, _), M, 2, Priority),
 1514        merge_options([priority(Priority)], OptL3, OptL4),
 1515        write_b(B, OptL4, 4+BPos)
 1516      ; write(''),
 1517        write_term(C, OptL3)
 1518      ),
 1519      cond_display(Display, ')')
 1520    ; true
 1521    ).
 1522
 1523deref_substitution(Var, Var) :- var(Var), !.
 1524deref_substitution('$sb'(_, _, _, _, Term), Sub) :-
 1525    !,
 1526    deref_substitution(Term, Sub).
 1527deref_substitution(Term, Term).
 1528
 1529write_pos_lines(Pos, Writer, Lines) :-
 1530    write_pos_rawstr(Pos, Writer, String),
 1531    atomics_to_string(Lines, '\n', String).
 1532
 1533write_pos_rawstr(Pos, Writer, String) :-
 1534    with_output_to_string(
 1535        String,
 1536        nl, % start with a new line, since the position is not reseted
 1537        ( line_pos(Pos),
 1538          call(Writer)
 1539        )).
 1540
 1541write_pos_string(Pos, Writer, String) :-
 1542    write_pos_rawstr(Pos, Writer, RawStr),
 1543    pos_indent(Pos, Indent),
 1544    atom_concat(Indent, String, RawStr).
 1545
 1546write_term_lines(Pos, Opt, Term, Lines) :-
 1547    write_pos_lines(Pos, write_term(Term, Opt), Lines).
 1548
 1549write_term_string(Pos, Opt, Term, String) :-
 1550    write_pos_string(Pos, write_term(Term, Opt), String).
 1551
 1552print_subtext_sb_1(Text, Options, '$sb'(SubPos, Term), From, To) :-
 1553    arg(1, SubPos, SubFrom),
 1554    print_subtext(From-SubFrom, Text),
 1555    write_term(Term, Options),
 1556    arg(2, SubPos, To).
 1557
 1558print_subtext_sb_2(Term, TermPos, RepL, Priority, Text, Options) :-
 1559    reindent(TermPos, Text,
 1560             with_cond_braces_2(print_subtext_2, Term, TermPos, RepL, Priority, Text, Options)).
 1561
 1562reindent(TermPos, Text, Goal) :-
 1563    with_output_to_string(RawText, Goal),
 1564    ( \+ sub_string(RawText, _, _, _, '\n') % No need to reindent
 1565    ->SubText = RawText
 1566    ; arg(1, TermPos, From),
 1567      ( seek1_char_left(Text, "\n", From, Distance1)
 1568      ->CropLength1 is From - (Distance1 + 1)
 1569      ; CropLength1 is From
 1570      ),
 1571      offset_pos('$OUTPOS', PrefLength1),
 1572      atomic_list_concat(L1, '\n', RawText),
 1573      L1 = [E|T1], % First line is OK
 1574      Delta is abs(PrefLength1 - CropLength1),
 1575      pos_indent(Delta, ReIndent),
 1576      ( CropLength1 < PrefLength1
 1577      ->% Increment indentation
 1578        A2 = E1,
 1579        A3 = E2
 1580      ; % Decrement indentation
 1581        A2 = E2,
 1582        A3 = E1
 1583      ),
 1584      findall(E2,
 1585              ( member(E1, T1),
 1586                once(( atom_concat(ReIndent, A2, A3)
 1587                     ; E2 = E1
 1588                     ))
 1589              ), L2),
 1590      atomic_list_concat([E|L2], '\n', SubText)
 1591    ),
 1592    print_text(SubText).
 1593
 1594with_cond_braces_2(Call, Term, TermPos, RepL, GPriority, Text, Options) :-
 1595    option(module(M), Options),
 1596    option(priority(Priority), Options),
 1597    fix_position_if_braced(TermPos, M, Term, GPriority, Term, Priority, Display),
 1598    cond_display(Display, '('),
 1599    call(Call, TermPos, RepL, Text, Options),
 1600    cond_display(Display, ')').
 1601
 1602print_subtext_2(sub_list_position(BFrom, To, BTo, _, From, PosL, Tail), RepL, Text, Options) :-
 1603    !,
 1604    print_subtext(BFrom-BTo, Text),
 1605    print_subtext_2(list_position(From, To, PosL, Tail), RepL, Text, Options).
 1606print_subtext_2(TermPos, RepL, Text, Options) :-
 1607    arg(1, TermPos, From),
 1608    arg(2, TermPos, To),
 1609    foldl(print_subtext_sb_1(Text, Options), RepL, From, SubTo),
 1610    print_subtext(SubTo-To, Text).
 1611
 1612:- public
 1613    rportray/2. 1614
 1615/*
 1616rportray('$sb'(TermPos), _) :-
 1617    \+ retract(rportray_skip),
 1618    !,
 1619    refactor_context(text, Text),
 1620    print_subtext(TermPos, Text).
 1621*/
 1622rportray('$sb'(SubPos, _, RepL, Priority, Term), Options) :-
 1623    \+ retract(rportray_skip),
 1624    !,
 1625    % Kludge to get the spaces needed to print Term:
 1626    select_option(portray_goal(PG), Options, Options2, PG),
 1627    stream_property(current_output, position(S1)),
 1628    write_term(Term, Options2),
 1629    stream_property(current_output, position(S2)),
 1630    write_length(Term, Length, Options2),
 1631    stream_position_data(char_count, S1, B1),
 1632    stream_position_data(char_count, S2, B2),
 1633    Offset is B2-B1-Length,
 1634    set_stream_position(current_output, S1),
 1635    % to use seek, Offset must be positive, otherwise it will not work properly
 1636    seek(current_output, Offset, current, _),
 1637    option(text(Text), Options),
 1638    ignore(print_subtext_sb_2(Term, SubPos, RepL, Priority, Text, Options)).
 1639rportray('$@'(Term), Options) :-
 1640    write_term(Term, Options).
 1641rportray('$$'(Term), Options1) :-
 1642    select_option(portray_goal(_), Options1, Options),
 1643    write_term(Term, Options).
 1644rportray(\\(Term), Options) :-
 1645    \+ retract(rportray_skip),
 1646    !,
 1647    assertz(rportray_skip),
 1648    write_term(Term, Options).
 1649% rportray('$sb'(_, _, _, _), _) :- !.
 1650rportray(@@(Term, STerm), Options) :-
 1651    \+ retract(rportray_skip),
 1652    !,
 1653    ( nonvar(STerm),
 1654      STerm = '$sb'(OTermPos, ITermPos, _, _, _)
 1655    ->arg(1, ITermPos, IFrom),
 1656      arg(2, ITermPos, ITo),
 1657      arg(1, OTermPos, OFrom),
 1658      arg(2, OTermPos, OTo),
 1659      option(text(Text), Options),
 1660      print_subtext(OFrom-IFrom, Text),
 1661      write_term(Term, Options),
 1662      print_subtext(ITo-OTo, Text)
 1663    ; write_term(Term, Options)
 1664    ).
 1665% Use a different pattern to guide the printing of Term:
 1666rportray('$@'(Into, '$sb'(_, SubPos, _, Priority, Term)), Options) :-
 1667    !,
 1668    option(text(Text), Options),
 1669    once(print_expansion_sb(Into, Term, SubPos, Priority, Options, Text)).
 1670rportray('$G'(Into, Goal), Opt) :-
 1671    callable(Goal),
 1672    \+ special_term(Goal),
 1673    !,
 1674    with_str_hook(write_term(Into, Opt), Goal).
 1675rportray('$C'(Goal, Into), Opt) :-
 1676    callable(Goal),
 1677    \+ special_term(Goal),
 1678    !,
 1679    call(Goal),
 1680    write_term(Into, Opt).
 1681% Ignore, but process for the side effects
 1682rportray('$NOOP', _) :- !.
 1683rportray('$NOOP'(Term), Opt) :-
 1684    !,
 1685    with_output_to(string(_), write_term(Term, Opt)).
 1686rportray('$TEXT'(T), Opt) :- !, write_t(T, Opt).
 1687rportray('$TEXT'(T, Offs), Opt) :-
 1688    offset_pos(Offs, Pos),
 1689    !,
 1690    line_pos(Pos),
 1691    write_t(T, Opt).
 1692rportray('$TEXTQ'(T), Opt) :- !, write_q(T, Opt).
 1693rportray('$TEXTQ'(T, Offs), Opt) :-
 1694    offset_pos(Offs, Pos),
 1695    !,
 1696    line_pos(Pos),
 1697    write_q(T, Opt).
 1698rportray('$PRETXT'(TXT, Term), Opt) :-
 1699    !,
 1700    write(TXT),
 1701    write_term(Term, Opt).
 1702rportray('$POSTXT'(Term, TXT), Opt) :-
 1703    !,
 1704    write_term(Term, Opt),
 1705    write(TXT).
 1706rportray(H :- B, Opt) :-
 1707    option(portray_clause(true), Opt),
 1708    !,
 1709    offset_pos('$OUTPOS', Pos),
 1710    rportray_clause((H :- B), Pos, Opt).
 1711rportray(H --> B, Opt) :-
 1712    option(portray_clause(true), Opt),
 1713    !,
 1714    offset_pos('$OUTPOS', Pos),
 1715    rportray_clause((H --> B), Pos, Opt).
 1716rportray('$CLAUSE'(C), Opt) :- !, rportray_clause(C, Opt).
 1717rportray('$CLAUSE'(C, Offs), Opt) :-
 1718    !,
 1719    offset_pos(Offs, Pos),
 1720    rportray_clause(C, Pos, Opt).
 1721rportray('$BODY'(B, Offs), Opt) :-
 1722    offset_pos(Offs, Pos),
 1723    !,
 1724    rportray_body(B, Pos, Opt).
 1725rportray('$BODY'(B), Opt) :-
 1726    !,
 1727    offset_pos('$OUTPOS', Pos),
 1728    rportray_body(B, Pos, Opt).
 1729rportray('$BODYB'(B, Offs), Opt) :-
 1730    offset_pos(Offs, Pos),
 1731    !,
 1732    rportray_bodyb(B, Pos, Opt).
 1733rportray('$BODYB'(B), Opt) :-
 1734    !,
 1735    offset_pos('$OUTPOS', Pos),
 1736    rportray_bodyb(B, Pos, Opt).
 1737rportray('$POS'(Name, Term), Opt) :-
 1738    get_output_position(Pos),
 1739    nonvar(Name),
 1740    ( \+ rportray_pos(Name, _)
 1741    ->assertz(rportray_pos(Name, Pos))
 1742    ; refactor_message(warning, format("Position named ~w redefined", [Name])),
 1743      retractall(rportray_pos(Name, _)),
 1744      assertz(rportray_pos(Name, Pos))
 1745    ),
 1746    write_term(Term, Opt).
 1747rportray('$APP'(L1, L2), Opt) :-
 1748    !,
 1749    ( nonvar(L1),
 1750      L1 = '$sb'(OTermPos, ITermPos, RepL1, Priority, Term)
 1751    ->once(( ITermPos = list_position(_, LTo, _, Pos)
 1752           ; ITermPos = sub_list_position(_, LTo, _, _, _, _, Pos)
 1753           ; Pos = ITermPos
 1754           )),
 1755      ( Pos = none
 1756      ->succ(From, LTo),
 1757        ( trim_brackets(L2, L3, Opt)
 1758        ->remove_hacks(L3, T3),
 1759          ( T3 == []
 1760          ->sort(['$sb'(From-From, L3)|RepL1], RepL)
 1761          ; sort(['$sb'(From-From, '$,'('$TEXT'(', '), L3))|RepL1], RepL)
 1762          )
 1763        ; sort(['$sb'(From-From, '$,'('$TEXT'('|'), L2))|RepL1], RepL)
 1764        )
 1765      ; arg(1, Pos, From),
 1766        arg(2, Pos, To),
 1767        sort(['$sb'(From-To, L2)|RepL1], RepL)
 1768      ),
 1769      write_term('$sb'(OTermPos, ITermPos, RepL, Priority, Term), Opt)
 1770    ; append(L, T, L1),
 1771      ( var(T)
 1772      ; T \= [_|_]
 1773      )
 1774    ->append(L, L2, N),
 1775      write_term(N, Opt)
 1776    ).
 1777rportray('$,'(A, B), Opt) :- !, write_term(A, Opt), write_term(B, Opt).
 1778rportray('$LIST'( L), Opt) :- !, rportray_list(L, nb, write_term, '',  Opt).
 1779rportray('$LIST,'(L), Opt) :- !, rportray_list(L, nb, write_term, ',', Opt).
 1780rportray('$LIST,_'(L), Opt) :- !, maplist(term_write_comma_2(Opt), L).
 1781rportray('$LIST'(L, Sep), Opt) :- !, rportray_list(L, nb, write_term, Sep, Opt).
 1782rportray('$LISTC'(CL), Opt) :-
 1783    !,
 1784    merge_options([priority(1200), portray_clause(true)], Opt, Opt1),
 1785    option(text(Text), Opt),
 1786    term_write_sep_list_3(CL, rportray_clause, Text, '.\n', '.\n', Opt1).
 1787rportray('$LISTC.NL'(CL), Opt) :-
 1788    !,
 1789    merge_options([priority(1200), portray_clause(true)], Opt, Opt1),
 1790    option(text(Text), Opt),
 1791    term_write_sep_list_3(CL, rportray_clause, Text, '.\n', '.\n', Opt1),
 1792    write('.\n').
 1793rportray('$LIST.NL'(L), Opt) :-
 1794    !,
 1795    merge_options([priority(1200)], Opt, Opt1),
 1796    rportray_list(L, nb, write_term_dot_nl, '', Opt1).
 1797rportray('$LISTNL.'(L), Opt) :-
 1798    !,
 1799    merge_options([priority(1200)], Opt, Opt1),
 1800    rportray_list(L, nb, write_term, '.\n', Opt1).
 1801rportray('$LIST,NL'(L), Opt) :-
 1802    offset_pos('$OUTPOS', Pos),
 1803    !,
 1804    rportray_list_nl_comma(L, nb, Pos, Opt).
 1805rportray('$LISTNL'(L), Opt) :-
 1806    offset_pos('$OUTPOS', Pos),
 1807    !,
 1808    rportray_list_nl(L, nb, Pos, Opt).
 1809rportray('$TAB'(Term, Offs), Opt) :-
 1810    offset_pos(Offs-'$OUTPOS', Delta),
 1811    !,
 1812    forall(between(1, Delta, _), write(' ')),
 1813    write_term(Term, Opt).
 1814rportray('$LIST,NL'(L, Offs), Opt) :-
 1815    offset_pos(Offs, Pos),
 1816    !,
 1817    rportray_list_nl_comma(L, nb, Pos, Opt).
 1818rportray('$LISTNL'(L, Offs), Opt) :-
 1819    offset_pos(Offs, Pos),
 1820    !,
 1821    rportray_list_nl(L, nb, Pos, Opt).
 1822rportray('$LISTB,NL'(L), Opt) :-
 1823    offset_pos('$OUTPOS'+2, Pos),
 1824    !,
 1825    rportray_list_nl(L, wb(2, Pos), Pos, Opt).
 1826rportray('$LISTB,NL'(L, Offs), Opt) :-
 1827    offset_pos(Offs, Pos),
 1828    !,
 1829    offset_pos(Pos-'$OUTPOS', Delta),
 1830    rportray_list_nl(L, wb(Delta, Pos), Pos, Opt).
 1831rportray('$NL'(Term, Offs), Opt) :-
 1832    offset_pos(Offs, Pos),
 1833    !,
 1834    nl,
 1835    line_pos(Pos),
 1836    write_term(Term, Opt).
 1837rportray('$SEEK'(Term, Offs), Opt) :-
 1838    offset_pos(Offs, Pos),
 1839    seek(current_output, Pos, current, _),
 1840    write_term(Term, Opt).
 1841rportray('$NL', _) :- nl.
 1842rportray('$PRIORITY'(T, Priority), Opt) :-
 1843    integer(Priority),
 1844    !,
 1845    merge_options([priority(Priority)], Opt, Opt1),
 1846    write_term(T, Opt1).
 1847rportray(\+ Term, Opt) :-
 1848    !,
 1849    write_t('\\+ ', Opt),
 1850    write(''),
 1851    term_priority((_, _), user, 1, Priority),
 1852    merge_options([priority(Priority)], Opt, Opt1),
 1853    write_term(Term, Opt1).
 1854rportray('$RM', Opt) :-
 1855    !,
 1856    write_term(true, Opt).
 1857rportray((A, B), Opt) :-
 1858    !,
 1859    ( A == '$RM'
 1860    ->rportray(B, Opt)
 1861    ; B == '$RM'
 1862    ->rportray(A, Opt)
 1863    ; rportray_conj(A, B, Opt)
 1864    ).
 1865rportray([E|T1], Opt) :-
 1866    !,
 1867    ( E == '$RM'
 1868    ->rportray(T1, Opt)
 1869    ; rportray_head_tail(E, T1, Opt)
 1870    ).
 1871% Better formatting:
 1872rportray((:- Decl), Opt) :-
 1873    !,
 1874    offset_pos('$OUTPOS', Pos),
 1875    write(':- '),
 1876    merge_options([priority(1200)], Opt, Opt1),
 1877    option(module(M), Opt),
 1878    ( Decl =.. [Name, Arg],
 1879      once(( current_op(OptPri, Type, M:Name),
 1880             valid_op_type_arity(Type, 1)
 1881           )),
 1882      option(priority(Pri), Opt),
 1883      OptPri =< Pri
 1884    ->NDecl =.. [Name, '$NL'('$BODY'(Arg), Pos+4)]
 1885    ; NDecl = Decl
 1886    ),
 1887    write_term(NDecl, Opt1).
 1888rportray(OperTerm, Opt) :-
 1889    \+ retract(rportray_skip),
 1890    nonvar(OperTerm),
 1891    ( OperTerm =.. [Op, _],
 1892      option(module(M), Opt),
 1893      current_op(_, fx, M:Op),
 1894      sub_string(Op, _, 1, 0, Char1),
 1895      char_type(Char1, prolog_symbol),
 1896      assertz(rportray_skip),
 1897      string_term(OperTerm, Opt, Text),
 1898      atom_concat(Op, Right, Text),
 1899      sub_string(Right, 0, 1, _, Char2),
 1900      char_type(Char2, prolog_symbol)
 1901    ->write_t(Op, Opt),
 1902      write(' '),
 1903      write_t(Right, Opt)
 1904    ; fail
 1905    ),
 1906    !.
 1907rportray(Operator, Opt) :-
 1908    % Fix to avoid useless operator parenthesis
 1909    atom(Operator),
 1910    option(module(M), Opt),
 1911    option(priority(Priority), Opt),
 1912    current_op(OpPriority, _, M:Operator),
 1913    OpPriority < Priority,
 1914    !,
 1915    write_q(Operator, Opt).
 1916rportray(String, Options) :-
 1917    string(String),
 1918    String \= "",
 1919    !,
 1920    rportray_string(String, Options).
 1921% Better formatting:
 1922rportray(Term, OptL) :-
 1923    callable(Term),
 1924    \+ escape_term(Term),
 1925    \+ ctrl(Term),
 1926    \+ skip_format(Term),
 1927    option(module(M), OptL),
 1928    ( ( compact_format(Term)
 1929      ; term_arithexpression(Term, M)
 1930      )
 1931    ->Space = ''
 1932    ; Space = ' '
 1933    ),
 1934    option(term_width(TermWidth), OptL),
 1935    ( Term =.. [Name, Left, Right],
 1936      current_op(OptPri, Type, M:Name),
 1937      valid_op_type_arity(Type, 2)
 1938    ->option(priority(Pri), OptL),
 1939      ( OptPri > Pri
 1940      ->Display = yes
 1941      ; Display = no
 1942      ),
 1943      term_priority_gnd(Term, M, 1, LP),
 1944      merge_options([priority(LP)], OptL, OptL1),
 1945      cond_display(Display, '('),
 1946      offset_pos('$OUTPOS', Pos),
 1947      write_term(Left, OptL1),
 1948      write_space(Space),
 1949      offset_pos('$OUTPOS', Pos2),
 1950      term_priority_gnd(Term, M, 2, RP),
 1951      merge_options([priority(RP)], OptL, OptL2),
 1952      write_pos_lines(Pos2,
 1953                      ( write_q(Name, OptL2),
 1954                        write_space(Space),
 1955                        write_term(Right, OptL2)
 1956                      ), Lines),
 1957      ( Lines = [Line],
 1958        atom_length(Line, Width),
 1959        Width =< TermWidth
 1960      ->pos_indent(Pos2, Indent),
 1961        atom_concat(Indent, Atom, Line),
 1962        write_t(Atom, OptL2)
 1963      ; write_pos_lines(Pos,
 1964                        ( write_q(Name, OptL2),
 1965                          write_space(Space),
 1966                          write_term(Right, OptL2)
 1967                        ), Lines2),
 1968        ( ( maplist(string_length, Lines, WidthL),
 1969            max_list(WidthL, Width),
 1970            Width > TermWidth
 1971          ; length(Lines2, Height2),
 1972            length(Lines,  Height),
 1973            Height2 < Height
 1974          )
 1975        ->nl,
 1976          atomic_list_concat(Lines2, '\n', Atom)
 1977        ; Lines = [Line1|Tail],
 1978          pos_indent(Pos2, Indent),
 1979          atom_concat(Indent, Line, Line1),
 1980          atomic_list_concat([Line|Tail], '\n', Atom)
 1981        ),
 1982        write_t(Atom, OptL2)
 1983      ),
 1984      cond_display(Display, ')')
 1985    ; \+ atomic(Term),
 1986      Term =.. [Name|Args],
 1987      Args = [_, _|_]
 1988      % There is no need to move the argument to another line if the arity is 1,
 1989      % however that could change in the future if we change the format
 1990      % \+ ( Args = [_],
 1991      %      current_op(_, Type, M:Name),
 1992      %      valid_op_type_arity(Type, 1)
 1993      %    )
 1994    ->atom_length(Name, NL),
 1995      offset_pos('$OUTPOS'+NL+1, Pos),
 1996      merge_options([priority(999)], OptL, Opt1),
 1997      maplist(write_term_lines(Pos, Opt1), Args, LinesL),
 1998      pos_indent(Pos, Indent),
 1999      foldl(collect_args(Indent, TermWidth), LinesL, (Pos-2)-[_|T], _-[]),
 2000      atomic_list_concat(T, Atom),
 2001      write_q(Name, Opt1),
 2002      write(''),
 2003      write_t('(',  Opt1),
 2004      write_t(Atom, Opt1),
 2005      write_t(')',  Opt1)
 2006    ),
 2007    !.
 2008
 2009rportray_conj(A, B, Opt) :-
 2010    sequence_list((A, B), AL, []),
 2011    exclude(==('$RM'), AL, L),
 2012    once(append(T, [Last], L)),
 2013    offset_pos('$OUTPOS', Pos),
 2014    term_priority((_, _), user, 1, Priority),
 2015    option(priority(Pri), Opt),
 2016    ( Priority >= Pri
 2017    ->Display = yes
 2018    ; Display = no
 2019    ),
 2020    merge_options([priority(Priority)], Opt, Opt1),
 2021    term_priority((_, _), user, 2, RPri),
 2022    merge_options([priority(RPri)], Opt, Opt2),
 2023    ( ( Display = yes
 2024      ->Format ="(~s~s)",
 2025        succ(Pos, Pos1)
 2026      ; Format = "~s~s",
 2027        Pos1 = Pos
 2028      ),
 2029      length(L, Length),
 2030      pos_indent(Pos1, Indent),
 2031      maplist([Pos1, Opt1, Indent] +\ E^Line^( write_term_lines(Pos1, Opt1, E, Lines),
 2032                                               Lines = [Line1],
 2033                                               string_concat(Indent, Line, Line1)
 2034                                             ), T, LineL1),
 2035      write_term_lines(Pos1, Opt2, Last, LastLines1),
 2036      LastLines1 = [LastLine1],
 2037      atom_concat(Indent, LastLine, LastLine1),
 2038      append(LineL1, [LastLine], StringL),
 2039      maplist(string_length, StringL, WidthL),
 2040      sum_list(WidthL, WidthTotal),
 2041      Sep = ", ",
 2042      string_length(Sep, SepLength),
 2043      option(conj_width(ConjWidth), Opt),
 2044      Pos1 + WidthTotal + (Length - 1) * SepLength < ConjWidth
 2045    ->CloseB = ""
 2046    ; ( Display = yes
 2047      ->Format = "( ~s~s)",
 2048        Pos1 = Pos + 2,
 2049        with_output_to_string(
 2050            CloseB,
 2051            ( nl,
 2052              line_pos(Pos)
 2053            ))
 2054      ; Format = "~s~s",
 2055        CloseB = "",
 2056        Pos1 = Pos
 2057      ),
 2058      maplist(write_term_string(Pos1, Opt1), T, StringL1),
 2059      write_term_string(Pos1, Opt2, Last, LastStr),
 2060      append(StringL1, [LastStr], StringL),
 2061      sep_nl(Pos1, ',', Sep)
 2062    ),
 2063    atomics_to_string(StringL, Sep, S),
 2064    format(atom(Atom), Format, [S, CloseB]),
 2065    write_t(Atom, Opt1).
 2066
 2067rportray_head_tail(E, T1, Opt) :-
 2068    offset_pos('$OUTPOS', Pos),
 2069    succ(Pos, Pos1),
 2070    H = [_|_],
 2071    append(H, T2, [E|T1]),
 2072    ( nonvar(T2),
 2073      T2 = '$sb'(OTermPos, ITermPos, _, _, Term),
 2074      is_list(Term),
 2075      compound(OTermPos),
 2076      !,
 2077      arg(1, OTermPos, TFrom),
 2078      arg(2, OTermPos, TTo),
 2079      arg(1, ITermPos, From),
 2080      arg(2, ITermPos, To),
 2081      write_term_string(Pos, Opt, T2, SB),
 2082      sub_string(SB, 1, _, 1, SC),
 2083      option(text(Text), Opt),
 2084      get_subtext(Text, TFrom, From, SL),
 2085      get_subtext(Text, To, TTo, SR),
 2086      format(atom(ST), "~s~s~s", [SL, SC, SR]),
 2087      ( ( Term == []
 2088        ; Term == '$RM'
 2089        )
 2090      ->T = H,
 2091        EndText = ST
 2092      ; append(H, ['$TEXT'(ST)], T),
 2093        EndText = ""
 2094      )
 2095    ; T2 == [],
 2096      T = H,
 2097      EndText = ""
 2098    ; once(( var(T2)
 2099           ; T2 \= [_|_]
 2100           )),
 2101      T = H,
 2102      write_term_string(Pos1, Opt, T2, ST),
 2103      atom_concat('|', ST, EndText)
 2104    ),
 2105    !,
 2106    write_t('[', Opt),
 2107    term_priority([_|_], user, 1, Priority),
 2108    merge_options([priority(Priority)], Opt, Opt1),
 2109    subtract(T, ['$RM'], [Elem|Tail]),
 2110    write_pos_rawstr(Pos1, write_term(Elem, Opt1), String),
 2111    pos_indent(Pos1, Indent),
 2112    option(list_width(ListWidth), Opt),
 2113    foldl(concat_list_elem(ListWidth, Pos1, Opt1), Tail, String-LinesLL, Last-[Last]),
 2114    ( LinesLL = [S1]
 2115    ->CloseB = "]"
 2116    ; with_output_to_string(
 2117          CloseB,
 2118          ( nl,
 2119            line_pos(Pos),
 2120            write(']')
 2121          )),
 2122      with_output_to(string(Sep), writeln(',')),
 2123      atomic_list_concat(LinesLL, Sep, S1)
 2124    ),
 2125    atom_concat(Indent, S, S1),
 2126    atomic_list_concat([S, EndText, CloseB], Atom),
 2127    write_t(Atom, Opt1).
 2128
 2129concat_list_elem(ListWidth, Pos, Opt1, Elem, String1-LinesL1, String-LinesL) :-
 2130    ( with_output_to_string(
 2131          String, Pos1, Pos2, true,
 2132          ( write(String1),
 2133            write(', '),
 2134            write_term(Elem, Opt1)
 2135          )),
 2136      stream_position_data(line_count, Pos1, L1),
 2137      stream_position_data(line_count, Pos2, L2),
 2138      stream_position_data(char_count, Pos2, B2),
 2139      L1 = L2,
 2140      B2 =< ListWidth
 2141    ->LinesL1 = LinesL
 2142    ; write_pos_rawstr(Pos, write_term(Elem, Opt1), String),
 2143      LinesL1 = [String1|LinesL]
 2144    ).
 2145
 2146write_space(Space) :-
 2147    ( Space = ''
 2148    ->true
 2149    ; write(Space)
 2150    ).
 2151
 2152trim_brackets(L, _, _) :- var(L), !, fail.
 2153trim_brackets(Term, Trim, Opt) :-
 2154    member(Term-Trim, ['$@'(L, E)-'$@'(T, E),
 2155                       '@@'(L, E)-'@@'(T, E)
 2156                      ]),
 2157    neck,
 2158    trim_brackets(L, T, Opt).
 2159trim_brackets('$sb'(OTermPos, ITermPos, RepL1, Priority, Term),
 2160              '$sb'(OTermPos, ITermPos, RepL,  Priority, Term), _) :-
 2161    once(( ITermPos = list_position(From, To, _, _)
 2162         ; ITermPos = sub_list_position(From, To, _, _, _, _, _)
 2163         ; ITermPos = From-To,
 2164           Term == []
 2165         )),
 2166    succ(From, From1),
 2167    succ(To1, To),
 2168    sort(['$sb'(From-From1, '$NOOP'),
 2169          '$sb'(To1-To, '$NOOP')
 2170          |RepL1], RepL).
 2171trim_brackets(L, '$TEXT'(S), Opt) :-
 2172    L = [_|_],
 2173    string_term(L, Opt, S1),
 2174    sub_string(S1, 1, _, 1, S).
 2175
 2176pos_indent(Pos, Indent) :- with_output_to(atom(Indent), line_pos(Pos)).
 2177
 2178collect_args(Indent, TermWidth, LineL, Pos1-[Sep, String|Tail], Pos-Tail) :-
 2179    ( LineL = [Line1],
 2180      string_concat(Indent, String, Line1),
 2181      string_length(String, Width),
 2182      Pos is Pos1 + 2 + Width,
 2183      Pos < TermWidth
 2184    ->Sep = ", "
 2185    ; atom_concat(',\n', Indent, Sep),
 2186      last(LineL, Last),
 2187      string_length(Last, Pos),
 2188      once(( ( atomic_list_concat([Indent, '\n', Indent], IndentNl)
 2189             ; IndentNl = Indent
 2190             ),
 2191             atomics_to_string(LineL, '\n', String1),
 2192             string_concat(IndentNl, String, String1)
 2193           ))
 2194    ).
 2195
 2196pos_value(Pos, Value) :-
 2197    ( rportray_pos(Pos, Value)
 2198    ->true
 2199    ; Pos == '$OUTPOS'
 2200    ->get_output_position(Value)
 2201    ; fail
 2202    ).
 2203
 2204term_arithexpression(X, M) :-
 2205    substitute(sanitize_hacks, X, Y),
 2206    compat_arithexpression(Y, M).
 2207
 2208sanitize_hacks(Term, Into) :-
 2209    nonvar(Term),
 2210    memberchk(Term, ['$sb'(_, _), '$sb'(_, _, _, _, Into)]).
 2211
 2212compat_arithexpression(X, _) :- var(X), !.
 2213compat_arithexpression(X, _) :- number(X), !.
 2214compat_arithexpression(X, M) :- arithmetic:evaluable(X, M), !.
 2215compat_arithexpression(X, M) :-
 2216    callable(X),
 2217    current_arithmetic_function(X),
 2218    forall((compound(X), arg(_, X, V)), compat_arithexpression(V, M)).
 2219
 2220arithexpression(X) :- number(X), !.
 2221arithexpression(X) :-
 2222    callable(X),
 2223    current_arithmetic_function(X),
 2224    forall((compound(X), arg(_, X, V)), arithexpression(V)).
 2225
 2226offset_pos(Offs, Pos) :-
 2227    substitute(pos_value, Offs, Expr),
 2228    arithexpression(Expr),
 2229    catch(Pos is round(Expr), _, fail).
 2230
 2231rportray_list_nl(L, WB, Pos, Opt) :-
 2232    rportray_list_nl_comma(L, WB, Pos, Opt).
 2233
 2234rportray_list_nl_comma(L, WB, Pos, Opt) :-
 2235    rportray_list_nl(',', L, WB, Pos, Opt).
 2236
 2237rportray_list_nl(Pre, L, WB, Pos, Opt) :-
 2238    sep_nl(Pos, Pre, Sep),
 2239    rportray_list(L, WB, write_term, Sep, Opt).
 2240
 2241rportray_list(L, WB, Writer, SepElem, Opt) :-
 2242    option(text(Text), Opt),
 2243    deref_substitution(L, D),
 2244    term_write_sep_list_2(D, WB, Writer, Text, SepElem, '|', Opt).
 2245
 2246term_write_sep_list_2([], nb, _, _, _, _, _) :- !.
 2247term_write_sep_list_2([E|T], WB, Writer, Text, SepElem, SepTail, Opt) :-
 2248    !,
 2249    term_priority([_|_], user, 1, Priority),
 2250    merge_options([priority(Priority)], Opt, Opt1),
 2251    with_output_to_string(
 2252        RawText1,
 2253        ( write(SepElem),
 2254          call(Writer, E, Opt1),
 2255          term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt1)
 2256        )),
 2257    atom_concat(SepElem, RawText2, RawText1),
 2258    string_length(RawText1, Length),
 2259    ( seek1_char_left(RawText2, '\n', Length, RTTo),
 2260      sub_string(RawText2, RTTo, _, 0, ToTrim),
 2261      string_chars(ToTrim, Chars),
 2262      forall(member(Char, Chars), char_type(Char, space))
 2263    ->sub_string(RawText2, 0, RTTo, _, RawText)
 2264    ; RawText = RawText2
 2265    ),
 2266    ( sub_string(RawText, _, _, _, '\n')
 2267    ->cond_ident_bracket(WB, '['),
 2268      print_text(RawText),
 2269      cond_idend_bracket(WB, ']')
 2270    ; cond_nonid_bracket(WB, '['),
 2271      print_text(RawText),
 2272      cond_nonid_bracket(WB, ']')
 2273    ).
 2274/*
 2275term_write_sep_list_2([E|T], WB, Writer, Text, SepElem, SepTail, Opt) :-
 2276    !,
 2277    term_priority([_|_], user, 1, Priority),
 2278    merge_options([priority(Priority)], Opt, Opt1),
 2279    cond_ident_bracket(WB, '['),
 2280    call(Writer, E, Opt1),
 2281    term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt1),
 2282    cond_idend_bracket(WB, ']').
 2283*/
 2284term_write_sep_list_2(E, _, Writer, _, _, _, Opt) :- call(Writer, E, Opt).
 2285
 2286cond_ident_bracket(wb(Delta, _), Bracket) :-
 2287    write(Bracket),
 2288    forall(between(2,Delta,_), write(' ')).
 2289cond_ident_bracket(nb, _).
 2290
 2291cond_idend_bracket(wb(Delta, Pos), Bracket) :-
 2292    sep_nl(Pos-Delta, '', SepNl),
 2293    write(SepNl),
 2294    write(Bracket).
 2295cond_idend_bracket(nb, _).
 2296
 2297cond_nonid_bracket(wb(_, _), Bracket) :- write(Bracket).
 2298cond_nonid_bracket(nb, _).
 2299
 2300term_write_sep_list_inner(L, Writer, Text, SepElem, SepTail, Opt) :-
 2301    nonvar(L),
 2302    L = [E|T],
 2303    !,
 2304    write(SepElem),
 2305    call(Writer, E, Opt),
 2306    term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt).
 2307term_write_sep_list_inner(P, Writer, Text, SepElem, _, Opt) :-
 2308    nonvar(P),
 2309    deref_substitution(P, L),
 2310    L = [_|_],
 2311    !,
 2312    P = '$sb'(SubPos1, ISubPos, RepL, Priority, Term),
 2313    SubPos1 =.. [SPF, From1, To1|SPT],
 2314    string_length(Text, N),
 2315    seekn_char_right(1, Text, N, "[", From1, From2),
 2316    % Remove space, since default indentation of list elements is 2:
 2317    ( sub_string(Text, From2, 1, _, " ")
 2318    ->succ(From2, From)
 2319    ; From = From2
 2320    ),
 2321    seek1_char_left(Text, "]", To1, To),
 2322    SubPos =.. [SPF, From, To|SPT],
 2323    P2 = '$sb'(SubPos, ISubPos, RepL, Priority, Term),
 2324    write(SepElem),
 2325    call(Writer, P2, Opt).
 2326term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt) :-
 2327    get_pred(T, F),
 2328    write_tail(T, F, Writer, Text, SepElem, SepTail, Opt).
 2329
 2330term_write_sep_list_3([E|T], Writer, Text, SepElem, SepTail, Opt) :-
 2331    !,
 2332    call(Writer, E, Opt),
 2333    get_pred(E, D),
 2334    term_write_sep_list_inner_3(T, D, Writer, Text, SepElem, SepTail, Opt).
 2335term_write_sep_list_3(E, Writer, _, _, _, Opt) :-
 2336    call(Writer, E, Opt).
 2337
 2338get_pred(T, F/A) :-
 2339    deref_substitution(T, C),
 2340    once(clause_head(C, H)),
 2341    deref_substitution(H, D),
 2342    functor(D, F, A).
 2343
 2344clause_head(H :-  _, H).
 2345clause_head(H --> _, H).
 2346clause_head(H,       H).
 2347
 2348
 2349term_write_sep_list_inner_3(L, D, Writer, Text, SepElem, SepTail, Opt) :-
 2350    nonvar(L),
 2351    L = [E|T],
 2352    !,
 2353    write(SepElem),
 2354    get_pred(E, F),
 2355    ignore((D \= F, nl)),
 2356    call(Writer, E, Opt),
 2357    term_write_sep_list_inner_3(T, F, Writer, Text, SepElem, SepTail, Opt).
 2358term_write_sep_list_inner_3(T, D, Writer, Text, SepElem, SepTail, Opt) :-
 2359    write_tail(T, D, Writer, Text, SepElem, SepTail, Opt).
 2360
 2361term_write_comma_2(Opt, Term) :- write_term(Term, Opt), write(', ').
 2362
 2363sep_nl(LinePos, Sep, SepNl) :-
 2364    with_output_to(atom(In), line_pos(LinePos)),
 2365    atomic_list_concat([Sep, '\n', In], SepNl).
 2366
 2367write_tail(T, _, Writer, _, _, SepTail, Opt) :-
 2368    var(T),
 2369    !,
 2370    write(SepTail),
 2371    call(Writer, T, Opt).
 2372write_tail([], _, _, _, _, _, _) :- !.
 2373write_tail('$LIST,NL'(L), _, Writer, Text, _, _, Opt) :-
 2374    !,
 2375    offset_pos('$OUTPOS', Pos),
 2376    sep_nl(Pos, ',', Sep),
 2377    term_write_sep_list_inner(L, Writer, Text, Sep, '|', Opt).
 2378write_tail('$LIST,NL'(L, Offs), _, Writer, Text, _, _, Opt) :-
 2379    offset_pos(Offs, Pos),
 2380    !,
 2381    sep_nl(Pos, ',', Sep),
 2382    term_write_sep_list_inner(L, Writer, Text, Sep, '|', Opt).
 2383write_tail(T, D, Writer, _, _, SepTail, Opt) :-
 2384    get_pred(T, F),
 2385    write(SepTail),
 2386    ignore((D \= F, nl)), % this only makes sense on list of clauses
 2387    call(Writer, T, Opt).
 2388
 2389print_expansion_rm_dot(Text, Before, To) :-
 2390    sub_string(Text, Before, _, 0, Right),
 2391    once(sub_string(Right, Next, _, _, ".")),
 2392    To is Before+Next+2.
 2393
 2394% Hacks that can only work at 1st level:
 2395
 2396print_expansion_1(Into, Term, TermPos, Options, Text, To, To) :-
 2397    var(Into),
 2398    !,
 2399    print_expansion(Into, Term, TermPos, Options, Text).
 2400print_expansion_1('$RM', _, _, _, _, To, To) :- !.
 2401print_expansion_1('$C'(Goal, Into), Term, TermPos, Options, Text, To, To) :-
 2402    \+ ( nonvar(Term),
 2403         Term = '$C'(_, _)
 2404       ),
 2405    !,
 2406    call(Goal),
 2407    print_expansion_1(Into, Term, TermPos, Options, Text, To, To).
 2408print_expansion_1('$TEXT'(Into), _, _, Options, _, To, To) :-
 2409    !,
 2410    write_t(Into, Options).
 2411print_expansion_1('$TEXT'(Into, Offs), _, _, Options, _, To1, To) :-
 2412    offset_pos(Offs, Pos),
 2413    !,
 2414    write_t(Into, Options),
 2415    To is To1+Pos.
 2416print_expansion_1('$TEXTQ'(Into), _, _, Options, _, To, To) :-
 2417    !,
 2418    write_q(Into, Options).
 2419print_expansion_1('$TEXTQ'(Into, Offs), _, _, Options, _, To1, To) :-
 2420    offset_pos(Offs, Pos),
 2421    !,
 2422    write_q(Into, Options),
 2423    To is To1+Pos.
 2424print_expansion_1('$LISTC'(IntoL), _, _, Options1, Text, To, To) :-
 2425    !,
 2426    merge_options([priority(1200), portray_clause(true)], Options1, Options),
 2427    term_write_sep_list_3(IntoL, rportray_clause, Text, '.\n', '.\n', Options).
 2428print_expansion_1('$LISTC.NL'(IntoL), _, _, Options1, Text, To, To) :-
 2429    !,
 2430    merge_options([priority(1200), portray_clause(true)], Options1, Options),
 2431    term_write_sep_list_3(IntoL, rportray_clause, Text, '.\n', '.\n', Options),
 2432    write('.\n').
 2433print_expansion_1(Into, Term, TermPos, Options, Text, To1, To) :-
 2434    print_expansion_2(Into, Term, TermPos, Options, Text, To1, To).
 2435
 2436print_expansion_2(Into, Term, TermPos, Options, Text, To, To) :-
 2437    var(Into),
 2438    !,
 2439    print_expansion(Into, Term, TermPos, Options, Text).
 2440print_expansion_2('$sb'(_, RefPos, RepL, Priority, Into), Term, _, Options, Text, To, To) :-
 2441    nonvar(RefPos),
 2442    \+ ( nonvar(Term),
 2443         Term = '$sb'(_, _, _, _, _),
 2444         Into \= '$sb'(_, _, _, _, _)
 2445       ),
 2446    !,
 2447    print_subtext_sb_2(Into, RefPos, RepL, Priority, Text, Options).
 2448print_expansion_2('$NODOT'(Into), Term, TermPos, Options, Text, To1, To) :-
 2449    !,
 2450    print_expansion_2(Into, Term, TermPos, Options, Text, To1, _),
 2451    print_expansion_rm_dot(Text, To1, To).
 2452print_expansion_2('$LIST.NL'(IntoL), Term, TermPos, Options1, Text, To1, To) :-
 2453    !,
 2454    merge_options([priority(1200)], Options1, Options),
 2455    print_expansion_rm_dot(Text, To1, To),
 2456    term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text).
 2457print_expansion_2(Into, Term, Pos, Options, Text, To, To) :-
 2458    % Hey, this is the place, don't overthink about it (test 60)
 2459    Pos = sub_list_position(_, _, _, From1, STo, PosL, Tail),
 2460    !,
 2461    refactor_context(from, From),
 2462    print_subtext(From-From1, Text),
 2463    ( Into == []
 2464    ->true
 2465    ; Into == '$RM'
 2466    ->true
 2467    ; ( is_list(Into)
 2468      ->true
 2469      ; ( get_subtext(From1-STo, Text, Sep1),
 2470          option(comments(Comments), Options, []),
 2471          replace_sep(",", "|", From1, Comments, Sep1, Sep)
 2472        ->print_text(Sep)
 2473        ; write('|') % just in case, but may be never reached
 2474        )
 2475      ),
 2476      with_from(print_expansion(Into, Term, list_position(From1, To, PosL, Tail), Options, Text), From1)
 2477    ),
 2478    ( is_list(Into),
 2479      Into \== []
 2480    ->true
 2481    ; last(PosL, Pos2),
 2482      arg(2, Pos2, To2),
 2483      print_subtext(To2-To, Text)
 2484    ).
 2485print_expansion_2(Into, Term, TermPos, Options, Text, To, To) :-
 2486    print_expansion(Into, Term, TermPos, Options, Text).
 2487
 2488term_write_stop_nl_list([Into|IntoL], Term, TermPos, Options, Text) :-
 2489    term_write_stop_nl__(Into, Term, TermPos, Options, Text),
 2490    term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text).
 2491term_write_stop_nl_list('$sb'(_, _, _, _, IntoL), Term, TermPos, Options, Text) :-
 2492    term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text).
 2493term_write_stop_nl_list([], _, _, _, _).
 2494
 2495term_write_stop_nl__('$NOOP'(Into), Term, TermPos, Options, Text) :- !,
 2496    with_output_to(string(_),   %Ignore, but process
 2497                   term_write_stop_nl__(Into, Term, TermPos, Options, Text)).
 2498term_write_stop_nl__('$NODOT'(Into), Term, TermPos, Options, Text) :- !,
 2499    print_expansion(Into, Term, TermPos, Options, Text).
 2500term_write_stop_nl__(Into, Term, TermPos, Options, Text) :-
 2501    print_expansion(Into, Term, TermPos, Options, Text),
 2502    write('.'),
 2503    nl.
 2504
 2505% if the term have been in parentheses, in a place where that was
 2506% required, include it!!!
 2507%
 2508fix_position_if_braced(term_position(_, _, _, _, _), M,
 2509                       Term, GPriority, Into, Priority, Display) :-
 2510    ( \+ term_needs_braces(M:Term, GPriority),
 2511      ( nonvar(Into),
 2512        term_needs_braces(M:Into, Priority)
 2513        % \+ term_needs_braces(M:Term, Priority)
 2514      )
 2515    ->Display = yes
 2516    ),
 2517    !.
 2518fix_position_if_braced(_, _, _, _, _, _, no). % fail-safe
 2519
 2520% If Term is a replacement, '$sb'/6, we assume that the substitution will not
 2521% require braces (not sure if this is correct, but it works)
 2522term_needs_braces(_:Term, _) :- \+ callable(Term), !, fail.
 2523% term_needs_braces(M:'$sb'(_, _, _, _, _, Into), Pri) :- !,
 2524%     term_needs_braces(M:Into, Pri).
 2525term_needs_braces(M:Term, Pri) :- term_needs_braces(Term, M, Pri).
 2526
 2527term_needs_braces(Term, M, Pri) :-
 2528    functor(Term, Name, Arity),
 2529    valid_op_type_arity(Type, Arity),
 2530    current_op(OpPri, Type, M:Name),
 2531    OpPri > Pri,
 2532    !.
 2533
 2534cond_display(yes, A) :- write(A).
 2535cond_display(no, _).
 2536
 2537:- meta_predicate
 2538    with_cond_braces(5, +, +, +, +, +, +). 2539
 2540print_expansion_sb(Into, Term, TermPos, Priority, Options, Text) :-
 2541    with_cond_braces(do_print_expansion_sb, Into, Term, TermPos, Priority, Options, Text).
 2542
 2543do_print_expansion_sb(Into, Term, TermPos, Options, Text) :-
 2544    arg(1, TermPos, From),
 2545    with_from(print_expansion_ne(Into, Term, TermPos, Options, Text), From).
 2546
 2547with_cond_braces(Call, Into, Term, TermPos, GPriority, Options, Text) :-
 2548    option(module(M), Options),
 2549    option(priority(Priority), Options),
 2550    fix_position_if_braced(TermPos, M, Term, GPriority, Into, Priority, Display),
 2551    cond_display(Display, '('),
 2552    call(Call, Into, Term, TermPos, Options, Text),
 2553    cond_display(Display, ')').
 2554
 2555% TODO: stream position would be biased --EMM
 2556with_str_hook(Command, StrHook) :-
 2557    with_output_to_string(S1, Command),
 2558    ( call(StrHook, S1, S)
 2559    ->true
 2560    ; S = S1
 2561    ),
 2562    format('~s', [S]).