View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Eva Stoewe, Guenter Kniesel and Jan Wielemaker
    4    E-mail:        pdt@lists.iai.uni-bonn.de
    5    WWW:           http://sewiki.iai.uni-bonn.de/research/pdt/start
    6    Copyright (c)  2004-2012, CS Dept. III, University of Bonn
    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(prolog_metainference,
   36          [ infer_meta_predicate/2,             % :Head, -MetaSpec
   37            inferred_meta_predicate/2           % :Head, ?MetaSpec
   38          ]).   39:- autoload(library(apply),[maplist/4]).   40:- autoload(library(lists),[append/3]).   41
   42
   43:- meta_predicate
   44    inferred_meta_predicate(:, ?),
   45    infer_meta_predicate(:, -).   46
   47:- dynamic
   48    inferred_meta_pred/3.                   % Head, Module, Meta
   49
   50/** <module> Infer meta-predicate properties
   51
   52This module infers meta-predicate properties   by inspecting the clauses
   53of predicates that call other predicates.   This is extremely useful for
   54program analysis and refactoring because  many   programs  `in the wild'
   55have incomplete or incorrect meta-predicate information.
   56
   57@see    This library is used by prolog_walk_code/1 to improve the
   58        accuracy of this analysis.
   59@tbd    Re-introduce some alias-analysis
   60@tbd    Not all missing meta-declarations are interesting.  Notably,
   61        meta-predicates that are private and only pass meta-arguments
   62        on behalve of a public meta-predicates do not need a declaration.
   63*/
   64
   65
   66%!  inferred_meta_predicate(:Head, ?MetaSpec) is nondet.
   67%
   68%   True when MetaSpec is an   inferred meta-predicate specification
   69%   for Head.
   70
   71inferred_meta_predicate(M:Head, MetaSpec) :-
   72    inferred_meta_pred(Head, M, MetaSpec).
   73inferred_meta_predicate(M:Head, MetaSpec) :-
   74    predicate_property(M:Head, imported_from(From)),
   75    inferred_meta_pred(Head, From, MetaSpec).
   76
   77
   78%!  infer_meta_predicate(:Head, -MetaSpec) is semidet
   79%
   80%   True  when  MetaSpec  is  a  meta-predicate  specifier  for  the
   81%   predicate Head. Derived meta-predicates are   collected and made
   82%   available through inferred_meta_predicate/2.
   83
   84infer_meta_predicate(Head, MetaSpec) :-
   85    inferred_meta_predicate(Head, MetaSpec),
   86    !.
   87infer_meta_predicate(M:Head, MetaSpec) :-
   88    predicate_property(M:Head, imported_from(From)),
   89    !,
   90    do_infer_meta_predicate(From:Head, MetaSpec),
   91    assertz(inferred_meta_pred(Head, From, MetaSpec)).
   92infer_meta_predicate(M:Head, MetaSpec) :-
   93    do_infer_meta_predicate(M:Head, MetaSpec),
   94    assertz(inferred_meta_pred(Head, M, MetaSpec)).
   95
   96:- meta_predicate
   97    do_infer_meta_predicate(:, -).   98
   99do_infer_meta_predicate(Module:AHead, MetaSpec):-
  100    functor(AHead, Functor, Arity),
  101    functor(Head, Functor, Arity),  % Generalise the head
  102    findall(MetaSpec,
  103            meta_pred_args_in_clause(Module, Head, MetaSpec),
  104            MetaSpecs),
  105    MetaSpecs \== [],
  106    combine_meta_args(MetaSpecs, MetaSpec).
  107
  108
  109%!  meta_pred_args_in_clause(+Module, +Head, -MetaSpec) is nondet.
  110
  111meta_pred_args_in_clause(Module, Head, MetaArgs) :-
  112    clause(Module:Head, Body),
  113    annotate_meta_vars_in_body(Body, Module),
  114    meta_annotation(Head, MetaArgs).
  115
  116
  117%!  annotate_meta_vars_in_body(+Term, +Module) is det
  118%
  119%   Annotate variables in Term if they appear as meta-arguments.
  120%
  121%   @tbd    Aliasing.  Previous code detected aliasing for
  122%           - =/2
  123%           - functor/3
  124%           - atom_concat/3
  125%           - =../2
  126%           - arg/3
  127%   @tbd    We can make this nondet, exploring multiple aliasing
  128%           paths in disjunctions.
  129
  130annotate_meta_vars_in_body(A, _) :-
  131    atomic(A),
  132    !.
  133annotate_meta_vars_in_body(Var, _) :-
  134    var(Var),
  135    !,
  136    annotate(Var, 0).
  137annotate_meta_vars_in_body(Module:Term, _) :-
  138    !,
  139    (   atom(Module)
  140    ->  annotate_meta_vars_in_body(Term, Module)
  141    ;   var(Module)
  142    ->  annotate(Module, m)
  143    ;   true                        % may continue if Term is a system
  144    ).                              % predicate?
  145annotate_meta_vars_in_body((TermA, TermB), Module) :-
  146    !,
  147    annotate_meta_vars_in_body(TermB, Module),
  148    annotate_meta_vars_in_body(TermA, Module).
  149annotate_meta_vars_in_body((TermA; TermB), Module) :-
  150    !,
  151    annotate_meta_vars_in_body(TermB, Module),
  152    annotate_meta_vars_in_body(TermA, Module).
  153annotate_meta_vars_in_body((TermA->TermB), Module) :-
  154    !,
  155    annotate_meta_vars_in_body(TermB, Module),
  156    annotate_meta_vars_in_body(TermA, Module).
  157annotate_meta_vars_in_body((TermA*->TermB), Module) :-
  158    !,
  159    annotate_meta_vars_in_body(TermB, Module),
  160    annotate_meta_vars_in_body(TermA, Module).
  161annotate_meta_vars_in_body(A=B, _) :-
  162    var(A), var(B),
  163    !,
  164    A = B.
  165annotate_meta_vars_in_body(Goal, Module) :- % TBD: do we trust this?
  166    predicate_property(Module:Goal, meta_predicate(Head)),
  167    !,
  168    functor(Goal, _, Arity),
  169    annotate_meta_args(1, Arity, Goal, Head, Module).
  170annotate_meta_vars_in_body(Goal, Module) :-
  171    inferred_meta_predicate(Module:Goal, Head),
  172    !,
  173    functor(Goal, _, Arity),
  174    annotate_meta_args(1, Arity, Goal, Head, Module).
  175annotate_meta_vars_in_body(_, _).
  176
  177
  178%!  annotate_meta_args(+Arg, +Arity, +Goal, +MetaSpec, +Module)
  179
  180annotate_meta_args(I, Arity, Goal, MetaSpec, Module) :-
  181    I =< Arity,
  182    !,
  183    arg(I, MetaSpec, MetaArg),
  184    arg(I, Goal, Arg),
  185    annotate_meta_arg(MetaArg, Arg, Module),
  186    I2 is I + 1,
  187    annotate_meta_args(I2, Arity, Goal, MetaSpec, Module).
  188annotate_meta_args(_, _, _, _, _).
  189
  190annotate_meta_arg(Spec, Arg, _) :-
  191    var(Arg),
  192    !,
  193    annotate(Arg, Spec).
  194annotate_meta_arg(0, Arg, Module) :-
  195    !,
  196    annotate_meta_vars_in_body(Arg, Module).
  197annotate_meta_arg(N, Arg, Module) :-
  198    integer(N),
  199    callable(Arg),
  200    !,
  201    Arg =.. List,
  202    length(Extra, N),
  203    append(List, Extra, ListX),
  204    ArgX =.. ListX,
  205    annotate_meta_vars_in_body(ArgX, Module).
  206annotate_meta_arg(Spec, Arg, _) :-
  207    is_meta(Spec),
  208    compound(Arg),
  209    Arg = Module:_,
  210    var(Module),
  211    !,
  212    annotate(Module, m).
  213annotate_meta_arg(_,_,_).
  214
  215annotate(Var, Annotation) :-
  216    get_attr(Var, prolog_metainference, Annot0),
  217    !,
  218    join_annotation(Annot0, Annotation, Joined),
  219    put_attr(Var, prolog_metainference, Joined).
  220annotate(Var, Annotation) :-
  221    put_attr(Var, prolog_metainference, Annotation).
  222
  223join_annotation(A, A, A) :- !.
  224join_annotation(A, B, C) :-
  225    (   is_meta(A), \+ is_meta(B)
  226    ->  C = A
  227    ;   \+ is_meta(A), is_meta(B)
  228    ->  C = B
  229    ;   is_meta(A), is_meta(B)
  230    ->  C = (:)
  231    ;   C = *
  232    ).
  233
  234attr_unify_hook(A0, Other) :-
  235    get_attr(Other, prolog_metainference, A1),
  236    !,
  237    join_annotation(A0, A1, A),
  238    put_attr(Other, prolog_metainference, A).
  239
  240
  241%!  meta_annotation(+Head, -Annotation) is semidet.
  242%
  243%   True when Annotation is an   appropriate  meta-specification for
  244%   Head.
  245
  246meta_annotation(Head, Meta) :-
  247    functor(Head, Name, Arity),
  248    functor(Meta, Name, Arity),
  249    meta_args(1, Arity, Head, Meta, HasMeta),
  250    HasMeta == true.
  251
  252meta_args(I, Arity, Head, Meta, HasMeta) :-
  253    I =< Arity,
  254    !,
  255    arg(I, Head, HeadArg),
  256    arg(I, Meta, MetaArg),
  257    meta_arg(HeadArg, MetaArg),
  258    (   is_meta(MetaArg)
  259    ->  HasMeta = true
  260    ;   true
  261    ),
  262    I2 is I + 1,
  263    meta_args(I2, Arity, Head, Meta, HasMeta).
  264meta_args(_, _, _, _, _).
  265
  266is_meta(I) :- integer(I), !.
  267is_meta(:).
  268is_meta(^).
  269is_meta(//).
  270
  271%!  meta_arg(+AnnotatedArg, -MetaSpec) is det.
  272%
  273%   True when MetaSpec is  a  proper   annotation  for  the argument
  274%   AnnotatedArg. This is simple if the argument is a plain argument
  275%   in the head (first clause). If it   is  a compound term, it must
  276%   unify to _:_, otherwise there is no point turning it into a meta
  277%   argument. If the  module  part  is   then  passed  to  a  module
  278%   sensitive predicate, we assume it is a meta-predicate.
  279
  280meta_arg(HeadArg, MetaArg) :-
  281    get_attr(HeadArg, prolog_metainference, MetaArg),
  282    MetaArg \== m,
  283    !.
  284meta_arg(HeadArg, :) :-
  285    compound(HeadArg),
  286    HeadArg = M:_,
  287    get_attr(M, prolog_metainference, m),
  288    !.
  289meta_arg(_, *).
  290
  291%!  combine_meta_args(+Heads, -Head) is det.
  292%
  293%   Combine multiple meta-specifications.
  294
  295combine_meta_args([], []) :- !.
  296combine_meta_args([List], List) :- !.
  297combine_meta_args([Spec,Spec|Specs], CombinedArgs) :-
  298    !,
  299    combine_meta_args([Spec|Specs], CombinedArgs).
  300combine_meta_args([Spec1,Spec2|Specs], CombinedArgs) :-
  301    Spec1 =.. [Name|Args1],
  302    Spec2 =.. [Name|Args2],
  303    maplist(join_annotation, Args1, Args2, Args),
  304    Spec =.. [Name|Args],
  305    combine_meta_args([Spec|Specs], CombinedArgs)