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            check_raw_option_access/0,
   52            check_raw_option_access/1           % :Spec
   53          ]).   54:- autoload(library(apply),[maplist/3]).   55:- use_module(library(debug),[debug/3]).   56:- autoload(library(error),
   57	    [ existence_error/2,
   58	      must_be/2,
   59	      instantiation_error/1,
   60	      uninstantiation_error/1,
   61	      is_of_type/2
   62	    ]).   63:- use_module(library(dialect/swi/syspred_options)).   64
   65:- autoload(library(listing),[portray_clause/1]).   66:- autoload(library(lists),[member/2,nth1/3,append/3,delete/3]).   67:- autoload(library(pairs),[group_pairs_by_key/2]).   68:- autoload(library(prolog_clause),[clause_info/4]).   69
   70
   71:- meta_predicate
   72    predicate_options(:, +, +),
   73    assert_predicate_options(:, +, +, ?),
   74    current_predicate_option(:, ?, ?),
   75    check_predicate_option(:, ?, ?),
   76    current_predicate_options(:, ?, ?),
   77    current_option_arg(:, ?),
   78    pred_option(:,-),
   79    derived_predicate_options(:,?,?),
   80    check_predicate_options(:),
   81    check_raw_option_access(:),
   82    raw_option_findings(:, -).   83
   84/** <module> Access and analyse predicate options
   85
   86This  module  provides  the  developers   interface  for  the  directive
   87predicate_options/3. This directive allows  us  to  specify  that, e.g.,
   88open/4 processes options using the 4th  argument and supports the option
   89=type= using the values =text= and  =binary=. Declaring options that are
   90processed allows for more reliable  handling   of  predicate options and
   91simplifies porting applications. This  library   provides  the following
   92functionality:
   93
   94  * Query supported options through current_predicate_option/3
   95    or current_predicate_options/3.  This is intended to support
   96    conditional compilation and an IDE.
   97  * Derive additional declarations through dataflow analysis using
   98    derive_predicate_options/0.
   99  * Perform a compile-time analysis of the entire loaded program using
  100    check_predicate_options/0.
  101  * Report _order-sensitive_ option handling (raw list access and
  102    overrides that are defeated by rightmost-wins predicates) using the
  103    opt-in linter check_raw_option_access/0.
  104
  105Below, we describe some use-cases.
  106
  107  $ Quick check of a program :
  108  This scenario is useful as an occasional check or to assess problems
  109  with option-handling for porting an application to SWI-Prolog.  It
  110  consists of three steps: loading the program (1 and 2), deriving
  111  option handling for application predicates (3) and running the
  112  checker (4).
  113
  114    ==
  115    1 ?- [load].
  116    2 ?- autoload.
  117    3 ?- derive_predicate_options.
  118    4 ?- check_predicate_options.
  119    ==
  120
  121  $ Add declarations to your program :
  122  Adding declarations about option processes improves the quality of
  123  the checking.  The analysis of derive_predicate_options/0 may miss
  124  options and does not derive the types for options that are processed
  125  in Prolog code.  The process is similar to the above.  In steps 4 and
  126  further, the inferred declarations are listed, inspected and added to
  127  the source code of the module.
  128
  129    ==
  130    1 ?- [load].
  131    2 ?- autoload.
  132    3 ?- derive_predicate_options.
  133    4 ?- derived_predicate_options(module_1).
  134    5 ?- derived_predicate_options(module_2).
  135    6 ?- ...
  136    ==
  137
  138  $ Declare option processing requirements :
  139  If an application requires that open/4 needs to support lock(write),
  140  it may do so using the directive below.  This directive raises an
  141  exception when loaded on a Prolog implementation that does not support
  142  this option.
  143
  144    ==
  145    :- current_predicate_option(open/4, 4, lock(write)).
  146    ==
  147
  148@see library(option) for accessing options in Prolog code.
  149*/
  150
  151:- multifile option_decl/3, pred_option/3.  152:- dynamic   dyn_option_decl/3.  153
  154%!  predicate_options(:PI, +Arg, +Options) is det.
  155%
  156%   Declare that the predicate PI processes options on Arg.  Options
  157%   is a list of options processed.  Each element is one of:
  158%
  159%     * Option(ModeAndType)
  160%     PI processes Option. The option-value must comply to
  161%     ModeAndType.  Mode is one of + or - and Type is a type as
  162%     accepted by must_be/2.
  163%
  164%     * pass_to(:PI,Arg)
  165%     The option-list is passed to the indicated predicate.
  166%
  167%   Below is an example that   processes  the option header(boolean)
  168%   and passes all options to open/4:
  169%
  170%     ==
  171%     :- predicate_options(write_xml_file/3, 3,
  172%                          [ header(boolean),
  173%                            pass_to(open/4, 4)
  174%                          ]).
  175%
  176%     write_xml_file(File, XMLTerm, Options) :-
  177%         open(File, write, Out, Options),
  178%         (   option(header(true), Options, true)
  179%         ->  write_xml_header(Out)
  180%         ;   true
  181%         ),
  182%         ...
  183%     ==
  184%
  185%   This predicate may  only  be  used   as  a  _directive_  and  is
  186%   processed  by  expand_term/2.  Option  processing    can  be
  187%   specified at runtime using  assert_predicate_options/3, which is
  188%   intended to support program analysis.
  189
  190predicate_options(PI, Arg, Options) :-
  191    throw(error(context_error(nodirective,
  192                              predicate_options(PI, Arg, Options)), _)).
  193
  194
  195%!  assert_predicate_options(:PI, +Arg, +Options, ?New) is semidet.
  196%
  197%   As predicate_options(:PI, +Arg, +Options).  New   is  a  boolean
  198%   indicating whether the declarations  have   changed.  If  New is
  199%   provided and =false=, the predicate   becomes  semidet and fails
  200%   without modifications if modifications are required.
  201
  202assert_predicate_options(PI, Arg, Options, New) :-
  203    canonical_pi(PI, M:Name/Arity),
  204    functor(Head, Name, Arity),
  205    (   dyn_option_decl(Head, M, Arg)
  206    ->  true
  207    ;   New = true,
  208        assertz(dyn_option_decl(Head, M, Arg))
  209    ),
  210    phrase('$predopts':option_clauses(Options, Head, M, Arg),
  211           OptionClauses),
  212    forall(member(Clause, OptionClauses),
  213           assert_option_clause(Clause, New)),
  214    (   var(New)
  215    ->  New = false
  216    ;   true
  217    ).
  218
  219assert_option_clause(Clause, New) :-
  220    rename_clause(Clause, NewClause,
  221                  '$pred_option'(A,B,C,D), '$dyn_pred_option'(A,B,C,D)),
  222    clause_head(NewClause, NewHead),
  223    (   clause(NewHead, _)
  224    ->  true
  225    ;   New = true,
  226        assertz(NewClause)
  227    ).
  228
  229clause_head(M:(Head:-_Body), M:Head) :- !.
  230clause_head((M:Head :-_Body), M:Head) :- !.
  231clause_head(Head, Head).
  232
  233rename_clause(M:Clause, M:NewClause, Head, NewHead) :-
  234    !,
  235    rename_clause(Clause, NewClause, Head, NewHead).
  236rename_clause((Head :- Body), (NewHead :- Body), Head, NewHead) :- !.
  237rename_clause(Head, NewHead, Head, NewHead) :- !.
  238rename_clause(Head, Head, _, _).
  239
  240
  241
  242                 /*******************************
  243                 *        QUERY OPTIONS         *
  244                 *******************************/
  245
  246%!  current_option_arg(:PI, ?Arg) is nondet.
  247%
  248%   True when Arg of PI processes   predicate options. Which options
  249%   are processed can be accessed using current_predicate_option/3.
  250
  251current_option_arg(Module:Name/Arity, Arg) :-
  252    current_option_arg(Module:Name/Arity, Arg, _DefM).
  253
  254current_option_arg(Module:Name/Arity, Arg, DefM) :-
  255    atom(Name), integer(Arity),
  256    !,
  257    resolve_module(Module:Name/Arity, DefM:Name/Arity),
  258    functor(Head, Name, Arity),
  259    (   option_decl(Head, DefM, Arg)
  260    ;   dyn_option_decl(Head, DefM, Arg)
  261    ).
  262current_option_arg(M:Name/Arity, Arg, M) :-
  263    (   option_decl(Head, M, Arg)
  264    ;   dyn_option_decl(Head, M, Arg)
  265    ),
  266    functor(Head, Name, Arity).
  267
  268%!  current_predicate_option(:PI, ?Arg, ?Option) is nondet.
  269%
  270%   True when Arg of PI processes Option. For example, the following
  271%   is true:
  272%
  273%     ==
  274%     ?- current_predicate_option(open/4, 4, type(text)).
  275%     true.
  276%     ==
  277%
  278%   This predicate is intended to   support  conditional compilation
  279%   using      if/1      ...      endif/0.        The      predicate
  280%   current_predicate_options/3 can be  used  to   access  the  full
  281%   capabilities of a predicate.
  282
  283current_predicate_option(Module:PI, Arg, Option) :-
  284    current_option_arg(Module:PI, Arg, DefM),
  285    PI = Name/Arity,
  286    functor(Head, Name, Arity),
  287    catch(pred_option(DefM:Head, Option),
  288          error(type_error(_,_),_),
  289          fail).
  290
  291%!  check_predicate_option(:PI, +Arg, +Option) is det.
  292%
  293%   Verify   predicate   options    at     runtime.    Similar    to
  294%   current_predicate_option/3,  but  intended  to  support  runtime
  295%   checking.
  296%
  297%   @error  existence_error(option, OptionName) if the option is not
  298%           supported by PI.
  299%   @error  type_error(Type, Value) if the option is supported but
  300%           the value does not match the option type. See must_be/2.
  301
  302check_predicate_option(Module:PI, Arg, Option) :-
  303    define_predicate(Module:PI),
  304    once(current_option_arg(Module:PI, Arg, DefM)),
  305    PI = Name/Arity,
  306    functor(Head, Name, Arity),
  307    (   pred_option(DefM:Head, Option)
  308    ->  true
  309    ;   existence_error(option, Option)
  310    ).
  311
  312
  313pred_option(Head, Option) :-
  314    pred_option(Head, Option, []).
  315
  316pred_option(M:Head, Option, Seen) :-
  317    (   has_static_option_decl(M),
  318        M:'$pred_option'(Head, _, Option, Seen)
  319    ;   has_dynamic_option_decl(M),
  320        M:'$dyn_pred_option'(Head, _, Option, Seen)
  321    ).
  322
  323has_static_option_decl(M) :-
  324    '$c_current_predicate'(_, M:'$pred_option'(_,_,_,_)).
  325has_dynamic_option_decl(M) :-
  326    '$c_current_predicate'(_, M:'$dyn_pred_option'(_,_,_,_)).
  327
  328
  329                 /*******************************
  330                 *     TYPE&MODE CONSTRAINTS    *
  331                 *******************************/
  332
  333:- public
  334    system:predicate_option_mode/2,
  335    system:predicate_option_type/2.  336
  337add_attr(Var, Value) :-
  338    (   get_attr(Var, predicate_options, Old)
  339    ->  put_attr(Var, predicate_options, [Value|Old])
  340    ;   put_attr(Var, predicate_options, [Value])
  341    ).
  342
  343system:predicate_option_type(Type, Arg) :-
  344    var(Arg),
  345    !,
  346    add_attr(Arg, option_type(Type)).
  347system:predicate_option_type(callable+_N, Arg) :-
  348    !,
  349    must_be(callable, Arg).
  350system:predicate_option_type(list, Arg) :-
  351    !,
  352    must_be(list_or_partial_list, Arg).
  353system:predicate_option_type(list(Type), Arg) :-
  354    !,
  355    must_be(list_or_partial_list(Type), Arg).
  356system:predicate_option_type(Type, Arg) :-
  357    must_be(Type, Arg).
  358
  359system:predicate_option_mode(_Mode, Arg) :-
  360    var(Arg),
  361    !.
  362system:predicate_option_mode(Mode, Arg) :-
  363    check_mode(Mode, Arg).
  364
  365check_mode(input, Arg) :-
  366    (   nonvar(Arg)
  367    ->  true
  368    ;   instantiation_error(Arg)
  369    ).
  370check_mode(output, Arg) :-
  371    (   var(Arg)
  372    ->  true
  373    ;   uninstantiation_error(Arg)
  374    ).
  375
  376attr_unify_hook([], _).
  377attr_unify_hook([H|T], Var) :-
  378    option_hook(H, Var),
  379    attr_unify_hook(T, Var).
  380
  381option_hook(option_type(Type), Value) :-
  382    is_of_type(Type, Value).
  383option_hook(option_mode(Mode), Value) :-
  384    check_mode(Mode, Value).
  385
  386
  387attribute_goals(Var) -->
  388    { get_attr(Var, predicate_options, Attrs) },
  389    option_goals(Attrs, Var).
  390
  391option_goals([], _) --> [].
  392option_goals([H|T], Var) -->
  393    option_goal(H, Var),
  394    option_goals(T, Var).
  395
  396option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)].
  397option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)].
  398
  399
  400                 /*******************************
  401                 *      OUTPUT DECLARATIONS     *
  402                 *******************************/
  403
  404%!  current_predicate_options(:PI, ?Arg, ?Options) is nondet.
  405%
  406%   True when Options is the current   active option declaration for
  407%   PI  on  Arg.   See   predicate_options/3    for   the   argument
  408%   descriptions. If PI  is  ground  and   refers  to  an  undefined
  409%   predicate, the autoloader is used to  obtain a definition of the
  410%   predicate.
  411
  412current_predicate_options(PI, Arg, Options) :-
  413    define_predicate(PI),
  414    setof(Arg-Option,
  415          current_predicate_option_decl(PI, Arg, Option),
  416          Options0),
  417    group_pairs_by_key(Options0, Grouped),
  418    member(Arg-Options, Grouped).
  419
  420current_predicate_option_decl(PI, Arg, Option) :-
  421    current_predicate_option(PI, Arg, Option0),
  422    Option0 =.. [Name|Values],
  423    maplist(mode_and_type, Values, Types),
  424    Option =.. [Name|Types].
  425
  426mode_and_type(Value, ModeAndType) :-
  427    copy_term(Value,_,Goals),
  428    (   memberchk(predicate_option_mode(output, _), Goals)
  429    ->  ModeAndType = -(Type)
  430    ;   ModeAndType = Type
  431    ),
  432    (   memberchk(predicate_option_type(Type, _), Goals)
  433    ->  true
  434    ;   Type = any
  435    ).
  436
  437define_predicate(PI) :-
  438    ground(PI),
  439    !,
  440    PI = M:Name/Arity,
  441    functor(Head, Name, Arity),
  442    once(predicate_property(M:Head, _)).
  443define_predicate(_).
  444
  445%!  derived_predicate_options(:PI, ?Arg, ?Options) is nondet.
  446%
  447%   Derive option arguments using static analysis. True when Options
  448%   is the current _derived_ active  option   declaration  for PI on
  449%   Arg.
  450
  451derived_predicate_options(PI, Arg, Options) :-
  452    define_predicate(PI),
  453    setof(Arg-Option,
  454          derived_predicate_option(PI, Arg, Option),
  455          Options0),
  456    group_pairs_by_key(Options0, Grouped),
  457    member(Arg-Options1, Grouped),
  458    PI = M:_,
  459    phrase(expand_pass_to_options(Options1, M), Options2),
  460    sort(Options2, Options).
  461
  462derived_predicate_option(PI, Arg, Decl) :-
  463    current_option_arg(PI, Arg, DefM),
  464    PI = _:Name/Arity,
  465    functor(Head, Name, Arity),
  466    has_dynamic_option_decl(DefM),
  467    (   has_static_option_decl(DefM),
  468        DefM:'$pred_option'(Head, Decl, _, [])
  469    ;   DefM:'$dyn_pred_option'(Head, Decl, _, [])
  470    ).
  471
  472%!  expand_pass_to_options(+OptionsIn, +Module, -OptionsOut)// is det.
  473%
  474%   Expand the options of pass_to(PI,Arg) if PI  does not refer to a
  475%   public predicate.
  476
  477expand_pass_to_options([], _) --> [].
  478expand_pass_to_options([H|T], M) -->
  479    expand_pass_to(H, M),
  480    expand_pass_to_options(T, M).
  481
  482expand_pass_to(pass_to(PI, Arg), Module) -->
  483    { strip_module(Module:PI, M, Name/Arity),
  484      functor(Head, Name, Arity),
  485      \+ (   predicate_property(M:Head, exported)
  486         ;   predicate_property(M:Head, public)
  487         ;   M == system
  488         ),
  489      !,
  490      current_predicate_options(M:Name/Arity, Arg, Options)
  491    },
  492    list(Options).
  493expand_pass_to(Option, _) -->
  494    [Option].
  495
  496list([]) --> [].
  497list([H|T]) --> [H], list(T).
  498
  499%!  derived_predicate_options(+Module) is det.
  500%
  501%   Derive predicate option declarations for   a module. The derived
  502%   options are printed to the =current_output= stream.
  503
  504derived_predicate_options(Module) :-
  505    var(Module),
  506    !,
  507    forall(current_module(Module),
  508           derived_predicate_options(Module)).
  509derived_predicate_options(Module) :-
  510    findall(predicate_options(Module:PI, Arg, Options),
  511            ( derived_predicate_options(Module:PI, Arg, Options),
  512              PI = Name/Arity,
  513              functor(Head, Name, Arity),
  514              (   predicate_property(Module:Head, exported)
  515              ->  true
  516              ;   predicate_property(Module:Head, public)
  517              )
  518            ),
  519            Decls0),
  520    maplist(qualify_decl(Module), Decls0, Decls1),
  521    sort(Decls1, Decls),
  522    (   Decls \== []
  523    ->  format('~N~n~n% Predicate option declarations for module ~q~n~n',
  524               [Module]),
  525        forall(member(Decl, Decls),
  526               portray_clause((:-Decl)))
  527    ;   true
  528    ).
  529
  530qualify_decl(M,
  531             predicate_options(PI0, Arg, Options0),
  532             predicate_options(PI1, Arg, Options1)) :-
  533    qualify(PI0, M, PI1),
  534    maplist(qualify_option(M), Options0, Options1).
  535
  536qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :-
  537    !,
  538    qualify(PI0, M, PI1).
  539qualify_option(_, Opt, Opt).
  540
  541qualify(M:Term, M, Term) :- !.
  542qualify(QTerm, _, QTerm).
  543
  544
  545                 /*******************************
  546                 *            CLEANUP           *
  547                 *******************************/
  548
  549%!  retractall_predicate_options is det.
  550%
  551%   Remove all dynamically (derived) predicate options.
  552
  553retractall_predicate_options :-
  554    forall(retract(dyn_option_decl(_,M,_)),
  555           abolish(M:'$dyn_pred_option'/4)).
  556
  557
  558                 /*******************************
  559                 *     COMPILE-TIME CHECKER     *
  560                 *******************************/
  561
  562
  563:- thread_local
  564    new_decl/1.  565
  566%!  check_predicate_options is det.
  567%
  568%   Analyse loaded program for  erroneous   options.  This predicate
  569%   decompiles  the  current  program  and  searches  for  calls  to
  570%   predicates that process  options.  For   each  option  list,  it
  571%   validates  whether  the  provided  options   are  supported  and
  572%   validates the argument type.  This   predicate  performs partial
  573%   dataflow analysis to track option-lists inside a clause.
  574%
  575%   @see    derive_predicate_options/0 can be used to derive
  576%           declarations for predicates that pass options. This
  577%           predicate should normally be called before
  578%           check_predicate_options/0.
  579
  580check_predicate_options :-
  581    forall(current_module(Module),
  582           check_predicate_options_module(Module)).
  583
  584%!  derive_predicate_options is det.
  585%
  586%   Derive  new  predicate  option    declarations.  This  predicate
  587%   analyses the loaded program to find clauses that process options
  588%   using one of  the  predicates   from  library(option)  or passes
  589%   options to other predicates that are   known to process options.
  590%   The process is repeated until no new declarations are retrieved.
  591%
  592%   @see autoload/0 may be used to complete the loaded program.
  593
  594derive_predicate_options :-
  595    derive_predicate_options(NewDecls),
  596    (   NewDecls == []
  597    ->  true
  598    ;   print_message(informational, check_options(new(NewDecls))),
  599        new_decls(NewDecls),
  600        derive_predicate_options
  601    ).
  602
  603new_decls([]).
  604new_decls([predicate_options(PI, A, O)|T]) :-
  605    assert_predicate_options(PI, A, O, _),
  606    new_decls(T).
  607
  608
  609derive_predicate_options(NewDecls) :-
  610    call_cleanup(
  611        ( forall(
  612              current_module(Module),
  613              forall(
  614                  ( predicate_in_module(Module, PI),
  615                    PI = Name/Arity,
  616                    functor(Head, Name, Arity),
  617                    catch(Module:clause(Head, Body, Ref), _, fail)
  618                  ),
  619                  check_clause((Head:-Body), Module, Ref, decl))),
  620          (   setof(Decl, retract(new_decl(Decl)), NewDecls)
  621              ->  true
  622              ;   NewDecls = []
  623          )
  624        ),
  625        retractall(new_decl(_))).
  626
  627
  628check_predicate_options_module(Module) :-
  629    forall(predicate_in_module(Module, PI),
  630           check_predicate_options(Module:PI)).
  631
  632predicate_in_module(Module, PI) :-
  633    current_predicate(Module:PI),
  634    PI = Name/Arity,
  635    functor(Head, Name, Arity),
  636    \+ predicate_property(Module:Head, imported_from(_)).
  637
  638%!  check_predicate_options(:PredicateIndicator) is det.
  639%
  640%   Verify calls to predicates that have   options in all clauses of
  641%   the predicate indicated by PredicateIndicator.
  642
  643check_predicate_options(Module:Name/Arity) :-
  644    debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
  645    functor(Head, Name, Arity),
  646    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  647           check_clause((Head:-Body), Module, Ref, check)).
  648
  649
  650                 /*******************************
  651                 *   RAW / ORDER-SENSITIVE      *
  652                 *******************************/
  653
  654:- thread_local
  655    lint_finding/2.                 % Finding, ClauseRef
  656
  657%!  check_raw_option_access is det.
  658%!  check_raw_option_access(:Spec) is det.
  659%
  660%   Report _order-sensitive_ option handling in the loaded program.
  661%   Unlike check_predicate_options/0, this is not part of check/0; it is
  662%   an opt-in linter intended for audits.  It reports two patterns:
  663%
  664%     $ Category A - raw option access :
  665%     A list known to be an option list (because it is a declared option
  666%     argument or is passed to a predicate that processes options) is
  667%     inspected using memberchk/2, member/2 or select/3 rather than
  668%     option/2.  Raw list search is order-agnostic and does not honour
  669%     the Name=Value form, so it may disagree with option/2 (leftmost
  670%     wins) semantics.
  671%
  672%     $ Category B - override defeated by rightmost-wins :
  673%     A partial list =|[Opt,...|Tail]|= is passed to a predicate that
  674%     resolves options with PL_scan_options() (rightmost wins, e.g.
  675%     open/4).  The prepended options look like an override but are
  676%     defeated by a duplicate in Tail.  Append the option or use
  677%     merge_options/3 instead.
  678%
  679%   Spec is a module or a Module:Name/Arity.
  680
  681check_raw_option_access :-
  682    raw_option_findings_(all, Findings),
  683    report_lint_findings(Findings).
  684
  685check_raw_option_access(Spec) :-
  686    raw_option_findings(Spec, Findings),
  687    report_lint_findings(Findings).
  688
  689%!  raw_option_findings(:Spec, -Findings) is det.
  690%
  691%   Findings is a list of Finding-ClauseRef pairs for Spec (a module or
  692%   Module:Name/Arity), without printing.  See check_raw_option_access/1
  693%   for the finding types.
  694
  695raw_option_findings(Spec, Findings) :-
  696    (   Spec = M:Name/Arity,
  697        atom(Name), integer(Arity)
  698    ->  raw_option_findings_(M:Name/Arity, Findings)
  699    ;   strip_module(Spec, _, Module),
  700        raw_option_findings_(module(Module), Findings)
  701    ).
  702
  703raw_option_findings_(What, Findings) :-
  704    retractall(lint_finding(_,_)),
  705    (   What == all
  706    ->  forall(current_module(Module), lint_module(Module))
  707    ;   What = module(Module)
  708    ->  lint_module(Module)
  709    ;   lint_predicate(What)
  710    ),
  711    findall(F-Ref, retract(lint_finding(F, Ref)), Findings).
  712
  713lint_module(Module) :-
  714    forall(predicate_in_module(Module, PI),
  715           lint_predicate(Module:PI)).
  716
  717lint_predicate(Module:Name/Arity) :-
  718    functor(Head, Name, Arity),
  719    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  720           lint_clause(Module:Head, Body, Ref)).
  721
  722lint_clause(Module:Head, Body, Ref) :-
  723    b_setval('$predopts_lint_clause', Ref),
  724    \+ \+ ( seed_head_options(Module:Head),
  725            catch(check_body(Body, Module, _, decl), _, true),   % annotate
  726            catch(check_body(Body, Module, _, lint), _, true) ). % report
  727
  728%!  seed_head_options(:Head) is det.
  729%
  730%   Annotate the declared option arguments of Head so the linter knows
  731%   they are option lists even when the clause only inspects them with
  732%   raw list search.
  733
  734seed_head_options(Module:Head) :-
  735    functor(Head, Name, Arity),
  736    PI = Module:Name/Arity,
  737    seed_head_options(1, Arity, PI, Head).
  738
  739seed_head_options(I, Arity, PI, Head) :-
  740    (   I > Arity
  741    ->  true
  742    ;   (   once(current_option_arg(PI, I)),
  743            arg(I, Head, QArg),
  744            remove_qualifier(QArg, A),
  745            var(A)
  746        ->  annotate(A, option_list_var(PI, I))
  747        ;   true
  748        ),
  749        I2 is I+1,
  750        seed_head_options(I2, Arity, PI, Head)
  751    ).
  752
  753report_lint_findings(Findings) :-
  754    forall(member(Finding-Ref, Findings),
  755           print_message(informational, predopts_lint(Finding, Ref))).
  756
  757record_lint(Finding) :-
  758    (   nb_current('$predopts_lint_clause', Ref)
  759    ->  true
  760    ;   Ref = (-)
  761    ),
  762    (   lint_finding(Finding, Ref)      % avoid duplicates within a clause
  763    ->  true
  764    ;   assertz(lint_finding(Finding, Ref))
  765    ).
  766
  767%!  raw_option_goal(+Goal, -List, -Option) is semidet.
  768%
  769%   Goal inspects List for an option-shaped Option using raw list search.
  770
  771raw_option_goal(memberchk(Opt, List), List, Opt) :- option_shaped(Opt).
  772raw_option_goal(member(Opt, List),    List, Opt) :- option_shaped(Opt).
  773raw_option_goal(select(Opt, List, _), List, Opt) :- option_shaped(Opt).
  774raw_option_goal(selectchk(Opt, List, _), List, Opt) :- option_shaped(Opt).
  775
  776option_shaped(Opt) :-
  777    compound(Opt),
  778    (   functor(Opt, _, 1)
  779    ;   Opt = (_=_)
  780    ),
  781    !.
  782
  783known_option_list(List) :-
  784    var(List),
  785    annotations(List, _).
  786
  787%!  check_clause(+Clause, +Module, +Ref, +Action) is det.
  788%
  789%   Action is one of
  790%
  791%     * decl
  792%     Create additional declarations
  793%     * check
  794%     Produce error messages
  795
  796check_clause((Head:-Body), M, ClauseRef, Action) :-
  797    !,
  798    catch(check_body(Body, M, _, Action), E, true),
  799    (   var(E)
  800    ->  option_decl(M:Head, Action)
  801    ;   (   clause_info(ClauseRef, File, TermPos, _NameOffset),
  802            TermPos = term_position(_,_,_,_,[_,BodyPos]),
  803            catch(check_body(Body, M, BodyPos, Action),
  804                  error(Formal, ArgPos), true),
  805            compound(ArgPos),
  806            arg(1, ArgPos, CharCount),
  807            integer(CharCount)
  808        ->  Location = file_char_count(File, CharCount)
  809        ;   Location = clause(ClauseRef),
  810            E = error(Formal, _)
  811        ),
  812        print_message(error, predicate_option_error(Formal, Location))
  813    ).
  814
  815
  816%!  check_body(+Body, +Module, +TermPos, +Action)
  817
  818:- multifile
  819    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  820    prolog:called_by/2.             % +Goal, -Called
  821
  822check_body(Var, _, _, _) :-
  823    var(Var),
  824    !.
  825check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :-
  826    !,
  827    check_body(G, M, Pos, Action).
  828check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  829    !,
  830    check_body(A, M, PA, Action),
  831    check_body(B, M, PB, Action).
  832check_body((A;B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  833    !,
  834    \+ \+ check_body(A, M, PA, Action),
  835    \+ \+ check_body(B, M, PB, Action).
  836check_body((A->B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  837    !,
  838    check_body(A, M, PA, Action),
  839    check_body(B, M, PB, Action).
  840check_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  841    !,
  842    check_body(A, M, PA, Action),
  843    check_body(B, M, PB, Action).
  844check_body(A=B, _, _, _) :-             % partial evaluation
  845    unify_with_occurs_check(A,B),
  846    !.
  847check_body(Goal, M, _, lint) :-         % Category A: raw option access
  848    raw_option_goal(Goal, ListArg, Opt),
  849    !,
  850    (   known_option_list(ListArg)
  851    ->  record_lint(raw_option_access(M:Goal, Opt))
  852    ;   true
  853    ).
  854check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :-
  855    callable(Goal),
  856    functor(Goal, Name, Arity),
  857    (   '$get_predicate_attribute'(M:Goal, imported, DefM)
  858    ->  true
  859    ;   DefM = M
  860    ),
  861    (   eval_option_pred(DefM:Goal)
  862    ->  true
  863    ;   current_option_arg(DefM:Name/Arity, OptArg),
  864        !,
  865        arg(OptArg, Goal, Options),
  866        nth1(OptArg, ArgPosList, ArgPos),
  867        check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action)
  868    ).
  869check_body(Goal, M, _, Action) :-
  870    (   (   predicate_property(M:Goal, imported_from(IM))
  871        ->  true
  872        ;   IM = M
  873        ),
  874        prolog:called_by(Goal, IM, M, Called)
  875    ;   prolog:called_by(Goal, Called)
  876    ),
  877    !,
  878    check_called_by(Called, M, Action).
  879check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :-
  880    '$get_predicate_attribute'(M:Meta, meta_predicate, Head),
  881    !,
  882    check_meta_args(1, Head, Meta, M, ArgPosList, Action).
  883check_body(_, _, _, _).
  884
  885check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :-
  886    arg(I, Head, AS),
  887    !,
  888    (   AS == 0
  889    ->  arg(I, Meta, MA),
  890        check_body(MA, M, ArgPos, Action)
  891    ;   true
  892    ),
  893    succ(I, I2),
  894    check_meta_args(I2, Head, Meta, M, ArgPosList, Action).
  895check_meta_args(_,_,_,_, _, _).
  896
  897%!  check_called_by(+CalledBy, +M, +Action) is det.
  898%
  899%   Handle results from prolog:called_by/2.
  900
  901check_called_by([], _, _).
  902check_called_by([H|T], M, Action) :-
  903    (   H = G+N
  904    ->  (   extend(G, N, G2)
  905        ->  check_body(G2, M, _, Action)
  906        ;   true
  907        )
  908    ;   check_body(H, M, _, Action)
  909    ),
  910    check_called_by(T, M, Action).
  911
  912extend(Goal, N, GoalEx) :-
  913    callable(Goal),
  914    Goal =.. List,
  915    length(Extra, N),
  916    append(List, Extra, ListEx),
  917    GoalEx =.. ListEx.
  918
  919
  920%!  check_options(:Predicate, +OptionArg, +Options, +ArgPos, +Action)
  921%
  922%   Verify the list Options,  that  is   passed  into  Predicate  on
  923%   argument OptionArg. ArgPos is a   term-position  term describing
  924%   the location of the Options list. If  Options is a partial list,
  925%   the tail is annotated with pass_to(PI, OptArg).
  926
  927check_options(PI, OptArg, QOptions, ArgPos, lint) :-
  928    !,
  929    remove_qualifier(QOptions, Options),
  930    (   is_list_or_partial_list(Options)
  931    ->  lint_prepend(PI, Options),
  932        check_option_list(Options, PI, OptArg, Options, ArgPos, lint)
  933    ;   true                        % not analysable as a list; ignore
  934    ).
  935check_options(PI, OptArg, QOptions, ArgPos, Action) :-
  936    debug(predicate_options, '\tChecking call to ~q', [PI]),
  937    remove_qualifier(QOptions, Options),
  938    must_be(list_or_partial_list, Options),
  939    check_option_list(Options, PI, OptArg, Options, ArgPos, Action).
  940
  941is_list_or_partial_list(Term) :-
  942    '$skip_list'(_, Term, Tail),
  943    (   Tail == []
  944    ->  true
  945    ;   var(Tail)
  946    ).
  947
  948%!  lint_prepend(+PI, +Options) is det.
  949%
  950%   Category B: Options is a _partial_ list [Opt,...|Var] whose concrete
  951%   prefix is prepended to override the caller, but PI resolves options
  952%   using PL_scan_options() (rightmost wins).  A duplicate of a prefix
  953%   option in Var thus defeats the intended override.
  954
  955lint_prepend(PI, Options) :-
  956    (   last_wins_option_pred(PI),
  957        partial_prefix(Options, Prefix, Tail),
  958        Prefix \== [],
  959        var(Tail)
  960    ->  record_lint(prepend_override(PI, Prefix))
  961    ;   true
  962    ).
  963
  964partial_prefix(Var, [], Var) :-
  965    var(Var),
  966    !.
  967partial_prefix([], [], []) :- !.
  968partial_prefix([H|T], [H|PT], Tail) :-
  969    partial_prefix(T, PT, Tail).
  970
  971%!  last_wins_option_pred(:PI) is semidet.
  972%
  973%   True when PI processes its option list with rightmost-wins semantics.
  974%   Foreign predicates use PL_scan_options() and are rightmost-wins;
  975%   Prolog predicates use library(option) (leftmost-wins).
  976
  977last_wins_option_pred(M:Name/Arity) :-
  978    functor(Head, Name, Arity),
  979    predicate_property(M:Head, foreign).
  980
  981remove_qualifier(X, X) :-
  982    var(X),
  983    !.
  984remove_qualifier(_:X, X) :- !.
  985remove_qualifier(X, X).
  986
  987check_option_list(Var,  PI, OptArg, _, _, _) :-
  988    var(Var),
  989    !,
  990    annotate(Var, pass_to(PI, OptArg)).
  991check_option_list([], _, _, _, _, _).
  992check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :-
  993    check_option(PI, OptArg, H, ArgPos, Action),
  994    check_option_list(T, PI, OptArg, Options, ArgPos, Action).
  995
  996check_option(_, _, _, _, decl) :- !.
  997check_option(_, _, _, _, lint) :- !.
  998check_option(PI, OptArg, Opt, ArgPos, _) :-
  999    catch(check_predicate_option(PI, OptArg, Opt), E, true),
 1000    !,
 1001    (   var(E)
 1002    ->  true
 1003    ;   E = error(Formal,_),
 1004        throw(error(Formal,ArgPos))
 1005    ).
 1006
 1007
 1008                 /*******************************
 1009                 *          ANNOTATIONS         *
 1010                 *******************************/
 1011
 1012%!  annotate(+Var, +Term) is det.
 1013%
 1014%   Use constraints to accumulate annotations   about  variables. If
 1015%   two annotated variables are unified, the attributes are joined.
 1016
 1017annotate(Var, Term) :-
 1018    (   get_attr(Var, predopts_analysis, Old)
 1019    ->  put_attr(Var, predopts_analysis, [Term|Old])
 1020    ;   var(Var)
 1021    ->  put_attr(Var, predopts_analysis, [Term])
 1022    ;   true
 1023    ).
 1024
 1025annotations(Var, Annotations) :-
 1026    get_attr(Var, predopts_analysis, Annotations).
 1027
 1028predopts_analysis:attr_unify_hook(Opts, Value) :-
 1029    get_attr(Value, predopts_analysis, Others),
 1030    !,
 1031    append(Opts, Others, All),
 1032    put_attr(Value, predopts_analysis, All).
 1033predopts_analysis:attr_unify_hook(_, _).
 1034
 1035
 1036                 /*******************************
 1037                 *         PARTIAL EVAL         *
 1038                 *******************************/
 1039
 1040eval_option_pred(swi_option:option(Opt, Options)) :-
 1041    processes(Opt, Spec),
 1042    annotate(Options, Spec).
 1043eval_option_pred(swi_option:option(Opt, Options, _Default)) :-
 1044    processes(Opt, Spec),
 1045    annotate(Options, Spec).
 1046eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :-
 1047    ignore(unify_with_occurs_check(Rest, Options)),
 1048    processes(Opt, Spec),
 1049    annotate(Options, Spec).
 1050eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :-
 1051    ignore(unify_with_occurs_check(Rest, Options)),
 1052    processes(Opt, Spec),
 1053    annotate(Options, Spec).
 1054eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :-
 1055    remove_qualifier(QOptionsIn, OptionsIn),
 1056    remove_qualifier(QOptionsOut, OptionsOut),
 1057    ignore(unify_with_occurs_check(OptionsIn, OptionsOut)).
 1058eval_option_pred(lists:append(A, B, C)) :-      % C = A ++ B; both are options
 1059    propagate_option_list(C, A),
 1060    propagate_option_list(C, B).
 1061eval_option_pred(swi_option:merge_options(New, Old, Merged)) :-
 1062    propagate_option_list(Merged, New),
 1063    propagate_option_list(Merged, Old).
 1064
 1065processes(Opt, Spec) :-
 1066    compound(Opt),
 1067    functor(Opt, OptName, 1),
 1068    Spec =.. [OptName,any].
 1069
 1070%!  propagate_option_list(?A, ?B) is det.
 1071%
 1072%   If one of A or B is a variable already known to be an option list,
 1073%   copy that knowledge to the other.  This lets option-list-ness flow
 1074%   through append/3 and merge_options/3 without _originating_ it: a
 1075%   plain list operation on non-options is left untouched.
 1076
 1077propagate_option_list(A, B) :-
 1078    (   annotated_var(A, Ann)
 1079    ->  copy_annotations(B, Ann)
 1080    ;   annotated_var(B, Ann)
 1081    ->  copy_annotations(A, Ann)
 1082    ;   true
 1083    ).
 1084
 1085annotated_var(V, Ann) :-
 1086    var(V),
 1087    annotations(V, Ann).
 1088
 1089copy_annotations(V, Ann) :-
 1090    (   var(V)
 1091    ->  copy_annotations_(Ann, V)
 1092    ;   true
 1093    ).
 1094
 1095copy_annotations_([], _).
 1096copy_annotations_([A|T], V) :-
 1097    annotate(V, A),
 1098    copy_annotations_(T, V).
 1099
 1100
 1101                 /*******************************
 1102                 *        NEW DECLARTIONS       *
 1103                 *******************************/
 1104
 1105%!  option_decl(:Head, +Action) is det.
 1106%
 1107%   Add new declarations based on attributes   left  by the analysis
 1108%   pass. We do not add declarations   for system modules or modules
 1109%   that already contain static declarations.
 1110%
 1111%   @tbd    Should we add a mode to include generating declarations
 1112%           for system modules and modules with static declarations?
 1113
 1114option_decl(_, check) :- !.
 1115option_decl(M:_, _) :-
 1116    system_module(M),
 1117    !.
 1118option_decl(M:_, _) :-
 1119    has_static_option_decl(M),
 1120    !.
 1121option_decl(M:Head, _) :-
 1122    compound(Head),
 1123    arg(AP, Head, QA),
 1124    remove_qualifier(QA, A),
 1125    annotations(A, Annotations0),
 1126    functor(Head, Name, Arity),
 1127    PI = M:Name/Arity,
 1128    delete(Annotations0, pass_to(PI,AP), Annotations),
 1129    Annotations \== [],
 1130    Decl = predicate_options(PI, AP, Annotations),
 1131    (   new_decl(Decl)
 1132    ->  true
 1133    ;   assert_predicate_options(M:Name/Arity, AP, Annotations, false)
 1134    ->  true
 1135    ;   assertz(new_decl(Decl)),
 1136        debug(predicate_options(decl), '~q', [Decl])
 1137    ),
 1138    fail.
 1139option_decl(_, _).
 1140
 1141system_module(system) :- !.
 1142system_module(Module) :-
 1143    sub_atom(Module, 0, _, _, $).
 1144
 1145
 1146                 /*******************************
 1147                 *             MISC             *
 1148                 *******************************/
 1149
 1150canonical_pi(M:Name//Arity, M:Name/PArity) :-
 1151    integer(Arity),
 1152    PArity is Arity+2.
 1153canonical_pi(PI, PI).
 1154
 1155%!  resolve_module(:PI, -DefPI) is det.
 1156%
 1157%   Find the real predicate  indicator   pointing  to the definition
 1158%   module of PI. This is similar to using predicate_property/3 with
 1159%   the       property       imported_from,         but        using
 1160%   '$get_predicate_attribute'/3    avoids    auto-importing     the
 1161%   predicate.
 1162
 1163resolve_module(Module:Name/Arity, DefM:Name/Arity) :-
 1164    functor(Head, Name, Arity),
 1165    (   '$get_predicate_attribute'(Module:Head, imported, M)
 1166    ->  DefM = M
 1167    ;   DefM = Module
 1168    ).
 1169
 1170
 1171                 /*******************************
 1172                 *            MESSAGES          *
 1173                 *******************************/
 1174:- multifile
 1175    prolog:message//1. 1176
 1177prolog:message(predicate_option_error(Formal, Location)) -->
 1178    error_location(Location),
 1179    '$messages':term_message(Formal). % TBD: clean interface
 1180prolog:message(check_options(new(Decls))) -->
 1181    [ 'Inferred declarations:'-[], nl ],
 1182    new_decls(Decls).
 1183prolog:message(predopts_lint(Finding, Ref)) -->
 1184    lint_location(Ref),
 1185    lint_message(Finding).
 1186
 1187lint_location(Ref) -->
 1188    { Ref \== (-),
 1189      clause_property(Ref, file(File)),
 1190      clause_property(Ref, line_count(Line))
 1191    },
 1192    !,
 1193    [ url(File:Line), ': ' ].
 1194lint_location(_) --> [].
 1195
 1196lint_message(raw_option_access(PI, Opt)) -->
 1197    [ 'raw option access ~q on an option list; prefer option/2'-[Opt],
 1198      nl, '    in ~q'-[PI] ].
 1199lint_message(prepend_override(PI, Prefix)) -->
 1200    [ 'option(s) ~q prepended to rightmost-wins predicate ~q;'-[Prefix, PI],
 1201      nl,
 1202      '    a duplicate in the list tail overrides them - '-[],
 1203      'append or use merge_options/3'-[] ].
 1204
 1205error_location(file_char_count(File, CharPos)) -->
 1206    { filepos_line(File, CharPos, Line, LinePos) },
 1207    [ url(File:Line:LinePos), ': ' ].
 1208error_location(clause(ClauseRef)) -->
 1209    { clause_property(ClauseRef, file(File)),
 1210      clause_property(ClauseRef, line_count(Line))
 1211    },
 1212    !,
 1213    [ url(File:Line), ': ' ].
 1214error_location(clause(ClauseRef)) -->
 1215    [ 'Clause ~q: '-[ClauseRef] ].
 1216
 1217filepos_line(File, CharPos, Line, LinePos) :-
 1218    setup_call_cleanup(
 1219        ( open(File, read, In),
 1220          open_null_stream(Out)
 1221        ),
 1222        ( Skip is CharPos-1,
 1223          copy_stream_data(In, Out, Skip),
 1224          stream_property(In, position(Pos)),
 1225          stream_position_data(line_count, Pos, Line),
 1226          stream_position_data(line_position, Pos, LinePos)
 1227        ),
 1228        ( close(Out),
 1229          close(In)
 1230        )).
 1231
 1232new_decls([]) --> [].
 1233new_decls([H|T]) -->
 1234    [ '    :- ~q'-[H], nl ],
 1235    new_decls(T).
 1236
 1237
 1238                 /*******************************
 1239                 *      SYSTEM DECLARATIONS     *
 1240                 *******************************/