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    % Non-ground dictionaries are not linked but duplicated, therefore we
 1216    % should use ==/2 instead of same_term
 1217    ( is_dict(Term1),
 1218      \+ ground(Term1)
 1219    ->Term1==Term2
 1220    ; same_term(Term1, Term2)
 1221    ),
 1222    !.
 1223subterm_location_same_term([N|L], Term1, Term2, SubTerm) :-
 1224    compound(Term1),
 1225    arg(N, Term1, SubTerm1),
 1226    arg(N, Term2, SubTerm2),
 1227    subterm_location_same_term(L, SubTerm1, SubTerm2, SubTerm).
 1228
 1229:- thread_local partial_path_db/1. 1230
 1231is_scanneable(Term) :-
 1232    compound(Term),
 1233    \+ memberchk(Term, ['$@'(_), '$$'(_), '$G'(_, _)]).
 1234
 1235find_term_path([Spec, Term2, Into2],
 1236               [Spec2, TermLoc2, IntoLoc2, ArgLoc2, SubLoc2],
 1237               [Spec1, TermLoc1, IntoLoc1, ArgLoc1, SubLoc1]) :-
 1238    ( Into2 \== Term2,
 1239      location_subterm_un(IntoLoc2, Into2, is_scanneable, Sub2),
 1240      location_subterm_eq(TermLoc2, Term2, Sub2),
 1241      ArgLoc1 = SubLoc1,
 1242      ( ArgLoc2 = []
 1243      ->Spec1 = Spec2
 1244      ; Spec1 = Spec
 1245      )
 1246    ; ArgLoc2 = [],
 1247      SubLoc2 = [],
 1248      Spec1 = Spec2
 1249    ),
 1250    append(IntoLoc2, SubLoc1, IntoLoc1),
 1251    append(TermLoc2, ArgLoc1, TermLoc1).
 1252
 1253curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size) :-
 1254    retractall(partial_path_db(_)),
 1255    foldl(find_term_path, SpecTermIntoLL,
 1256          [orig, TermLoc, IntoLoc, TermLoc, IntoLoc], [Spec1, TermLoc1, IntoLoc1, _, _]),
 1257    once(location_subterm_un(IntoLoc1, Into1, is_scanneable, Sub1)),
 1258    \+ partial_path_db(IntoLoc1),
 1259    % Next check avoids things like [A|[]] being printed:
 1260    \+ ( memberchk(Spec1, [rawt, texp]),
 1261         Sub1 == []
 1262       ),
 1263    subterm_location(sleq(Arg1, Sub1), Term1, TermLoc1),
 1264    append(IntoLoc1, _, PIntoLoc1),
 1265    assertz(partial_path_db(PIntoLoc1)),
 1266    findall([Ord1, ArgLoc],
 1267            ( subterm_location_same_term(ArgLoc, Arg1, Sub1, ToRep),
 1268              term_size(ToRep, Size1),
 1269              Ord1 is -Size1
 1270            ), ArgLocLU),
 1271    sort(ArgLocLU, ArgLocLL),
 1272    transpose(ArgLocLL, [[Ord1|_], ArgLocL]),
 1273    Size is -Ord1.
 1274
 1275replace_subterm_locations(VNL, SpecTermIntoLL, Term1, Into1, M, TermPos, Priority, Into) :-
 1276    findall(([TermLoc1, IntoLoc1]-ArgLocL),
 1277            order_by([desc(Size)],
 1278                     curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size)),
 1279            TermLocArgLocLL),
 1280    foldl(perform_replacement(VNL, M, TermPos, Priority, Term1, Into1), TermLocArgLocLL, Into1-[], Into-VL),
 1281    maplist(collapse_bindings, VL).
 1282
 1283collapse_bindings(A=B) :- ignore(A=B).
 1284
 1285perform_replacement(VNL, M, TermPos, Priority1, Term1, Into1, [TermLoc, IntoLoc]-ArgLocL, TInto1-VL1, TInto-[Var1=Rep1|VL1]) :-
 1286    % location_subterm_un(TermLoc, Term1, Sub1),
 1287    location_subterm_un(IntoLoc, Into1, Arg1),
 1288    subpos_location(TermLoc, TermPos, SubPos),
 1289    foldl(perform_replacement_2(VNL, SubPos, Arg1), ArgLocL, RepU, []),
 1290    sort(RepU, RepL),
 1291    ( append(L1, [E], TermLoc),
 1292      location_subterm_un(L1, Term1, TP),
 1293      term_priority(TP, M, E, Priority)
 1294    ->true
 1295    ; Priority = Priority1
 1296    ),
 1297    compound(SubPos),
 1298    arg(1, SubPos, From),
 1299    arg(2, SubPos, To),
 1300    From \= To,
 1301    get_innerpos(SubPos, ISubPos),
 1302    Rep1 = '$sb'(SubPos, ISubPos, RepL, Priority, Arg1),
 1303    replace_at_subterm_location(IntoLoc, Var1, TInto1, TInto),
 1304    !.
 1305perform_replacement(_, _, _, _, _, _, _, IntoVL, IntoVL).
 1306
 1307get_innerpos(OSubPos, ISubPos) :-
 1308    OSubPos =.. [F, OFrom, OTo|Args],
 1309    term_innerpos(OFrom, OTo, IFrom, ITo),
 1310    !,
 1311    ISubPos =.. [F, IFrom, ITo|Args].
 1312get_innerpos(SubPos, SubPos).
 1313
 1314replace_at_subterm_location([], Rep, _, Rep).
 1315replace_at_subterm_location([N|L], Rep, Term1, Term2) :-
 1316    compound(Term1),
 1317    compound_name_arguments(Term1, Name, Args1),
 1318    length([_|Left], N),
 1319    append(Left, [Arg1|Right], Args1),
 1320    append(Left, [Arg2|Right], Args2),
 1321    compound_name_arguments(Term2, Name, Args2),
 1322    replace_at_subterm_location(L, Rep, Arg1, Arg2).
 1323
 1324perform_replacement_2(VNL, SubPos, Arg1, ArgLoc) -->
 1325    { subpos_location(ArgLoc, SubPos, ArgPos),
 1326      location_subterm_un(ArgLoc, Arg1, ToRep1)
 1327    },
 1328    ( {var(ToRep1)}
 1329    ->( { member(Name = Var, VNL),
 1330          ToRep1 == Var
 1331        }
 1332      ->['$sb'(ArgPos, '$VAR'(Name))]
 1333      ; []
 1334      )
 1335    ; []
 1336    ).
 1337
 1338fake_pos(T-T).

 trim_fake_pos(+TermPos, -Pos, -N)

remove fake arguments that would be added by dcg

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

 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.

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