1/* Part of Extended Tools for SWI-Prolog 2 3 Author: Edison Mera 4 E-mail: efmera@gmail.com 5 WWW: https://github.com/edisonm/xtools 6 Copyright (C): 2015, 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(record_locations, 36 [ record_location/0 37 ]). 38 39:- use_module(library(filesex)). 40:- use_module(extra_location). % shold be the first 41:- use_module(library(prolog_codewalk), []). 42:- use_module(library(apply)).

Record locations

Be careful since this module MUST not depend on others, otherwise such extra locations in the dependent modules will not be recorded, that is why we avoid the usage of the next two libraries:

:- use_module(library(from_utils)).
:- use_module(library(filepos_line)).

57:- multifile 58 system:term_expansion/4, 59 system:goal_expansion/4. 60 61:- dynamic record_location/0. 62record_location. % Enable recording of locations 63 64:- thread_local rl_tmp/3. % trick to detect if term_expansion was applied 65 66% Extra location for assertions of a given predicate 67extra_location:loc_declaration(Head, M, assertion(Status, Type), From) :- 68 assertions:asr_head_prop(_, CM, Head, Status, Type, _, _, From), 69 predicate_property(CM:Head, implementation_module(M)). 70 71:- multifile skip_record_decl/1. 72 73skip_record_decl(initialization(_)) :- !. 74skip_record_decl(Decl) :- 75 nonvar(Decl), 76 '$current_source_module'(M), 77 predicate_property(M:Decl, imported_from(assertions)), 78 functor(Decl, Type, Arity), 79 memberchk(Arity, [1, 2]), 80 assertions:assrt_type(Type), !. 81 82:- public record_extra_location/4. 83 84record_extra_location((:- Decl), 85 term_position(_, _, _, _, [DPos])) --> 86 ( {\+ skip_record_decl(Decl)} 87 ->record_extra_decl(Decl, DPos) 88 ; [] 89 ). 90 91record_extra_decl(Decl, DPos) --> 92 { '$current_source_module'(SM), 93 declaration_pos(Decl, DPos, SM, M, IdL, ArgL, PosL) 94 }, 95 foldl(assert_declaration(M), IdL, ArgL, PosL), 96 !. 97record_extra_decl(Goal, Pos) --> 98 { nonvar(Goal), 99 source_location(File, Line), 100 retractall(rl_tmp(File, Line, _)), 101 asserta(rl_tmp(File, Line, 1)), 102 assert_position(Goal, Pos, body) 103 }. 104 105declaration_pos(DM:Decl, term_position(_, _, _, _, [_, DPos]), _, M, ID, U, Pos) :- 106 declaration_pos(Decl, DPos, DM, M, ID, U, Pos). 107declaration_pos(module(M, L), DPos, 108 _, M, [module_2, export], [module(M, L), L], [DPos, Pos]) :- 109 DPos = term_position(_, _, _, _, [_, Pos]). 110declaration_pos(volatile(L), term_position(_, _, _, _, PosL), 111 M, M, [volatile], [L], PosL). 112declaration_pos(dynamic(L), term_position(_, _, _, _, PosL), 113 M, M, [dynamic], [L], PosL). 114declaration_pos(thread_local(L), term_position(_, _, _, _, PosL), 115 M, M, [thread_local], [L], PosL). 116declaration_pos(public(L), term_position(_, _, _, _, PosL), 117 M, M, [public], [L], PosL). 118declaration_pos(export(L), term_position(_, _, _, _, PosL), 119 M, M, [export], [L], PosL). 120declaration_pos(multifile(L), term_position(_, _, _, _, PosL), 121 M, M, [multifile], [L], PosL). 122declaration_pos(discontiguous(L), term_position(_, _, _, _, PosL), 123 M, M, [discontiguous], [L], PosL). 124declaration_pos(meta_predicate(L), term_position(_, _, _, _, PosL), 125 M, M, [meta_predicate], [L], PosL). 126declaration_pos(reexport(SM:DU), DPos, _, M, ID, U, Pos) :- !, 127 declaration_pos(reexport(DU), DPos, SM, M, ID, U, Pos). 128declaration_pos(use_module(SM:DU), DPos, _, M, ID, U, Pos) :- !, 129 declaration_pos(use_module(DU), DPos, SM, M, ID, U, Pos). 130declaration_pos(use_module(SM:DU, L), DPos, ID, _, M, U, Pos) :- !, 131 declaration_pos(use_module(DU, L), DPos, ID, SM, M, U, Pos). 132declaration_pos(reexport(SM:DU, L), DPos, ID, _, M, U, Pos) :- !, 133 declaration_pos(reexport(DU, L), DPos, ID, SM, M, U, Pos). 134declaration_pos(include(U), DPos, M, M, [include], [U], [DPos]). 135declaration_pos(use_module(U), DPos, M, M, [use_module], [U], [DPos]). 136declaration_pos(reexport(U), DPos, M, M, [reexport], [U], [DPos]). 137declaration_pos(consult(U), DPos, M, M, [consult], [U], [DPos]). 138declaration_pos(reexport(U, L), DPos, M, M, 139 [reexport_2, reexport(U)], [reexport(U, L), L], [DPos, Pos]) :- 140 DPos = term_position(_, _, _, _, [_, Pos]). 141declaration_pos(use_module(U, L), DPos, M, M, 142 [use_module_2, import(U)], [use_module(U, L), L], [DPos, Pos]) :- 143 DPos = term_position(_, _, _, _, [_, Pos]). 144 145:- meta_predicate foldsequence(4,?,?,?,?). 146 147foldsequence(G, A, B) --> foldsequence_(A, G, B). 148 149foldsequence_(A, _, _) --> 150 {var(A)}, 151 !. 152 % call(G, A). 153foldsequence_([], _, _) --> !. 154foldsequence_([E|L], G, list_position(_, _, PosL, _)) --> 155 !, 156 foldl(foldsequence(G), [E|L], PosL). 157foldsequence_((A, B), G, term_position(_, _, _, _, [PA, PB])) --> 158 !, 159 foldsequence_(A, G, PA), 160 foldsequence_(B, G, PB). 161foldsequence_(A, G, PA) --> call(G, A, PA). 162 163assert_declaration(M, Declaration, Sequence, Pos) --> 164 foldsequence(assert_declaration_one(Declaration, M), Sequence, Pos). 165 166assert_declaration_one(reexport(U), M, PI, Pos) --> 167 !, 168 assert_reexport_declaration_2(PI, U, Pos, M). 169assert_declaration_one(module_2, M, H, Pos) --> 170 !, 171 % [(:- discontiguous '$exported_op'/3)], % Not a good idea: commented out because it causes problems in apps that use this library 172 assert_declaration_one(H, M, module_2, Pos). 173assert_declaration_one(Declaration, _, M:PI, 174 term_position(_, _, _, _, [_, Pos])) --> 175 !, 176 assert_declaration_one(Declaration, M, PI, Pos). 177assert_declaration_one(Declaration, M, F/A, Pos) --> 178 { atom(F), 179 integer(A) 180 }, 181 !, 182 {functor(H, F, A)}, 183 assert_position(H, M, Declaration, Pos). 184assert_declaration_one(Declaration, M, F//A1, Pos) --> 185 { atom(F), 186 integer(A1) 187 }, 188 !, 189 { A is A1+2, 190 functor(H, F, A) 191 }, 192 assert_position(H, M, Declaration, Pos). 193assert_declaration_one(Declaration, M, H, Pos) --> 194 assert_position(H, M, Declaration, Pos). 195 196assert_reexport_declaration_2((F/A as G), U, Pos, M) --> 197 {functor(H, G, A)}, 198 assert_position(H, M, reexport(U, [F/A as G]), Pos). 199assert_reexport_declaration_2(F/A, U, Pos, M) --> 200 {functor(H, F, A)}, 201 assert_position(H, M, reexport(U, [F/A]), Pos). 202assert_reexport_declaration_2(op(_, _, _), _, _, _) --> []. 203assert_reexport_declaration_2(except(_), _, _, _) --> []. 204 205assert_position(H, M, Type, TermPos) :- 206 assert_position(H, M, Type, TermPos, Clauses, []), 207 compile_aux_clauses(Clauses). 208 209assert_position(H, M, Type, TermPos) --> 210 % resolve TermPos to file/4 term because later the source code will not be 211 % available and therefore we will not be able to get LinePos 212 { source_location(File, Line1), 213 ( nonvar(TermPos) 214 ->arg(1, TermPos, Chars), 215 setup_call_cleanup( 216 '$push_input_context'(rl_filepos_line), 217 (prolog_codewalk:filepos_line(File, Chars, Line, LinePos)), 218 '$pop_input_context') 219 ; Line = Line1, 220 LinePos = -1 221 ) 222 }, 223 assert_location(H, M, Type, File, Line, file(File, Line, LinePos, Chars)). 224 225assert_location(H, M, Type, File, Line, From) --> 226 ( {\+ extra_location(H, M, Type, From)} 227 ->['$source_location'(File, Line):extra_location:loc_declaration(H, M, Type, From)] 228 ; [] 229 ). 230 231in_swipl_home(File) :- 232 current_prolog_flag(home, Dir), 233 directory_file_path(Dir, _, File). 234 235system:term_expansion(Term, Pos, [Term|Clauses], Pos) :- 236 record_location, 237 source_location(File, Line), 238 \+ in_swipl_home(File), 239 ( rl_tmp(File, Line, _) 240 ->fail 241 ; retractall(rl_tmp(_, _, _)), 242 asserta(rl_tmp(File, Line, 0 )), 243 record_extra_location(Term, Pos, Clauses, []), 244 Clauses \= [] 245 ). 246 247redundant((_,_)). 248redundant((_;_)). 249redundant((_:_)). 250redundant(true). 251redundant(!). 252 253assert_position(G, Pos, T) :- 254 '$current_source_module'(M), 255 assert_position(G, M, T, Pos). 256 257:- public rl_goal_expansion/2. 258rl_goal_expansion(Goal, Pos) :- 259 callable(Goal), 260 \+ redundant(Goal), 261 source_location(File, Line), 262 \+ in_swipl_home(File), 263 ( nb_current('$term', Term) 264 ->( rl_tmp(File, Line, Flag) 265 ->Flag == 1 266 ; true 267 ), 268 memberchk(Term, [(:-_), []]) 269 ; % if '$term' is not defined, then is if(...), or elif(...) 270 true 271 ), 272 \+ clause(declaration_pos(Goal, _, _, _, _, _, _), _), 273 \+ skip_record_decl(Goal), 274 assert_position(Goal, Pos, goal), 275 !. 276 277system:goal_expansion(Goal, Pos, _, _) :- 278 record_location, 279 rl_goal_expansion(Goal, Pos), 280 fail