1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2011-2016, VU University Amsterdam
    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(predicate_options,
   36          [ predicate_options/3,                % +PI, +Arg, +Options
   37            assert_predicate_options/4,         % +PI, +Arg, +Options, ?New
   38
   39            current_option_arg/2,               % ?PI, ?Arg
   40            current_predicate_option/3,         % ?PI, ?Arg, ?Option
   41            check_predicate_option/3,           % +PI, +Arg, +Option
   42                                                % Create declarations
   43            current_predicate_options/3,        % ?PI, ?Arg, ?Options
   44            retractall_predicate_options/0,
   45            derived_predicate_options/3,        % :PI, ?Arg, ?Options
   46            derived_predicate_options/1,        % +Module
   47                                                % Checking
   48            check_predicate_options/0,
   49            derive_predicate_options/0,
   50            check_predicate_options/1           % :PredicateIndicator
   51          ]).   52:- autoload(library(apply),[maplist/3]).   53:- autoload(library(debug),[debug/3]).   54:- autoload(library(error),
   55	    [ existence_error/2,
   56	      must_be/2,
   57	      instantiation_error/1,
   58	      uninstantiation_error/1,
   59	      is_of_type/2
   60	    ]).   61:- use_module(library(dialect/swi/syspred_options)).   62
   63:- autoload(library(listing),[portray_clause/1]).   64:- autoload(library(lists),[member/2,nth1/3,append/3,delete/3]).   65:- autoload(library(pairs),[group_pairs_by_key/2]).   66:- autoload(library(prolog_clause),[clause_info/4]).   67
   68
   69:- meta_predicate
   70    predicate_options(:, +, +),
   71    assert_predicate_options(:, +, +, ?),
   72    current_predicate_option(:, ?, ?),
   73    check_predicate_option(:, ?, ?),
   74    current_predicate_options(:, ?, ?),
   75    current_option_arg(:, ?),
   76    pred_option(:,-),
   77    derived_predicate_options(:,?,?),
   78    check_predicate_options(:).   79
   80/** <module> Access and analyse predicate options
   81
   82This  module  provides  the  developers   interface  for  the  directive
   83predicate_options/3. This directive allows  us  to  specify  that, e.g.,
   84open/4 processes options using the 4th  argument and supports the option
   85=type= using the values =text= and  =binary=. Declaring options that are
   86processed allows for more reliable  handling   of  predicate options and
   87simplifies porting applications. This  library   provides  the following
   88functionality:
   89
   90  * Query supported options through current_predicate_option/3
   91    or current_predicate_options/3.  This is intended to support
   92    conditional compilation and an IDE.
   93  * Derive additional declarations through dataflow analysis using
   94    derive_predicate_options/0.
   95  * Perform a compile-time analysis of the entire loaded program using
   96    check_predicate_options/0.
   97
   98Below, we describe some use-cases.
   99
  100  $ Quick check of a program :
  101  This scenario is useful as an occasional check or to assess problems
  102  with option-handling for porting an application to SWI-Prolog.  It
  103  consists of three steps: loading the program (1 and 2), deriving
  104  option handling for application predicates (3) and running the
  105  checker (4).
  106
  107    ==
  108    1 ?- [load].
  109    2 ?- autoload.
  110    3 ?- derive_predicate_options.
  111    4 ?- check_predicate_options.
  112    ==
  113
  114  $ Add declarations to your program :
  115  Adding declarations about option processes improves the quality of
  116  the checking.  The analysis of derive_predicate_options/0 may miss
  117  options and does not derive the types for options that are processed
  118  in Prolog code.  The process is similar to the above.  In steps 4 and
  119  further, the inferred declarations are listed, inspected and added to
  120  the source code of the module.
  121
  122    ==
  123    1 ?- [load].
  124    2 ?- autoload.
  125    3 ?- derive_predicate_options.
  126    4 ?- derived_predicate_options(module_1).
  127    5 ?- derived_predicate_options(module_2).
  128    6 ?- ...
  129    ==
  130
  131  $ Declare option processing requirements :
  132  If an application requires that open/4 needs to support lock(write),
  133  it may do so using the directive below.  This directive raises an
  134  exception when loaded on a Prolog implementation that does not support
  135  this option.
  136
  137    ==
  138    :- current_predicate_option(open/4, 4, lock(write)).
  139    ==
  140
  141@see library(option) for accessing options in Prolog code.
  142*/
  143
  144:- multifile option_decl/3, pred_option/3.  145:- dynamic   dyn_option_decl/3.  146
  147%!  predicate_options(:PI, +Arg, +Options) is det.
  148%
  149%   Declare that the predicate PI processes options on Arg.  Options
  150%   is a list of options processed.  Each element is one of:
  151%
  152%     * Option(ModeAndType)
  153%     PI processes Option. The option-value must comply to
  154%     ModeAndType.  Mode is one of + or - and Type is a type as
  155%     accepted by must_be/2.
  156%
  157%     * pass_to(:PI,Arg)
  158%     The option-list is passed to the indicated predicate.
  159%
  160%   Below is an example that   processes  the option header(boolean)
  161%   and passes all options to open/4:
  162%
  163%     ==
  164%     :- predicate_options(write_xml_file/3, 3,
  165%                          [ header(boolean),
  166%                            pass_to(open/4, 4)
  167%                          ]).
  168%
  169%     write_xml_file(File, XMLTerm, Options) :-
  170%         open(File, write, Out, Options),
  171%         (   option(header(true), Options, true)
  172%         ->  write_xml_header(Out)
  173%         ;   true
  174%         ),
  175%         ...
  176%     ==
  177%
  178%   This predicate may  only  be  used   as  a  _directive_  and  is
  179%   processed  by  expand_term/2.  Option  processing    can  be
  180%   specified at runtime using  assert_predicate_options/3, which is
  181%   intended to support program analysis.
  182
  183predicate_options(PI, Arg, Options) :-
  184    throw(error(context_error(nodirective,
  185                              predicate_options(PI, Arg, Options)), _)).
  186
  187
  188%!  assert_predicate_options(:PI, +Arg, +Options, ?New) is semidet.
  189%
  190%   As predicate_options(:PI, +Arg, +Options).  New   is  a  boolean
  191%   indicating whether the declarations  have   changed.  If  New is
  192%   provided and =false=, the predicate   becomes  semidet and fails
  193%   without modifications if modifications are required.
  194
  195assert_predicate_options(PI, Arg, Options, New) :-
  196    canonical_pi(PI, M:Name/Arity),
  197    functor(Head, Name, Arity),
  198    (   dyn_option_decl(Head, M, Arg)
  199    ->  true
  200    ;   New = true,
  201        assertz(dyn_option_decl(Head, M, Arg))
  202    ),
  203    phrase('$predopts':option_clauses(Options, Head, M, Arg),
  204           OptionClauses),
  205    forall(member(Clause, OptionClauses),
  206           assert_option_clause(Clause, New)),
  207    (   var(New)
  208    ->  New = false
  209    ;   true
  210    ).
  211
  212assert_option_clause(Clause, New) :-
  213    rename_clause(Clause, NewClause,
  214                  '$pred_option'(A,B,C,D), '$dyn_pred_option'(A,B,C,D)),
  215    clause_head(NewClause, NewHead),
  216    (   clause(NewHead, _)
  217    ->  true
  218    ;   New = true,
  219        assertz(NewClause)
  220    ).
  221
  222clause_head(M:(Head:-_Body), M:Head) :- !.
  223clause_head((M:Head :-_Body), M:Head) :- !.
  224clause_head(Head, Head).
  225
  226rename_clause(M:Clause, M:NewClause, Head, NewHead) :-
  227    !,
  228    rename_clause(Clause, NewClause, Head, NewHead).
  229rename_clause((Head :- Body), (NewHead :- Body), Head, NewHead) :- !.
  230rename_clause(Head, NewHead, Head, NewHead) :- !.
  231rename_clause(Head, Head, _, _).
  232
  233
  234
  235                 /*******************************
  236                 *        QUERY OPTIONS         *
  237                 *******************************/
  238
  239%!  current_option_arg(:PI, ?Arg) is nondet.
  240%
  241%   True when Arg of PI processes   predicate options. Which options
  242%   are processed can be accessed using current_predicate_option/3.
  243
  244current_option_arg(Module:Name/Arity, Arg) :-
  245    current_option_arg(Module:Name/Arity, Arg, _DefM).
  246
  247current_option_arg(Module:Name/Arity, Arg, DefM) :-
  248    atom(Name), integer(Arity),
  249    !,
  250    resolve_module(Module:Name/Arity, DefM:Name/Arity),
  251    functor(Head, Name, Arity),
  252    (   option_decl(Head, DefM, Arg)
  253    ;   dyn_option_decl(Head, DefM, Arg)
  254    ).
  255current_option_arg(M:Name/Arity, Arg, M) :-
  256    (   option_decl(Head, M, Arg)
  257    ;   dyn_option_decl(Head, M, Arg)
  258    ),
  259    functor(Head, Name, Arity).
  260
  261%!  current_predicate_option(:PI, ?Arg, ?Option) is nondet.
  262%
  263%   True when Arg of PI processes Option. For example, the following
  264%   is true:
  265%
  266%     ==
  267%     ?- current_predicate_option(open/4, 4, type(text)).
  268%     true.
  269%     ==
  270%
  271%   This predicate is intended to   support  conditional compilation
  272%   using      if/1      ...      endif/0.        The      predicate
  273%   current_predicate_options/3 can be  used  to   access  the  full
  274%   capabilities of a predicate.
  275
  276current_predicate_option(Module:PI, Arg, Option) :-
  277    current_option_arg(Module:PI, Arg, DefM),
  278    PI = Name/Arity,
  279    functor(Head, Name, Arity),
  280    catch(pred_option(DefM:Head, Option),
  281          error(type_error(_,_),_),
  282          fail).
  283
  284%!  check_predicate_option(:PI, +Arg, +Option) is det.
  285%
  286%   Verify   predicate   options    at     runtime.    Similar    to
  287%   current_predicate_option/3,  but  intended  to  support  runtime
  288%   checking.
  289%
  290%   @error  existence_error(option, OptionName) if the option is not
  291%           supported by PI.
  292%   @error  type_error(Type, Value) if the option is supported but
  293%           the value does not match the option type. See must_be/2.
  294
  295check_predicate_option(Module:PI, Arg, Option) :-
  296    define_predicate(Module:PI),
  297    current_option_arg(Module:PI, Arg, DefM),
  298    PI = Name/Arity,
  299    functor(Head, Name, Arity),
  300    (   pred_option(DefM:Head, Option)
  301    ->  true
  302    ;   existence_error(option, Option)
  303    ).
  304
  305
  306pred_option(M:Head, Option) :-
  307    pred_option(M:Head, Option, []).
  308
  309pred_option(M:Head, Option, Seen) :-
  310    (   has_static_option_decl(M),
  311        M:'$pred_option'(Head, _, Option, Seen)
  312    ;   has_dynamic_option_decl(M),
  313        M:'$dyn_pred_option'(Head, _, Option, Seen)
  314    ).
  315
  316has_static_option_decl(M) :-
  317    '$c_current_predicate'(_, M:'$pred_option'(_,_,_,_)).
  318has_dynamic_option_decl(M) :-
  319    '$c_current_predicate'(_, M:'$dyn_pred_option'(_,_,_,_)).
  320
  321
  322                 /*******************************
  323                 *     TYPE&MODE CONSTRAINTS    *
  324                 *******************************/
  325
  326:- public
  327    system:predicate_option_mode/2,
  328    system:predicate_option_type/2.  329
  330add_attr(Var, Value) :-
  331    (   get_attr(Var, predicate_options, Old)
  332    ->  put_attr(Var, predicate_options, [Value|Old])
  333    ;   put_attr(Var, predicate_options, [Value])
  334    ).
  335
  336system:predicate_option_type(Type, Arg) :-
  337    var(Arg),
  338    !,
  339    add_attr(Arg, option_type(Type)).
  340system:predicate_option_type(Type, Arg) :-
  341    must_be(Type, Arg).
  342
  343system:predicate_option_mode(Mode, Arg) :-
  344    var(Arg),
  345    !,
  346    add_attr(Arg, option_mode(Mode)).
  347system:predicate_option_mode(Mode, Arg) :-
  348    check_mode(Mode, Arg).
  349
  350check_mode(input, Arg) :-
  351    (   nonvar(Arg)
  352    ->  true
  353    ;   instantiation_error(Arg)
  354    ).
  355check_mode(output, Arg) :-
  356    (   var(Arg)
  357    ->  true
  358    ;   uninstantiation_error(Arg)
  359    ).
  360
  361attr_unify_hook([], _).
  362attr_unify_hook([H|T], Var) :-
  363    option_hook(H, Var),
  364    attr_unify_hook(T, Var).
  365
  366option_hook(option_type(Type), Value) :-
  367    is_of_type(Type, Value).
  368option_hook(option_mode(Mode), Value) :-
  369    check_mode(Mode, Value).
  370
  371
  372attribute_goals(Var) -->
  373    { get_attr(Var, predicate_options, Attrs) },
  374    option_goals(Attrs, Var).
  375
  376option_goals([], _) --> [].
  377option_goals([H|T], Var) -->
  378    option_goal(H, Var),
  379    option_goals(T, Var).
  380
  381option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)].
  382option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)].
  383
  384
  385                 /*******************************
  386                 *      OUTPUT DECLARATIONS     *
  387                 *******************************/
  388
  389%!  current_predicate_options(:PI, ?Arg, ?Options) is nondet.
  390%
  391%   True when Options is the current   active option declaration for
  392%   PI  on  Arg.   See   predicate_options/3    for   the   argument
  393%   descriptions. If PI  is  ground  and   refers  to  an  undefined
  394%   predicate, the autoloader is used to  obtain a definition of the
  395%   predicate.
  396
  397current_predicate_options(PI, Arg, Options) :-
  398    define_predicate(PI),
  399    setof(Arg-Option,
  400          current_predicate_option_decl(PI, Arg, Option),
  401          Options0),
  402    group_pairs_by_key(Options0, Grouped),
  403    member(Arg-Options, Grouped).
  404
  405current_predicate_option_decl(PI, Arg, Option) :-
  406    current_predicate_option(PI, Arg, Option0),
  407    Option0 =.. [Name|Values],
  408    maplist(mode_and_type, Values, Types),
  409    Option =.. [Name|Types].
  410
  411mode_and_type(Value, ModeAndType) :-
  412    copy_term(Value,_,Goals),
  413    (   memberchk(predicate_option_mode(output, _), Goals)
  414    ->  ModeAndType = -(Type)
  415    ;   ModeAndType = Type
  416    ),
  417    (   memberchk(predicate_option_type(Type, _), Goals)
  418    ->  true
  419    ;   Type = any
  420    ).
  421
  422define_predicate(PI) :-
  423    ground(PI),
  424    !,
  425    PI = M:Name/Arity,
  426    functor(Head, Name, Arity),
  427    once(predicate_property(M:Head, _)).
  428define_predicate(_).
  429
  430%!  derived_predicate_options(:PI, ?Arg, ?Options) is nondet.
  431%
  432%   Derive option arguments using static analysis. True when Options
  433%   is the current _derived_ active  option   declaration  for PI on
  434%   Arg.
  435
  436derived_predicate_options(PI, Arg, Options) :-
  437    define_predicate(PI),
  438    setof(Arg-Option,
  439          derived_predicate_option(PI, Arg, Option),
  440          Options0),
  441    group_pairs_by_key(Options0, Grouped),
  442    member(Arg-Options1, Grouped),
  443    PI = M:_,
  444    phrase(expand_pass_to_options(Options1, M), Options2),
  445    sort(Options2, Options).
  446
  447derived_predicate_option(PI, Arg, Decl) :-
  448    current_option_arg(PI, Arg, DefM),
  449    PI = _:Name/Arity,
  450    functor(Head, Name, Arity),
  451    has_dynamic_option_decl(DefM),
  452    (   has_static_option_decl(DefM),
  453        DefM:'$pred_option'(Head, Decl, _, [])
  454    ;   DefM:'$dyn_pred_option'(Head, Decl, _, [])
  455    ).
  456
  457%!  expand_pass_to_options(+OptionsIn, +Module, -OptionsOut)// is det.
  458%
  459%   Expand the options of pass_to(PI,Arg) if PI  does not refer to a
  460%   public predicate.
  461
  462expand_pass_to_options([], _) --> [].
  463expand_pass_to_options([H|T], M) -->
  464    expand_pass_to(H, M),
  465    expand_pass_to_options(T, M).
  466
  467expand_pass_to(pass_to(PI, Arg), Module) -->
  468    { strip_module(Module:PI, M, Name/Arity),
  469      functor(Head, Name, Arity),
  470      \+ (   predicate_property(M:Head, exported)
  471         ;   predicate_property(M:Head, public)
  472         ;   M == system
  473         ),
  474      !,
  475      current_predicate_options(M:Name/Arity, Arg, Options)
  476    },
  477    list(Options).
  478expand_pass_to(Option, _) -->
  479    [Option].
  480
  481list([]) --> [].
  482list([H|T]) --> [H], list(T).
  483
  484%!  derived_predicate_options(+Module) is det.
  485%
  486%   Derive predicate option declarations for   a module. The derived
  487%   options are printed to the =current_output= stream.
  488
  489derived_predicate_options(Module) :-
  490    var(Module),
  491    !,
  492    forall(current_module(Module),
  493           derived_predicate_options(Module)).
  494derived_predicate_options(Module) :-
  495    findall(predicate_options(Module:PI, Arg, Options),
  496            ( derived_predicate_options(Module:PI, Arg, Options),
  497              PI = Name/Arity,
  498              functor(Head, Name, Arity),
  499              (   predicate_property(Module:Head, exported)
  500              ->  true
  501              ;   predicate_property(Module:Head, public)
  502              )
  503            ),
  504            Decls0),
  505    maplist(qualify_decl(Module), Decls0, Decls1),
  506    sort(Decls1, Decls),
  507    (   Decls \== []
  508    ->  format('~N~n~n% Predicate option declarations for module ~q~n~n',
  509               [Module]),
  510        forall(member(Decl, Decls),
  511               portray_clause((:-Decl)))
  512    ;   true
  513    ).
  514
  515qualify_decl(M,
  516             predicate_options(PI0, Arg, Options0),
  517             predicate_options(PI1, Arg, Options1)) :-
  518    qualify(PI0, M, PI1),
  519    maplist(qualify_option(M), Options0, Options1).
  520
  521qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :-
  522    !,
  523    qualify(PI0, M, PI1).
  524qualify_option(_, Opt, Opt).
  525
  526qualify(M:Term, M, Term) :- !.
  527qualify(QTerm, _, QTerm).
  528
  529
  530                 /*******************************
  531                 *            CLEANUP           *
  532                 *******************************/
  533
  534%!  retractall_predicate_options is det.
  535%
  536%   Remove all dynamically (derived) predicate options.
  537
  538retractall_predicate_options :-
  539    forall(retract(dyn_option_decl(_,M,_)),
  540           abolish(M:'$dyn_pred_option'/4)).
  541
  542
  543                 /*******************************
  544                 *     COMPILE-TIME CHECKER     *
  545                 *******************************/
  546
  547
  548:- thread_local
  549    new_decl/1.  550
  551%!  check_predicate_options is det.
  552%
  553%   Analyse loaded program for  erroneous   options.  This predicate
  554%   decompiles  the  current  program  and  searches  for  calls  to
  555%   predicates that process  options.  For   each  option  list,  it
  556%   validates  whether  the  provided  options   are  supported  and
  557%   validates the argument type.  This   predicate  performs partial
  558%   dataflow analysis to track option-lists inside a clause.
  559%
  560%   @see    derive_predicate_options/0 can be used to derive
  561%           declarations for predicates that pass options. This
  562%           predicate should normally be called before
  563%           check_predicate_options/0.
  564
  565check_predicate_options :-
  566    forall(current_module(Module),
  567           check_predicate_options_module(Module)).
  568
  569%!  derive_predicate_options is det.
  570%
  571%   Derive  new  predicate  option    declarations.  This  predicate
  572%   analyses the loaded program to find clauses that process options
  573%   using one of  the  predicates   from  library(option)  or passes
  574%   options to other predicates that are   known to process options.
  575%   The process is repeated until no new declarations are retrieved.
  576%
  577%   @see autoload/0 may be used to complete the loaded program.
  578
  579derive_predicate_options :-
  580    derive_predicate_options(NewDecls),
  581    (   NewDecls == []
  582    ->  true
  583    ;   print_message(informational, check_options(new(NewDecls))),
  584        new_decls(NewDecls),
  585        derive_predicate_options
  586    ).
  587
  588new_decls([]).
  589new_decls([predicate_options(PI, A, O)|T]) :-
  590    assert_predicate_options(PI, A, O, _),
  591    new_decls(T).
  592
  593
  594derive_predicate_options(NewDecls) :-
  595    call_cleanup(
  596        ( forall(
  597              current_module(Module),
  598              forall(
  599                  ( predicate_in_module(Module, PI),
  600                    PI = Name/Arity,
  601                    functor(Head, Name, Arity),
  602                    catch(Module:clause(Head, Body, Ref), _, fail)
  603                  ),
  604                  check_clause((Head:-Body), Module, Ref, decl))),
  605          (   setof(Decl, retract(new_decl(Decl)), NewDecls)
  606              ->  true
  607              ;   NewDecls = []
  608          )
  609        ),
  610        retractall(new_decl(_))).
  611
  612
  613check_predicate_options_module(Module) :-
  614    forall(predicate_in_module(Module, PI),
  615           check_predicate_options(Module:PI)).
  616
  617predicate_in_module(Module, PI) :-
  618    current_predicate(Module:PI),
  619    PI = Name/Arity,
  620    functor(Head, Name, Arity),
  621    \+ predicate_property(Module:Head, imported_from(_)).
  622
  623%!  check_predicate_options(:PredicateIndicator) is det.
  624%
  625%   Verify calls to predicates that have   options in all clauses of
  626%   the predicate indicated by PredicateIndicator.
  627
  628check_predicate_options(Module:Name/Arity) :-
  629    debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
  630    functor(Head, Name, Arity),
  631    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  632           check_clause((Head:-Body), Module, Ref, check)).
  633
  634%!  check_clause(+Clause, +Module, +Ref, +Action) is det.
  635%
  636%   Action is one of
  637%
  638%     * decl
  639%     Create additional declarations
  640%     * check
  641%     Produce error messages
  642
  643check_clause((Head:-Body), M, ClauseRef, Action) :-
  644    !,
  645    catch(check_body(Body, M, _, Action), E, true),
  646    (   var(E)
  647    ->  option_decl(M:Head, Action)
  648    ;   (   clause_info(ClauseRef, File, TermPos, _NameOffset),
  649            TermPos = term_position(_,_,_,_,[_,BodyPos]),
  650            catch(check_body(Body, M, BodyPos, Action),
  651                  error(Formal, ArgPos), true),
  652            compound(ArgPos),
  653            arg(1, ArgPos, CharCount),
  654            integer(CharCount)
  655        ->  Location = file_char_count(File, CharCount)
  656        ;   Location = clause(ClauseRef),
  657            E = error(Formal, _)
  658        ),
  659        print_message(error, predicate_option_error(Formal, Location))
  660    ).
  661
  662
  663%!  check_body(+Body, +Module, +TermPos, +Action)
  664
  665:- multifile
  666    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  667    prolog:called_by/2.             % +Goal, -Called
  668
  669check_body(Var, _, _, _) :-
  670    var(Var),
  671    !.
  672check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :-
  673    !,
  674    check_body(G, M, Pos, Action).
  675check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  676    !,
  677    check_body(A, M, PA, Action),
  678    check_body(B, M, PB, Action).
  679check_body(A=B, _, _, _) :-             % partial evaluation
  680    unify_with_occurs_check(A,B),
  681    !.
  682check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :-
  683    callable(Goal),
  684    functor(Goal, Name, Arity),
  685    (   '$get_predicate_attribute'(M:Goal, imported, DefM)
  686    ->  true
  687    ;   DefM = M
  688    ),
  689    (   eval_option_pred(DefM:Goal)
  690    ->  true
  691    ;   current_option_arg(DefM:Name/Arity, OptArg),
  692        !,
  693        arg(OptArg, Goal, Options),
  694        nth1(OptArg, ArgPosList, ArgPos),
  695        check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action)
  696    ).
  697check_body(Goal, M, _, Action) :-
  698    (   (   predicate_property(M:Goal, imported_from(IM))
  699        ->  true
  700        ;   IM = M
  701        ),
  702        prolog:called_by(Goal, IM, M, Called)
  703    ;   prolog:called_by(Goal, Called)
  704    ),
  705    !,
  706    check_called_by(Called, M, Action).
  707check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :-
  708    '$get_predicate_attribute'(M:Meta, meta_predicate, Head),
  709    !,
  710    check_meta_args(1, Head, Meta, M, ArgPosList, Action).
  711check_body(_, _, _, _).
  712
  713check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :-
  714    arg(I, Head, AS),
  715    !,
  716    (   AS == 0
  717    ->  arg(I, Meta, MA),
  718        check_body(MA, M, ArgPos, Action)
  719    ;   true
  720    ),
  721    succ(I, I2),
  722    check_meta_args(I2, Head, Meta, M, ArgPosList, Action).
  723check_meta_args(_,_,_,_, _, _).
  724
  725%!  check_called_by(+CalledBy, +M, +Action) is det.
  726%
  727%   Handle results from prolog:called_by/2.
  728
  729check_called_by([], _, _).
  730check_called_by([H|T], M, Action) :-
  731    (   H = G+N
  732    ->  (   extend(G, N, G2)
  733        ->  check_body(G2, M, _, Action)
  734        ;   true
  735        )
  736    ;   check_body(H, M, _, Action)
  737    ),
  738    check_called_by(T, M, Action).
  739
  740extend(Goal, N, GoalEx) :-
  741    callable(Goal),
  742    Goal =.. List,
  743    length(Extra, N),
  744    append(List, Extra, ListEx),
  745    GoalEx =.. ListEx.
  746
  747
  748%!  check_options(:Predicate, +OptionArg, +Options, +ArgPos, +Action)
  749%
  750%   Verify the list Options,  that  is   passed  into  Predicate  on
  751%   argument OptionArg. ArgPos is a   term-position  term describing
  752%   the location of the Options list. If  Options is a partial list,
  753%   the tail is annotated with pass_to(PI, OptArg).
  754
  755check_options(PI, OptArg, QOptions, ArgPos, Action) :-
  756    debug(predicate_options, '\tChecking call to ~q', [PI]),
  757    remove_qualifier(QOptions, Options),
  758    must_be(list_or_partial_list, Options),
  759    check_option_list(Options, PI, OptArg, Options, ArgPos, Action).
  760
  761remove_qualifier(X, X) :-
  762    var(X),
  763    !.
  764remove_qualifier(_:X, X) :- !.
  765remove_qualifier(X, X).
  766
  767check_option_list(Var,  PI, OptArg, _, _, _) :-
  768    var(Var),
  769    !,
  770    annotate(Var, pass_to(PI, OptArg)).
  771check_option_list([], _, _, _, _, _).
  772check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :-
  773    check_option(PI, OptArg, H, ArgPos, Action),
  774    check_option_list(T, PI, OptArg, Options, ArgPos, Action).
  775
  776check_option(_, _, _, _, decl) :- !.
  777check_option(PI, OptArg, Opt, ArgPos, _) :-
  778    catch(check_predicate_option(PI, OptArg, Opt), E, true),
  779    !,
  780    (   var(E)
  781    ->  true
  782    ;   E = error(Formal,_),
  783        throw(error(Formal,ArgPos))
  784    ).
  785
  786
  787                 /*******************************
  788                 *          ANNOTATIONS         *
  789                 *******************************/
  790
  791%!  annotate(+Var, +Term) is det.
  792%
  793%   Use constraints to accumulate annotations   about  variables. If
  794%   two annotated variables are unified, the attributes are joined.
  795
  796annotate(Var, Term) :-
  797    (   get_attr(Var, predopts_analysis, Old)
  798    ->  put_attr(Var, predopts_analysis, [Term|Old])
  799    ;   var(Var)
  800    ->  put_attr(Var, predopts_analysis, [Term])
  801    ;   true
  802    ).
  803
  804annotations(Var, Annotations) :-
  805    get_attr(Var, predopts_analysis, Annotations).
  806
  807predopts_analysis:attr_unify_hook(Opts, Value) :-
  808    get_attr(Value, predopts_analysis, Others),
  809    !,
  810    append(Opts, Others, All),
  811    put_attr(Value, predopts_analysis, All).
  812predopts_analysis:attr_unify_hook(_, _).
  813
  814
  815                 /*******************************
  816                 *         PARTIAL EVAL         *
  817                 *******************************/
  818
  819eval_option_pred(swi_option:option(Opt, Options)) :-
  820    processes(Opt, Spec),
  821    annotate(Options, Spec).
  822eval_option_pred(swi_option:option(Opt, Options, _Default)) :-
  823    processes(Opt, Spec),
  824    annotate(Options, Spec).
  825eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :-
  826    ignore(unify_with_occurs_check(Rest, Options)),
  827    processes(Opt, Spec),
  828    annotate(Options, Spec).
  829eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :-
  830    ignore(unify_with_occurs_check(Rest, Options)),
  831    processes(Opt, Spec),
  832    annotate(Options, Spec).
  833eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :-
  834    remove_qualifier(QOptionsIn, OptionsIn),
  835    remove_qualifier(QOptionsOut, OptionsOut),
  836    ignore(unify_with_occurs_check(OptionsIn, OptionsOut)).
  837
  838processes(Opt, Spec) :-
  839    compound(Opt),
  840    functor(Opt, OptName, 1),
  841    Spec =.. [OptName,any].
  842
  843
  844                 /*******************************
  845                 *        NEW DECLARTIONS       *
  846                 *******************************/
  847
  848%!  option_decl(:Head, +Action) is det.
  849%
  850%   Add new declarations based on attributes   left  by the analysis
  851%   pass. We do not add declarations   for system modules or modules
  852%   that already contain static declarations.
  853%
  854%   @tbd    Should we add a mode to include generating declarations
  855%           for system modules and modules with static declarations?
  856
  857option_decl(_, check) :- !.
  858option_decl(M:_, _) :-
  859    system_module(M),
  860    !.
  861option_decl(M:_, _) :-
  862    has_static_option_decl(M),
  863    !.
  864option_decl(M:Head, _) :-
  865    compound(Head),
  866    arg(AP, Head, QA),
  867    remove_qualifier(QA, A),
  868    annotations(A, Annotations0),
  869    functor(Head, Name, Arity),
  870    PI = M:Name/Arity,
  871    delete(Annotations0, pass_to(PI,AP), Annotations),
  872    Annotations \== [],
  873    Decl = predicate_options(PI, AP, Annotations),
  874    (   new_decl(Decl)
  875    ->  true
  876    ;   assert_predicate_options(M:Name/Arity, AP, Annotations, false)
  877    ->  true
  878    ;   assertz(new_decl(Decl)),
  879        debug(predicate_options(decl), '~q', [Decl])
  880    ),
  881    fail.
  882option_decl(_, _).
  883
  884system_module(system) :- !.
  885system_module(Module) :-
  886    sub_atom(Module, 0, _, _, $).
  887
  888
  889                 /*******************************
  890                 *             MISC             *
  891                 *******************************/
  892
  893canonical_pi(M:Name//Arity, M:Name/PArity) :-
  894    integer(Arity),
  895    PArity is Arity+2.
  896canonical_pi(PI, PI).
  897
  898%!  resolve_module(:PI, -DefPI) is det.
  899%
  900%   Find the real predicate  indicator   pointing  to the definition
  901%   module of PI. This is similar to using predicate_property/3 with
  902%   the       property       imported_from,         but        using
  903%   '$get_predicate_attribute'/3    avoids    auto-importing     the
  904%   predicate.
  905
  906resolve_module(Module:Name/Arity, DefM:Name/Arity) :-
  907    functor(Head, Name, Arity),
  908    (   '$get_predicate_attribute'(Module:Head, imported, M)
  909    ->  DefM = M
  910    ;   DefM = Module
  911    ).
  912
  913
  914                 /*******************************
  915                 *            MESSAGES          *
  916                 *******************************/
  917:- multifile
  918    prolog:message//1.  919
  920prolog:message(predicate_option_error(Formal, Location)) -->
  921    error_location(Location),
  922    '$messages':term_message(Formal). % TBD: clean interface
  923prolog:message(check_options(new(Decls))) -->
  924    [ 'Inferred declarations:'-[], nl ],
  925    new_decls(Decls).
  926
  927error_location(file_char_count(File, CharPos)) -->
  928    { filepos_line(File, CharPos, Line, LinePos) },
  929    [ '~w:~d:~d: '-[File, Line, LinePos] ].
  930error_location(clause(ClauseRef)) -->
  931    { clause_property(ClauseRef, file(File)),
  932      clause_property(ClauseRef, line_count(Line))
  933    },
  934    !,
  935    [ '~w:~d: '-[File, Line] ].
  936error_location(clause(ClauseRef)) -->
  937    [ 'Clause ~q: '-[ClauseRef] ].
  938
  939filepos_line(File, CharPos, Line, LinePos) :-
  940    setup_call_cleanup(
  941        ( open(File, read, In),
  942          open_null_stream(Out)
  943        ),
  944        ( Skip is CharPos-1,
  945          copy_stream_data(In, Out, Skip),
  946          stream_property(In, position(Pos)),
  947          stream_position_data(line_count, Pos, Line),
  948          stream_position_data(line_position, Pos, LinePos)
  949        ),
  950        ( close(Out),
  951          close(In)
  952        )).
  953
  954new_decls([]) --> [].
  955new_decls([H|T]) -->
  956    [ '    :- ~q'-[H], nl ],
  957    new_decls(T).
  958
  959
  960                 /*******************************
  961                 *      SYSTEM DECLARATIONS     *
  962                 *******************************/