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(location_utils,
   36          [property_location/3, predicate_location/2, record_location_dynamic/3,
   37           in_dir/2, all_call_refs/5, record_location_meta/5, record_location/4,
   38           in_set/2, from_location/2, property_from/3, record_location_goal/6,
   39           cleanup_loc_dynamic/4]).   40
   41:- use_module(library(lists)).   42:- use_module(library(prolog_codewalk), []).   43:- use_module(library(clambda)).   44:- use_module(library(normalize_head)).   45:- use_module(library(database_fact)).   46:- use_module(library(extra_location)).   47:- use_module(library(static_strip_module)).   48:- use_module(library(compact_goal)).   49:- use_module(library(predicate_from)).   50:- init_expansors.   51
   52from_location(From, Location) :-
   53    '$messages':swi_location(From, Location, []),
   54    Location \= [],
   55    !.
   56from_location(From, From).
   57
   58in_set(FileL, File) :-
   59    memberchk(File, FileL).
   60
   61in_dir(DirL, File) :-
   62    member(Dir, DirL),
   63    directory_file_path(Dir, _, File),
   64    !.
   65
   66% For preds + decls
   67property_location(Prop, Declaration, Location) :-
   68    property_from(Prop, Declaration, From),
   69    from_location(From, Location).
   70
   71% non det
   72property_from(Head, Declaration, From) :-
   73    ( dec_location(Head, Declaration, From)
   74    ; def_location(Head, Declaration, From)
   75    ).
   76
   77dec_location(Head1/0, Declaration, From) :-
   78    normalize_head(Head1, M:Head),
   79    extra_location(Head, M, Declaration, From).
   80dec_location(M:Head1, Declaration, From) :-
   81    normalize_head(M:Head1, MHead),
   82    strip_module(MHead, N, Head),
   83    extra_location(Head, N, Declaration, From).
   84
   85clause_from(Ref, clause(Ref)).
   86
   87def_location(Head/I, clause(I), From) :-
   88    normalize_head(Head, P),
   89    nth_clause(P, I, Ref),
   90    clause_from(Ref, From).
   91def_location(M:Head, Declaration, From) :-
   92    normalize_head(M:Head, P),
   93    predicate_properties(P, List),
   94    ( List = []
   95    ->Declaration = predicate
   96    ; Declaration = predicate(List)
   97    ),
   98    predicate_from(P, From).
   99
  100:- meta_predicate predicate_location(:,-).  101
  102predicate_location(P, Loc) :-
  103    predicate_from(P, From),
  104    from_location(From, Loc).
  105
  106:- meta_predicate predicate_properties(:,-).  107predicate_properties(P, List) :-
  108    findall(Prop,
  109            ( predicate_property(P, Prop),
  110              \+ memberchk(Prop, [interpreted,
  111                                  visible,
  112                                  built_in,
  113                                  defined,
  114                                  nodebug,
  115                                  number_of_rules(_),
  116                                  number_of_clauses(_),
  117                                  imported_from(_),
  118                                  file(_),
  119                                  indexed(_),
  120                                  last_modified_generation(_),
  121                                  line_count(_)])
  122            ), List).
  123
  124prop_t(use). % In some cases is already tracked by prolog:called_by/4@database_fact
  125prop_t(def).
  126prop_t(dec).
  127
  128all_call_refs(lit,  Goal,  _, CM, CM:Goal).
  129all_call_refs(Prop, Goal, IM, CM, CM:Fact) :-
  130    prop_t(Prop),
  131    database_fact(Prop, IM:Goal, Fact).
  132
  133record_location_callable(Head, CM, Type, Call, _, From) :-
  134    callable(Head),
  135    ground(CM),
  136    predicate_property(CM:Head, implementation_module(M)),
  137    compact_goal(Call, Comp),
  138    record_location_goal(Head, M, Type, CM, Comp, From).
  139
  140record_location_goal(Head, M, Type, CM, Call, From) :-
  141    record_location(Head, M, dynamic(Type, CM, Call), From).
  142
  143record_location(Head, M, Type, From) :-
  144    ( loc_dynamic(Head, M, Type, From)
  145    ->true
  146    ; assertz(loc_dynamic(Head, M, Type, From))
  147    ).
  148
  149record_location_meta_each(MCall, M, From, FactBuilder, Recorder) :-
  150    static_strip_module(MCall, M, Call, CM),
  151    predicate_property(MCall, implementation_module(IM)),
  152    call(FactBuilder, Type, Call, IM, CM, MFact),
  153    static_strip_module(MFact, CM, Fact, FM),
  154    call(Recorder, Fact, FM, Type, IM:Call, CM, From).
  155
  156:- meta_predicate record_location_meta(+,?,+,5,6).  157record_location_meta(MCall, M, From, FactBuilder, Recorder) :-
  158    \+ ( record_location_meta_each(MCall, M, From, FactBuilder, Recorder)
  159       *->
  160         fail
  161       ; true
  162       ).
  163
  164record_location_dynamic(MCall, M, From) :-
  165    record_location_meta(MCall, M, From, \T^G^MG^_^F^database_fact_ort(T,G,MG,F),
  166                         record_location_callable).
  167
  168cleanup_loc_dynamic(Head, M, Type, From) :-
  169    retractall(loc_dynamic(Head, M, Type, From))