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