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