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:- use_module(library(debug),[debug/3]).   54:- autoload(library(error),
   55	    [ existence_error/2,
   56	      must_be/2,
   57	      instantiation_error/1,
   58	      uninstantiation_error/1,
   59	      is_of_type/2
   60	    ]).   61:- use_module(library(dialect/swi/syspred_options)).   62
   63:- autoload(library(listing),[portray_clause/1]).   64:- autoload(library(lists),[member/2,nth1/3,append/3,delete/3]).   65:- autoload(library(pairs),[group_pairs_by_key/2]).   66:- autoload(library(prolog_clause),[clause_info/4]).   67
   68
   69:- meta_predicate
   70    predicate_options(:, +, +),
   71    assert_predicate_options(:, +, +, ?),
   72    current_predicate_option(:, ?, ?),
   73    check_predicate_option(:, ?, ?),
   74    current_predicate_options(:, ?, ?),
   75    current_option_arg(:, ?),
   76    pred_option(:,-),
   77    derived_predicate_options(:,?,?),
   78    check_predicate_options(:).

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. */
  144:- multifile option_decl/3, pred_option/3.  145:- 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.

  183predicate_options(PI, Arg, Options) :-
  184    throw(error(context_error(nodirective,
  185                              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.
  195assert_predicate_options(PI, Arg, Options, New) :-
  196    canonical_pi(PI, M:Name/Arity),
  197    functor(Head, Name, Arity),
  198    (   dyn_option_decl(Head, M, Arg)
  199    ->  true
  200    ;   New = true,
  201        assertz(dyn_option_decl(Head, M, Arg))
  202    ),
  203    phrase('$predopts':option_clauses(Options, Head, M, Arg),
  204           OptionClauses),
  205    forall(member(Clause, OptionClauses),
  206           assert_option_clause(Clause, New)),
  207    (   var(New)
  208    ->  New = false
  209    ;   true
  210    ).
  211
  212assert_option_clause(Clause, New) :-
  213    rename_clause(Clause, NewClause,
  214                  '$pred_option'(A,B,C,D), '$dyn_pred_option'(A,B,C,D)),
  215    clause_head(NewClause, NewHead),
  216    (   clause(NewHead, _)
  217    ->  true
  218    ;   New = true,
  219        assertz(NewClause)
  220    ).
  221
  222clause_head(M:(Head:-_Body), M:Head) :- !.
  223clause_head((M:Head :-_Body), M:Head) :- !.
  224clause_head(Head, Head).
  225
  226rename_clause(M:Clause, M:NewClause, Head, NewHead) :-
  227    !,
  228    rename_clause(Clause, NewClause, Head, NewHead).
  229rename_clause((Head :- Body), (NewHead :- Body), Head, NewHead) :- !.
  230rename_clause(Head, NewHead, Head, NewHead) :- !.
  231rename_clause(Head, Head, _, _).
  232
  233
  234
  235                 /*******************************
  236                 *        QUERY OPTIONS         *
  237                 *******************************/
 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.
  244current_option_arg(Module:Name/Arity, Arg) :-
  245    current_option_arg(Module:Name/Arity, Arg, _DefM).
  246
  247current_option_arg(Module:Name/Arity, Arg, DefM) :-
  248    atom(Name), integer(Arity),
  249    !,
  250    resolve_module(Module:Name/Arity, DefM:Name/Arity),
  251    functor(Head, Name, Arity),
  252    (   option_decl(Head, DefM, Arg)
  253    ;   dyn_option_decl(Head, DefM, Arg)
  254    ).
  255current_option_arg(M:Name/Arity, Arg, M) :-
  256    (   option_decl(Head, M, Arg)
  257    ;   dyn_option_decl(Head, M, Arg)
  258    ),
  259    functor(Head, Name, Arity).
 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.

  276current_predicate_option(Module:PI, Arg, Option) :-
  277    current_option_arg(Module:PI, Arg, DefM),
  278    PI = Name/Arity,
  279    functor(Head, Name, Arity),
  280    catch(pred_option(DefM:Head, Option),
  281          error(type_error(_,_),_),
  282          fail).
 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.
  295check_predicate_option(Module:PI, Arg, Option) :-
  296    define_predicate(Module:PI),
  297    current_option_arg(Module:PI, Arg, DefM),
  298    PI = Name/Arity,
  299    functor(Head, Name, Arity),
  300    (   pred_option(DefM:Head, Option)
  301    ->  true
  302    ;   existence_error(option, Option)
  303    ).
  304
  305
  306pred_option(Head, Option) :-
  307    pred_option(Head, Option, []).
  308
  309pred_option(M:Head, Option, Seen) :-
  310    (   has_static_option_decl(M),
  311        M:'$pred_option'(Head, _, Option, Seen)
  312    ;   has_dynamic_option_decl(M),
  313        M:'$dyn_pred_option'(Head, _, Option, Seen)
  314    ).
  315
  316has_static_option_decl(M) :-
  317    '$c_current_predicate'(_, M:'$pred_option'(_,_,_,_)).
  318has_dynamic_option_decl(M) :-
  319    '$c_current_predicate'(_, M:'$dyn_pred_option'(_,_,_,_)).
  320
  321
  322                 /*******************************
  323                 *     TYPE&MODE CONSTRAINTS    *
  324                 *******************************/
  325
  326:- public
  327    system:predicate_option_mode/2,
  328    system:predicate_option_type/2.  329
  330add_attr(Var, Value) :-
  331    (   get_attr(Var, predicate_options, Old)
  332    ->  put_attr(Var, predicate_options, [Value|Old])
  333    ;   put_attr(Var, predicate_options, [Value])
  334    ).
  335
  336system:predicate_option_type(Type, Arg) :-
  337    var(Arg),
  338    !,
  339    add_attr(Arg, option_type(Type)).
  340system:predicate_option_type(callable+_N, Arg) :-
  341    !,
  342    must_be(callable, Arg).
  343system:predicate_option_type(list, Arg) :-
  344    !,
  345    must_be(list_or_partial_list, Arg).
  346system:predicate_option_type(list(Type), Arg) :-
  347    !,
  348    must_be(list_or_partial_list(Type), Arg).
  349system:predicate_option_type(Type, Arg) :-
  350    must_be(Type, Arg).
  351
  352system:predicate_option_mode(_Mode, Arg) :-
  353    var(Arg),
  354    !.
  355system:predicate_option_mode(Mode, Arg) :-
  356    check_mode(Mode, Arg).
  357
  358check_mode(input, Arg) :-
  359    (   nonvar(Arg)
  360    ->  true
  361    ;   instantiation_error(Arg)
  362    ).
  363check_mode(output, Arg) :-
  364    (   var(Arg)
  365    ->  true
  366    ;   uninstantiation_error(Arg)
  367    ).
  368
  369attr_unify_hook([], _).
  370attr_unify_hook([H|T], Var) :-
  371    option_hook(H, Var),
  372    attr_unify_hook(T, Var).
  373
  374option_hook(option_type(Type), Value) :-
  375    is_of_type(Type, Value).
  376option_hook(option_mode(Mode), Value) :-
  377    check_mode(Mode, Value).
  378
  379
  380attribute_goals(Var) -->
  381    { get_attr(Var, predicate_options, Attrs) },
  382    option_goals(Attrs, Var).
  383
  384option_goals([], _) --> [].
  385option_goals([H|T], Var) -->
  386    option_goal(H, Var),
  387    option_goals(T, Var).
  388
  389option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)].
  390option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)].
  391
  392
  393                 /*******************************
  394                 *      OUTPUT DECLARATIONS     *
  395                 *******************************/
 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.
  405current_predicate_options(PI, Arg, Options) :-
  406    define_predicate(PI),
  407    setof(Arg-Option,
  408          current_predicate_option_decl(PI, Arg, Option),
  409          Options0),
  410    group_pairs_by_key(Options0, Grouped),
  411    member(Arg-Options, Grouped).
  412
  413current_predicate_option_decl(PI, Arg, Option) :-
  414    current_predicate_option(PI, Arg, Option0),
  415    Option0 =.. [Name|Values],
  416    maplist(mode_and_type, Values, Types),
  417    Option =.. [Name|Types].
  418
  419mode_and_type(Value, ModeAndType) :-
  420    copy_term(Value,_,Goals),
  421    (   memberchk(predicate_option_mode(output, _), Goals)
  422    ->  ModeAndType = -(Type)
  423    ;   ModeAndType = Type
  424    ),
  425    (   memberchk(predicate_option_type(Type, _), Goals)
  426    ->  true
  427    ;   Type = any
  428    ).
  429
  430define_predicate(PI) :-
  431    ground(PI),
  432    !,
  433    PI = M:Name/Arity,
  434    functor(Head, Name, Arity),
  435    once(predicate_property(M:Head, _)).
  436define_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.
  444derived_predicate_options(PI, Arg, Options) :-
  445    define_predicate(PI),
  446    setof(Arg-Option,
  447          derived_predicate_option(PI, Arg, Option),
  448          Options0),
  449    group_pairs_by_key(Options0, Grouped),
  450    member(Arg-Options1, Grouped),
  451    PI = M:_,
  452    phrase(expand_pass_to_options(Options1, M), Options2),
  453    sort(Options2, Options).
  454
  455derived_predicate_option(PI, Arg, Decl) :-
  456    current_option_arg(PI, Arg, DefM),
  457    PI = _:Name/Arity,
  458    functor(Head, Name, Arity),
  459    has_dynamic_option_decl(DefM),
  460    (   has_static_option_decl(DefM),
  461        DefM:'$pred_option'(Head, Decl, _, [])
  462    ;   DefM:'$dyn_pred_option'(Head, Decl, _, [])
  463    ).
 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.
  470expand_pass_to_options([], _) --> [].
  471expand_pass_to_options([H|T], M) -->
  472    expand_pass_to(H, M),
  473    expand_pass_to_options(T, M).
  474
  475expand_pass_to(pass_to(PI, Arg), Module) -->
  476    { strip_module(Module:PI, M, Name/Arity),
  477      functor(Head, Name, Arity),
  478      \+ (   predicate_property(M:Head, exported)
  479         ;   predicate_property(M:Head, public)
  480         ;   M == system
  481         ),
  482      !,
  483      current_predicate_options(M:Name/Arity, Arg, Options)
  484    },
  485    list(Options).
  486expand_pass_to(Option, _) -->
  487    [Option].
  488
  489list([]) --> [].
  490list([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.
  497derived_predicate_options(Module) :-
  498    var(Module),
  499    !,
  500    forall(current_module(Module),
  501           derived_predicate_options(Module)).
  502derived_predicate_options(Module) :-
  503    findall(predicate_options(Module:PI, Arg, Options),
  504            ( derived_predicate_options(Module:PI, Arg, Options),
  505              PI = Name/Arity,
  506              functor(Head, Name, Arity),
  507              (   predicate_property(Module:Head, exported)
  508              ->  true
  509              ;   predicate_property(Module:Head, public)
  510              )
  511            ),
  512            Decls0),
  513    maplist(qualify_decl(Module), Decls0, Decls1),
  514    sort(Decls1, Decls),
  515    (   Decls \== []
  516    ->  format('~N~n~n% Predicate option declarations for module ~q~n~n',
  517               [Module]),
  518        forall(member(Decl, Decls),
  519               portray_clause((:-Decl)))
  520    ;   true
  521    ).
  522
  523qualify_decl(M,
  524             predicate_options(PI0, Arg, Options0),
  525             predicate_options(PI1, Arg, Options1)) :-
  526    qualify(PI0, M, PI1),
  527    maplist(qualify_option(M), Options0, Options1).
  528
  529qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :-
  530    !,
  531    qualify(PI0, M, PI1).
  532qualify_option(_, Opt, Opt).
  533
  534qualify(M:Term, M, Term) :- !.
  535qualify(QTerm, _, QTerm).
  536
  537
  538                 /*******************************
  539                 *            CLEANUP           *
  540                 *******************************/
 retractall_predicate_options is det
Remove all dynamically (derived) predicate options.
  546retractall_predicate_options :-
  547    forall(retract(dyn_option_decl(_,M,_)),
  548           abolish(M:'$dyn_pred_option'/4)).
  549
  550
  551                 /*******************************
  552                 *     COMPILE-TIME CHECKER     *
  553                 *******************************/
  554
  555
  556:- thread_local
  557    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.
  573check_predicate_options :-
  574    forall(current_module(Module),
  575           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.
  587derive_predicate_options :-
  588    derive_predicate_options(NewDecls),
  589    (   NewDecls == []
  590    ->  true
  591    ;   print_message(informational, check_options(new(NewDecls))),
  592        new_decls(NewDecls),
  593        derive_predicate_options
  594    ).
  595
  596new_decls([]).
  597new_decls([predicate_options(PI, A, O)|T]) :-
  598    assert_predicate_options(PI, A, O, _),
  599    new_decls(T).
  600
  601
  602derive_predicate_options(NewDecls) :-
  603    call_cleanup(
  604        ( forall(
  605              current_module(Module),
  606              forall(
  607                  ( predicate_in_module(Module, PI),
  608                    PI = Name/Arity,
  609                    functor(Head, Name, Arity),
  610                    catch(Module:clause(Head, Body, Ref), _, fail)
  611                  ),
  612                  check_clause((Head:-Body), Module, Ref, decl))),
  613          (   setof(Decl, retract(new_decl(Decl)), NewDecls)
  614              ->  true
  615              ;   NewDecls = []
  616          )
  617        ),
  618        retractall(new_decl(_))).
  619
  620
  621check_predicate_options_module(Module) :-
  622    forall(predicate_in_module(Module, PI),
  623           check_predicate_options(Module:PI)).
  624
  625predicate_in_module(Module, PI) :-
  626    current_predicate(Module:PI),
  627    PI = Name/Arity,
  628    functor(Head, Name, Arity),
  629    \+ 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.
  636check_predicate_options(Module:Name/Arity) :-
  637    debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
  638    functor(Head, Name, Arity),
  639    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  640           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
  651check_clause((Head:-Body), M, ClauseRef, Action) :-
  652    !,
  653    catch(check_body(Body, M, _, Action), E, true),
  654    (   var(E)
  655    ->  option_decl(M:Head, Action)
  656    ;   (   clause_info(ClauseRef, File, TermPos, _NameOffset),
  657            TermPos = term_position(_,_,_,_,[_,BodyPos]),
  658            catch(check_body(Body, M, BodyPos, Action),
  659                  error(Formal, ArgPos), true),
  660            compound(ArgPos),
  661            arg(1, ArgPos, CharCount),
  662            integer(CharCount)
  663        ->  Location = file_char_count(File, CharCount)
  664        ;   Location = clause(ClauseRef),
  665            E = error(Formal, _)
  666        ),
  667        print_message(error, predicate_option_error(Formal, Location))
  668    ).
 check_body(+Body, +Module, +TermPos, +Action)
  673:- multifile
  674    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  675    prolog:called_by/2.             % +Goal, -Called
  676
  677check_body(Var, _, _, _) :-
  678    var(Var),
  679    !.
  680check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :-
  681    !,
  682    check_body(G, M, Pos, Action).
  683check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  684    !,
  685    check_body(A, M, PA, Action),
  686    check_body(B, M, PB, Action).
  687check_body((A;B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  688    !,
  689    \+ \+ check_body(A, M, PA, Action),
  690    \+ \+ check_body(B, M, PB, Action).
  691check_body(A=B, _, _, _) :-             % partial evaluation
  692    unify_with_occurs_check(A,B),
  693    !.
  694check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :-
  695    callable(Goal),
  696    functor(Goal, Name, Arity),
  697    (   '$get_predicate_attribute'(M:Goal, imported, DefM)
  698    ->  true
  699    ;   DefM = M
  700    ),
  701    (   eval_option_pred(DefM:Goal)
  702    ->  true
  703    ;   current_option_arg(DefM:Name/Arity, OptArg),
  704        !,
  705        arg(OptArg, Goal, Options),
  706        nth1(OptArg, ArgPosList, ArgPos),
  707        check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action)
  708    ).
  709check_body(Goal, M, _, Action) :-
  710    (   (   predicate_property(M:Goal, imported_from(IM))
  711        ->  true
  712        ;   IM = M
  713        ),
  714        prolog:called_by(Goal, IM, M, Called)
  715    ;   prolog:called_by(Goal, Called)
  716    ),
  717    !,
  718    check_called_by(Called, M, Action).
  719check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :-
  720    '$get_predicate_attribute'(M:Meta, meta_predicate, Head),
  721    !,
  722    check_meta_args(1, Head, Meta, M, ArgPosList, Action).
  723check_body(_, _, _, _).
  724
  725check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :-
  726    arg(I, Head, AS),
  727    !,
  728    (   AS == 0
  729    ->  arg(I, Meta, MA),
  730        check_body(MA, M, ArgPos, Action)
  731    ;   true
  732    ),
  733    succ(I, I2),
  734    check_meta_args(I2, Head, Meta, M, ArgPosList, Action).
  735check_meta_args(_,_,_,_, _, _).
 check_called_by(+CalledBy, +M, +Action) is det
Handle results from prolog:called_by/2.
  741check_called_by([], _, _).
  742check_called_by([H|T], M, Action) :-
  743    (   H = G+N
  744    ->  (   extend(G, N, G2)
  745        ->  check_body(G2, M, _, Action)
  746        ;   true
  747        )
  748    ;   check_body(H, M, _, Action)
  749    ),
  750    check_called_by(T, M, Action).
  751
  752extend(Goal, N, GoalEx) :-
  753    callable(Goal),
  754    Goal =.. List,
  755    length(Extra, N),
  756    append(List, Extra, ListEx),
  757    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).
  767check_options(PI, OptArg, QOptions, ArgPos, Action) :-
  768    debug(predicate_options, '\tChecking call to ~q', [PI]),
  769    remove_qualifier(QOptions, Options),
  770    must_be(list_or_partial_list, Options),
  771    check_option_list(Options, PI, OptArg, Options, ArgPos, Action).
  772
  773remove_qualifier(X, X) :-
  774    var(X),
  775    !.
  776remove_qualifier(_:X, X) :- !.
  777remove_qualifier(X, X).
  778
  779check_option_list(Var,  PI, OptArg, _, _, _) :-
  780    var(Var),
  781    !,
  782    annotate(Var, pass_to(PI, OptArg)).
  783check_option_list([], _, _, _, _, _).
  784check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :-
  785    check_option(PI, OptArg, H, ArgPos, Action),
  786    check_option_list(T, PI, OptArg, Options, ArgPos, Action).
  787
  788check_option(_, _, _, _, decl) :- !.
  789check_option(PI, OptArg, Opt, ArgPos, _) :-
  790    catch(check_predicate_option(PI, OptArg, Opt), E, true),
  791    !,
  792    (   var(E)
  793    ->  true
  794    ;   E = error(Formal,_),
  795        throw(error(Formal,ArgPos))
  796    ).
  797
  798
  799                 /*******************************
  800                 *          ANNOTATIONS         *
  801                 *******************************/
 annotate(+Var, +Term) is det
Use constraints to accumulate annotations about variables. If two annotated variables are unified, the attributes are joined.
  808annotate(Var, Term) :-
  809    (   get_attr(Var, predopts_analysis, Old)
  810    ->  put_attr(Var, predopts_analysis, [Term|Old])
  811    ;   var(Var)
  812    ->  put_attr(Var, predopts_analysis, [Term])
  813    ;   true
  814    ).
  815
  816annotations(Var, Annotations) :-
  817    get_attr(Var, predopts_analysis, Annotations).
  818
  819predopts_analysis:attr_unify_hook(Opts, Value) :-
  820    get_attr(Value, predopts_analysis, Others),
  821    !,
  822    append(Opts, Others, All),
  823    put_attr(Value, predopts_analysis, All).
  824predopts_analysis:attr_unify_hook(_, _).
  825
  826
  827                 /*******************************
  828                 *         PARTIAL EVAL         *
  829                 *******************************/
  830
  831eval_option_pred(swi_option:option(Opt, Options)) :-
  832    processes(Opt, Spec),
  833    annotate(Options, Spec).
  834eval_option_pred(swi_option:option(Opt, Options, _Default)) :-
  835    processes(Opt, Spec),
  836    annotate(Options, Spec).
  837eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :-
  838    ignore(unify_with_occurs_check(Rest, Options)),
  839    processes(Opt, Spec),
  840    annotate(Options, Spec).
  841eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :-
  842    ignore(unify_with_occurs_check(Rest, Options)),
  843    processes(Opt, Spec),
  844    annotate(Options, Spec).
  845eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :-
  846    remove_qualifier(QOptionsIn, OptionsIn),
  847    remove_qualifier(QOptionsOut, OptionsOut),
  848    ignore(unify_with_occurs_check(OptionsIn, OptionsOut)).
  849
  850processes(Opt, Spec) :-
  851    compound(Opt),
  852    functor(Opt, OptName, 1),
  853    Spec =.. [OptName,any].
  854
  855
  856                 /*******************************
  857                 *        NEW DECLARTIONS       *
  858                 *******************************/
 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?
  869option_decl(_, check) :- !.
  870option_decl(M:_, _) :-
  871    system_module(M),
  872    !.
  873option_decl(M:_, _) :-
  874    has_static_option_decl(M),
  875    !.
  876option_decl(M:Head, _) :-
  877    compound(Head),
  878    arg(AP, Head, QA),
  879    remove_qualifier(QA, A),
  880    annotations(A, Annotations0),
  881    functor(Head, Name, Arity),
  882    PI = M:Name/Arity,
  883    delete(Annotations0, pass_to(PI,AP), Annotations),
  884    Annotations \== [],
  885    Decl = predicate_options(PI, AP, Annotations),
  886    (   new_decl(Decl)
  887    ->  true
  888    ;   assert_predicate_options(M:Name/Arity, AP, Annotations, false)
  889    ->  true
  890    ;   assertz(new_decl(Decl)),
  891        debug(predicate_options(decl), '~q', [Decl])
  892    ),
  893    fail.
  894option_decl(_, _).
  895
  896system_module(system) :- !.
  897system_module(Module) :-
  898    sub_atom(Module, 0, _, _, $).
  899
  900
  901                 /*******************************
  902                 *             MISC             *
  903                 *******************************/
  904
  905canonical_pi(M:Name//Arity, M:Name/PArity) :-
  906    integer(Arity),
  907    PArity is Arity+2.
  908canonical_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.
  918resolve_module(Module:Name/Arity, DefM:Name/Arity) :-
  919    functor(Head, Name, Arity),
  920    (   '$get_predicate_attribute'(Module:Head, imported, M)
  921    ->  DefM = M
  922    ;   DefM = Module
  923    ).
  924
  925
  926                 /*******************************
  927                 *            MESSAGES          *
  928                 *******************************/
  929:- multifile
  930    prolog:message//1.  931
  932prolog:message(predicate_option_error(Formal, Location)) -->
  933    error_location(Location),
  934    '$messages':term_message(Formal). % TBD: clean interface
  935prolog:message(check_options(new(Decls))) -->
  936    [ 'Inferred declarations:'-[], nl ],
  937    new_decls(Decls).
  938
  939error_location(file_char_count(File, CharPos)) -->
  940    { filepos_line(File, CharPos, Line, LinePos) },
  941    [ url(File:Line:LinePos), ': ' ].
  942error_location(clause(ClauseRef)) -->
  943    { clause_property(ClauseRef, file(File)),
  944      clause_property(ClauseRef, line_count(Line))
  945    },
  946    !,
  947    [ url(File:Line), ': ' ].
  948error_location(clause(ClauseRef)) -->
  949    [ 'Clause ~q: '-[ClauseRef] ].
  950
  951filepos_line(File, CharPos, Line, LinePos) :-
  952    setup_call_cleanup(
  953        ( open(File, read, In),
  954          open_null_stream(Out)
  955        ),
  956        ( Skip is CharPos-1,
  957          copy_stream_data(In, Out, Skip),
  958          stream_property(In, position(Pos)),
  959          stream_position_data(line_count, Pos, Line),
  960          stream_position_data(line_position, Pos, LinePos)
  961        ),
  962        ( close(Out),
  963          close(In)
  964        )).
  965
  966new_decls([]) --> [].
  967new_decls([H|T]) -->
  968    [ '    :- ~q'-[H], nl ],
  969    new_decls(T).
  970
  971
  972                 /*******************************
  973                 *      SYSTEM DECLARATIONS     *
  974                 *******************************/