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(fix_termpos, 36 [ fix_subtermpos/1, 37 fix_subtermpos/2, 38 fix_termpos/1, 39 fix_termpos/2, 40 term_innerpos/4 41 ]). 42 43:- use_module(library(apply)). 44:- use_module(library(lists)). 45:- use_module(library(option)). 46:- use_module(library(ref_context)). 47:- use_module(library(ref_message)). 48:- use_module(library(seek_text)).
55:- thread_local term_innerpos/4.The subterm positions are adjusted recursively according to the Options as follows:
subterm_boundary(+Boundary) Specifies what are the boundaries of the term,
which can be subterm, leftcomm, rightcomm or comment (default).
Due to performance concerns, this predicate makes a destructive assignment in the TermPos argument, but preserve the extra positions in the term_innerpos/4 predicate.
@see fix_subtermpos/1
75fix_termpos(TermPos) :- 76 fix_termpos(TermPos, []). 77 78fix_termpos(TermPos, Options) :- 79 retractall(term_innerpos(_, _, _, _)), 80 option(subterm_boundary(Boundary), Options, comment), 81 fix_subtermpos_rec(TermPos, Boundary), 82 fix_termouterpos(TermPos).
97fix_subtermpos(Pos) :- 98 fix_subtermpos(Pos, []). 99 100fix_subtermpos(Pos, _) :- var(Pos), !. 101fix_subtermpos(Pos, Options) :- 102 retractall(term_innerpos(_, _, _, _)), 103 option(subterm_boundary(Boundary), Options, comment), 104 fix_subtermpos_rec(Pos, Boundary), 105 arg(1, Pos, From), 106 arg(2, Pos, To), 107 assertz(term_innerpos(From, To, From, To)).
114fix_termouterpos(TermPos) :- 115 arg(1, TermPos, From), 116 ( refactor_context(comments, Comments) 117 ->true 118 ; Comments = [] 119 ), 120 ( Comments = [Pos-_|_], 121 stream_position_data(char_count, Pos, From1), 122 From1 < From 123 ->CommentFrom = From1 124 ; CommentFrom = From 125 ), 126 refactor_context(text, Text), 127 string_length(Text, L), 128 % Now move to the left until the previous last one newline 129 ( seek1_char_left(Text, ".", CommentFrom, DotFrom) 130 ->( seek_sub_string(Text, "\n", 1, L, DotFrom, NLFrom), 131 NLFrom < From 132 ->succ(NLFrom, OuterFrom) 133 ; succ(DotFrom, OuterFrom) 134 ) 135 ; OuterFrom = CommentFrom 136 ), 137 arg(2, TermPos, To), 138 ( append(_, [Pos-Comment], Comments), 139 stream_position_data(char_count, Pos, To1), 140 string_length(Comment, CL), 141 To2 is To1 + CL, 142 To2 > To 143 ->To3 = To2 144 ; To3 = To 145 ), 146 once(seek_sub_string(Text, ".", 1, L, To3, DotTo)), 147 ( seek_sub_string(Text, "\n", 1, L, DotTo, NLTo) 148 % TBD: this is assuming that from . to nl we only have comments or spaces 149 ->succ(NLTo, OuterTo) 150 ; succ(DotTo, OuterTo) 151 ), 152 nb_setarg(1, TermPos, OuterFrom), 153 nb_setarg(2, TermPos, OuterTo), 154 assertz(term_innerpos(OuterFrom, OuterTo, From, To)). 155 156fix_subtermpos_rec(Pos, _) :- var(Pos), !. % Nothing to fix 157fix_subtermpos_rec(Pos, Boundary) :- 158 Pos = term_position(From1, To1, FFrom, FTo, PosL), 159 !, 160 fix_subtermpos_from_to(Boundary, From1, To1, FFrom, FTo, From, To, PosL), 161 nb_setarg(1, Pos, From), 162 nb_setarg(2, Pos, To). 163fix_subtermpos_rec(Pos, Boundary) :- 164 Pos = key_value_position(From1, To1, SFrom, STo, _, KPos, VPos), 165 !, 166 fix_subtermpos_from_to(Boundary, From1, To1, SFrom, STo, From, To, [KPos, VPos]), 167 nb_setarg(1, Pos, From), 168 nb_setarg(2, Pos, To). 169/* 170fix_subtermpos_rec(Pos, Boundary) :- 171 fail, 172 Pos = dict_position(From1, To1, FFrom, FTo, PosL), 173 !, 174 fix_subtermpos_from_to(Boundary, From1, To1, FFrom, FTo, From, To, PosL), 175 nb_setarg(1, Pos, From), 176 nb_setarg(2, Pos, To). 177*/ 178fix_subtermpos_rec(dict_position(_, _, _, TypeTo, KVPos), Boundary) :- 179 refactor_context(text, Text), 180 succ(TypeTo, TypeTo1), 181 foldl(fix_termpos_from_left_comm(Boundary, Text), KVPos, TypeTo1, _). 182fix_subtermpos_rec(_-_, _). 183fix_subtermpos_rec(string_position(_, _), _). 184fix_subtermpos_rec(brace_term_position(From, _, Arg), Boundary) :- 185 refactor_context(text, Text), 186 succ(From, From1), 187 fix_termpos_from_left(Boundary, Text, Arg, From1, _). 188fix_subtermpos_rec(parentheses_term_position(From, _, Arg), Boundary) :- 189 refactor_context(text, Text), 190 % BUG: we can not assume that the next character is '(', since a comment 191 % could come next, which is included in the From-To interval, for instance 192 % (/**/(Term)), but surprisinlgy this problem doesn't happen with braces {} 193 % (see test seekn_parenthesis_right.plt) 194 include_comments_right(Text, From, FixedFrom), 195 succ(FixedFrom, From1), 196 fix_termpos_from_left(Boundary, Text, Arg, From1, _). 197% Note: don't assume that a list is between brackets [], because this clause is 198% also used to process list of clauses: 199fix_subtermpos_rec(list_position(From, To, Elms, Tail), Boundary) :- 200 refactor_context(text, Text), 201 foldl(fix_termpos_from_left_comm(Boundary, Text), Elms, From, To1), 202 ( Tail = none 203 ->true 204 ; once(seek_sub_string(Text, "|", 1, To, To1, ToL)), 205 succ(ToL, FromT), 206 fix_termpos_from_left(Boundary, Text, Tail, FromT, _) 207 ). 208 209rcomment_bound(From, To) :- 210 refactor_context(comments, CommentL), 211 reverse(CommentL, CommentR), 212 comment_bound(CommentR, From, To). 213 214count_sub_string(Text, From1, To1, SubText, SubTextN, From, To, N) :- 215 ( seek_sub_string(Text, SubText, SubTextN, To1, From1, From2) 216 ->From = From2, 217 To2 is From2 + SubTextN, 218 ( To2 =< To1 219 ->S = s(1, To2), 220 forall(seek_sub_string(Text, SubText, SubTextN, To1, To2, To3), 221 ( arg(1, S, N1), 222 succ(N1, N2), 223 nb_setarg(1, S, N2), 224 To4 is To3 + SubTextN, 225 nb_setarg(2, S, To4) 226 )), 227 arg(1, S, N), 228 arg(2, S, To) 229 ; N = 1, 230 To = To2 231 ) 232 ; From = To1, 233 To = From1, 234 N = 0 235 ). 236 237 238seek1_parenthesis_left(Text, F1, F) :- 239 comment_bound(F2, F1), 240 !, 241 seek1_parenthesis_left(Text, F2, F). 242seek1_parenthesis_left(Text, F1, F) :- 243 succ(F2, F1), 244 ( sub_string(Text, F2, _, _, "(") 245 ->F = F2 246 ; seek1_parenthesis_left(Text, F2, F) 247 ). 248 249seekn_parenthesis_left(0, _, F, F) :- !. 250seekn_parenthesis_left(N1, Text, F1, F) :- 251 N1>0, 252 seek1_parenthesis_left(Text, F1, F2), 253 succ(N, N1), 254 seekn_parenthesis_left(N, Text, F2, F). 255 256include_comments_left(subterm, _, From, From). 257include_comments_left(rightcomm, _, From, From). 258include_comments_left(leftcomm, Text, To, From) :- include_comments_left(Text, To, From). 259include_comments_left(comment, Text, To, From) :- include_comments_left(Text, To, From). 260 261include_comments_left(Text, To, From) :- 262 S = s(To), 263 ( rcomment_bound(FromC, ToC), 264 arg(1, S, From1), 265 ToC =< From1, 266 ( L is From1 - ToC, 267 sub_string(Text, ToC, L, _, Text1), 268 \+ ( sub_string(Text1, _, 1, _, Char), 269 \+ member(Char, [" ", "\t", "\n"]) 270 ) 271 ->nb_setarg(1, S, FromC), 272 fail 273 ; ToC = From1 274 ->nb_setarg(1, S, FromC), 275 !, 276 fail 277 ; !, 278 fail 279 ) 280 ->true 281 ; true 282 ), 283 arg(1, S, From). 284 285include_comments_right(subterm, _, To, To). 286include_comments_right(leftcomm, _, To, To). 287include_comments_right(rightcomm, Text, From, To) :- include_comments_right(Text, From, To). 288include_comments_right(comment, Text, From, To) :- include_comments_right(Text, From, To). 289 290include_comments_right(Text, From, To) :- 291 S = s(From), 292 ( comment_bound(FromC, ToC), 293 arg(1, S, To1), 294 To1 =< FromC, 295 ( L is FromC - To1, 296 sub_string(Text, To1, L, _, Text1), 297 \+ ( sub_string(Text1, _, 1, _, Char), 298 \+ member(Char, [" ", "\t", "\n"]) 299 ) 300 ->nb_setarg(1, S, ToC), 301 fail 302 ; To1 = FromC 303 ->nb_setarg(1, S, ToC), 304 !, 305 fail 306 ; !, 307 fail 308 ) 309 ->true 310 ; true 311 ), 312 arg(1, S, To). 313 314seekn_parenthesis_right(N, Text, L, T1, T) :- 315 seekn_char_right(N, Text, L, ")", T1, T). 316 317fix_boundaries_from_right(Boundary, Text, Pos, To1, From2, To3, From, To) :- 318 arg(2, Pos, To2), 319 ( To1 < To2 320 ->RL is To2 - To1, 321 sub_string(Text, To1, RL, _, TextL), 322 with_termpos(refactor_message(warning, format("Misplaced text --> `~w'", [TextL])), Pos) 323 ; true 324 ), 325 count_sub_string(Text, To2, To1, ")", 1, _, To3, N), 326 include_comments_right(Boundary, Text, To3, To), 327 arg(1, Pos, From1), 328 seekn_parenthesis_left(N, Text, From1, From2), 329 From = From2. 330 331fix_termpos_from_right(Boundary, Text, To1, Pos ) :- 332 fix_subtermpos_rec(Pos, Boundary), 333 fix_boundaries_from_right(Boundary, Text, Pos, To1, From2, To2, From, To), 334 nb_setarg(1, Pos, From), 335 nb_setarg(2, Pos, To), 336 assertz(term_innerpos(From, To, From2, To2)). 337 338fix_termpos_from_left(Boundary, Text, Pos, From1, To) :- 339 fix_subtermpos_rec(Pos, Boundary), 340 fix_boundaries_from_left(Boundary, Text, Pos, From1, From2, From, To), 341 nb_setarg(1, Pos, From), 342 nb_setarg(2, Pos, To), 343 assertz(term_innerpos(From, To, From2, To)). 344 345fix_termpos_from_left_comm(Boundary, Text, Pos, From1, To) :- 346 fix_subtermpos_rec(Pos, Boundary), 347 fix_boundaries_from_left(Boundary, Text, Pos, From1, From2, From, To2), 348 include_comments_right(Boundary, Text, To2, To), 349 nb_setarg(1, Pos, From), 350 nb_setarg(2, Pos, To), 351 assertz(term_innerpos(From, To, From2, To2)). 352 353fix_boundaries_from_left(Boundary, Text, Pos, From1, From3, From, To) :- 354 arg(1, Pos, From2), 355 ( From2 < From1 356 ->RL is From1 - From2, 357 sub_string(Text, From2, RL, _, TextL), 358 with_termpos( 359 refactor_message( 360 warning, 361 format("Misplaced text <-- `~w' (~w)", 362 [TextL, 363 fix_boundaries_from_left(Boundary, _, Pos, From1, From3, From, To)])), 364 Pos) 365 ; true 366 ), 367 count_sub_string(Text, From1, From2, "(", 1, From3, _, N), 368 include_comments_left(Boundary, Text, From3, From), 369 arg(2, Pos, To1), 370 string_length(Text, L), 371 seekn_parenthesis_right(N, Text, L, To1, To). 372 373fix_subtermpos_from_to(Boundary, From1, To1, FFrom, FTo, From, To, PosL) :- 374 refactor_context(text, Text), 375 sub_string(Text, FTo, 1, _, Char), 376 ( PosL = [LPos, RPos ], 377 arg(2, LPos, LTo), 378 LTo =< FFrom 379 ->fix_termpos_from_right(Boundary, Text, FFrom, LPos), 380 fix_termpos_from_left(Boundary, Text, RPos, FTo, _), 381 arg(1, LPos, From), 382 arg(2, RPos, To) 383 ; PosL = [Pos], 384 arg(1, Pos, FromR), 385 FTo =< FromR, 386 Char \= "(" 387 ->fix_termpos_from_left(Boundary, Text, Pos, FTo, _), 388 From = From1, 389 arg(2, Pos, To) 390 ; succ(FTo, FTo1), 391 foldl(fix_termpos_from_left_comm(Boundary, Text), PosL, FTo1, _), 392 From = From1, 393 To = To1 394 )