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): 2017, 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(codewalk_source, []).   36
   37:- use_module(library(prolog_source)).   38:- use_module(library(prolog_xref), []).   39:- use_module(library(context_values)).   40:- use_module(library(option_utils)).   41:- use_module(library(extend_args)).   42
   43codewalk:walk_code(source, Options) :-
   44    do_source_walk_code(Options).
   45
   46head_caller(MHead, M:Head) :-
   47    '$current_source_module'(CM),
   48    strip_module(CM:MHead, M, Head).
   49
   50determine_caller((Head :-  _), Caller) :- !, head_caller(Head, Caller).
   51determine_caller((Head --> _), Caller) :-
   52    !,
   53    extend_args(Head, [_, _], EHead),
   54    head_caller(EHead, Caller).
   55determine_caller((:- Decl), Caller) :- !, decl_caller(Decl, Caller).
   56determine_caller(Head, Caller) :- head_caller(Head, Caller).
   57
   58decl_caller(initialization(_), '<initialization>').
   59decl_caller(_,                 '<declaration>').
   60
   61:- public
   62    check_trace_reference/3,
   63    do_term_expansion/1,
   64    do_goal_expansion/3,
   65    determine_caller/2.   66
   67prepare(To, Undefined, p(TRef, GRef)) :-
   68    ( To \== (-)
   69    ->( var(To)
   70      ->assertz((system:goal_expansion(G, P, _, _) :-
   71                       '$current_source_module'(M),
   72                       once(do_goal_expansion(M, G, P)),
   73                       fail), GRef)
   74      ; To = _:H
   75      ->functor(H, F, A),
   76        functor(G, F, A), % speed up goal expansion
   77        assertz((system:goal_expansion(G, P, _, _) :-
   78                     '$current_source_module'(M),
   79                     check_trace_reference(To, M, G),
   80                     once(do_goal_expansion(M, G, P)),
   81                     fail), GRef)
   82      ; true
   83      )
   84    ; Undefined = ignore
   85    ->true
   86    ; Undefined = trace
   87    ->assertz((system:goal_expansion(G, P, _, _) :-
   88                   '$current_source_module'(M),
   89                   \+ '$get_predicate_attribute'(M:G, defined, 1),
   90                   \+ predicate_property(M:G, autoload(_)),
   91                   once(do_goal_expansion(M, G, P)),
   92                   fail), GRef)
   93    ; true
   94    ),
   95    ( nonvar(GRef)
   96    ->assertz((system:term_expansion(T, P, T, P) :-
   97               do_term_expansion(T)), TRef)
   98    ; true
   99    ).
  100
  101cleanup(p(TRef, GRef)) :-
  102    ( nonvar(TRef)
  103    ->erase(TRef)
  104    ; true
  105    ),
  106    ( nonvar(GRef)
  107    ->erase(GRef)
  108    ; true
  109    ).
  110
  111skip((_,_)).
  112skip((_;_)).
  113skip((_->_)).
  114skip((_*->_)).
  115skip(\+(_)).
  116skip(module(_, _)).
  117skip(module(_, _, _)).
  118skip(_:_).
  119
  120check_file(File) :-
  121    current_context_value(file, File),
  122    prolog_load_context(source, File).
  123
  124do_term_expansion(Term) :-
  125    check_file(_),
  126    determine_caller(Term, Caller),
  127    set_context_value(caller, Caller).
  128
  129check_trace_reference(To, M, Goal) :-
  130    (   subsumes_term(To, M:Goal)
  131    ->  true
  132    ;   predicate_property(M:Goal, imported_from(M2)),
  133        subsumes_term(To, M2:Goal)
  134    ).
  135
  136do_goal_expansion(M, Goal, TermPos) :-
  137    check_file(File),
  138    \+ skip(Goal),
  139    ( TermPos \= none
  140    ->From = file_term_position(File, TermPos)
  141    ; prolog_load_context(term_position, Pos),
  142      stream_position_data(line_count, Pos, Line),
  143      From = file(File, Line, -1, _)
  144    ),
  145    current_context_value(on_trace, OnTrace),
  146    current_context_value(caller,   Caller),
  147    call(OnTrace, M:Goal, Caller, From).
  148
  149do_source_walk_code(Options1) :-
  150    foldl(select_option_default,
  151          [on_trace(OnTrace)-(codewalk:true_3),
  152           trace_reference(To)-To,
  153           undefined(Undefined)-ignore,
  154           if(Loaded)-true,
  155           variable_names(VNL)-VNL],
  156          Options1, Options2),
  157    option_allchk(M, File, FileMGen-[if(Loaded)|Options2], true-Options),
  158    freeze(VNL, b_setval('$variable_names', VNL)),
  159    with_context_values(
  160        setup_call_cleanup(
  161            ( '$current_source_module'(OldM),
  162              freeze(M, '$set_source_module'(_, M)),
  163              prepare(To, Undefined, Ref)
  164            ),
  165            walk_source(FileMGen, File, [variable_names(VNL)|Options]),
  166            ( '$set_source_module'(_, OldM),
  167              cleanup(Ref)
  168            )),
  169        [file, on_trace],
  170        [File, OnTrace]).
  171
  172walk_source(FileMGen, File, Options) :-
  173    forall(FileMGen,
  174           setup_call_cleanup(
  175               prolog_open_source(File, In),
  176               fetch_term(In, Options),
  177               prolog_close_source(In))).
  178
  179fetch_term(In, Options1) :-
  180    foldl(select_option_default,
  181          [subterm_positons(TermPos)-TermPos,
  182           term_position(Pos)-Pos,
  183           syntax_errors(SE)-dec10,
  184           process_comment(PC)-false,
  185           comments(C)-C
  186          ], Options1, Options2),
  187    Options = [subterm_positions(TermPos),
  188               syntax_errors(SE),
  189               term_position(Pos),
  190               process_comment(PC),
  191               comments(C)
  192               |Options2
  193              ],
  194    repeat,
  195      read_clause(In, Term, Options),
  196      prolog_xref:update_condition(Term),
  197      '$current_source_module'(M),
  198      prolog_xref:current_condition(Cond),
  199      ( M:Cond
  200      ->prolog_source:expand(Term, TermPos, In, Expanded),
  201        prolog_source:update_state(Term, Expanded, M)
  202      ; true
  203      ),
  204      Term == end_of_file,
  205    !