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( , , , , , , , , ), 106 fixpoint_file( , , ), 107 reindent( , , ), 108 replace( , , , , ), 109 rportray_list( , , , , ), 110 with_context( , , , , , , , , , , , , , , ), 111 with_cond_braces_2( , , , , , , ), 112 with_counters( , ), 113 with_styles( , ).
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:
If level is sent, some special cases of Term are used to control its behavior:
The term Into could contain certain hacks to control its behavior, as follows:
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'$TEXT'(T,'$OUTPOS')
is equivalent to:
'$POS'(my_outpos, '$TEXT'(T, my_outpos))
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.
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 changesconj_width(+ConjWidth)
Print several conjunctions in the same line, provided that they don't
surpasses ConjWidth columns.
Default is 160term_width(+TermWidth)
Split long terms so that when printed, they don't surpasses TermWidth
columns.
Default is 160list_width(+ListWidth)
Split long lists so that when printed, they don't surpasses ListWidth
columns.
Default is 160linearize(+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 namescomments(-Comments)
Commentssyntax_errors(SE)
Default errorsubterm_positions(-SentPos)
Subterm positionsterm_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.
409replace(Level, Patt, Into, Expander, MOptions) :-
411 meta_options(replace_meta_option, MOptions, Options), 412 with_styles(with_counters(do_replace(Level, Patt, Into, Expander, Options), 413 Options), [-singleton])
413. 414 415replace_meta_option(decrease_metric). 416 417curr_style(Style, CurrStyle) :- 418 arg(1, Style, Name), 419 ( style_check(?(Name)) 420 ->CurrStyle = +Name 421 ; CurrStyle = -Name 422 ). 423 424with_styles(Goal, StyleL) :- 425 maplist(curr_style, StyleL, OldStyleL), 426 setup_call_cleanup(maplist(style_check, StyleL), 427 Goal, 428 maplist(style_check, OldStyleL)). 429 430% Note: To avoid this hook be applied more than once, we record the positions 431% already refactorized in ref_position/3. 432 433remove_attribute(Attr, Var) :- 434 del_attr(Var, Attr). 435 436:- public do_goal_expansion/2. 437 438do_goal_expansion(Term, TermPos) :- 439 compound(TermPos), 440 arg(1, TermPos, From), 441 arg(2, TermPos, To), 442 nonvar(From), 443 nonvar(To), 444 refactor_context(file, File), 445 \+ ref_position(File, From, To), 446 assertz(ref_position(File, From, To)), 447 term_variables(Term, Vars), 448 ( refactor_context(cleanup_attributes, yes) 449 ->maplist(remove_attribute('$var_info'), Vars) 450 ; true 451 ), 452 refactor_context(goal_args, ga(Pattern, Into, Expander)), 453 '$current_source_module'(M), 454 b_getval('$variable_names', VNL), 455 with_varnames( 456 forall(substitute_term_norec(sub, M, Term, TermPos, 999, data(Pattern, Into, Expander, TermPos), Command), 457 assertz(command_db(Command))), 458 VNL). 459 460do_replace(Level, Patt, Into, Expander, Options) :- 461 setup_call_cleanup( 462 prepare_level(Level, Ref), 463 apply_ec_term_level(Level, Patt, Into, Expander, Options), 464 cleanup_level(Level, Ref)). 465 466prepare_level(goal, Ref) :- 467 !, 468 asserta((system:goal_expansion(G, P, _, _) :- 469 once(do_goal_expansion(G, P)),fail), Ref). 470prepare_level(_, _). 471 472cleanup_level(goal, Ref) :- !, 473 erase(Ref), 474 retractall(ref_position(_, _, _)). 475cleanup_level(_, _). 476 477with_counters(Goal, Options1) :- 478 foldl(select_option_default, 479 [max_tries(MaxTries)-MaxTries], 480 Options1, Options), 481 with_refactor_context( 482 ( Goal, 483 refactor_context(count, Count), 484 refactor_context(tries, Tries), 485 foldl(select_option_default, 486 [changes(Count)-Count, 487 tries(Tries) -Tries], 488 Options, _), 489 message_type(Type), 490 print_message(Type, 491 format("~w changes of ~w attempts", [Count, Tries])) 492 ), 493 [max_tries], 494 [MaxTries] 495 ). 496 497param_module_file(clause(CRef), M, File) :- 498 clause_property(CRef, file(File)), 499 clause_property(CRef, module(M)). 500param_module_file(mfiled(MFileD), M, File) :- 501 get_dict(M1, MFileD, FileD), 502 ( M1 = (-) 503 ->true 504 ; M = M1 505 ), 506 get_dict(File, FileD, _). 507 508apply_ec_term_level(Level, Patt, Into, Expander, Options1) :- 509 (Level = goal -> DExpand=yes ; DExpand = no), 510 (Level = sent -> SentPattern = Patt ; true), % speed up 511 option(module(M), Options1, M), 512 foldl(select_option_default, 513 [max_tries(MaxTries)-MaxTries, 514 syntax_errors(SE)-error, 515 subterm_positions(SentPos)-SentPos, 516 term_position(Pos)-Pos, 517 conj_width(ConjWidth)-160, % In (_,_), try to wrap lines 518 term_width(TermWidth)-160, % In terms, try to wrap lines 519 list_width(ListWidth)-160, % In lists, try to wrap lines 520 linearize(Linearize)-[], 521 sentence(SentPattern)-SentPattern, 522 comments(Comments)-Comments, 523 expand(Expand)-DExpand, 524 expanded(Expanded)-Expanded, 525 cleanup_attributes(CleanupAttributes)-yes, 526 fixpoint(FixPoint)-decreasing, 527 max_changes(Max)-Max, 528 variable_names(VNL)-VNL, 529 vars_prefix(Prefix)-'V', 530 file(AFile)-AFile, 531 % By default refactor even non loaded files 532 loaded(Loaded)-false 533 ], 534 Options1, Options2), 535 ( option(clause(CRef), Options2) 536 ->MFileParam = clause(CRef), 537 clause_property(CRef, line_count(Line)), 538 merge_options([line(Line)], Options2, Options3) 539 ; option_module_files([loaded(Loaded), file(AFile)|Options2], MFileD), 540 MFileParam = mfiled(MFileD), 541 Options3 = Options2 542 ), 543 Options = [syntax_errors(SE), 544 subterm_positions(SentPos), 545 term_position(Pos), 546 variable_names(VNL), 547 conj_width(ConjWidth), 548 term_width(TermWidth), 549 list_width(ListWidth), 550 comments(Comments)|Options3], 551 ignore(( var(AFile), 552 File = AFile 553 )), 554 setup_call_cleanup( 555 ( '$current_source_module'(OldM) 556 % freeze(M, '$set_source_module'(_, M)) 557 ), 558 process_sentences( 559 MFileParam, FixPoint, Max, SentPattern, Options, CleanupAttributes, M, File, Expanded, Expand, Pos, 560 ga(Patt, Into, Expander), Linearize, MaxTries, Prefix, Level, data(Patt, Into, Expander, SentPos)), 561 '$set_source_module'(_, OldM)). 562 563param_module_file_sorted(MFileParam, M, File) :- 564 order_by([desc(Size)], 565 ( param_module_file(MFileParam, M, File), 566 ignore(catch(size_file(File, Size), _, Size = 0 )) 567 )). 568 569process_sentences( 570 MFileParam, FixPoint, Max, SentPattern, Options, CleanupAttributes, M, File, Expanded, Expand, 571 Pos, GoalArgs, Linearize, MaxTries, Prefix, Level, Data) :- 572 index_change(Index), 573 ini_counter(0, STries), 574 ini_counter(0, SCount), 575 option(concurrent(Conc), Options, true), 576 cond_forall( 577 Conc, 578 param_module_file_sorted(MFileParam, M, File), 579 process_sentence_file( 580 Index, FixPoint, Max, SentPattern, Options, CleanupAttributes, 581 M, File, Expanded, Expand, Pos, GoalArgs, Linearize, MaxTries, 582 Prefix, Level, Data, Tries, Count), 583 ( inc_counter(STries, Tries, _), 584 inc_counter(SCount, Count, _) 585 )), 586 STries = count(Tries), 587 SCount = count(Count), 588 set_refactor_context(tries, Tries), 589 set_refactor_context(count, Count). 590 591fixpoint_file(none, _, Goal) :- ignore(Goal). 592fixpoint_file(true, Max, Goal) :- 593 repeat, 594 set_refactor_context(modified, false), 595 ignore(Goal), 596 refactor_context(count, Count), 597 ( nonvar(Max), 598 Count >= Max 599 ->! 600 ; true 601 ), 602 ( refactor_context(modified, false) 603 ->! 604 ; print_message(informational, 605 format("Restarting expansion", [])), 606 fail 607 ). 608 609rec_fixpoint_file(rec, P, F) :- rec_ff(P, F). 610rec_fixpoint_file(norec, P, F) :- norec_ff(P, F). 611 612rec_ff(decreasing, none). 613rec_ff(file, true). 614rec_ff(term, none). 615rec_ff(true, none). 616rec_ff(none, none). 617 618norec_ff(decreasing, none). 619norec_ff(file, true). 620norec_ff(term, none). 621norec_ff(true, true). 622norec_ff(none, none). 623 624process_sentence_file(Index, FixPoint, Max, SentPattern, Options, CleanupAttributes, 625 M, File, Expanded, Expand, Pos, GoalArgs, 626 Linearize, MaxTries, Prefix, Level, Data, Tries, Count) :- 627 maplist(set_refactor_context, 628 [bindings, cleanup_attributes, comments, expanded, file, goal_args, modified, 629 tries, count, max_tries, options, pos, prefix, sent_pattern, sentence, subpos], 630 [Bindings, CleanupAttributes, Comments, Expanded, File, GoalArgs, false, 631 0, 0, MaxTries, Options, Pos, Prefix, SentPattern, Sent, SentPos]), 632 \+ \+ ( option(comments(Comments), Options, Comments), 633 option(subterm_positions(SentPos), Options, SentPos), 634 option(variable_names(VNL), Options, VNL), 635 option(term_position(Pos), Options, Pos), 636 level_rec(Level, Rec), 637 rec_fixpoint_file(Rec, FixPoint, FPFile), 638 fixpoint_file(FPFile, Max, 639 apply_commands( 640 Index, File, Level, M, Rec, FixPoint, Max, Pos, 641 gen_module_command( 642 SentPattern, Options, Expand, SentPos, Expanded, 643 Linearize, Sent, VNL, Bindings, Data))) 644 ), 645 refactor_context(tries, Tries), 646 refactor_context(count, Count). 647 648binding_varname(VNL, Var=Term) --> 649 ( { atomic(Term), 650 Term \= [], 651 atomic_concat('_Atm_', Term, Name) 652 ; member(Name=Var1, VNL), 653 Var1==Term 654 } 655 ->[Name=Var] 656 ; [] 657 ). 658 659gen_module_command(SentPattern, Options, Expand, SentPos, Expanded, Linearize, 660 Sent, VNL, Bindings, Data, Level, M, In, Text, Command) :- 661 ref_fetch_term_info(SentPattern, RawSent, In, Options, Once), 662 b_setval('$variable_names', VNL), 663 set_refactor_context(text, Text), 664 expand_if_required(Expand, M, RawSent, SentPos, In, Expanded), 665 make_linear_if_required(RawSent, Linearize, Sent, Bindings), 666 foldl(binding_varname(VNL), Bindings, RVNL, VNL), 667 S = solved(no), 668 ( true 669 ; arg(1, S, yes) 670 ->cond_cut_once(Once), 671 fail 672 ), 673 set_refactor_context(variable_names, RVNL), 674 substitute_term_level(Level, M, Sent, SentPos, 1200, Data, Command), 675 nb_setarg(1, S, yes). 676 677cond_cut_once(once). 678cond_cut_once(mult(CP)) :- prolog_cut_to(CP). 679 680ref_fetch_term_info(SentPattern, Sent, In, Options, once) :- 681 nonvar(SentPattern), 682 memberchk(SentPattern, [[], end_of_file]), 683 !, 684 ref_term_info_file(SentPattern, Sent, In, Options). 685ref_fetch_term_info(SentPattern, Sent, In, Options, mult(CP)) :- 686 repeat, 687 prolog_current_choice(CP), 688 ( fetch_term_info(SentPattern, Sent, Options, In) 689 ; !, 690 fail 691 ). 692 693ref_term_info_file(end_of_file, end_of_file, In, Options) :- 694 seek(In, 0, eof, Size), 695 ref_term_null_option(Size, In, Options). 696ref_term_info_file([], [], In, Options) :- 697 seek(In, 0, bof, 0), 698 ref_term_null_option(0, In, Options). 699 700ref_term_null_option(Size, In, Options) :- 701 option(comments([]), Options), 702 option(subterm_positions(Size-Size), Options), 703 stream_property(In, position(Pos)), 704 option(term_position(Pos), Options), 705 option(variable_names([]), Options). 706 707expand_if_required(Expand, M, Sent, SentPos, In, Expanded) :- 708 ( Expand = no 709 ->Expanded = Sent 710 ; '$expand':expand_terms(prolog_source:expand, Sent, SentPos, In, Expanded) 711 ), 712 ignore(( '$set_source_module'(CM, CM), 713 M = CM 714 )), 715 prolog_source:update_state(Sent, Expanded, M). 716 717make_linear_if_required(Sent, Linearize, Linear, Bindings) :- 718 foldl(linearize, Linearize, Sent-Bindings, Linear-[]). 719 720linearize(Which, Sent-Bindings1, Linear-Bindings) :- 721 linearize(Which, Sent, Linear, Bindings1, Bindings). 722 723prologxref_open_source(File, Fd) :- 724 nb_current(ti_open_source, yes), 725 !, 726 ( pending_change(_, File, Text) 727 ->true 728 ; read_file_to_string(File, Text, []) 729 ), 730 open_codes_stream(Text, Fd). 731 % set_refactor_context(text, Text). % NOTE: update_state/2 has the side effect of 732 % modify refactor_text 733 734substitute_term_level(goal, _, _, _, _, _, Cmd) :- 735 retract(command_db(Cmd)). 736substitute_term_level(term, M, Sent, SentPos, Priority, Data, Cmd) :- 737 substitute_term_rec(M, Sent, SentPos, Priority, Data, Cmd). 738substitute_term_level(sent, M, Sent, SentPos, Priority, Data, Cmd) :- 739 substitute_term_norec(top, M, Sent, SentPos, Priority, Data, Cmd). 740substitute_term_level(head, M, Sent, SentPos, Priority, Data, Cmd) :- 741 substitute_term_head(norec, M, Sent, SentPos, Priority, Data, Cmd). 742substitute_term_level(head_rec, M, Sent, SentPos, Priority, Data, Cmd) :- 743 substitute_term_head(rec, M, Sent, SentPos, Priority, Data, Cmd). 744substitute_term_level(body, M, Sent, SentPos, _, Data, Cmd) :- 745 substitute_term_body(norec, M, Sent, SentPos, Data, Cmd). 746substitute_term_level(body_rec, M, Sent, SentPos, _, Data, Cmd) :- 747 substitute_term_body(rec, M, Sent, SentPos, Data, Cmd). 748 749substitute_term_body(Rec, M, Sent, parentheses_term_position(_, _, TermPos), Data, Cmd) :- 750 !, 751 substitute_term_body(Rec, M, Sent, TermPos, Data, Cmd). 752substitute_term_body(Rec, M, (_ :- Body), term_position(_, _, _, _, [_, BodyPos]), Data, 753 Cmd) :- 754 term_priority((_ :- Body), M, 2, Priority), 755 substitute_term(Rec, sub, M, Body, BodyPos, Priority, Data, Cmd). 756 757substitute_term_head(Rec, M, Clause, parentheses_term_position(_, _, TermPos), Priority, 758 Data, Cmd) :- 759 !, 760 substitute_term_head(Rec, M, Clause, TermPos, Priority, Data, Cmd). 761substitute_term_head(Rec, M, Clause, TermPos, Priority, Data, Cmd) :- 762 ( Clause = (MHead :- _) 763 ->( nonvar(MHead), 764 MHead = IM:Head 765 ->term_priority(IM:Head, M, 2, HPriority), 766 term_position(_, _, _, _, [MHPos, _]) = TermPos, 767 mhead_pos(MHPos, HeadPos) 768 ; Head = MHead, 769 term_priority(Clause, M, 1, HPriority), 770 term_position(_, _, _, _, [HeadPos, _]) = TermPos 771 ) 772 ; Clause \= (:- _), 773 Head = Clause, 774 HPriority = Priority, 775 HeadPos = TermPos 776 ), 777 substitute_term(Rec, sub, M, Head, HeadPos, HPriority, Data, Cmd). 778 779mhead_pos(parentheses_term_position(_, _, Pos), HPos) :- !, mhead_pos(Pos, HPos). 780mhead_pos(term_position(_, _, _, _, [_, HPos]), HPos). 781 782substitute_term(rec, _, M, Term, TermPos, Priority, Data, Cmd) :- 783 substitute_term_rec(M, Term, TermPos, Priority, Data, Cmd). 784substitute_term(norec, Level, M, Term, TermPos, Priority, Data, Cmd) :- 785 substitute_term_norec(Level, M, Term, TermPos, Priority, Data, Cmd). 786 787%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 788% ANCILLARY PREDICATES: 789%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 790 791level_rec(goal, norec). 792level_rec(term, rec). 793level_rec(sent, norec). 794level_rec(head, norec). 795level_rec(head_rec, rec). 796level_rec(body, norec). 797level_rec(body_rec, rec). 798 799rec_fixpoint_term(norec, _, not). 800rec_fixpoint_term(rec, P, F) :- rec_ft(P, F). 801 802rec_ft(decreasing, dec). 803rec_ft(file, not). 804rec_ft(term, rec). 805rec_ft(true, rec). 806rec_ft(none, not). 807rec_ft(false, not). 808 809% This is weird due to the operators 810apply_commands(Index, File, Level, M, Rec, FixPoint, Max, Pos, GenModuleCommand) :- 811 ( pending_change(_, File, Text1) 812 ->true 813 ; exists_file(File) 814 ->read_file_to_string(File, Text1, []) 815 ; Text1 = "" 816 ), 817 rec_fixpoint_term(Rec, FixPoint, FPTerm), 818 with_refactor_context( 819 with_source_file( 820 File, In, 821 apply_commands_stream( 822 FPTerm, GenModuleCommand, File, Level, M, nocs, Max, Pos, In, Text1, Text)), 823 [file], [File]), 824 ( Text1 \= Text 825 ->nb_set_refactor_context(modified, true), 826 save_change(Index, File-Text) 827 ; true 828 ). 829 830decreasing_recursion(nocs, _). 831decreasing_recursion(subst(_, _, _, _, S1), 832 subst(_, _, _, _, S2)) :- 833 freeze(S2, S1 > S2). 834 835do_recursion(dec(G), C, G, C). 836do_recursion(rec(G), _, G, nocs). 837 838rec_command_info(not, _, not). 839rec_command_info(rec, G, rec(C)) :- copy_term(G, C). 840rec_command_info(dec, G, dec(C)) :- copy_term(G, C). 841 842increase_counter(Count1) :- 843 refactor_context(count, Count), 844 succ(Count, Count1), 845 nb_set_refactor_context(count, Count1). 846 847fix_exception(error(Error, stream(_, Line, Row, Pos)), File, 848 error(Error, file(File, Line, Row, Pos))) :- !. 849fix_exception(E, _, E). 850 851do_genmcmd(GenModuleCommand, File, Level, M, CS, Max, In, Text, Command) :- 852 decreasing_recursion(CS, Command), 853 catch(call(GenModuleCommand, Level, M, In, Text, Command), 854 E1, 855 ( fix_exception(E1, File, E), 856 print_message(error, E), 857 fail 858 )), 859 increase_counter(Count1), 860 ( nonvar(Max), 861 Count1 >= Max 862 ->! 863 ; true 864 ). 865 866:- thread_local subtext_db/2. 867 868apply_commands_stream(FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text) :- 869 retractall(subtext_db(_, _)), 870 apply_commands_stream(1, FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text). 871 872apply_commands_stream(RecNo, FPTerm, GenModuleCommand, File, Level, M, CS, Max, Pos, In, Text1, Text) :- 873 IPosText = ipt(0 ), 874 rec_command_info(FPTerm, GenModuleCommand, CI), 875 ignore( 876 forall( 877 do_genmcmd(GenModuleCommand, File, Level, M, CS, Max, In, Text1, Command), 878 apply_commands_stream_each( 879 RecNo, FPTerm, File, CI, M, Max, Pos, Command, Text1, IPosText))), 880 IPosText = ipt(Pos1), 881 sub_string(Text1, Pos1, _, 0, Text3), 882 findall(SubText, retract(subtext_db(RecNo, SubText)), TextL, [Text3]), 883 atomics_to_string(TextL, Text). 884 885apply_commands_stream_each(RecNo1, FPTerm, File, CI, M, Max, Pos1, Command, Text, IPosText) :- 886 apply_change(Text, M, Command, FromToPText1), 887 ( do_recursion(CI, Command, GenModuleCommand, CS), 888 FromToPText1 = t(From, To, PasteText1), 889 get_out_pos(Text, Pos1, From, LPos), 890 line_pos(LPos, atom(LeftText)), 891 atomics_to_string([LeftText, PasteText1], Text1), 892 setup_call_cleanup( 893 ( atomics_to_string([Text1, "."], TextS), 894 open_codes_stream(TextS, In), 895 stream_property(In, position(Pos3)), 896 set_refactor_context(text, Text1), 897 succ(RecNo1, RecNo) 898 ), 899 apply_commands_stream(RecNo, FPTerm, GenModuleCommand, File, 900 term, M, CS, Max, Pos3, In, Text1, Text2), 901 close(In)) 902 ->atomics_string([LeftText, PasteText2], Text2), 903 FromToPText = t(From, To, PasteText2) 904 ; FromToPText = FromToPText1 905 ), 906 string_concat_to(RecNo1, Text, FromToPText, IPosText). 907 908get_out_pos(Text, Pos, From, LPos) :- 909 stream_position_data(line_position, Pos, LPos1), 910 stream_position_data(char_count, Pos, Pos1), 911 Length is max(0, From-Pos1), 912 sub_string(Text, Pos1, Length, _, Text2), 913 with_output_to(atom(_), 914 ( line_pos(LPos1), 915 format("~s", [Text2]), 916 stream_property(current_output, position(Pos2)), 917 stream_position_data(line_position, Pos2, LPos) 918 )). 919 920/* This was too slow --EMM 921get_out_pos(RText, Pos-Text1, From, LPos) :- 922 Length is max(0, From - Pos), 923 sub_string(RText, Pos, Length, _, Text2), 924 string_concat(Text1, Text2, Text3), 925 textpos_line(Text3, From, LPos). 926*/ 927 928string_concat_to(RecNo, Text, t(From, To, Text2), IPos) :- 929 IPos = ipt(Pos), 930 Length is max(0, From - Pos), 931 sub_string(Text, Pos, Length, _, Text1), 932 nb_setarg(1, IPos, To), 933 assertz(subtext_db(RecNo, Text1)), 934 ignore(space_succ_operators(RecNo, Text1, Text2)), 935 assertz(subtext_db(RecNo, Text2)).
940space_succ_operators(RecNo, Text1, Text2) :- 941 sub_string(Text1, _, 1, 0, Char1), 942 sub_string(Text2, 0, 1, _, Char2), 943 char_type(Char1, prolog_symbol), 944 char_type(Char2, prolog_symbol), 945 assertz(subtext_db(RecNo, " ")). 946 947gen_new_variable_name(VNL, Prefix, Count, Name) :- 948 atom_concat(Prefix, Count, Name), 949 \+ member(Name=_, VNL), !. 950gen_new_variable_name(VNL, Prefix, Count1, Name) :- 951 succ(Count1, Count), 952 gen_new_variable_name(VNL, Prefix, Count, Name). 953 954will_occurs(Var, Sent, Pattern, Into, VNL, T) :- 955 findall(N, 956 ( member(Name=Var1, VNL), 957 Name \= '_', 958 Var==Var1 959 ->member(Name=Var2, VNL), 960 will_occurs(Var2, Sent, Pattern, Into, N) 961 ; will_occurs(Var, Sent, Pattern, Into, N) 962 ), NL), 963 sum_list(NL, T). 964 965will_occurs(Var, Sent, Pattern, Into, N) :- 966 occurrences_of_var(Var, Sent, SN), 967 occurrences_of_var(Var, Pattern, PN), 968 occurrences_of_var(Var, Into, IN), 969 N is SN-PN+IN. 970 971gen_new_variable_names([], _, _, _, _, _, _, VNL, VNL). 972gen_new_variable_names([Var|VarL], [Name1|NameL], Prefix, Count1, 973 Sent, Pattern, Into, VNL1, VNL) :- 974 ( nonvar(Name1) 975 ->VNL2 = VNL1, 976 Count = Count1 977 ; will_occurs(Var, Sent, Pattern, Into, VNL1, N), 978 N > 1 979 ->gen_new_variable_name(VNL1, Prefix, Count1, Name), 980 succ(Count1, Count), 981 VNL2 = [Name=Var|VNL1] 982 ; VNL2 = ['_'=Var|VNL1], 983 Count = Count1 984 ), 985 gen_new_variable_names(VarL, NameL, Prefix, Count, Sent, Pattern, Into, VNL2, VNL). 986 987level_1_term(V) :- var(V), !, fail. 988level_1_term('$RM'). 989level_1_term('$C'(_, Into)) :- level_1_term(Into). 990level_1_term('$TEXT'(_)). 991level_1_term('$TEXT'(_, _)). 992level_1_term('$TEXTQ'(_)). 993level_1_term('$TEXTQ'(_, _)). 994level_1_term('$LISTC'(_)). 995level_1_term('$LISTC.NL'(_)). 996 997apply_change(Text, M, subst(TermPos, Options, Term, Into, _), 998 t(From, To, PasteText)) :- 999 ( level_1_term(Into) 1000 ->ITermPos = TermPos 1001 ; get_innerpos(TermPos, ITermPos) 1002 ), 1003 arg(1, ITermPos, From), 1004 arg(2, ITermPos, To1), 1005 call_cleanup( 1006 with_output_to( 1007 string(OutputText), 1008 ( stream_property(current_output, position(Pos1)), 1009 with_from( 1010 with_termpos( 1011 print_expansion_1(Into, Term, ITermPos, 1012 [ module(M), 1013 text(Text) 1014 |Options 1015 ], Text, To1, To), 1016 TermPos), 1017 From), 1018 stream_property(current_output, position(Pos2)) 1019 )), 1020 retractall(rportray_pos(_, _))), 1021 stream_position_data(char_count, Pos1, B1), 1022 stream_position_data(char_count, Pos2, B2), 1023 get_subtext(OutputText, B1, B2, PasteText). 1024 1025wr_options([portray_goal(ref_replace:rportray), 1026 spacing(next_argument), 1027 numbervars(true), 1028 quoted(true), 1029 partial(true), 1030 character_escapes(false)]). 1031 1032call_expander(Expander, TermPos, Pattern, Into) :- 1033 refactor_context(tries, Tries), 1034 refactor_context(max_tries, MaxTries), 1035 ( nonvar(MaxTries) 1036 ->Tries < MaxTries 1037 ; true 1038 ), 1039 succ(Tries, Tries1), 1040 nb_set_refactor_context(tries, Tries1), 1041 with_refactor_context(catch(once(Expander), Error, 1042 ( refactor_message(error, Error), 1043 fail 1044 )), 1045 [termpos, pattern, into], 1046 [TermPos, Pattern, Into]). 1047 1048special_term(top, Term1, Into1, Into7, Into) :- 1049 ( nonvar(Into1), 1050 escape_term(Into1) 1051 ->Into = Into7 1052 ; nonvar(Term1), 1053 memberchk(Term1, [[], end_of_file]) 1054 ->( \+ is_list(Into1) 1055 ->List = [Into7] 1056 ; List = Into7 1057 ), 1058 Into = '$LISTC.NL'(List) 1059 ; var(Into1) 1060 ->Into = Into7 1061 ; is_list(Into1), 1062 same_length(Into1, Term1) 1063 ->Into = Into7 1064 ; Into1 = [_|_] 1065 ->Into = '$LISTC'(Into7) 1066 ; Into1 = [] 1067 ->Into = '$RM' 1068 ; Into1 = '$C'(C, []) 1069 ->Into = '$C'(C, '$RM') 1070 ; Into = Into7 1071 ). 1072special_term(sub_cw, _, _, Term, Term). 1073special_term(sub, _, _, Term, Term). 1074 1075trim_hacks(Term, Trim) :- 1076 substitute(trim_hack, Term, Trim). 1077 1078trim_hack(Term, Trim) :- 1079 nonvar(Term), 1080 do_trim_hack(Term, Trim1), 1081 trim_hacks(Trim1, Trim). 1082 1083do_trim_hack('$@'(Term, _), Term). 1084do_trim_hack('@@'(Term, _), Term). 1085do_trim_hack('$C'(_, Term), Term). 1086do_trim_hack(\\(Term), Term). 1087do_trim_hack('$NOOP'(_), ''). 1088 1089remove_hacks(H, T) :- 1090 trim_hacks(H, S), 1091 deref_substitution(S, T). 1092 1093match_vars_with_names(VNL1, Var, Name) :- 1094 ignore(( member(Name=Var1, VNL1), 1095 Var == Var1 1096 )). 1097 1098gen_new_variable_names(Sent, Term, Into, VNL, NewVNL) :- 1099 refactor_context(prefix, Prefix), 1100 refactor_context(variable_names, VNL1), 1101 trim_hacks(Into, TInto), 1102 term_variables(TInto, VarL), 1103 maplist(match_vars_with_names(VNL1), VarL, NameL), 1104 gen_new_variable_names(VarL, NameL, Prefix, 1, Sent, Term, TInto, VNL1, VNL), 1105 once(append(NewVNL, VNL1, VNL)). 1106 1107check_bindings(Sent, Sent2, Options) :- 1108 ( Sent=@=Sent2 1109 ->true 1110 ; option(show_left_bindings(Show), Options, false), 1111 ( Show = true 1112 ->refactor_message(warning, format("Bindings occurs: ~w \\=@= ~w.", [Sent2, Sent])) 1113 ; true 1114 ) 1115 ). 1116 1117:- public 1118 pattern_size/3. 1119 1120pattern_size(Term, Pattern, Size) :- 1121 findall(S, 1122 ( sub_term(Sub, Term), 1123 subsumes_term(Pattern, Sub), 1124 term_size(Sub, S) 1125 ), SL), 1126 sum_list(SL, Size). 1127 1128fix_subtermpos(Pattern, _, _, _, _) :- 1129 nonvar(Pattern), 1130 memberchk(Pattern, [[], end_of_file]), !. 1131fix_subtermpos(_, Into, Sub, TermPos, Options) :- 1132 fix_subtermpos(Sub, Into, TermPos, Options). 1133 1134fix_subtermpos(sub_cw, _, _, _). % Do nothing 1135fix_subtermpos(sub, _, TermPos, Options) :- 1136 fix_subtermpos(TermPos, Options). 1137fix_subtermpos(top, Into, TermPos, Options) :- 1138 ( Into \= [_|_] 1139 ->fix_termpos( TermPos, Options) 1140 ; fix_subtermpos(TermPos, Options) 1141 ).
1147substitute_term_norec(Sub, M, Term, TermPos1, Priority, 1148 data(Pattern1, Into1, Expander, SentPos), 1149 subst(TTermPos1, SubstOptions, Term, Into, Size)) :- 1150 wr_options(WriteOptions), 1151 refactor_context(sentence, Sent), 1152 refactor_context(sent_pattern, SentPattern), 1153 subsumes_term(SentPattern-Pattern1, Sent-Term), 1154 refactor_context(options, Options), 1155 merge_options([priority(Priority), 1156 variable_names(VNL), 1157 new_variable_names(NewVNL) 1158 |WriteOptions], Options, SubstOptions), 1159 option(decrease_metric(Metric), Options, ref_replace:pattern_size), 1160 call(Metric, Term, Pattern1, Size), 1161 with_context(Sub, M, Term, TermPos1, TTermPos1, Priority, Sent, SentPos, Pattern1, Into1, Into, VNL, NewVNL, Expander, Options). 1162 1163val_subs(V, S) --> 1164 ( {var(S)} 1165 ->{V=S} 1166 ; [V=S] 1167 ). 1168 1169with_context(Sub, M, Term1, TermPos1, TTermPos1, Priority, Sent1, SentPos1, Pattern1, Into1, Into, VNL, NewVNL, Expander1, Options) :- 1170 % Suffix numbers in variables should refer to: 1171 % 1: Term changes during Expander1 execution 1172 % 2: Substitutions instead of unifications in Into2 due to Term changes in (1) 1173 % 3: The raw Term, as read from the file 1174 % 4: Pattern changes during Expander1 execution 1175 % 5: Original pattern 1176 refactor_context(sent_pattern, SentPattern1), 1177 copy_term(SentPattern1-Pattern1-Into1, _Sent5-Term5-Into5), 1178 copy_term(SentPattern1-Pattern1-Into1, _Sent4-Term4-Into4), 1179 Pattern1 = Term1, 1180 SentPattern1 = Sent1, 1181 term_variables(Sent1-Term1-Into1, Vars1), 1182 copy_term(Sent1-Term1-Into1-Vars1, Sent3-Term3-Into3-Vars3), 1183 call_expander(Expander1, TermPos1, Term4, Into4), 1184 Term2 = Term3, 1185 foldl(val_subs, Vars3, Vars1, ValSubs, []), 1186 substitute_values(ValSubs, Into3, Into2), 1187 check_bindings(Sent1, Sent3, Options), 1188 gen_new_variable_names(Sent1, Term1, Into1, VNL, NewVNL), 1189 trim_fake_pos(TermPos1, TTermPos1, N), 1190 substitute_value(TermPos1, TTermPos1, SentPos1, TSentPos1), 1191 trim_fake_args_ll(N, [[ _, Term2, Into2], 1192 [orig, Term5, Into5], 1193 [pexp, Term4, Into4], 1194 %[rawt, Term3, Into3], % Not needed since it is implicit in (2) 1195 [texp, Term2, Into2]], 1196 [[_, TTerm1, TInto1]|SpecTermIntoLL]), 1197 /* Note: fix_subtermpos/5 is a very expensive predicate, due to that we 1198 delay its execution until its result be really needed, and we only 1199 apply it to the subterm positions being affected by the refactoring. 1200 The predicate performs destructive assignment (as in imperative 1201 languages), modifying term position once the predicate is called */ 1202 fix_subtermpos(TTerm1, TInto1, Sub, TSentPos1, Options), 1203 set_refactor_context(subpos, TSentPos1), 1204 replace_subterm_locations(NewVNL, SpecTermIntoLL, TTerm1, TInto1, M, TTermPos1, Priority, TInto7), 1205 special_term(Sub, TTerm1, TInto1, TInto7, Into). 1206 1207sleq(Term, Into, Term) :- Term == Into. 1208 1209subterm_location_same_term([], Term1, Term2, Term1) :- 1210 same_term(Term1, Term2), 1211 !. 1212subterm_location_same_term([N|L], Term1, Term2, SubTerm) :- 1213 compound(Term1), 1214 arg(N, Term1, SubTerm1), 1215 arg(N, Term2, SubTerm2), 1216 subterm_location_same_term(L, SubTerm1, SubTerm2, SubTerm). 1217 1218:- thread_local partial_path_db/1. 1219 1220is_scanneable(Term) :- 1221 compound(Term), 1222 \+ memberchk(Term, ['$@'(_), '$$'(_), '$G'(_, _)]). 1223 1224find_term_path([Spec, Term2, Into2], 1225 [Spec2, TermLoc2, IntoLoc2, ArgLoc2, SubLoc2], 1226 [Spec1, TermLoc1, IntoLoc1, ArgLoc1, SubLoc1]) :- 1227 ( Into2 \== Term2, 1228 location_subterm_un(IntoLoc2, Into2, is_scanneable, Sub2), 1229 location_subterm_eq(TermLoc2, Term2, Sub2), 1230 ArgLoc1 = SubLoc1, 1231 ( ArgLoc2 = [] 1232 ->Spec1 = Spec2 1233 ; Spec1 = Spec 1234 ) 1235 ; ArgLoc2 = [], 1236 SubLoc2 = [], 1237 Spec1 = Spec2 1238 ), 1239 append(IntoLoc2, SubLoc1, IntoLoc1), 1240 append(TermLoc2, ArgLoc1, TermLoc1). 1241 1242curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size) :- 1243 retractall(partial_path_db(_)), 1244 foldl(find_term_path, SpecTermIntoLL, 1245 [orig, TermLoc, IntoLoc, TermLoc, IntoLoc], [Spec1, TermLoc1, IntoLoc1, _, _]), 1246 once(location_subterm_un(IntoLoc1, Into1, is_scanneable, Sub1)), 1247 \+ partial_path_db(IntoLoc1), 1248 % Next check avoids things like [A|[]] being printed: 1249 \+ ( memberchk(Spec1, [rawt, texp]), 1250 Sub1 == [] 1251 ), 1252 subterm_location(sleq(Arg1, Sub1), Term1, TermLoc1), 1253 append(IntoLoc1, _, PIntoLoc1), 1254 assertz(partial_path_db(PIntoLoc1)), 1255 findall([Ord1, ArgLoc], 1256 ( subterm_location_same_term(ArgLoc, Arg1, Sub1, ToRep), 1257 term_size(ToRep, Size1), 1258 Ord1 is -Size1 1259 ), ArgLocLU), 1260 sort(ArgLocLU, ArgLocLL), 1261 transpose(ArgLocLL, [[Ord1|_], ArgLocL]), 1262 Size is -Ord1. 1263 1264replace_subterm_locations(VNL, SpecTermIntoLL, Term1, Into1, M, TermPos, Priority, Into) :- 1265 findall(([TermLoc1, IntoLoc1]-ArgLocL), 1266 order_by([desc(Size)], 1267 curr_subterm_replacement(SpecTermIntoLL, Term1, Into1, TermLoc1, IntoLoc1, ArgLocL, Size)), 1268 TermLocArgLocLL), 1269 foldl(perform_replacement(VNL, M, TermPos, Priority, Term1, Into1), TermLocArgLocLL, Into1-[], Into-VL), 1270 maplist(collapse_bindings, VL). 1271 1272collapse_bindings(A=B) :- ignore(A=B). 1273 1274perform_replacement(VNL, M, TermPos, Priority1, Term1, Into1, [TermLoc, IntoLoc]-ArgLocL, TInto1-VL1, TInto-[Var1=Rep1|VL1]) :- 1275 % location_subterm_un(TermLoc, Term1, Sub1), 1276 location_subterm_un(IntoLoc, Into1, Arg1), 1277 subpos_location(TermLoc, TermPos, SubPos), 1278 foldl(perform_replacement_2(VNL, SubPos, Arg1), ArgLocL, RepU, []), 1279 sort(RepU, RepL), 1280 ( append(L1, [E], TermLoc), 1281 location_subterm_un(L1, Term1, TP), 1282 term_priority(TP, M, E, Priority) 1283 ->true 1284 ; Priority = Priority1 1285 ), 1286 compound(SubPos), 1287 arg(1, SubPos, From), 1288 arg(2, SubPos, To), 1289 From \= To, 1290 get_innerpos(SubPos, ISubPos), 1291 Rep1 = '$sb'(SubPos, ISubPos, RepL, Priority, Arg1), 1292 replace_at_subterm_location(IntoLoc, Var1, TInto1, TInto), 1293 !. 1294perform_replacement(_, _, _, _, _, _, _, IntoVL, IntoVL). 1295 1296get_innerpos(OSubPos, ISubPos) :- 1297 OSubPos =.. [F, OFrom, OTo|Args], 1298 term_innerpos(OFrom, OTo, IFrom, ITo), 1299 !, 1300 ISubPos =.. [F, IFrom, ITo|Args]. 1301get_innerpos(SubPos, SubPos). 1302 1303replace_at_subterm_location([], Rep, _, Rep). 1304replace_at_subterm_location([N|L], Rep, Term1, Term2) :- 1305 compound(Term1), 1306 compound_name_arguments(Term1, Name, Args1), 1307 length([_|Left], N), 1308 append(Left, [Arg1|Right], Args1), 1309 append(Left, [Arg2|Right], Args2), 1310 compound_name_arguments(Term2, Name, Args2), 1311 replace_at_subterm_location(L, Rep, Arg1, Arg2). 1312 1313perform_replacement_2(VNL, SubPos, Arg1, ArgLoc) --> 1314 { subpos_location(ArgLoc, SubPos, ArgPos), 1315 location_subterm_un(ArgLoc, Arg1, ToRep1) 1316 }, 1317 ( {var(ToRep1)} 1318 ->( { member(Name = Var, VNL), 1319 ToRep1 == Var 1320 } 1321 ->['$sb'(ArgPos, '$VAR'(Name))] 1322 ; [] 1323 ) 1324 ; [] 1325 ). 1326 1327fake_pos(T-T).
1332trim_fake_pos(Pos1, Pos, N) :- 1333 ( nonvar(Pos1), 1334 Pos1 = term_position(F, T, FF, FT, PosL1), 1335 nonvar(PosL1) 1336 ->partition(fake_pos, PosL1, FakePosL, PosL), 1337 length(FakePosL, N), 1338 Pos = term_position(F, T, FF, FT, PosL) 1339 ; Pos = Pos1, 1340 N = 0 1341 ). 1342 1343trim_fake_args_ll(N, L, T) :- 1344 maplist(trim_fake_args_l(N), L, T). 1345 1346trim_fake_args_l(N, [E|L], [E|T]) :- 1347 maplist(trim_fake_args(N), L, T). 1348 1349trim_fake_args(N, Term1, Term) :- 1350 ( N > 0, 1351 Term1 =.. ATerm1, 1352 length(TE, N), 1353 append(ATerm, TE, ATerm1), 1354 Term =.. ATerm 1355 ->true 1356 ; Term = Term1 1357 ).
data(Pattern, Into, Expander, SentPos)
.
This predicate must be cautious about handling bindings:
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.
1374substitute_term_rec(M, Term, TermPos, Priority, Data, Cmd) :- 1375 substitute_term_norec(sub, M, Term, TermPos, Priority, Data, Cmd), 1376 !. 1377substitute_term_rec(M, Term, TermPos, _, Data, Cmd) :- 1378 substitute_term_into(TermPos, M, Term, Data, Cmd). 1379 1380substitute_term_into(brace_term_position(_, _, Pos), M, {Term}, Data, Cmd) :- 1381 substitute_term_rec(M, Term, Pos, 1200, Data, Cmd). 1382substitute_term_into(parentheses_term_position(_, _, Pos), M, Term, Data, Cmd) :- 1383 substitute_term_rec(M, Term, Pos, 1200, Data, Cmd). 1384substitute_term_into(term_position(_, _, _, _, PosL), M, Term, Data, Cmd) :- 1385 substitute_term_args(PosL, M, Term, Data, Cmd). 1386substitute_term_into(Pos, M, Term, Data, Cmd) :- 1387 member(Pos, [list_position(_, _, _, _), 1388 sub_list_position(_, _, _, _, _, _, _)]), 1389 neck, 1390 substitute_term_list(Pos, M, Term, Data, Cmd). 1391substitute_term_into(dict_position(_, _, _, _, PosL), M, Term, Data, Cmd) :- 1392 member(Pos, PosL), 1393 substitute_term_pair(M, Term, Pos, Data, Cmd). 1394 1395substitute_term_pair(M, Term, key_value_position(_, _, _, _, Key, PosK, PosV), Data, Cmd) :- 1396 ( substitute_term_rec(M, Key, PosK, 999, Data, Cmd) 1397 ; substitute_term_rec(M, Term.Key, PosV, 999, Data, Cmd) 1398 ). 1399 1400:- use_module(library(listing), []). 1401 1402term_priority(Term, M, N, Priority) :- 1403 compound(Term), 1404 term_priority_gnd(Term, M, N, PrG), 1405 ( arg(N, Term, Arg), 1406 term_needs_braces(M:Arg, PrG) 1407 ->Priority = 999 1408 ; Priority = PrG 1409 ). 1410 1411term_priority_gnd(Term, M, N, PrG) :- 1412 functor(Term, F, A), 1413 ( ( A == 1 1414 ->( prolog_listing:prefix_op(M:F, PrG) -> true 1415 ; prolog_listing:postfix_op(M:F, PrG) -> true 1416 ) 1417 ; A == 2 1418 ->prolog_listing:infix_op(M:F, Left, Right), 1419 ( N==1 -> PrG = Left 1420 ; N==2 -> PrG = Right 1421 ) 1422 ) 1423 ->true 1424 ; term_priority((_, _), user, 1, PrG) 1425 ). 1426 1427substitute_term_args(PAL, M, Term, Data, Cmd) :- 1428 nth1(N, PAL, PA), 1429 arg(N, Term, Arg), 1430 term_priority(Term, M, N, Priority), 1431 substitute_term_rec(M, Arg, PA, Priority, Data, Cmd). 1432 1433substitute_term_list(Pos, M, [Elem|Tail], Data, Cmd) :- 1434 member(Loc-Term, [1-Elem, 2-Tail]), 1435 subpos_location([Loc], Pos, SubPos), 1436 term_priority([_|_], M, Loc, Priority), 1437 substitute_term_rec(M, Term, SubPos, Priority, Data, Cmd). 1438 1439compound_positions(Line1, Pos2, Pos1, Pos) :- Line1 =< 1, !, Pos is Pos1+Pos2. 1440compound_positions(_, Pos, _, Pos). 1441 1442get_output_position(Pos) :- 1443 ( refactor_context(from, From) 1444 ->true 1445 ; From = 0 1446 ), 1447 get_output_position(From, Pos). 1448 1449get_output_position(From, Pos) :- 1450 refactor_context(text, Text), 1451 textpos_line(Text, From, Pos1), 1452 stream_property(current_output, position(StrPos)), 1453 stream_position_data(line_count, StrPos, Line1), 1454 stream_position_data(line_position, StrPos, Pos2), 1455 compound_positions(Line1, Pos2, Pos1, Pos). 1456 1457write_term_dot_nl(Term, OptL) :- 1458 write_term(Term, OptL), 1459 write('.\n'). 1460 1461rportray_clause(Clause, OptL) :- rportray_clause(Clause, 0, OptL). 1462 1463% We can not use portray_clause/3 because it does not handle the hooks 1464% portray_clause_(OptL, Clause) :- 1465% portray_clause(current_output, Clause, OptL). 1466 1467rportray_clause(C, Pos, OptL1) :- 1468 option(module(M), OptL1), 1469 stream_property(current_output, position(SPos1)), 1470 merge_options([portray_clause(false), partial(false)], OptL1, OptL2), 1471 write(''), 1472 write_term(C, OptL2), 1473 stream_property(current_output, position(SPos2)), 1474 ( nonvar(C), 1475 ( stream_position_data(line_count, SPos1, Line1), 1476 stream_position_data(line_count, SPos2, Line2), 1477 Line1 \= Line2 1478 ; stream_position_data(line_position, SPos2, Pos2), 1479 Pos2 > 80 1480 ) 1481 ->set_stream_position(current_output, SPos1), 1482 ( option(priority(CPri), OptL1), 1483 term_needs_braces(C, M, CPri) 1484 ->Display = yes, 1485 succ(Pos, BPos) 1486 ; Display = no, 1487 BPos = Pos 1488 ), 1489 cond_display(Display, '('), 1490 merge_options([portray_clause(true)], OptL1, OptL3), 1491 ( memberchk(C, [(H :- B), (H --> B)]) 1492 ->write(''), 1493 write_term(H, OptL3), 1494 functor(C, Neck, _), 1495 write(' '), 1496 writeln(Neck), 1497 line_pos(4+BPos), 1498 term_priority((_, _), M, 2, Priority), 1499 merge_options([priority(Priority)], OptL3, OptL4), 1500 write_b(B, OptL4, 4+BPos) 1501 ; write(''), 1502 write_term(C, OptL3) 1503 ), 1504 cond_display(Display, ')') 1505 ; true 1506 ). 1507 1508deref_substitution(Var, Var) :- var(Var), !. 1509deref_substitution('$sb'(_, _, _, _, Term), Sub) :- 1510 !, 1511 deref_substitution(Term, Sub). 1512deref_substitution(Term, Term). 1513 1514write_pos_lines(Pos, Writer, Lines) :- 1515 write_pos_rawstr(Pos, Writer, String), 1516 atomics_to_string(Lines, '\n', String). 1517 1518write_pos_rawstr(Pos, Writer, String) :- 1519 with_output_to(string(String1), 1520 ( nl, % start with a new line, since the position is not reseted 1521 stream_property(current_output, position(Pos1)), 1522 line_pos(Pos), 1523 call(Writer), 1524 stream_property(current_output, position(Pos2)), 1525 stream_position_data(char_count, Pos1, B1), 1526 stream_position_data(char_count, Pos2, B2) 1527 )), 1528 L is B2-B1, 1529 sub_string(String1, B1, L, _, String). 1530 1531write_pos_string(Pos, Writer, String) :- 1532 write_pos_rawstr(Pos, Writer, RawStr), 1533 pos_indent(Pos, Indent), 1534 atom_concat(Indent, String, RawStr). 1535 1536write_term_lines(Pos, Opt, Term, Lines) :- 1537 write_pos_lines(Pos, write_term(Term, Opt), Lines). 1538 1539write_term_string(Pos, Opt, Term, String) :- 1540 write_pos_string(Pos, write_term(Term, Opt), String). 1541 1542print_subtext_sb_1(Text, Options, '$sb'(SubPos, Term), From, To) :- 1543 arg(1, SubPos, SubFrom), 1544 print_subtext(From-SubFrom, Text), 1545 write_term(Term, Options), 1546 arg(2, SubPos, To). 1547 1548print_subtext_sb_2(Term, TermPos, RepL, Priority, Text, Options) :- 1549 reindent(TermPos, Text, 1550 with_cond_braces_2(print_subtext_2, Term, TermPos, RepL, Priority, Text, Options)). 1551 1552reindent(TermPos, Text, Goal) :- 1553 with_output_to(string(RawText), Goal), 1554 ( \+ sub_string(RawText, _, _, _, '\n') % No need to reindent 1555 ->SubText = RawText 1556 ; arg(1, TermPos, From), 1557 ( seek1_char_left(Text, "\n", From, Distance1) 1558 ->CropLength1 is From - (Distance1 + 1) 1559 ; CropLength1 is From 1560 ), 1561 offset_pos('$OUTPOS', PrefLength1), 1562 atomic_list_concat(L1, '\n', RawText), 1563 L1 = [E|T1], % First line is OK 1564 Delta is abs(PrefLength1 - CropLength1), 1565 pos_indent(Delta, ReIndent), 1566 ( CropLength1 < PrefLength1 1567 ->% Increment indentation 1568 A2 = E1, 1569 A3 = E2 1570 ; % Decrement indentation 1571 A2 = E2, 1572 A3 = E1 1573 ), 1574 findall(E2, 1575 ( member(E1, T1), 1576 once(( atom_concat(ReIndent, A2, A3) 1577 ; E2 = E1 1578 )) 1579 ), L2), 1580 atomic_list_concat([E|L2], '\n', SubText) 1581 ), 1582 print_text(SubText). 1583 1584with_cond_braces_2(Call, Term, TermPos, RepL, GPriority, Text, Options) :- 1585 option(module(M), Options), 1586 option(priority(Priority), Options), 1587 fix_position_if_braced(TermPos, M, Term, GPriority, Term, Priority, Display), 1588 cond_display(Display, '('), 1589 call(Call, TermPos, RepL, Text, Options), 1590 cond_display(Display, ')'). 1591 1592print_subtext_2(sub_list_position(BFrom, To, BTo, _, From, PosL, Tail), RepL, Text, Options) :- 1593 !, 1594 print_subtext(BFrom-BTo, Text), 1595 print_subtext_2(list_position(From, To, PosL, Tail), RepL, Text, Options). 1596print_subtext_2(TermPos, RepL, Text, Options) :- 1597 arg(1, TermPos, From), 1598 arg(2, TermPos, To), 1599 foldl(print_subtext_sb_1(Text, Options), RepL, From, SubTo), 1600 print_subtext(SubTo-To, Text). 1601 1602:- public 1603 rportray/2. 1604 1605/* 1606rportray('$sb'(TermPos), _) :- 1607 \+ retract(rportray_skip), 1608 !, 1609 refactor_context(text, Text), 1610 print_subtext(TermPos, Text). 1611*/ 1612rportray('$sb'(SubPos, _, RepL, Priority, Term), Options) :- 1613 \+ retract(rportray_skip), 1614 !, 1615 ignore(( option(text(Text), Options), 1616 print_subtext_sb_2(Term, SubPos, RepL, Priority, Text, Options) 1617 )). 1618rportray('$@'(Term), Options) :- 1619 write_term(Term, Options). 1620rportray('$$'(Term), Options1) :- 1621 select_option(portray_goal(_), Options1, Options), 1622 write_term(Term, Options). 1623rportray(\\(Term), Options) :- 1624 \+ retract(rportray_skip), 1625 !, 1626 assertz(rportray_skip), 1627 write_term(Term, Options). 1628% rportray('$sb'(_, _, _, _), _) :- !. 1629rportray(@@(Term, STerm), Options) :- 1630 \+ retract(rportray_skip), 1631 !, 1632 ( nonvar(STerm), 1633 STerm = '$sb'(OTermPos, ITermPos, _, _, _) 1634 ->arg(1, ITermPos, IFrom), 1635 arg(2, ITermPos, ITo), 1636 arg(1, OTermPos, OFrom), 1637 arg(2, OTermPos, OTo), 1638 option(text(Text), Options), 1639 print_subtext(OFrom-IFrom, Text), 1640 write_term(Term, Options), 1641 print_subtext(ITo-OTo, Text) 1642 ; write_term(Term, Options) 1643 ). 1644% Use a different pattern to guide the printing of Term: 1645rportray('$@'(Into, '$sb'(_, SubPos, _, Priority, Term)), Options) :- 1646 !, 1647 option(text(Text), Options), 1648 once(print_expansion_sb(Into, Term, SubPos, Priority, Options, Text)). 1649rportray('$G'(Into, Goal), Opt) :- 1650 callable(Goal), 1651 \+ special_term(Goal), 1652 !, 1653 with_str_hook(write_term(Into, Opt), Goal). 1654rportray('$C'(Goal, Into), Opt) :- 1655 callable(Goal), 1656 \+ special_term(Goal), 1657 !, 1658 call(Goal), 1659 write_term(Into, Opt). 1660% Ignore, but process for the side effects 1661rportray('$NOOP', _) :- !. 1662rportray('$NOOP'(Term), Opt) :- 1663 !, 1664 with_output_to(string(_), write_term(Term, Opt)). 1665rportray('$TEXT'(T), Opt) :- !, write_t(T, Opt). 1666rportray('$TEXT'(T, Offs), Opt) :- 1667 offset_pos(Offs, Pos), 1668 !, 1669 line_pos(Pos), 1670 write_t(T, Opt). 1671rportray('$TEXTQ'(T), Opt) :- !, write_q(T, Opt). 1672rportray('$TEXTQ'(T, Offs), Opt) :- 1673 offset_pos(Offs, Pos), 1674 !, 1675 line_pos(Pos), 1676 write_q(T, Opt). 1677rportray('$PRETXT'(TXT, Term), Opt) :- 1678 !, 1679 write(TXT), 1680 write_term(Term, Opt). 1681rportray('$POSTXT'(Term, TXT), Opt) :- 1682 !, 1683 write_term(Term, Opt), 1684 write(TXT). 1685rportray(H :- B, Opt) :- 1686 option(portray_clause(true), Opt), 1687 !, 1688 offset_pos('$OUTPOS', Pos), 1689 rportray_clause((H :- B), Pos, Opt). 1690rportray(H --> B, Opt) :- 1691 option(portray_clause(true), Opt), 1692 !, 1693 offset_pos('$OUTPOS', Pos), 1694 rportray_clause((H --> B), Pos, Opt). 1695rportray('$CLAUSE'(C), Opt) :- !, rportray_clause(C, Opt). 1696rportray('$CLAUSE'(C, Offs), Opt) :- 1697 !, 1698 offset_pos(Offs, Pos), 1699 rportray_clause(C, Pos, Opt). 1700rportray('$BODY'(B, Offs), Opt) :- 1701 offset_pos(Offs, Pos), 1702 !, 1703 rportray_body(B, Pos, Opt). 1704rportray('$BODY'(B), Opt) :- 1705 !, 1706 offset_pos('$OUTPOS', Pos), 1707 rportray_body(B, Pos, Opt). 1708rportray('$BODYB'(B, Offs), Opt) :- 1709 offset_pos(Offs, Pos), 1710 !, 1711 rportray_bodyb(B, Pos, Opt). 1712rportray('$BODYB'(B), Opt) :- 1713 !, 1714 offset_pos('$OUTPOS', Pos), 1715 rportray_bodyb(B, Pos, Opt). 1716rportray('$POS'(Name, Term), Opt) :- 1717 get_output_position(Pos), 1718 nonvar(Name), 1719 ( \+ rportray_pos(Name, _) 1720 ->assertz(rportray_pos(Name, Pos)) 1721 ; refactor_message(warning, format("Position named ~w redefined", [Name])), 1722 retractall(rportray_pos(Name, _)), 1723 assertz(rportray_pos(Name, Pos)) 1724 ), 1725 write_term(Term, Opt). 1726rportray('$APP'(L1, L2), Opt) :- 1727 !, 1728 ( nonvar(L1), 1729 L1 = '$sb'(OTermPos, ITermPos, RepL1, Priority, Term) 1730 ->once(( ITermPos = list_position(_, LTo, _, Pos) 1731 ; ITermPos = sub_list_position(_, LTo, _, _, _, _, Pos) 1732 ; Pos = ITermPos 1733 )), 1734 ( Pos = none 1735 ->succ(From, LTo), 1736 ( trim_brackets(L2, L3, Opt) 1737 ->remove_hacks(L3, T3), 1738 ( T3 == [] 1739 ->sort(['$sb'(From-From, L3)|RepL1], RepL) 1740 ; sort(['$sb'(From-From, '$,'('$TEXT'(', '), L3))|RepL1], RepL) 1741 ) 1742 ; sort(['$sb'(From-From, '$,'('$TEXT'('|'), L2))|RepL1], RepL) 1743 ) 1744 ; arg(1, Pos, From), 1745 arg(2, Pos, To), 1746 sort(['$sb'(From-To, L2)|RepL1], RepL) 1747 ), 1748 write_term('$sb'(OTermPos, ITermPos, RepL, Priority, Term), Opt) 1749 ; append(L, T, L1), 1750 ( var(T) 1751 ; T \= [_|_] 1752 ) 1753 ->append(L, L2, N), 1754 write_term(N, Opt) 1755 ). 1756rportray('$,'(A, B), Opt) :- !, write_term(A, Opt), write_term(B, Opt). 1757rportray('$LIST'( L), Opt) :- !, rportray_list(L, nb, write_term, '', Opt). 1758rportray('$LIST,'(L), Opt) :- !, rportray_list(L, nb, write_term, ',', Opt). 1759rportray('$LIST,_'(L), Opt) :- !, maplist(term_write_comma_2(Opt), L). 1760rportray('$LIST'(L, Sep), Opt) :- !, rportray_list(L, nb, write_term, Sep, Opt). 1761rportray('$LISTC'(CL), Opt) :- 1762 !, 1763 merge_options([priority(1200), portray_clause(true)], Opt, Opt1), 1764 option(text(Text), Opt), 1765 term_write_sep_list_3(CL, rportray_clause, Text, '.\n', '.\n', Opt1). 1766rportray('$LISTC.NL'(CL), Opt) :- 1767 !, 1768 merge_options([priority(1200), portray_clause(true)], Opt, Opt1), 1769 option(text(Text), Opt), 1770 term_write_sep_list_3(CL, rportray_clause, Text, '.\n', '.\n', Opt1), 1771 write('.\n'). 1772rportray('$LIST.NL'(L), Opt) :- 1773 !, 1774 merge_options([priority(1200)], Opt, Opt1), 1775 rportray_list(L, nb, write_term_dot_nl, '', Opt1). 1776rportray('$LISTNL.'(L), Opt) :- 1777 !, 1778 merge_options([priority(1200)], Opt, Opt1), 1779 rportray_list(L, nb, write_term, '.\n', Opt1). 1780rportray('$LIST,NL'(L), Opt) :- 1781 offset_pos('$OUTPOS', Pos), 1782 !, 1783 rportray_list_nl_comma(L, nb, Pos, Opt). 1784rportray('$LISTNL'(L), Opt) :- 1785 offset_pos('$OUTPOS', Pos), 1786 !, 1787 rportray_list_nl(L, nb, Pos, Opt). 1788rportray('$TAB'(Term, Offs), Opt) :- 1789 offset_pos(Offs-'$OUTPOS', Delta), 1790 !, 1791 forall(between(1, Delta, _), write(' ')), 1792 write_term(Term, Opt). 1793rportray('$LIST,NL'(L, Offs), Opt) :- 1794 offset_pos(Offs, Pos), 1795 !, 1796 rportray_list_nl_comma(L, nb, Pos, Opt). 1797rportray('$LISTNL'(L, Offs), Opt) :- 1798 offset_pos(Offs, Pos), 1799 !, 1800 rportray_list_nl(L, nb, Pos, Opt). 1801rportray('$LISTB,NL'(L), Opt) :- 1802 offset_pos('$OUTPOS'+2, Pos), 1803 !, 1804 rportray_list_nl(L, wb(2, Pos), Pos, Opt). 1805rportray('$LISTB,NL'(L, Offs), Opt) :- 1806 offset_pos(Offs, Pos), 1807 !, 1808 offset_pos(Pos-'$OUTPOS', Delta), 1809 rportray_list_nl(L, wb(Delta, Pos), Pos, Opt). 1810rportray('$NL'(Term, Offs), Opt) :- 1811 offset_pos(Offs, Pos), 1812 !, 1813 nl, 1814 line_pos(Pos), 1815 write_term(Term, Opt). 1816rportray('$SEEK'(Term, Offs), Opt) :- 1817 offset_pos(Offs, Pos), 1818 seek(current_output, Pos, current, _), 1819 write_term(Term, Opt). 1820rportray('$NL', _) :- nl. 1821rportray('$PRIORITY'(T, Priority), Opt) :- 1822 integer(Priority), 1823 !, 1824 merge_options([priority(Priority)], Opt, Opt1), 1825 write_term(T, Opt1). 1826rportray(\+ Term, Opt) :- 1827 !, 1828 write_t('\\+ ', Opt), 1829 write(''), 1830 term_priority((_, _), user, 1, Priority), 1831 merge_options([priority(Priority)], Opt, Opt1), 1832 write_term(Term, Opt1). 1833rportray('$RM', Opt) :- 1834 !, 1835 write_term(true, Opt). 1836rportray((A, B), Opt) :- 1837 !, 1838 ( A == '$RM' 1839 ->rportray(B, Opt) 1840 ; B == '$RM' 1841 ->rportray(A, Opt) 1842 ; rportray_conj(A, B, Opt) 1843 ). 1844rportray([E|T1], Opt) :- 1845 !, 1846 ( E == '$RM' 1847 ->rportray(T1, Opt) 1848 ; rportray_head_tail(E, T1, Opt) 1849 ). 1850% Better formatting: 1851rportray((:- Decl), Opt) :- 1852 !, 1853 offset_pos('$OUTPOS', Pos), 1854 write(':- '), 1855 merge_options([priority(1200)], Opt, Opt1), 1856 option(module(M), Opt), 1857 ( Decl =.. [Name, Arg], 1858 once(( current_op(OptPri, Type, M:Name), 1859 valid_op_type_arity(Type, 1) 1860 )), 1861 option(priority(Pri), Opt), 1862 OptPri =< Pri 1863 ->NDecl =.. [Name, '$NL'('$BODY'(Arg), Pos+4)] 1864 ; NDecl = Decl 1865 ), 1866 write_term(NDecl, Opt1). 1867rportray(Operator, Opt) :- 1868 % Fix to avoid useless operator parenthesis 1869 atom(Operator), 1870 option(module(M), Opt), 1871 option(priority(Priority), Opt), 1872 current_op(OpPriority, _, M:Operator), 1873 OpPriority < Priority, 1874 !, 1875 write_q(Operator, Opt). 1876rportray(String, Options) :- 1877 string(String), 1878 String \= "", 1879 !, 1880 rportray_string(String, Options). 1881% Better formatting: 1882rportray(Term, OptL) :- 1883 callable(Term), 1884 \+ escape_term(Term), 1885 \+ ctrl(Term), 1886 \+ skip_format(Term), 1887 option(module(M), OptL), 1888 ( ( compact_format(Term) 1889 ; term_arithexpression(Term, M) 1890 ) 1891 ->Space = '' 1892 ; Space = ' ' 1893 ), 1894 option(term_width(TermWidth), OptL), 1895 ( Term =.. [Name, Left, Right], 1896 current_op(OptPri, Type, M:Name), 1897 valid_op_type_arity(Type, 2) 1898 ->option(priority(Pri), OptL), 1899 ( OptPri > Pri 1900 ->Display = yes 1901 ; Display = no 1902 ), 1903 term_priority_gnd(Term, M, 1, LP), 1904 merge_options([priority(LP)], OptL, OptL1), 1905 cond_display(Display, '('), 1906 offset_pos('$OUTPOS', Pos), 1907 write_term(Left, OptL1), 1908 write_space(Space), 1909 offset_pos('$OUTPOS', Pos2), 1910 term_priority_gnd(Term, M, 2, RP), 1911 merge_options([priority(RP)], OptL, OptL2), 1912 write_pos_lines(Pos2, 1913 ( write_q(Name, Opt2), 1914 write_space(Space), 1915 write_term(Right, OptL2) 1916 ), Lines), 1917 ( Lines = [Line], 1918 atom_length(Line, Width), 1919 Width =< TermWidth 1920 ->pos_indent(Pos2, Indent), 1921 atom_concat(Indent, Atom, Line), 1922 write_t(Atom, OptL2) 1923 ; write_pos_lines(Pos, 1924 ( write_q(Name, Opt2), 1925 write_space(Space), 1926 write_term(Right, OptL2) 1927 ), Lines2), 1928 ( ( maplist(string_length, Lines, WidthL), 1929 max_list(WidthL, Width), 1930 Width > TermWidth 1931 ; length(Lines2, Height2), 1932 length(Lines, Height), 1933 Height2 < Height 1934 ) 1935 ->nl, 1936 atomic_list_concat(Lines2, '\n', Atom) 1937 ; Lines = [Line1|Tail], 1938 pos_indent(Pos2, Indent), 1939 atom_concat(Indent, Line, Line1), 1940 atomic_list_concat([Line|Tail], '\n', Atom) 1941 ), 1942 write_t(Atom, OptL2) 1943 ), 1944 cond_display(Display, ')') 1945 ; \+ atomic(Term), 1946 Term =.. [Name|Args], 1947 Args = [_, _|_] 1948 % There is no need to move the argument to another line if the arity is 1, 1949 % however that could change in the future if we change the format 1950 % \+ ( Args = [_], 1951 % current_op(_, Type, M:Name), 1952 % valid_op_type_arity(Type, 1) 1953 % ) 1954 ->atom_length(Name, NL), 1955 offset_pos('$OUTPOS'+NL+1, Pos), 1956 merge_options([priority(999)], OptL, Opt1), 1957 maplist(write_term_lines(Pos, Opt1), Args, LinesL), 1958 pos_indent(Pos, Indent), 1959 foldl(collect_args(Indent, TermWidth), LinesL, (Pos-2)-[_|T], _-[]), 1960 atomic_list_concat(T, Atom), 1961 write_q(Name, Opt1), 1962 write(''), 1963 write_t('(', Opt1), 1964 write_t(Atom, Opt1), 1965 write_t(')', Opt1) 1966 ), 1967 !. 1968 1969rportray_conj(A, B, Opt) :- 1970 sequence_list((A, B), AL, []), 1971 exclude(==('$RM'), AL, L), 1972 once(append(T, [Last], L)), 1973 offset_pos('$OUTPOS', Pos), 1974 term_priority((_, _), user, 1, Priority), 1975 option(priority(Pri), Opt), 1976 ( Priority > Pri 1977 ->Display = yes 1978 ; Display = no 1979 ), 1980 merge_options([priority(Priority)], Opt, Opt1), 1981 term_priority((_, _), user, 2, RPri), 1982 merge_options([priority(RPri)], Opt, Opt2), 1983 ( ( Display = yes 1984 ->Format ="(~s~s)", 1985 succ(Pos, Pos1) 1986 ; Format = "~s~s", 1987 Pos1 = Pos 1988 ), 1989 length(L, Length), 1990 pos_indent(Pos1, Indent), 1991 maplist([Pos1, Opt1, Indent] +\ E^Line^( write_term_lines(Pos1, Opt1, E, Lines), 1992 Lines = [Line1], 1993 string_concat(Indent, Line, Line1) 1994 ), T, LineL1), 1995 write_term_lines(Pos1, Opt2, Last, LastLines1), 1996 LastLines1 = [LastLine1], 1997 atom_concat(Indent, LastLine, LastLine1), 1998 append(LineL1, [LastLine], StringL), 1999 maplist(string_length, StringL, WidthL), 2000 sum_list(WidthL, WidthTotal), 2001 Sep = ", ", 2002 string_length(Sep, SepLength), 2003 option(conj_width(ConjWidth), Opt), 2004 Pos1 + WidthTotal + (Length - 1) * SepLength < ConjWidth 2005 ->CloseB = "" 2006 ; ( Display = yes 2007 ->Format = "( ~s~s)", 2008 Pos1 = Pos + 2, 2009 with_output_to(string(CloseB), 2010 ( nl, 2011 line_pos(Pos) 2012 )) 2013 ; Format = "~s~s", 2014 CloseB = "", 2015 Pos1 = Pos 2016 ), 2017 maplist(write_term_string(Pos1, Opt1), T, StringL1), 2018 write_term_string(Pos1, Opt2, Last, LastStr), 2019 append(StringL1, [LastStr], StringL), 2020 sep_nl(Pos1, ',', Sep) 2021 ), 2022 atomics_to_string(StringL, Sep, S), 2023 format(atom(Atom), Format, [S, CloseB]), 2024 write_t(Atom, Opt1). 2025 2026rportray_head_tail(E, T1, Opt) :- 2027 offset_pos('$OUTPOS', Pos), 2028 succ(Pos, Pos1), 2029 H = [_|_], 2030 append(H, T2, [E|T1]), 2031 ( nonvar(T2), 2032 T2 = '$sb'(OTermPos, ITermPos, _, _, Term), 2033 is_list(Term), 2034 compound(OTermPos), 2035 !, 2036 arg(1, OTermPos, TFrom), 2037 arg(2, OTermPos, TTo), 2038 arg(1, ITermPos, From), 2039 arg(2, ITermPos, To), 2040 write_term_string(Pos, Opt, T2, SB), 2041 sub_string(SB, 1, _, 1, SC), 2042 option(text(Text), Opt), 2043 get_subtext(Text, TFrom, From, SL), 2044 get_subtext(Text, To, TTo, SR), 2045 format(atom(ST), "~s~s~s", [SL, SC, SR]), 2046 ( ( Term == [] 2047 ; Term == '$RM' 2048 ) 2049 ->T = H, 2050 EndText = ST 2051 ; append(H, ['$TEXT'(ST)], T), 2052 EndText = "" 2053 ) 2054 ; T2 == [], 2055 T = H, 2056 EndText = "" 2057 ; once(( var(T2) 2058 ; T2 \= [_|_] 2059 )), 2060 T = H, 2061 write_term_string(Pos1, Opt, T2, ST), 2062 atom_concat('|', ST, EndText) 2063 ), 2064 !, 2065 write_t('[', Opt), 2066 term_priority([_|_], user, 1, Priority), 2067 merge_options([priority(Priority)], Opt, Opt1), 2068 subtract(T, ['$RM'], [Elem|Tail]), 2069 write_pos_rawstr(Pos1, write_term(Elem, Opt1), String), 2070 pos_indent(Pos1, Indent), 2071 option(list_width(ListWidth), Opt), 2072 foldl(concat_list_elem(ListWidth, Pos1, Opt1), Tail, String-LinesLL, Last-[Last]), 2073 ( LinesLL = [S1] 2074 ->CloseB = "]" 2075 ; with_output_to(string(CloseB), 2076 ( nl, 2077 line_pos(Pos), 2078 write(']') 2079 )), 2080 with_output_to(string(Sep), writeln(',')), 2081 atomic_list_concat(LinesLL, Sep, S1) 2082 ), 2083 atom_concat(Indent, S, S1), 2084 atomic_list_concat([S, EndText, CloseB], Atom), 2085 write_t(Atom, Opt1). 2086 2087concat_list_elem(ListWidth, Pos, Opt1, Elem, String1-LinesL1, String-LinesL) :- 2088 ( with_output_to(string(String), 2089 ( stream_property(current_output, position(Pos1)), 2090 write(String1), 2091 write(', '), 2092 write_term(Elem, Opt1), 2093 stream_property(current_output, position(Pos2)), 2094 stream_position_data(char_count, Pos2, B2), 2095 stream_position_data(line_count, Pos1, L1), 2096 stream_position_data(line_count, Pos2, L2) 2097 )), 2098 L1 = L2, B2 =< ListWidth 2099 ->LinesL1 = LinesL 2100 ; write_pos_rawstr(Pos, write_term(Elem, Opt1), String), 2101 LinesL1 = [String1|LinesL] 2102 ). 2103 2104write_space(Space) :- 2105 ( Space = '' 2106 ->true 2107 ; write(Space) 2108 ). 2109 2110trim_brackets(L, _, _) :- var(L), !, fail. 2111trim_brackets(Term, Trim, Opt) :- 2112 member(Term-Trim, ['$@'(L, E)-'$@'(T, E), 2113 '@@'(L, E)-'@@'(T, E) 2114 ]), 2115 neck, 2116 trim_brackets(L, T, Opt). 2117trim_brackets('$sb'(OTermPos, ITermPos, RepL1, Priority, Term), 2118 '$sb'(OTermPos, ITermPos, RepL, Priority, Term), _) :- 2119 once(( ITermPos = list_position(From, To, _, _) 2120 ; ITermPos = sub_list_position(From, To, _, _, _, _, _) 2121 ; ITermPos = From-To, 2122 Term == [] 2123 )), 2124 succ(From, From1), 2125 succ(To1, To), 2126 sort(['$sb'(From-From1, '$NOOP'), 2127 '$sb'(To1-To, '$NOOP') 2128 |RepL1], RepL). 2129trim_brackets(L, '$TEXT'(S), Opt) :- 2130 L = [_|_], 2131 with_output_to(string(S1), write_term(L, Opt)), 2132 sub_string(S1, 1, _, 1, S). 2133 2134pos_indent(Pos, Indent) :- with_output_to(atom(Indent), line_pos(Pos)). 2135 2136collect_args(Indent, TermWidth, LineL, Pos1-[Sep, String|Tail], Pos-Tail) :- 2137 ( LineL = [Line1], 2138 string_concat(Indent, String, Line1), 2139 string_length(String, Width), 2140 Pos is Pos1 + 2 + Width, 2141 Pos < TermWidth 2142 ->Sep = ", " 2143 ; atom_concat(',\n', Indent, Sep), 2144 last(LineL, Last), 2145 string_length(Last, Pos), 2146 once(( ( atomic_list_concat([Indent, '\n', Indent], IndentNl) 2147 ; IndentNl = Indent 2148 ), 2149 atomics_to_string(LineL, '\n', String1), 2150 string_concat(IndentNl, String, String1) 2151 )) 2152 ). 2153 2154pos_value(Pos, Value) :- 2155 ( rportray_pos(Pos, Value) 2156 ->true 2157 ; Pos == '$OUTPOS' 2158 ->get_output_position(Value) 2159 ; fail 2160 ). 2161 2162term_arithexpression(X, M) :- 2163 substitute(sanitize_hacks, X, Y), 2164 compat_arithexpression(Y, M). 2165 2166sanitize_hacks(Term, Into) :- 2167 nonvar(Term), 2168 memberchk(Term, ['$sb'(_, _), '$sb'(_, _, _, _, Into)]). 2169 2170compat_arithexpression(X, _) :- var(X), !. 2171compat_arithexpression(X, _) :- number(X), !. 2172compat_arithexpression(X, M) :- arithmetic:evaluable(X, M), !. 2173compat_arithexpression(X, M) :- 2174 callable(X), 2175 current_arithmetic_function(X), 2176 forall((compound(X), arg(_, X, V)), compat_arithexpression(V, M)). 2177 2178arithexpression(X) :- number(X), !. 2179arithexpression(X) :- 2180 callable(X), 2181 current_arithmetic_function(X), 2182 forall((compound(X), arg(_, X, V)), arithexpression(V)). 2183 2184offset_pos(Offs, Pos) :- 2185 substitute(pos_value, Offs, Expr), 2186 arithexpression(Expr), 2187 catch(Pos is round(Expr), _, fail). 2188 2189rportray_list_nl(L, WB, Pos, Opt) :- 2190 rportray_list_nl_comma(L, WB, Pos, Opt). 2191 2192rportray_list_nl_comma(L, WB, Pos, Opt) :- 2193 rportray_list_nl(',', L, WB, Pos, Opt). 2194 2195rportray_list_nl(Pre, L, WB, Pos, Opt) :- 2196 sep_nl(Pos, Pre, Sep), 2197 rportray_list(L, WB, write_term, Sep, Opt). 2198 2199rportray_list(L, WB, Writer, SepElem, Opt) :- 2200 option(text(Text), Opt), 2201 deref_substitution(L, D), 2202 term_write_sep_list_2(D, WB, Writer, Text, SepElem, '|', Opt). 2203 2204term_write_sep_list_2([], nb, _, _, _, _, _) :- !. 2205term_write_sep_list_2([E|T], WB, Writer, Text, SepElem, SepTail, Opt) :- 2206 !, 2207 term_priority([_|_], user, 1, Priority), 2208 merge_options([priority(Priority)], Opt, Opt1), 2209 with_output_to( 2210 string(RawText1), 2211 ( write(SepElem), 2212 call(Writer, E, Opt1), 2213 term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt1) 2214 )), 2215 atom_concat(SepElem, RawText2, RawText1), 2216 string_length(RawText1, Length), 2217 ( seek1_char_left(RawText2, '\n', Length, RTTo), 2218 sub_string(RawText2, RTTo, _, 0, ToTrim), 2219 string_chars(ToTrim, Chars), 2220 forall(member(Char, Chars), char_type(Char, space)) 2221 ->sub_string(RawText2, 0, RTTo, _, RawText) 2222 ; RawText = RawText2 2223 ), 2224 ( sub_string(RawText, _, _, _, '\n') 2225 ->cond_ident_bracket(WB, '['), 2226 print_text(RawText), 2227 cond_idend_bracket(WB, ']') 2228 ; cond_nonid_bracket(WB, '['), 2229 print_text(RawText), 2230 cond_nonid_bracket(WB, ']') 2231 ). 2232/* 2233term_write_sep_list_2([E|T], WB, Writer, Text, SepElem, SepTail, Opt) :- 2234 !, 2235 term_priority([_|_], user, 1, Priority), 2236 merge_options([priority(Priority)], Opt, Opt1), 2237 cond_ident_bracket(WB, '['), 2238 call(Writer, E, Opt1), 2239 term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt1), 2240 cond_idend_bracket(WB, ']'). 2241*/ 2242term_write_sep_list_2(E, _, Writer, _, _, _, Opt) :- call(Writer, E, Opt). 2243 2244cond_ident_bracket(wb(Delta, _), Bracket) :- 2245 write(Bracket), 2246 forall(between(2,Delta,_), write(' ')). 2247cond_ident_bracket(nb, _). 2248 2249cond_idend_bracket(wb(Delta, Pos), Bracket) :- 2250 sep_nl(Pos-Delta, '', SepNl), 2251 write(SepNl), 2252 write(Bracket). 2253cond_idend_bracket(nb, _). 2254 2255cond_nonid_bracket(wb(_, _), Bracket) :- write(Bracket). 2256cond_nonid_bracket(nb, _). 2257 2258term_write_sep_list_inner(L, Writer, Text, SepElem, SepTail, Opt) :- 2259 nonvar(L), 2260 L = [E|T], 2261 !, 2262 write(SepElem), 2263 call(Writer, E, Opt), 2264 term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt). 2265term_write_sep_list_inner(P, Writer, Text, SepElem, _, Opt) :- 2266 nonvar(P), 2267 deref_substitution(P, L), 2268 L = [_|_], 2269 !, 2270 P = '$sb'(SubPos1, ISubPos, RepL, Priority, Term), 2271 SubPos1 =.. [SPF, From1, To1|SPT], 2272 string_length(Text, N), 2273 seekn_char_right(1, Text, N, "[", From1, From2), 2274 % Remove space, since default indentation of list elements is 2: 2275 ( sub_string(Text, From2, 1, _, " ") 2276 ->succ(From2, From) 2277 ; From = From2 2278 ), 2279 seek1_char_left(Text, "]", To1, To), 2280 SubPos =.. [SPF, From, To|SPT], 2281 P2 = '$sb'(SubPos, ISubPos, RepL, Priority, Term), 2282 write(SepElem), 2283 call(Writer, P2, Opt). 2284term_write_sep_list_inner(T, Writer, Text, SepElem, SepTail, Opt) :- 2285 get_pred(T, F), 2286 write_tail(T, F, Writer, Text, SepElem, SepTail, Opt). 2287 2288term_write_sep_list_3([E|T], Writer, Text, SepElem, SepTail, Opt) :- 2289 !, 2290 call(Writer, E, Opt), 2291 get_pred(E, D), 2292 term_write_sep_list_inner_3(T, D, Writer, Text, SepElem, SepTail, Opt). 2293term_write_sep_list_3(E, Writer, _, _, _, Opt) :- 2294 call(Writer, E, Opt). 2295 2296get_pred(T, F/A) :- 2297 deref_substitution(T, C), 2298 once(clause_head(C, H)), 2299 deref_substitution(H, D), 2300 functor(D, F, A). 2301 2302clause_head(H :- _, H). 2303clause_head(H --> _, H). 2304clause_head(H, H). 2305 2306 2307term_write_sep_list_inner_3(L, D, Writer, Text, SepElem, SepTail, Opt) :- 2308 nonvar(L), 2309 L = [E|T], 2310 !, 2311 write(SepElem), 2312 get_pred(E, F), 2313 ignore((D \= F, nl)), 2314 call(Writer, E, Opt), 2315 term_write_sep_list_inner_3(T, F, Writer, Text, SepElem, SepTail, Opt). 2316term_write_sep_list_inner_3(T, D, Writer, Text, SepElem, SepTail, Opt) :- 2317 write_tail(T, D, Writer, Text, SepElem, SepTail, Opt). 2318 2319term_write_comma_2(Opt, Term) :- write_term(Term, Opt), write(', '). 2320 2321sep_nl(LinePos, Sep, SepNl) :- 2322 with_output_to(atom(In), line_pos(LinePos)), 2323 atomic_list_concat([Sep, '\n', In], SepNl). 2324 2325write_tail(T, _, Writer, _, _, SepTail, Opt) :- 2326 var(T), 2327 !, 2328 write(SepTail), 2329 call(Writer, T, Opt). 2330write_tail([], _, _, _, _, _, _) :- !. 2331write_tail('$LIST,NL'(L), _, Writer, Text, _, _, Opt) :- 2332 !, 2333 offset_pos('$OUTPOS', Pos), 2334 sep_nl(Pos, ',', Sep), 2335 term_write_sep_list_inner(L, Writer, Text, Sep, '|', Opt). 2336write_tail('$LIST,NL'(L, Offs), _, Writer, Text, _, _, Opt) :- 2337 offset_pos(Offs, Pos), 2338 !, 2339 sep_nl(Pos, ',', Sep), 2340 term_write_sep_list_inner(L, Writer, Text, Sep, '|', Opt). 2341write_tail(T, D, Writer, _, _, SepTail, Opt) :- 2342 get_pred(T, F), 2343 write(SepTail), 2344 ignore((D \= F, nl)), % this only makes sense on list of clauses 2345 call(Writer, T, Opt). 2346 2347print_expansion_rm_dot(Text, Before, To) :- 2348 sub_string(Text, Before, _, 0, Right), 2349 once(sub_string(Right, Next, _, _, ".")), 2350 To is Before+Next+2. 2351 2352% Hacks that can only work at 1st level: 2353 2354print_expansion_1(Into, Term, TermPos, Options, Text, To, To) :- 2355 var(Into), 2356 !, 2357 print_expansion(Into, Term, TermPos, Options, Text). 2358print_expansion_1('$RM', _, _, _, _, To, To) :- !. 2359print_expansion_1('$C'(Goal, Into), Term, TermPos, Options, Text, To, To) :- 2360 \+ ( nonvar(Term), 2361 Term = '$C'(_, _) 2362 ), 2363 !, 2364 call(Goal), 2365 print_expansion_1(Into, Term, TermPos, Options, Text, To, To). 2366print_expansion_1('$TEXT'(Into), _, _, Options, _, To, To) :- 2367 !, 2368 write_t(Into, Options). 2369print_expansion_1('$TEXT'(Into, Offs), _, _, Options, _, To1, To) :- 2370 offset_pos(Offs, Pos), 2371 !, 2372 write_t(Into, Options), 2373 To is To1+Pos. 2374print_expansion_1('$TEXTQ'(Into), _, _, Options, _, To, To) :- 2375 !, 2376 write_q(Into, Options). 2377print_expansion_1('$TEXTQ'(Into, Offs), _, _, Options, _, To1, To) :- 2378 offset_pos(Offs, Pos), 2379 !, 2380 write_q(Into, Options), 2381 To is To1+Pos. 2382print_expansion_1('$LISTC'(IntoL), _, _, Options1, Text, To, To) :- 2383 !, 2384 merge_options([priority(1200), portray_clause(true)], Options1, Options), 2385 term_write_sep_list_3(IntoL, rportray_clause, Text, '.\n', '.\n', Options). 2386print_expansion_1('$LISTC.NL'(IntoL), _, _, Options1, Text, To, To) :- 2387 !, 2388 merge_options([priority(1200), portray_clause(true)], Options1, Options), 2389 term_write_sep_list_3(IntoL, rportray_clause, Text, '.\n', '.\n', Options), 2390 write('.\n'). 2391print_expansion_1(Into, Term, TermPos, Options, Text, To1, To) :- 2392 print_expansion_2(Into, Term, TermPos, Options, Text, To1, To). 2393 2394print_expansion_2(Into, Term, TermPos, Options, Text, To, To) :- 2395 var(Into), 2396 !, 2397 print_expansion(Into, Term, TermPos, Options, Text). 2398print_expansion_2('$sb'(_, RefPos, RepL, Priority, Into), Term, _, Options, Text, To, To) :- 2399 nonvar(RefPos), 2400 \+ ( nonvar(Term), 2401 Term = '$sb'(_, _, _, _, _), 2402 Into \= '$sb'(_, _, _, _, _) 2403 ), 2404 !, 2405 print_subtext_sb_2(Into, RefPos, RepL, Priority, Text, Options). 2406print_expansion_2('$NODOT'(Into), Term, TermPos, Options, Text, To1, To) :- 2407 !, 2408 print_expansion_2(Into, Term, TermPos, Options, Text, To1, _), 2409 print_expansion_rm_dot(Text, To1, To). 2410print_expansion_2('$LIST.NL'(IntoL), Term, TermPos, Options1, Text, To1, To) :- 2411 !, 2412 merge_options([priority(1200)], Options1, Options), 2413 print_expansion_rm_dot(Text, To1, To), 2414 term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text). 2415print_expansion_2(Into, Term, Pos, Options, Text, To, To) :- 2416 % Hey, this is the place, don't overthink about it (test 60) 2417 Pos = sub_list_position(_, _, _, From1, STo, PosL, Tail), 2418 !, 2419 refactor_context(from, From), 2420 print_subtext(From-From1, Text), 2421 ( Into == [] 2422 ->true 2423 ; Into == '$RM' 2424 ->true 2425 ; ( is_list(Into) 2426 ->true 2427 ; ( get_subtext(From1-STo, Text, Sep1), 2428 option(comments(Comments), Options, []), 2429 replace_sep(",", "|", From1, Comments, Sep1, Sep) 2430 ->print_text(Sep) 2431 ; write('|') % just in case, but may be never reached 2432 ) 2433 ), 2434 with_from(print_expansion(Into, Term, list_position(From1, To, PosL, Tail), Options, Text), From1) 2435 ), 2436 ( is_list(Into), 2437 Into \== [] 2438 ->true 2439 ; last(PosL, Pos2), 2440 arg(2, Pos2, To2), 2441 print_subtext(To2-To, Text) 2442 ). 2443print_expansion_2(Into, Term, TermPos, Options, Text, To, To) :- 2444 print_expansion(Into, Term, TermPos, Options, Text). 2445 2446term_write_stop_nl_list([Into|IntoL], Term, TermPos, Options, Text) :- 2447 term_write_stop_nl__(Into, Term, TermPos, Options, Text), 2448 term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text). 2449term_write_stop_nl_list('$sb'(_, _, _, _, IntoL), Term, TermPos, Options, Text) :- 2450 term_write_stop_nl_list(IntoL, Term, TermPos, Options, Text). 2451term_write_stop_nl_list([], _, _, _, _). 2452 2453term_write_stop_nl__('$NOOP'(Into), Term, TermPos, Options, Text) :- !, 2454 with_output_to(string(_), %Ignore, but process 2455 term_write_stop_nl__(Into, Term, TermPos, Options, Text)). 2456term_write_stop_nl__('$NODOT'(Into), Term, TermPos, Options, Text) :- !, 2457 print_expansion(Into, Term, TermPos, Options, Text). 2458term_write_stop_nl__(Into, Term, TermPos, Options, Text) :- 2459 print_expansion(Into, Term, TermPos, Options, Text), 2460 write('.'), 2461 nl. 2462 2463% if the term have been in parentheses, in a place where that was 2464% required, include it!!! 2465% 2466fix_position_if_braced(term_position(_, _, _, _, _), M, 2467 Term, GPriority, Into, Priority, Display) :- 2468 ( \+ term_needs_braces(M:Term, GPriority), 2469 ( nonvar(Into), 2470 term_needs_braces(M:Into, Priority) 2471 % \+ term_needs_braces(M:Term, Priority) 2472 ) 2473 ->Display = yes 2474 ), 2475 !. 2476fix_position_if_braced(_, _, _, _, _, _, no). % fail-safe 2477 2478% If Term is a replacement, '$sb'/6, we assume that the substitution will not 2479% require braces (not sure if this is correct, but it works) 2480term_needs_braces(_:Term, _) :- \+ callable(Term), !, fail. 2481% term_needs_braces(M:'$sb'(_, _, _, _, _, Into), Pri) :- !, 2482% term_needs_braces(M:Into, Pri). 2483term_needs_braces(M:Term, Pri) :- term_needs_braces(Term, M, Pri). 2484 2485term_needs_braces(Term, M, Pri) :- 2486 functor(Term, Name, Arity), 2487 valid_op_type_arity(Type, Arity), 2488 current_op(OpPri, Type, M:Name), 2489 OpPri > Pri, 2490 !. 2491 2492cond_display(yes, A) :- write(A). 2493cond_display(no, _). 2494 2495:- meta_predicate 2496 with_cond_braces( , , , , , , ). 2497 2498print_expansion_sb(Into, Term, TermPos, Priority, Options, Text) :- 2499 with_cond_braces(do_print_expansion_sb, Into, Term, TermPos, Priority, Options, Text). 2500 2501do_print_expansion_sb(Into, Term, TermPos, Options, Text) :- 2502 arg(1, TermPos, From), 2503 with_from(print_expansion_ne(Into, Term, TermPos, Options, Text), From). 2504 2505with_cond_braces(Call, Into, Term, TermPos, GPriority, Options, Text) :- 2506 option(module(M), Options), 2507 option(priority(Priority), Options), 2508 fix_position_if_braced(TermPos, M, Term, GPriority, Into, Priority, Display), 2509 cond_display(Display, '('), 2510 call(Call, Into, Term, TermPos, Options, Text), 2511 cond_display(Display, ')'). 2512 2513% TODO: stream position would be biased --EMM 2514with_str_hook(Command, StrHook) :- 2515 with_output_to(string(S1), call(Command)), 2516 ( call(StrHook, S1, S) 2517 ->true 2518 ; S = S1 2519 ), 2520 format('~s', [S]).
2524print_expansion(Var, _, RefPos, Options, Text) :- 2525 var(Var), 2526 !, 2527 option(new_variable_names(VNL), Options, []), 2528 ( member(Name=Var1, VNL), 2529 Var1 == Var 2530 ->write(Name) 2531 ; print_subtext(RefPos, Text) 2532 ). 2533print_expansion('$sb'(RefPos, _), Term, _, _, Text) :- 2534 \+ ( nonvar(Term), 2535 Term = '$sb'(_, _) 2536 ), 2537 !, 2538 print_subtext(RefPos, Text). 2539print_expansion('$sb'(RefPos, _, RepL, Priority, Into), Term, _RPos, Options, Text) :- 2540 nonvar(RefPos), 2541 \+ ( nonvar(Term), 2542 Term = '$sb'(_, _, _, _, _), 2543 Into \= '$sb'(_, _, _, _, _) 2544 ), 2545 !, 2546 print_subtext_sb_2(Into, RefPos, RepL, Priority, Text, Options). 2547print_expansion(Into, Term, RefPos, Options, Text) :- 2548 print_expansion_ne(Into, Term, RefPos, Options, Text). 2549 2550print_expansion_ne('$G'(Into, Goal), Term, RefPos, Options, Text) :- 2551 \+ ( nonvar(Term), 2552 Term = '$G'(_, _) 2553 ), 2554 !, 2555 with_str_hook(print_expansion(Into, Term, RefPos, Options, Text), Goal). 2556print_expansion_ne('$C'(Goal, Into), Term, RefPos, Options, Text) :- 2557 \+ ( nonvar(Term), 2558 Term = '$C'(_, _) 2559 ), 2560 !, 2561 call(Goal), 2562 print_expansion(Into, Term, RefPos, Options, Text). 2563print_expansion_ne('$,NL', Term, RefPos, Options, Text) :- 2564 Term \=='$,NL', 2565 !,
2567 write(','), 2568 print_expansion('$NL', Term, RefPos, Options, Text)
2568. 2569print_expansion_ne('$NL', Term, _, _, Text) :- % Print an indented new line 2570 Term \== '$NL', 2571 !, 2572 refactor_context(from, From), 2573 textpos_line(Text, From, LinePos), 2574 nl, 2575 line_pos(LinePos). 2576/* 2577print_expansion_ne(Into, Term1, _, Options, Text) :- 2578 nonvar(Term1), 2579 Term1\='$sb'(_, _, _, _), % is not a read term, but a command 2580 SPattern='$sb'(RefPos, _, _, Term, Pattern), 2581 !, 2582 print_expansion_ne(Into, Pattern, Term, RefPos, Options, Text). 2583*/ 2584print_expansion_ne(Into, Term, RefPos, Options, Text) :- 2585 ( \+ escape_term(Into), 2586 print_expansion_pos(RefPos, Into, Term, Options, Text) 2587 ->true 2588 ; write_term(Into, Options) 2589 ). 2590 2591print_expansion_arg(M, MInto, Options1, Text, From-To, 2592 v(N, RefPos, Into, Term), Freeze1, Freeze) :- 2593 ( N = 0, 2594 Into == Term 2595 ->Freeze1 = true, 2596 print_subtext(RefPos, Text), 2597 freeze(Freeze, print_subtext(Text, From, To)) 2598 ; N = 1, 2599 Into == '$RM', 2600 Term \== '$RM' 2601 ->Freeze1 = true 2602 ; term_priority(MInto, M, N, Priority), 2603 merge_options([priority(Priority)], Options1, Options), 2604 print_expansion_elem(Options, Text, From-To, RefPos, Into, Term, Freeze1, Freeze) 2605 ). 2606 2607print_expansion_elem(Options, Text, From-To, RefPos, Into, Term, Freeze1, Freeze) :- 2608 ( Into == '$RM', 2609 Term \== '$RM' 2610 ->true 2611 ; Freeze1 = true, 2612 print_expansion(Into, Term, RefPos, Options, Text) 2613 ), 2614 freeze(Freeze, print_subtext(Text, From, To)). 2615 2616escape_term($@(_)). 2617escape_term($$(_)). 2618escape_term(\\(_)). 2619escape_term(_@@_). 2620escape_term(_$@_). 2621% escape_term('$G'(_, _)). 2622% escape_term('$C'(_, _)). 2623escape_term('$NOOP'(_)). 2624escape_term('$NODOT'(_)). 2625escape_term('$LIST'(_)). 2626escape_term('$LISTC'(_)). 2627escape_term('$LIST,'(_)). 2628escape_term('$LIST,_'(_)). 2629escape_term('$LIST,NL'(_)). 2630escape_term('$LIST,NL'(_, _)). 2631escape_term('$NL'(_, _)). 2632escape_term('$POS'(_, _)). 2633escape_term('$SEEK'(_, _)). 2634escape_term('$LISTC.NL'(_)). 2635escape_term('$LISTB,NL'(_)). 2636escape_term('$LISTB,NL'(_, _)). 2637escape_term('$PRIORITY'(_, _)). 2638escape_term('$TEXT'(_)). 2639escape_term('$TEXT'(_, _)). 2640escape_term('$TEXTQ'(_)). 2641escape_term('$TEXTQ'(_, _)). 2642escape_term('$PRETXT'(_, _)). 2643escape_term('$POSTXT'(_, _)). 2644escape_term('$CLAUSE'(_)). 2645escape_term('$CLAUSE'(_, _)). 2646escape_term('$BODY'(_, _)). 2647escape_term('$BODY'(_)). 2648escape_term('$BODYB'(_, _)). 2649escape_term('$BODYB'(_)). 2650 2651special_term('$sb'(_, _)). 2652special_term('$sb'(_, _, _, _, _)). 2653 2654valid_op_type_arity(xf, 1). 2655valid_op_type_arity(yf, 1). 2656valid_op_type_arity(xfx, 2). 2657valid_op_type_arity(xfy, 2). 2658valid_op_type_arity(yfx, 2). 2659valid_op_type_arity(fy, 1). 2660valid_op_type_arity(fx, 1). 2661 2662from_to_pairs([], _, To, To) --> []. 2663from_to_pairs([To2-From2|PosL], From1, To1, To) --> 2664 { (To2 = 0 -> To1 = From1 ; To1 = To2), 2665 (From2 = 0 -> From = To1 ; From = From2) 2666 }, 2667 [From-To3], 2668 from_to_pairs(PosL, From, To3, To). 2669 2670normalize_pos(Pos, F-T) :- 2671 arg(1, Pos, F), 2672 arg(2, Pos, T). 2673 2674print_expansion_pos(term_position(From, To, FFrom, FFTo, PosT), Into, Term, Options, Text) :- 2675 compound(Into), 2676 Into \= [_|_], 2677 \+ ( Into = (CA, CB), 2678 ( CA == '$RM' 2679 ; CB == '$RM' 2680 ) 2681 ), 2682 nonvar(Term), 2683 functor(Into, FT, A), 2684 functor(Term, FP, A), 2685 option(module(M), Options), 2686 ( option(priority(Priority), Options), 2687 current_op(PrP, TypeOpP, M:FP), 2688 valid_op_type_arity(TypeOpP, A), 2689 current_op(PrT, TypeOpT, M:FT), 2690 valid_op_type_arity(TypeOpT, A), 2691 PrT =< Priority, 2692 ( PrP =< PrT 2693 ; forall(arg(AP, Into, Arg), 2694 ( term_priority_gnd(Into, M, AP, PrA), 2695 \+ term_needs_braces(M:Arg, PrA) 2696 )) 2697 ) 2698 ; option(module(M), Options), 2699 \+ current_op(_, _, M:FT), 2700 \+ current_op(_, _, M:FP) 2701 ), 2702 ( FT == FP 2703 ->NT = FT % preserve layout 2704 ; NT = '$TEXTQ'(FT) 2705 ), 2706 !, 2707 mapilist([Into, Term] +\ N^Pos^(PosK-v(N, Pos, Arg, TAr))^ 2708 ( arg(N, Into, Arg), 2709 arg(N, Term, TAr), 2710 normalize_pos(Pos, PosK) 2711 ), 1, PosT, KPosValTU), 2712 /* 0 is the functor, priority 1200 */ 2713 KPosValU = [(FFrom-FFTo)-v(0, FFrom-FFTo, NT, FP)|KPosValTU], 2714 keysort(KPosValU, KPosValL), 2715 pairs_keys_values(KPosValL, PosKL, ValL), 2716 from_to_pairs(PosKL, From, To1, To2, FromToL, []), 2717 succ(A, N), 2718 nth1(N, PosKL, E), 2719 arg(2, E, To2), 2720 print_subtext(Text, From, To1), 2721 foldl(print_expansion_arg(M, Into, Options, Text), FromToL, ValL, _, true), 2722 print_subtext(Text, To2, To). 2723print_expansion_pos(sub_list_position(BFrom, To, BTo, _, From, PosL, Tail), Into, Term, Options, Text) :- 2724 print_subtext(Text, BFrom, BTo), 2725 print_expansion_list(PosL, From, To, Tail, Into, Term, Options, Text, init). 2726print_expansion_pos(list_position(From, To, PosL, Tail), Into, Term, Options, Text) :- 2727 print_expansion_list(PosL, From, To, Tail, Into, Term, Options, Text, init). 2728print_expansion_pos(brace_term_position(From, To, TermPos), {Into}, {Term}, Options1, Text) :- 2729 arg(1, TermPos, AFrom), 2730 arg(2, TermPos, ATo), 2731 print_subtext(Text, From, AFrom), 2732 merge_options([priority(1200)], Options1, Options), 2733 print_expansion_elem(Options, Text, ATo-To, TermPos, Into, Term, _, true). 2734print_expansion_pos(parentheses_term_position(From, To, TermPos), Into, Term, Options1, Text) :- 2735 arg(1, TermPos, AFrom), 2736 arg(2, TermPos, ATo), 2737 print_subtext(Text, From, AFrom), 2738 merge_options([priority(1200)], Options1, Options), 2739 print_expansion_elem(Options, Text, ATo-To, TermPos, Into, Term, _, true). 2740 2741print_expansion_list(PosL, From, To, TPos, IntoL, TermL, Options1, Text, Cont) :- 2742 ( ( IntoL = '$sb'(sub_list_position(_, To2, _, _, From2, PosL2, TPos2), _, RepL, Priority, Into), 2743 PosL = [Pos|_], 2744 arg(1, Pos, From1) 2745 ->( Cont \= init_rm 2746 ->print_subtext(Text, From, From1) 2747 ; true 2748 ) 2749 ; IntoL = '$sb'(list_position(From21, To2, PosL2, TPos2), _, RepL, Priority, Into), 2750 ( Cont = cont, 2751 PosL2 = [Pos2|_], 2752 compound(Pos2), 2753 arg(1, Pos2, From2) 2754 ->write(', ') 2755 ; From2 = From21 2756 ) 2757 ) 2758 ->print_subtext_sb_2(Into, list_position(From2, To2, PosL2, TPos2), RepL, Priority, Text, Options1) 2759 ; ( PosL = [Pos|PosT] 2760 ->( normalize_pos(Pos, From1-To1), 2761 IntoL = [Into|IT], 2762 TermL = [Term|TT] 2763 ->option(module(M), Options1), 2764 term_priority([_|_], M, 1, Priority1), 2765 select_option(priority(Priority), Options1, Options, Priority), 2766 Options2=[priority(Priority1)|Options], 2767 ( Into == '$RM', 2768 Term \== '$RM' 2769 ->( Cont = init 2770 ->Cont2 = init_rm, 2771 print_subtext(Text, From, From1) 2772 ; Cont2 = Cont 2773 ) 2774 ; ( Cont \= init_rm 2775 ->print_subtext(Text, From, From1) 2776 ; true 2777 ), 2778 print_expansion(Into, Term, Pos, Options2, Text), 2779 Cont2 = cont 2780 ), 2781 print_expansion_list(PosT, To1, To, TPos, IT, TT, Options1, Text, Cont2) 2782 ; memberchk(IntoL, [[], '$RM']) 2783 ->arg(1, Pos, From1), 2784 ( TPos = none 2785 ->last(PosL, LPos), 2786 arg(2, LPos, To1) 2787 ; arg(2, TPos, To1) 2788 ), 2789 ( Cont = cont 2790 ->true 2791 ; print_subtext(Text, From, From1) 2792 ), 2793 print_subtext(Text, To1, To) 2794 ) 2795 ) 2796 ->true 2797 ; PosL = [] 2798 ->( TPos = none 2799 ->( IntoL == [] 2800 ->true 2801 ; ( Cont = cont 2802 ->write('|') 2803 ; true 2804 ), 2805 print_expansion(IntoL, TermL, From-From, Options1, Text) 2806 ), 2807 print_subtext(Text, From, To) 2808 ; normalize_pos(TPos, From1-To1), 2809 print_subtext(Text, From, From1), 2810 print_expansion(IntoL, TermL, TPos, Options1, Text), 2811 print_subtext(Text, To1, To) 2812 ) 2813 ; write_term(IntoL, Options1) 2814 ). 2815 2816replace_sep(S1, S2, From1, Comments, Text1, Text2) :- 2817 sub_string(Text1, Before, _, After, S1), 2818 \+ ( member(Pos-Comment, Comments), 2819 stream_position_data(char_count, Pos, From2), 2820 From is From2-From1, 2821 string_length(Comment, Length), 2822 To is From + Length, 2823 Before > From, 2824 Before < To 2825 ), 2826 !, 2827 sub_string(Text1, 0, Before, _, L), 2828 sub_string(Text1, _, After, 0, R), 2829 atomics_to_string([L, S2, R], Text2). 2830 2831print_subtext(RefPos, Text) :- 2832 get_subtext(RefPos, Text, SubText), 2833 print_text(SubText). 2834 2835print_text(Text) :- format("~s", [Text]), write(''). % reset partial(true) logic 2836 2837print_subtext(Text, From, To) :- 2838 get_subtext(Text, From, To, SubText), 2839 print_text(SubText). 2840 2841get_subtext(RefPos, Text, SubText) :- 2842 compound(RefPos), 2843 arg(1, RefPos, From), 2844 arg(2, RefPos, To), 2845 get_subtext(Text, From, To, SubText). 2846 2847% get_subtext(Text1, Pos, From, To, Text) :- 2848% get_subtext(Text1, From-Pos, To-Pos, Text). 2849 2850get_subtext(Text1, From, To, Text) :- 2851 arithexpression(From), 2852 arithexpression(To), 2853 LPaste is To-From, 2854 From1 is max(0, From), 2855 sub_string(Text1, From1, LPaste, _, Text). 2856 2857bin_op(Term, Op, Left, Right, A, B) :- 2858 nonvar(Term), 2859 functor(Term, Op, N), 2860 N == 2, 2861 prolog_listing:infix_op(Op, Left, Right), 2862 arg(1, Term, A), 2863 arg(2, Term, B). 2864 2865rportray_bodyb(B, Pos, OptL) :- write_b(B, OptL, Pos). 2866 2867rportray_body(B, Pos, OptL) :- write_b1(B, OptL, Pos). 2868 2869write_b(Term, OptL, Pos1) :- 2870 ( option(priority(N), OptL), 2871 option(module(M), OptL), 2872 term_needs_braces(M:Term, N) 2873 ->stream_property(current_output, position(S1)), 2874 write_t('( ', OptL), 2875 stream_property(current_output, position(S2)), 2876 stream_position_data(char_count, S1, B1), 2877 stream_position_data(char_count, S2, B2), 2878 Pos is Pos1+B2-B1, 2879 write_b1(Term, OptL, Pos), 2880 nl, 2881 line_pos(Pos - 2), 2882 write_t(')', OptL) 2883 ; write_b1(Term, OptL, Pos1) 2884 ). 2885 2886and_layout(T) :- T = (_,_). 2887 2888write_b1(Term, OptL, Pos) :- 2889 prolog_listing:or_layout(Term), !, 2890 write_b_layout(Term, OptL, or, Pos). 2891write_b1(Term, OptL, Pos) :- 2892 and_layout(Term), !, 2893 write_b_layout(Term, OptL, and, Pos). 2894write_b1(Term, OptL, _Pos) :- 2895 option(module(M), OptL), 2896 ( nonvar(Term), 2897 has_meta(Term, M, 0, Spec) 2898 ->body_meta_args(Term, Spec, TMeta) 2899 ; TMeta = Term 2900 ), 2901 write_term(TMeta, OptL). 2902 2903has_meta(Term, _, _, _) :- 2904 var(Term), !, fail. 2905has_meta(M:Term, _, Meta, Spec) :- !, 2906 has_meta(Term, M, Meta, Spec). 2907has_meta(Term, M, Meta, Spec) :- 2908 \+ memberchk(Term, ['$BODYB'(_), 2909 '$BODYB'(_, _)]), 2910 predicate_property(M:Term, meta_predicate(Spec)), 2911 ( findall(Arg, 2912 ( arg(Idx, Spec, Meta), 2913 arg(Idx, Term, Arg), 2914 nonvar(Arg) 2915 ), ArgL), 2916 ( ArgL = [_, _, _|_] 2917 ; member(Arg, ArgL), 2918 has_meta(Arg, M, 0, _) 2919 ) 2920 ->true 2921 ; ctrl(Term) 2922 ). 2923 2924body_meta_args(Term, Spec, Meta) :- 2925 functor(Term, F, N), 2926 functor(Meta, F, N), 2927 mapnargs(body_meta_arg, Term, Spec, Meta). 2928 2929ctrl((_ , _)). 2930ctrl((_ ; _)). 2931ctrl((_ -> _)). 2932ctrl((_ *-> _)). 2933 2934skip_format(_/_). 2935skip_format(_//_). 2936skip_format('$VAR'(_)). 2937skip_format(_:_). 2938 2939compact_format(_-_). 2940 2941body_meta_arg(_, Term, Spec, Meta) :- 2942 ( Spec = 0, 2943 nonvar(Term) 2944 ->Meta = '$BODYB'(Term) 2945 ; Meta = Term 2946 ). 2947 2948write_b_layout(Term, OptL1, Layout, Pos) :- 2949 bin_op(Term, Op, Left, Right, A, B), 2950 !, 2951 merge_options([priority(Left)], OptL1, OptL2), 2952 write_b(A, OptL2, Pos), 2953 nl_indent(Layout, Op, Pos), 2954 merge_options([priority(Right)], OptL1, OptL3), 2955 write_b(B, OptL3, Pos). 2956 2957nl_indent(or, Op, LinePos) :- 2958 nl, 2959 line_pos(LinePos - 2), 2960 format(atom(A), '~|~a~2+',[Op]), 2961 % Kludge to reset logic of partial(true): 2962 write(A). 2963nl_indent(and, Op, LinePos) :- 2964 writeln(Op), 2965 line_pos(LinePos). 2966 2967line_pos(LinePos, Output) :- 2968 ( setting(listing:tab_distance, N), 2969 N =\= 0 2970 ->Tabs is LinePos div N, 2971 Spcs is Tabs + LinePos mod N 2972 ; Tabs is 0, 2973 Spcs is LinePos 2974 ), 2975 format(Output, "~`\tt~*|~` t~*|", [Tabs, Spcs]). 2976 2977line_pos(LinePos) :- 2978 line_pos(LinePos, current_output), 2979 fail. 2980line_pos(_) :- 2981 write(''). 2982 2983write_t(Term, Options1) :- 2984 write_qt(false, Term, Options1). 2985 2986write_q(Term, Options1) :- 2987 write_qt(true, Term, Options1). 2988 2989write_qt(Quoted, Term, Options1) :- 2990 merge_options([quoted(Quoted), priority(1200)], Options1, Options2), 2991 select_option(portray_goal(PG), Options2, Options, PG), 2992 write_term(Term, Options). 2993 2994rportray_string(String, Options1) :- 2995 merge_options([quoted(true), character_escapes(true)], Options1, Options2), 2996 select_option(portray_goal(PG), Options2, Options, PG), 2997 atomics_to_string(Atoms, '\n', String), 2998 maplist(fix_string(Options), Atoms, List), 2999 atomics_to_string(List, '\n', String2), 3000 write('"'), 3001 write(String2), 3002 write('"'). 3003 3004fix_string(Options, Atom, Elem) :- 3005 with_output_to(string(String), 3006 ( string_to_atom(Raw, Atom), 3007 write_term(Raw, Options) 3008 )), 3009 atomics_string(['\"', Elem, '\"'], String)
Basic Term Expansion operations
This library provides the predicate replace/5, which is the basic entry point for all the refactoring scenarios.
Note for implementors/hackers:
TODO
: document them.format("~a", [Atom])
does not behaves aswrite_term(Atom, Options)
, since a space is not added to separate operators from the next term, for instance after rewriting :- dynamic a/1, you would get :- dynamica/1.write('')
is used to reset the effect of thepartial(true)
option*/