View source with raw comments or as raw
    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:- autoload(library(listing),[portray_clause/1]).   62:- autoload(library(lists),[member/2,nth1/3,append/3,delete/3]).   63:- autoload(library(pairs),[group_pairs_by_key/2]).   64:- autoload(library(prolog_clause),[clause_info/4]).   65
   66
   67:- meta_predicate
   68    predicate_options(:, +, +),
   69    assert_predicate_options(:, +, +, ?),
   70    current_predicate_option(:, ?, ?),
   71    check_predicate_option(:, ?, ?),
   72    current_predicate_options(:, ?, ?),
   73    current_option_arg(:, ?),
   74    pred_option(:,-),
   75    derived_predicate_options(:,?,?),
   76    check_predicate_options(:).

Access and analyse predicate options

This module provides the developers interface for the directive predicate_options/3. This directive allows us to specify that, e.g., open/4 processes options using the 4th argument and supports the option type using the values text and binary. Declaring options that are processed allows for more reliable handling of predicate options and simplifies porting applications. This library provides the following functionality:

Below, we describe some use-cases.

Quick check of a program
This scenario is useful as an occasional check or to assess problems with option-handling for porting an application to SWI-Prolog. It consists of three steps: loading the program (1 and 2), deriving option handling for application predicates (3) and running the checker (4).
1 ?- [load].
2 ?- autoload.
3 ?- derive_predicate_options.
4 ?- check_predicate_options.
Add declarations to your program
Adding declarations about option processes improves the quality of the checking. The analysis of derive_predicate_options/0 may miss options and does not derive the types for options that are processed in Prolog code. The process is similar to the above. In steps 4 and further, the inferred declarations are listed, inspected and added to the source code of the module.
1 ?- [load].
2 ?- autoload.
3 ?- derive_predicate_options.
4 ?- derived_predicate_options(module_1).
5 ?- derived_predicate_options(module_2).
6 ?- ...
Declare option processing requirements
If an application requires that open/4 needs to support lock(write), it may do so using the directive below. This directive raises an exception when loaded on a Prolog implementation that does not support this option.
:- current_predicate_option(open/4, 4, lock(write)).
See also
- library(option) for accessing options in Prolog code. */
  142:- multifile option_decl/3, pred_option/3.  143:- dynamic   dyn_option_decl/3.
 predicate_options(:PI, +Arg, +Options) is det
Declare that the predicate PI processes options on Arg. Options is a list of options processed. Each element is one of:

Below is an example that processes the option header(boolean) and passes all options to open/4:

:- predicate_options(write_xml_file/3, 3,
                     [ header(boolean),
                       pass_to(open/4, 4)
                     ]).

write_xml_file(File, XMLTerm, Options) :-
    open(File, write, Out, Options),
    (   option(header(true), Options, true)
    ->  write_xml_header(Out)
    ;   true
    ),
    ...

This predicate may only be used as a directive and is processed by expand_term/2. Option processing can be specified at runtime using assert_predicate_options/3, which is intended to support program analysis.

  181predicate_options(PI, Arg, Options) :-
  182    throw(error(context_error(nodirective,
  183                              predicate_options(PI, Arg, Options)), _)).
 assert_predicate_options(:PI, +Arg, +Options, ?New) is semidet
As predicate_options(:PI, +Arg, +Options). New is a boolean indicating whether the declarations have changed. If New is provided and false, the predicate becomes semidet and fails without modifications if modifications are required.
  193assert_predicate_options(PI, Arg, Options, New) :-
  194    canonical_pi(PI, M:Name/Arity),
  195    functor(Head, Name, Arity),
  196    (   dyn_option_decl(Head, M, Arg)
  197    ->  true
  198    ;   New = true,
  199        assertz(dyn_option_decl(Head, M, Arg))
  200    ),
  201    phrase('$predopts':option_clauses(Options, Head, M, Arg),
  202           OptionClauses),
  203    forall(member(Clause, OptionClauses),
  204           assert_option_clause(Clause, New)),
  205    (   var(New)
  206    ->  New = false
  207    ;   true
  208    ).
  209
  210assert_option_clause(Clause, New) :-
  211    rename_clause(Clause, NewClause,
  212                  '$pred_option'(A,B,C,D), '$dyn_pred_option'(A,B,C,D)),
  213    clause_head(NewClause, NewHead),
  214    (   clause(NewHead, _)
  215    ->  true
  216    ;   New = true,
  217        assertz(NewClause)
  218    ).
  219
  220clause_head(M:(Head:-_Body), M:Head) :- !.
  221clause_head((M:Head :-_Body), M:Head) :- !.
  222clause_head(Head, Head).
  223
  224rename_clause(M:Clause, M:NewClause, Head, NewHead) :-
  225    !,
  226    rename_clause(Clause, NewClause, Head, NewHead).
  227rename_clause((Head :- Body), (NewHead :- Body), Head, NewHead) :- !.
  228rename_clause(Head, NewHead, Head, NewHead) :- !.
  229rename_clause(Head, Head, _, _).
  230
  231
  232
  233                 /*******************************
  234                 *        QUERY OPTIONS         *
  235                 *******************************/
 current_option_arg(:PI, ?Arg) is nondet
True when Arg of PI processes predicate options. Which options are processed can be accessed using current_predicate_option/3.
  242current_option_arg(Module:Name/Arity, Arg) :-
  243    current_option_arg(Module:Name/Arity, Arg, _DefM).
  244
  245current_option_arg(Module:Name/Arity, Arg, DefM) :-
  246    atom(Name), integer(Arity),
  247    !,
  248    resolve_module(Module:Name/Arity, DefM:Name/Arity),
  249    functor(Head, Name, Arity),
  250    (   option_decl(Head, DefM, Arg)
  251    ;   dyn_option_decl(Head, DefM, Arg)
  252    ).
  253current_option_arg(M:Name/Arity, Arg, M) :-
  254    (   option_decl(Head, M, Arg)
  255    ;   dyn_option_decl(Head, M, Arg)
  256    ),
  257    functor(Head, Name, Arity).
 current_predicate_option(:PI, ?Arg, ?Option) is nondet
True when Arg of PI processes Option. For example, the following is true:
?- current_predicate_option(open/4, 4, type(text)).
true.

This predicate is intended to support conditional compilation using if/1 ... endif/0. The predicate current_predicate_options/3 can be used to access the full capabilities of a predicate.

  274current_predicate_option(Module:PI, Arg, Option) :-
  275    current_option_arg(Module:PI, Arg, DefM),
  276    PI = Name/Arity,
  277    functor(Head, Name, Arity),
  278    catch(pred_option(DefM:Head, Option),
  279          error(type_error(_,_),_),
  280          fail).
 check_predicate_option(:PI, +Arg, +Option) is det
Verify predicate options at runtime. Similar to current_predicate_option/3, but intended to support runtime checking.
Errors
- existence_error(option, OptionName) if the option is not supported by PI.
- type_error(Type, Value) if the option is supported but the value does not match the option type. See must_be/2.
  293check_predicate_option(Module:PI, Arg, Option) :-
  294    define_predicate(Module:PI),
  295    current_option_arg(Module:PI, Arg, DefM),
  296    PI = Name/Arity,
  297    functor(Head, Name, Arity),
  298    (   pred_option(DefM:Head, Option)
  299    ->  true
  300    ;   existence_error(option, Option)
  301    ).
  302
  303
  304pred_option(M:Head, Option) :-
  305    pred_option(M:Head, Option, []).
  306
  307pred_option(M:Head, Option, Seen) :-
  308    (   has_static_option_decl(M),
  309        M:'$pred_option'(Head, _, Option, Seen)
  310    ;   has_dynamic_option_decl(M),
  311        M:'$dyn_pred_option'(Head, _, Option, Seen)
  312    ).
  313
  314has_static_option_decl(M) :-
  315    '$c_current_predicate'(_, M:'$pred_option'(_,_,_,_)).
  316has_dynamic_option_decl(M) :-
  317    '$c_current_predicate'(_, M:'$dyn_pred_option'(_,_,_,_)).
  318
  319
  320                 /*******************************
  321                 *     TYPE&MODE CONSTRAINTS    *
  322                 *******************************/
  323
  324:- public
  325    system:predicate_option_mode/2,
  326    system:predicate_option_type/2.  327
  328add_attr(Var, Value) :-
  329    (   get_attr(Var, predicate_options, Old)
  330    ->  put_attr(Var, predicate_options, [Value|Old])
  331    ;   put_attr(Var, predicate_options, [Value])
  332    ).
  333
  334system:predicate_option_type(Type, Arg) :-
  335    var(Arg),
  336    !,
  337    add_attr(Arg, option_type(Type)).
  338system:predicate_option_type(Type, Arg) :-
  339    must_be(Type, Arg).
  340
  341system:predicate_option_mode(Mode, Arg) :-
  342    var(Arg),
  343    !,
  344    add_attr(Arg, option_mode(Mode)).
  345system:predicate_option_mode(Mode, Arg) :-
  346    check_mode(Mode, Arg).
  347
  348check_mode(input, Arg) :-
  349    (   nonvar(Arg)
  350    ->  true
  351    ;   instantiation_error(Arg)
  352    ).
  353check_mode(output, Arg) :-
  354    (   var(Arg)
  355    ->  true
  356    ;   uninstantiation_error(Arg)
  357    ).
  358
  359attr_unify_hook([], _).
  360attr_unify_hook([H|T], Var) :-
  361    option_hook(H, Var),
  362    attr_unify_hook(T, Var).
  363
  364option_hook(option_type(Type), Value) :-
  365    is_of_type(Type, Value).
  366option_hook(option_mode(Mode), Value) :-
  367    check_mode(Mode, Value).
  368
  369
  370attribute_goals(Var) -->
  371    { get_attr(Var, predicate_options, Attrs) },
  372    option_goals(Attrs, Var).
  373
  374option_goals([], _) --> [].
  375option_goals([H|T], Var) -->
  376    option_goal(H, Var),
  377    option_goals(T, Var).
  378
  379option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)].
  380option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)].
  381
  382
  383                 /*******************************
  384                 *      OUTPUT DECLARATIONS     *
  385                 *******************************/
 current_predicate_options(:PI, ?Arg, ?Options) is nondet
True when Options is the current active option declaration for PI on Arg. See predicate_options/3 for the argument descriptions. If PI is ground and refers to an undefined predicate, the autoloader is used to obtain a definition of the predicate.
  395current_predicate_options(PI, Arg, Options) :-
  396    define_predicate(PI),
  397    setof(Arg-Option,
  398          current_predicate_option_decl(PI, Arg, Option),
  399          Options0),
  400    group_pairs_by_key(Options0, Grouped),
  401    member(Arg-Options, Grouped).
  402
  403current_predicate_option_decl(PI, Arg, Option) :-
  404    current_predicate_option(PI, Arg, Option0),
  405    Option0 =.. [Name|Values],
  406    maplist(mode_and_type, Values, Types),
  407    Option =.. [Name|Types].
  408
  409mode_and_type(Value, ModeAndType) :-
  410    copy_term(Value,_,Goals),
  411    (   memberchk(predicate_option_mode(output, _), Goals)
  412    ->  ModeAndType = -(Type)
  413    ;   ModeAndType = Type
  414    ),
  415    (   memberchk(predicate_option_type(Type, _), Goals)
  416    ->  true
  417    ;   Type = any
  418    ).
  419
  420define_predicate(PI) :-
  421    ground(PI),
  422    !,
  423    PI = M:Name/Arity,
  424    functor(Head, Name, Arity),
  425    once(predicate_property(M:Head, _)).
  426define_predicate(_).
 derived_predicate_options(:PI, ?Arg, ?Options) is nondet
Derive option arguments using static analysis. True when Options is the current derived active option declaration for PI on Arg.
  434derived_predicate_options(PI, Arg, Options) :-
  435    define_predicate(PI),
  436    setof(Arg-Option,
  437          derived_predicate_option(PI, Arg, Option),
  438          Options0),
  439    group_pairs_by_key(Options0, Grouped),
  440    member(Arg-Options1, Grouped),
  441    PI = M:_,
  442    phrase(expand_pass_to_options(Options1, M), Options2),
  443    sort(Options2, Options).
  444
  445derived_predicate_option(PI, Arg, Decl) :-
  446    current_option_arg(PI, Arg, DefM),
  447    PI = _:Name/Arity,
  448    functor(Head, Name, Arity),
  449    has_dynamic_option_decl(DefM),
  450    (   has_static_option_decl(DefM),
  451        DefM:'$pred_option'(Head, Decl, _, [])
  452    ;   DefM:'$dyn_pred_option'(Head, Decl, _, [])
  453    ).
 expand_pass_to_options(+OptionsIn, +Module, -OptionsOut)// is det
Expand the options of pass_to(PI,Arg) if PI does not refer to a public predicate.
  460expand_pass_to_options([], _) --> [].
  461expand_pass_to_options([H|T], M) -->
  462    expand_pass_to(H, M),
  463    expand_pass_to_options(T, M).
  464
  465expand_pass_to(pass_to(PI, Arg), Module) -->
  466    { strip_module(Module:PI, M, Name/Arity),
  467      functor(Head, Name, Arity),
  468      \+ (   predicate_property(M:Head, exported)
  469         ;   predicate_property(M:Head, public)
  470         ;   M == system
  471         ),
  472      !,
  473      current_predicate_options(M:Name/Arity, Arg, Options)
  474    },
  475    list(Options).
  476expand_pass_to(Option, _) -->
  477    [Option].
  478
  479list([]) --> [].
  480list([H|T]) --> [H], list(T).
 derived_predicate_options(+Module) is det
Derive predicate option declarations for a module. The derived options are printed to the current_output stream.
  487derived_predicate_options(Module) :-
  488    var(Module),
  489    !,
  490    forall(current_module(Module),
  491           derived_predicate_options(Module)).
  492derived_predicate_options(Module) :-
  493    findall(predicate_options(Module:PI, Arg, Options),
  494            ( derived_predicate_options(Module:PI, Arg, Options),
  495              PI = Name/Arity,
  496              functor(Head, Name, Arity),
  497              (   predicate_property(Module:Head, exported)
  498              ->  true
  499              ;   predicate_property(Module:Head, public)
  500              )
  501            ),
  502            Decls0),
  503    maplist(qualify_decl(Module), Decls0, Decls1),
  504    sort(Decls1, Decls),
  505    (   Decls \== []
  506    ->  format('~N~n~n% Predicate option declarations for module ~q~n~n',
  507               [Module]),
  508        forall(member(Decl, Decls),
  509               portray_clause((:-Decl)))
  510    ;   true
  511    ).
  512
  513qualify_decl(M,
  514             predicate_options(PI0, Arg, Options0),
  515             predicate_options(PI1, Arg, Options1)) :-
  516    qualify(PI0, M, PI1),
  517    maplist(qualify_option(M), Options0, Options1).
  518
  519qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :-
  520    !,
  521    qualify(PI0, M, PI1).
  522qualify_option(_, Opt, Opt).
  523
  524qualify(M:Term, M, Term) :- !.
  525qualify(QTerm, _, QTerm).
  526
  527
  528                 /*******************************
  529                 *            CLEANUP           *
  530                 *******************************/
 retractall_predicate_options is det
Remove all dynamically (derived) predicate options.
  536retractall_predicate_options :-
  537    forall(retract(dyn_option_decl(_,M,_)),
  538           abolish(M:'$dyn_pred_option'/4)).
  539
  540
  541                 /*******************************
  542                 *     COMPILE-TIME CHECKER     *
  543                 *******************************/
  544
  545
  546:- thread_local
  547    new_decl/1.
 check_predicate_options is det
Analyse loaded program for erroneous options. This predicate decompiles the current program and searches for calls to predicates that process options. For each option list, it validates whether the provided options are supported and validates the argument type. This predicate performs partial dataflow analysis to track option-lists inside a clause.
See also
- derive_predicate_options/0 can be used to derive declarations for predicates that pass options. This predicate should normally be called before check_predicate_options/0.
  563check_predicate_options :-
  564    forall(current_module(Module),
  565           check_predicate_options_module(Module)).
 derive_predicate_options is det
Derive new predicate option declarations. This predicate analyses the loaded program to find clauses that process options using one of the predicates from library(option) or passes options to other predicates that are known to process options. The process is repeated until no new declarations are retrieved.
See also
- autoload/0 may be used to complete the loaded program.
  577derive_predicate_options :-
  578    derive_predicate_options(NewDecls),
  579    (   NewDecls == []
  580    ->  true
  581    ;   print_message(informational, check_options(new(NewDecls))),
  582        new_decls(NewDecls),
  583        derive_predicate_options
  584    ).
  585
  586new_decls([]).
  587new_decls([predicate_options(PI, A, O)|T]) :-
  588    assert_predicate_options(PI, A, O, _),
  589    new_decls(T).
  590
  591
  592derive_predicate_options(NewDecls) :-
  593    call_cleanup(
  594        ( forall(
  595              current_module(Module),
  596              forall(
  597                  ( predicate_in_module(Module, PI),
  598                    PI = Name/Arity,
  599                    functor(Head, Name, Arity),
  600                    catch(Module:clause(Head, Body, Ref), _, fail)
  601                  ),
  602                  check_clause((Head:-Body), Module, Ref, decl))),
  603          (   setof(Decl, retract(new_decl(Decl)), NewDecls)
  604              ->  true
  605              ;   NewDecls = []
  606          )
  607        ),
  608        retractall(new_decl(_))).
  609
  610
  611check_predicate_options_module(Module) :-
  612    forall(predicate_in_module(Module, PI),
  613           check_predicate_options(Module:PI)).
  614
  615predicate_in_module(Module, PI) :-
  616    current_predicate(Module:PI),
  617    PI = Name/Arity,
  618    functor(Head, Name, Arity),
  619    \+ predicate_property(Module:Head, imported_from(_)).
 check_predicate_options(:PredicateIndicator) is det
Verify calls to predicates that have options in all clauses of the predicate indicated by PredicateIndicator.
  626check_predicate_options(Module:Name/Arity) :-
  627    debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
  628    functor(Head, Name, Arity),
  629    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  630           check_clause((Head:-Body), Module, Ref, check)).
 check_clause(+Clause, +Module, +Ref, +Action) is det
Action is one of
decl
Create additional declarations
check
Produce error messages
  641check_clause((Head:-Body), M, ClauseRef, Action) :-
  642    !,
  643    catch(check_body(Body, M, _, Action), E, true),
  644    (   var(E)
  645    ->  option_decl(M:Head, Action)
  646    ;   (   clause_info(ClauseRef, File, TermPos, _NameOffset),
  647            TermPos = term_position(_,_,_,_,[_,BodyPos]),
  648            catch(check_body(Body, M, BodyPos, Action),
  649                  error(Formal, ArgPos), true),
  650            compound(ArgPos),
  651            arg(1, ArgPos, CharCount),
  652            integer(CharCount)
  653        ->  Location = file_char_count(File, CharCount)
  654        ;   Location = clause(ClauseRef),
  655            E = error(Formal, _)
  656        ),
  657        print_message(error, predicate_option_error(Formal, Location))
  658    ).
 check_body(+Body, +Module, +TermPos, +Action)
  663:- multifile
  664    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  665    prolog:called_by/2.             % +Goal, -Called
  666
  667check_body(Var, _, _, _) :-
  668    var(Var),
  669    !.
  670check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :-
  671    !,
  672    check_body(G, M, Pos, Action).
  673check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  674    !,
  675    check_body(A, M, PA, Action),
  676    check_body(B, M, PB, Action).
  677check_body(A=B, _, _, _) :-             % partial evaluation
  678    unify_with_occurs_check(A,B),
  679    !.
  680check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :-
  681    callable(Goal),
  682    functor(Goal, Name, Arity),
  683    (   '$get_predicate_attribute'(M:Goal, imported, DefM)
  684    ->  true
  685    ;   DefM = M
  686    ),
  687    (   eval_option_pred(DefM:Goal)
  688    ->  true
  689    ;   current_option_arg(DefM:Name/Arity, OptArg),
  690        !,
  691        arg(OptArg, Goal, Options),
  692        nth1(OptArg, ArgPosList, ArgPos),
  693        check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action)
  694    ).
  695check_body(Goal, M, _, Action) :-
  696    (   (   predicate_property(M:Goal, imported_from(IM))
  697        ->  true
  698        ;   IM = M
  699        ),
  700        prolog:called_by(Goal, IM, M, Called)
  701    ;   prolog:called_by(Goal, Called)
  702    ),
  703    !,
  704    check_called_by(Called, M, Action).
  705check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :-
  706    '$get_predicate_attribute'(M:Meta, meta_predicate, Head),
  707    !,
  708    check_meta_args(1, Head, Meta, M, ArgPosList, Action).
  709check_body(_, _, _, _).
  710
  711check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :-
  712    arg(I, Head, AS),
  713    !,
  714    (   AS == 0
  715    ->  arg(I, Meta, MA),
  716        check_body(MA, M, ArgPos, Action)
  717    ;   true
  718    ),
  719    succ(I, I2),
  720    check_meta_args(I2, Head, Meta, M, ArgPosList, Action).
  721check_meta_args(_,_,_,_, _, _).
 check_called_by(+CalledBy, +M, +Action) is det
Handle results from prolog:called_by/2.
  727check_called_by([], _, _).
  728check_called_by([H|T], M, Action) :-
  729    (   H = G+N
  730    ->  (   extend(G, N, G2)
  731        ->  check_body(G2, M, _, Action)
  732        ;   true
  733        )
  734    ;   check_body(H, M, _, Action)
  735    ),
  736    check_called_by(T, M, Action).
  737
  738extend(Goal, N, GoalEx) :-
  739    callable(Goal),
  740    Goal =.. List,
  741    length(Extra, N),
  742    append(List, Extra, ListEx),
  743    GoalEx =.. ListEx.
 check_options(:Predicate, +OptionArg, +Options, +ArgPos, +Action)
Verify the list Options, that is passed into Predicate on argument OptionArg. ArgPos is a term-position term describing the location of the Options list. If Options is a partial list, the tail is annotated with pass_to(PI, OptArg).
  753check_options(PI, OptArg, QOptions, ArgPos, Action) :-
  754    debug(predicate_options, '\tChecking call to ~q', [PI]),
  755    remove_qualifier(QOptions, Options),
  756    must_be(list_or_partial_list, Options),
  757    check_option_list(Options, PI, OptArg, Options, ArgPos, Action).
  758
  759remove_qualifier(X, X) :-
  760    var(X),
  761    !.
  762remove_qualifier(_:X, X) :- !.
  763remove_qualifier(X, X).
  764
  765check_option_list(Var,  PI, OptArg, _, _, _) :-
  766    var(Var),
  767    !,
  768    annotate(Var, pass_to(PI, OptArg)).
  769check_option_list([], _, _, _, _, _).
  770check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :-
  771    check_option(PI, OptArg, H, ArgPos, Action),
  772    check_option_list(T, PI, OptArg, Options, ArgPos, Action).
  773
  774check_option(_, _, _, _, decl) :- !.
  775check_option(PI, OptArg, Opt, ArgPos, _) :-
  776    catch(check_predicate_option(PI, OptArg, Opt), E, true),
  777    !,
  778    (   var(E)
  779    ->  true
  780    ;   E = error(Formal,_),
  781        throw(error(Formal,ArgPos))
  782    ).
  783
  784
  785                 /*******************************
  786                 *          ANNOTATIONS         *
  787                 *******************************/
 annotate(+Var, +Term) is det
Use constraints to accumulate annotations about variables. If two annotated variables are unified, the attributes are joined.
  794annotate(Var, Term) :-
  795    (   get_attr(Var, predopts_analysis, Old)
  796    ->  put_attr(Var, predopts_analysis, [Term|Old])
  797    ;   var(Var)
  798    ->  put_attr(Var, predopts_analysis, [Term])
  799    ;   true
  800    ).
  801
  802annotations(Var, Annotations) :-
  803    get_attr(Var, predopts_analysis, Annotations).
  804
  805predopts_analysis:attr_unify_hook(Opts, Value) :-
  806    get_attr(Value, predopts_analysis, Others),
  807    !,
  808    append(Opts, Others, All),
  809    put_attr(Value, predopts_analysis, All).
  810predopts_analysis:attr_unify_hook(_, _).
  811
  812
  813                 /*******************************
  814                 *         PARTIAL EVAL         *
  815                 *******************************/
  816
  817eval_option_pred(swi_option:option(Opt, Options)) :-
  818    processes(Opt, Spec),
  819    annotate(Options, Spec).
  820eval_option_pred(swi_option:option(Opt, Options, _Default)) :-
  821    processes(Opt, Spec),
  822    annotate(Options, Spec).
  823eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :-
  824    ignore(unify_with_occurs_check(Rest, Options)),
  825    processes(Opt, Spec),
  826    annotate(Options, Spec).
  827eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :-
  828    ignore(unify_with_occurs_check(Rest, Options)),
  829    processes(Opt, Spec),
  830    annotate(Options, Spec).
  831eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :-
  832    remove_qualifier(QOptionsIn, OptionsIn),
  833    remove_qualifier(QOptionsOut, OptionsOut),
  834    ignore(unify_with_occurs_check(OptionsIn, OptionsOut)).
  835
  836processes(Opt, Spec) :-
  837    compound(Opt),
  838    functor(Opt, OptName, 1),
  839    Spec =.. [OptName,any].
  840
  841
  842                 /*******************************
  843                 *        NEW DECLARTIONS       *
  844                 *******************************/
 option_decl(:Head, +Action) is det
Add new declarations based on attributes left by the analysis pass. We do not add declarations for system modules or modules that already contain static declarations.
To be done
- Should we add a mode to include generating declarations for system modules and modules with static declarations?
  855option_decl(_, check) :- !.
  856option_decl(M:_, _) :-
  857    system_module(M),
  858    !.
  859option_decl(M:_, _) :-
  860    has_static_option_decl(M),
  861    !.
  862option_decl(M:Head, _) :-
  863    compound(Head),
  864    arg(AP, Head, QA),
  865    remove_qualifier(QA, A),
  866    annotations(A, Annotations0),
  867    functor(Head, Name, Arity),
  868    PI = M:Name/Arity,
  869    delete(Annotations0, pass_to(PI,AP), Annotations),
  870    Annotations \== [],
  871    Decl = predicate_options(PI, AP, Annotations),
  872    (   new_decl(Decl)
  873    ->  true
  874    ;   assert_predicate_options(M:Name/Arity, AP, Annotations, false)
  875    ->  true
  876    ;   assertz(new_decl(Decl)),
  877        debug(predicate_options(decl), '~q', [Decl])
  878    ),
  879    fail.
  880option_decl(_, _).
  881
  882system_module(system) :- !.
  883system_module(Module) :-
  884    sub_atom(Module, 0, _, _, $).
  885
  886
  887                 /*******************************
  888                 *             MISC             *
  889                 *******************************/
  890
  891canonical_pi(M:Name//Arity, M:Name/PArity) :-
  892    integer(Arity),
  893    PArity is Arity+2.
  894canonical_pi(PI, PI).
 resolve_module(:PI, -DefPI) is det
Find the real predicate indicator pointing to the definition module of PI. This is similar to using predicate_property/3 with the property imported_from, but using '$get_predicate_attribute'/3 avoids auto-importing the predicate.
  904resolve_module(Module:Name/Arity, DefM:Name/Arity) :-
  905    functor(Head, Name, Arity),
  906    (   '$get_predicate_attribute'(Module:Head, imported, M)
  907    ->  DefM = M
  908    ;   DefM = Module
  909    ).
  910
  911
  912                 /*******************************
  913                 *            MESSAGES          *
  914                 *******************************/
  915:- multifile
  916    prolog:message//1.  917
  918prolog:message(predicate_option_error(Formal, Location)) -->
  919    error_location(Location),
  920    '$messages':term_message(Formal). % TBD: clean interface
  921prolog:message(check_options(new(Decls))) -->
  922    [ 'Inferred declarations:'-[], nl ],
  923    new_decls(Decls).
  924
  925error_location(file_char_count(File, CharPos)) -->
  926    { filepos_line(File, CharPos, Line, LinePos) },
  927    [ '~w:~d:~d: '-[File, Line, LinePos] ].
  928error_location(clause(ClauseRef)) -->
  929    { clause_property(ClauseRef, file(File)),
  930      clause_property(ClauseRef, line_count(Line))
  931    },
  932    !,
  933    [ '~w:~d: '-[File, Line] ].
  934error_location(clause(ClauseRef)) -->
  935    [ 'Clause ~q: '-[ClauseRef] ].
  936
  937filepos_line(File, CharPos, Line, LinePos) :-
  938    setup_call_cleanup(
  939        ( open(File, read, In),
  940          open_null_stream(Out)
  941        ),
  942        ( Skip is CharPos-1,
  943          copy_stream_data(In, Out, Skip),
  944          stream_property(In, position(Pos)),
  945          stream_position_data(line_count, Pos, Line),
  946          stream_position_data(line_position, Pos, LinePos)
  947        ),
  948        ( close(Out),
  949          close(In)
  950        )).
  951
  952new_decls([]) --> [].
  953new_decls([H|T]) -->
  954    [ '    :- ~q'-[H], nl ],
  955    new_decls(T).
  956
  957
  958                 /*******************************
  959                 *      SYSTEM DECLARATIONS     *
  960                 *******************************/