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