1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2011-2016, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(predicate_options,
   36          [ predicate_options/3,                % +PI, +Arg, +Options
   37            assert_predicate_options/4,         % +PI, +Arg, +Options, ?New
   38
   39            current_option_arg/2,               % ?PI, ?Arg
   40            current_predicate_option/3,         % ?PI, ?Arg, ?Option
   41            check_predicate_option/3,           % +PI, +Arg, +Option
   42                                                % Create declarations
   43            current_predicate_options/3,        % ?PI, ?Arg, ?Options
   44            retractall_predicate_options/0,
   45            derived_predicate_options/3,        % :PI, ?Arg, ?Options
   46            derived_predicate_options/1,        % +Module
   47                                                % Checking
   48            check_predicate_options/0,
   49            derive_predicate_options/0,
   50            check_predicate_options/1           % :PredicateIndicator
   51          ]).   52:- use_module(library(lists)).   53:- use_module(library(pairs)).   54:- use_module(library(error)).   55:- use_module(library(lists)).   56:- use_module(library(debug)).   57:- use_module(library(prolog_clause)).   58
   59:- meta_predicate
   60    predicate_options(:, +, +),
   61    assert_predicate_options(:, +, +, ?),
   62    current_predicate_option(:, ?, ?),
   63    check_predicate_option(:, ?, ?),
   64    current_predicate_options(:, ?, ?),
   65    current_option_arg(:, ?),
   66    pred_option(:,-),
   67    derived_predicate_options(:,?,?),
   68    check_predicate_options(:).

  134:- multifile option_decl/3, pred_option/3.  135:- 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:

• Option(ModeAndType) PI processes Option. The option-value must comply to ModeAndType. Mode is one of + or - and Type is a type as accepted by must_be/2.
• pass_to(:PI,Arg) The option-list is passed to the indicated predicate.

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.

  173predicate_options(PI, Arg, Options) :-
  174    throw(error(context_error(nodirective,
  175                              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.

  185assert_predicate_options(PI, Arg, Options, New) :-
  186    canonical_pi(PI, M:Name/Arity),
  187    functor(Head, Name, Arity),
  188    (   dyn_option_decl(Head, M, Arg)
  189    ->  true
  190    ;   New = true,
  191        assertz(dyn_option_decl(Head, M, Arg))
  192    ),
  193    phrase('$predopts':option_clauses(Options, Head, M, Arg),
  194           OptionClauses),
  195    forall(member(Clause, OptionClauses),
  196           assert_option_clause(Clause, New)),
  197    (   var(New)
  198    ->  New = false
  199    ;   true
  200    ).
  201
  202assert_option_clause(Clause, New) :-
  203    rename_clause(Clause, NewClause,
  204                  '$pred_option'(A,B,C,D), '$dyn_pred_option'(A,B,C,D)),
  205    clause_head(NewClause, NewHead),
  206    (   clause(NewHead, _)
  207    ->  true
  208    ;   New = true,
  209        assertz(NewClause)
  210    ).
  211
  212clause_head(M:(Head:-_Body), M:Head) :- !.
  213clause_head((M:Head :-_Body), M:Head) :- !.
  214clause_head(Head, Head).
  215
  216rename_clause(M:Clause, M:NewClause, Head, NewHead) :-
  217    !,
  218    rename_clause(Clause, NewClause, Head, NewHead).
  219rename_clause((Head :- Body), (NewHead :- Body), Head, NewHead) :- !.
  220rename_clause(Head, NewHead, Head, NewHead) :- !.
  221rename_clause(Head, Head, _, _).
  222
  223
  224
  225                 /*******************************
  226                 *        QUERY OPTIONS         *
  227                 *******************************/

 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.

  234current_option_arg(Module:Name/Arity, Arg) :-
  235    current_option_arg(Module:Name/Arity, Arg, _DefM).
  236
  237current_option_arg(Module:Name/Arity, Arg, DefM) :-
  238    atom(Name), integer(Arity),
  239    !,
  240    resolve_module(Module:Name/Arity, DefM:Name/Arity),
  241    functor(Head, Name, Arity),
  242    (   option_decl(Head, DefM, Arg)
  243    ;   dyn_option_decl(Head, DefM, Arg)
  244    ).
  245current_option_arg(M:Name/Arity, Arg, M) :-
  246    (   option_decl(Head, M, Arg)
  247    ;   dyn_option_decl(Head, M, Arg)
  248    ),
  249    functor(Head, Name, Arity).

 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.

  266current_predicate_option(Module:PI, Arg, Option) :-
  267    current_option_arg(Module:PI, Arg, DefM),
  268    PI = Name/Arity,
  269    functor(Head, Name, Arity),
  270    catch(pred_option(DefM:Head, Option),
  271          error(type_error(_,_),_),
  272          fail).

 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.

  285check_predicate_option(Module:PI, Arg, Option) :-
  286    define_predicate(Module:PI),
  287    current_option_arg(Module:PI, Arg, DefM),
  288    PI = Name/Arity,
  289    functor(Head, Name, Arity),
  290    (   pred_option(DefM:Head, Option)
  291    ->  true
  292    ;   existence_error(option, Option)
  293    ).
  294
  295
  296pred_option(M:Head, Option) :-
  297    pred_option(M:Head, Option, []).
  298
  299pred_option(M:Head, Option, Seen) :-
  300    (   has_static_option_decl(M),
  301        M:'$pred_option'(Head, _, Option, Seen)
  302    ;   has_dynamic_option_decl(M),
  303        M:'$dyn_pred_option'(Head, _, Option, Seen)
  304    ).
  305
  306has_static_option_decl(M) :-
  307    '$c_current_predicate'(_, M:'$pred_option'(_,_,_,_)).
  308has_dynamic_option_decl(M) :-
  309    '$c_current_predicate'(_, M:'$dyn_pred_option'(_,_,_,_)).
  310
  311
  312                 /*******************************
  313                 *     TYPE&MODE CONSTRAINTS    *
  314                 *******************************/
  315
  316:- public
  317    system:predicate_option_mode/2,
  318    system:predicate_option_type/2.  319
  320add_attr(Var, Value) :-
  321    (   get_attr(Var, predicate_options, Old)
  322    ->  put_attr(Var, predicate_options, [Value|Old])
  323    ;   put_attr(Var, predicate_options, [Value])
  324    ).
  325
  326system:predicate_option_type(Type, Arg) :-
  327    var(Arg),
  328    !,
  329    add_attr(Arg, option_type(Type)).
  330system:predicate_option_type(Type, Arg) :-
  331    must_be(Type, Arg).
  332
  333system:predicate_option_mode(Mode, Arg) :-
  334    var(Arg),
  335    !,
  336    add_attr(Arg, option_mode(Mode)).
  337system:predicate_option_mode(Mode, Arg) :-
  338    check_mode(Mode, Arg).
  339
  340check_mode(input, Arg) :-
  341    (   nonvar(Arg)
  342    ->  true
  343    ;   instantiation_error(Arg)
  344    ).
  345check_mode(output, Arg) :-
  346    (   var(Arg)
  347    ->  true
  348    ;   uninstantiation_error(Arg)
  349    ).
  350
  351attr_unify_hook([], _).
  352attr_unify_hook([H|T], Var) :-
  353    option_hook(H, Var),
  354    attr_unify_hook(T, Var).
  355
  356option_hook(option_type(Type), Value) :-
  357    is_of_type(Type, Value).
  358option_hook(option_mode(Mode), Value) :-
  359    check_mode(Mode, Value).
  360
  361
  362attribute_goals(Var) -->
  363    { get_attr(Var, predicate_options, Attrs) },
  364    option_goals(Attrs, Var).
  365
  366option_goals([], _) --> [].
  367option_goals([H|T], Var) -->
  368    option_goal(H, Var),
  369    option_goals(T, Var).
  370
  371option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)].
  372option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)].
  373
  374
  375                 /*******************************
  376                 *      OUTPUT DECLARATIONS     *
  377                 *******************************/

 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.

  387current_predicate_options(PI, Arg, Options) :-
  388    define_predicate(PI),
  389    setof(Arg-Option,
  390          current_predicate_option_decl(PI, Arg, Option),
  391          Options0),
  392    group_pairs_by_key(Options0, Grouped),
  393    member(Arg-Options, Grouped).
  394
  395current_predicate_option_decl(PI, Arg, Option) :-
  396    current_predicate_option(PI, Arg, Option0),
  397    Option0 =.. [Name|Values],
  398    maplist(mode_and_type, Values, Types),
  399    Option =.. [Name|Types].
  400
  401mode_and_type(Value, ModeAndType) :-
  402    copy_term(Value,_,Goals),
  403    (   memberchk(predicate_option_mode(output, _), Goals)
  404    ->  ModeAndType = -(Type)
  405    ;   ModeAndType = Type
  406    ),
  407    (   memberchk(predicate_option_type(Type, _), Goals)
  408    ->  true
  409    ;   Type = any
  410    ).
  411
  412define_predicate(PI) :-
  413    ground(PI),
  414    !,
  415    PI = M:Name/Arity,
  416    functor(Head, Name, Arity),
  417    once(predicate_property(M:Head, _)).
  418define_predicate(_).

 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.

  426derived_predicate_options(PI, Arg, Options) :-
  427    define_predicate(PI),
  428    setof(Arg-Option,
  429          derived_predicate_option(PI, Arg, Option),
  430          Options0),
  431    group_pairs_by_key(Options0, Grouped),
  432    member(Arg-Options1, Grouped),
  433    PI = M:_,
  434    phrase(expand_pass_to_options(Options1, M), Options2),
  435    sort(Options2, Options).
  436
  437derived_predicate_option(PI, Arg, Decl) :-
  438    current_option_arg(PI, Arg, DefM),
  439    PI = _:Name/Arity,
  440    functor(Head, Name, Arity),
  441    has_dynamic_option_decl(DefM),
  442    (   has_static_option_decl(DefM),
  443        DefM:'$pred_option'(Head, Decl, _, [])
  444    ;   DefM:'$dyn_pred_option'(Head, Decl, _, [])
  445    ).

 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.

  452expand_pass_to_options([], _) --> [].
  453expand_pass_to_options([H|T], M) -->
  454    expand_pass_to(H, M),
  455    expand_pass_to_options(T, M).
  456
  457expand_pass_to(pass_to(PI, Arg), Module) -->
  458    { strip_module(Module:PI, M, Name/Arity),
  459      functor(Head, Name, Arity),
  460      \+ (   predicate_property(M:Head, exported)
  461         ;   predicate_property(M:Head, public)
  462         ;   M == system
  463         ),
  464      !,
  465      current_predicate_options(M:Name/Arity, Arg, Options)
  466    },
  467    list(Options).
  468expand_pass_to(Option, _) -->
  469    [Option].
  470
  471list([]) --> [].
  472list([H|T]) --> [H], list(T).

 derived_predicate_options(+Module) is det

Derive predicate option declarations for a module. The derived options are printed to the current_output stream.

  479derived_predicate_options(Module) :-
  480    var(Module),
  481    !,
  482    forall(current_module(Module),
  483           derived_predicate_options(Module)).
  484derived_predicate_options(Module) :-
  485    findall(predicate_options(Module:PI, Arg, Options),
  486            ( derived_predicate_options(Module:PI, Arg, Options),
  487              PI = Name/Arity,
  488              functor(Head, Name, Arity),
  489              (   predicate_property(Module:Head, exported)
  490              ->  true
  491              ;   predicate_property(Module:Head, public)
  492              )
  493            ),
  494            Decls0),
  495    maplist(qualify_decl(Module), Decls0, Decls1),
  496    sort(Decls1, Decls),
  497    (   Decls \== []
  498    ->  format('~N~n~n% Predicate option declarations for module ~q~n~n',
  499               [Module]),
  500        forall(member(Decl, Decls),
  501               portray_clause((:-Decl)))
  502    ;   true
  503    ).
  504
  505qualify_decl(M,
  506             predicate_options(PI0, Arg, Options0),
  507             predicate_options(PI1, Arg, Options1)) :-
  508    qualify(PI0, M, PI1),
  509    maplist(qualify_option(M), Options0, Options1).
  510
  511qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :-
  512    !,
  513    qualify(PI0, M, PI1).
  514qualify_option(_, Opt, Opt).
  515
  516qualify(M:Term, M, Term) :- !.
  517qualify(QTerm, _, QTerm).
  518
  519
  520                 /*******************************
  521                 *            CLEANUP           *
  522                 *******************************/

 retractall_predicate_options is det

Remove all dynamically (derived) predicate options.

  528retractall_predicate_options :-
  529    forall(retract(dyn_option_decl(_,M,_)),
  530           abolish(M:'$dyn_pred_option'/4)).
  531
  532
  533                 /*******************************
  534                 *     COMPILE-TIME CHECKER     *
  535                 *******************************/
  536
  537
  538:- thread_local
  539    new_decl/1.

 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.

  555check_predicate_options :-
  556    forall(current_module(Module),
  557           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.

  569derive_predicate_options :-
  570    derive_predicate_options(NewDecls),
  571    (   NewDecls == []
  572    ->  true
  573    ;   print_message(informational, check_options(new(NewDecls))),
  574        new_decls(NewDecls),
  575        derive_predicate_options
  576    ).
  577
  578new_decls([]).
  579new_decls([predicate_options(PI, A, O)|T]) :-
  580    assert_predicate_options(PI, A, O, _),
  581    new_decls(T).
  582
  583
  584derive_predicate_options(NewDecls) :-
  585    call_cleanup(
  586        ( forall(
  587              current_module(Module),
  588              forall(
  589                  ( predicate_in_module(Module, PI),
  590                    PI = Name/Arity,
  591                    functor(Head, Name, Arity),
  592                    catch(Module:clause(Head, Body, Ref), _, fail)
  593                  ),
  594                  check_clause((Head:-Body), Module, Ref, decl))),
  595          (   setof(Decl, retract(new_decl(Decl)), NewDecls)
  596              ->  true
  597              ;   NewDecls = []
  598          )
  599        ),
  600        retractall(new_decl(_))).
  601
  602
  603check_predicate_options_module(Module) :-
  604    forall(predicate_in_module(Module, PI),
  605           check_predicate_options(Module:PI)).
  606
  607predicate_in_module(Module, PI) :-
  608    current_predicate(Module:PI),
  609    PI = Name/Arity,
  610    functor(Head, Name, Arity),
  611    \+ predicate_property(Module:Head, imported_from(_)).

 check_predicate_options(:PredicateIndicator) is det

Verify calls to predicates that have options in all clauses of the predicate indicated by PredicateIndicator.

  618check_predicate_options(Module:Name/Arity) :-
  619    debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
  620    functor(Head, Name, Arity),
  621    forall(catch(Module:clause(Head, Body, Ref), _, fail),
  622           check_clause((Head:-Body), Module, Ref, check)).

 check_clause(+Clause, +Module, +Ref, +Action) is det

Action is one of

decl

Create additional declarations

check

Produce error messages

  633check_clause((Head:-Body), M, ClauseRef, Action) :-
  634    !,
  635    catch(check_body(Body, M, _, Action), E, true),
  636    (   var(E)
  637    ->  option_decl(M:Head, Action)
  638    ;   (   clause_info(ClauseRef, File, TermPos, _NameOffset),
  639            TermPos = term_position(_,_,_,_,[_,BodyPos]),
  640            catch(check_body(Body, M, BodyPos, Action),
  641                  error(Formal, ArgPos), true),
  642            compound(ArgPos),
  643            arg(1, ArgPos, CharCount),
  644            integer(CharCount)
  645        ->  Location = file_char_count(File, CharCount)
  646        ;   Location = clause(ClauseRef),
  647            E = error(Formal, _)
  648        ),
  649        print_message(error, predicate_option_error(Formal, Location))
  650    ).

 check_body(+Body, +Module, +TermPos, +Action)

  655:- multifile
  656    prolog:called_by/4,             % +Goal, +Module, +Context, -Called
  657    prolog:called_by/2.             % +Goal, -Called
  658
  659check_body(Var, _, _, _) :-
  660    var(Var),
  661    !.
  662check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :-
  663    !,
  664    check_body(G, M, Pos, Action).
  665check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :-
  666    !,
  667    check_body(A, M, PA, Action),
  668    check_body(B, M, PB, Action).
  669check_body(A=B, _, _, _) :-             % partial evaluation
  670    unify_with_occurs_check(A,B),
  671    !.
  672check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :-
  673    callable(Goal),
  674    functor(Goal, Name, Arity),
  675    (   '$get_predicate_attribute'(M:Goal, imported, DefM)
  676    ->  true
  677    ;   DefM = M
  678    ),
  679    (   eval_option_pred(DefM:Goal)
  680    ->  true
  681    ;   current_option_arg(DefM:Name/Arity, OptArg),
  682        !,
  683        arg(OptArg, Goal, Options),
  684        nth1(OptArg, ArgPosList, ArgPos),
  685        check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action)
  686    ).
  687check_body(Goal, M, _, Action) :-
  688    (   (   predicate_property(M:Goal, imported_from(IM))
  689        ->  true
  690        ;   IM = M
  691        ),
  692        prolog:called_by(Goal, IM, M, Called)
  693    ;   prolog:called_by(Goal, Called)
  694    ),
  695    !,
  696    check_called_by(Called, M, Action).
  697check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :-
  698    '$get_predicate_attribute'(M:Meta, meta_predicate, Head),
  699    !,
  700    check_meta_args(1, Head, Meta, M, ArgPosList, Action).
  701check_body(_, _, _, _).
  702
  703check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :-
  704    arg(I, Head, AS),
  705    !,
  706    (   AS == 0
  707    ->  arg(I, Meta, MA),
  708        check_body(MA, M, ArgPos, Action)
  709    ;   true
  710    ),
  711    succ(I, I2),
  712    check_meta_args(I2, Head, Meta, M, ArgPosList, Action).
  713check_meta_args(_,_,_,_, _, _).

 check_called_by(+CalledBy, +M, +Action) is det

Handle results from prolog:called_by/2.

  719check_called_by([], _, _).
  720check_called_by([H|T], M, Action) :-
  721    (   H = G+N
  722    ->  (   extend(G, N, G2)
  723        ->  check_body(G2, M, _, Action)
  724        ;   true
  725        )
  726    ;   check_body(H, M, _, Action)
  727    ),
  728    check_called_by(T, M, Action).
  729
  730extend(Goal, N, GoalEx) :-
  731    callable(Goal),
  732    Goal =.. List,
  733    length(Extra, N),
  734    append(List, Extra, ListEx),
  735    GoalEx =.. ListEx.

 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).

  745check_options(PI, OptArg, QOptions, ArgPos, Action) :-
  746    debug(predicate_options, '\tChecking call to ~q', [PI]),
  747    remove_qualifier(QOptions, Options),
  748    must_be(list_or_partial_list, Options),
  749    check_option_list(Options, PI, OptArg, Options, ArgPos, Action).
  750
  751remove_qualifier(X, X) :-
  752    var(X),
  753    !.
  754remove_qualifier(_:X, X) :- !.
  755remove_qualifier(X, X).
  756
  757check_option_list(Var,  PI, OptArg, _, _, _) :-
  758    var(Var),
  759    !,
  760    annotate(Var, pass_to(PI, OptArg)).
  761check_option_list([], _, _, _, _, _).
  762check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :-
  763    check_option(PI, OptArg, H, ArgPos, Action),
  764    check_option_list(T, PI, OptArg, Options, ArgPos, Action).
  765
  766check_option(_, _, _, _, decl) :- !.
  767check_option(PI, OptArg, Opt, ArgPos, _) :-
  768    catch(check_predicate_option(PI, OptArg, Opt), E, true),
  769    !,
  770    (   var(E)
  771    ->  true
  772    ;   E = error(Formal,_),
  773        throw(error(Formal,ArgPos))
  774    ).
  775
  776
  777                 /*******************************
  778                 *          ANNOTATIONS         *
  779                 *******************************/

 annotate(+Var, +Term) is det

Use constraints to accumulate annotations about variables. If two annotated variables are unified, the attributes are joined.

  786annotate(Var, Term) :-
  787    (   get_attr(Var, predopts_analysis, Old)
  788    ->  put_attr(Var, predopts_analysis, [Term|Old])
  789    ;   var(Var)
  790    ->  put_attr(Var, predopts_analysis, [Term])
  791    ;   true
  792    ).
  793
  794annotations(Var, Annotations) :-
  795    get_attr(Var, predopts_analysis, Annotations).
  796
  797predopts_analysis:attr_unify_hook(Opts, Value) :-
  798    get_attr(Value, predopts_analysis, Others),
  799    !,
  800    append(Opts, Others, All),
  801    put_attr(Value, predopts_analysis, All).
  802predopts_analysis:attr_unify_hook(_, _).
  803
  804
  805                 /*******************************
  806                 *         PARTIAL EVAL         *
  807                 *******************************/
  808
  809eval_option_pred(swi_option:option(Opt, Options)) :-
  810    processes(Opt, Spec),
  811    annotate(Options, Spec).
  812eval_option_pred(swi_option:option(Opt, Options, _Default)) :-
  813    processes(Opt, Spec),
  814    annotate(Options, Spec).
  815eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :-
  816    ignore(unify_with_occurs_check(Rest, Options)),
  817    processes(Opt, Spec),
  818    annotate(Options, Spec).
  819eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :-
  820    ignore(unify_with_occurs_check(Rest, Options)),
  821    processes(Opt, Spec),
  822    annotate(Options, Spec).
  823eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :-
  824    remove_qualifier(QOptionsIn, OptionsIn),
  825    remove_qualifier(QOptionsOut, OptionsOut),
  826    ignore(unify_with_occurs_check(OptionsIn, OptionsOut)).
  827
  828processes(Opt, Spec) :-
  829    compound(Opt),
  830    functor(Opt, OptName, 1),
  831    Spec =.. [OptName,any].
  832
  833
  834                 /*******************************
  835                 *        NEW DECLARTIONS       *
  836                 *******************************/

 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?

  847option_decl(_, check) :- !.
  848option_decl(M:_, _) :-
  849    system_module(M),
  850    !.
  851option_decl(M:_, _) :-
  852    has_static_option_decl(M),
  853    !.
  854option_decl(M:Head, _) :-
  855    compound(Head),
  856    arg(AP, Head, QA),
  857    remove_qualifier(QA, A),
  858    annotations(A, Annotations0),
  859    functor(Head, Name, Arity),
  860    PI = M:Name/Arity,
  861    delete(Annotations0, pass_to(PI,AP), Annotations),
  862    Annotations \== [],
  863    Decl = predicate_options(PI, AP, Annotations),
  864    (   new_decl(Decl)
  865    ->  true
  866    ;   assert_predicate_options(M:Name/Arity, AP, Annotations, false)
  867    ->  true
  868    ;   assertz(new_decl(Decl)),
  869        debug(predicate_options(decl), '~q', [Decl])
  870    ),
  871    fail.
  872option_decl(_, _).
  873
  874system_module(system) :- !.
  875system_module(Module) :-
  876    sub_atom(Module, 0, _, _, $).
  877
  878
  879                 /*******************************
  880                 *             MISC             *
  881                 *******************************/
  882
  883canonical_pi(M:Name//Arity, M:Name/PArity) :-
  884    integer(Arity),
  885    PArity is Arity+2.
  886canonical_pi(PI, PI).

 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.

  896resolve_module(Module:Name/Arity, DefM:Name/Arity) :-
  897    functor(Head, Name, Arity),
  898    (   '$get_predicate_attribute'(Module:Head, imported, M)
  899    ->  DefM = M
  900    ;   DefM = Module
  901    ).
  902
  903
  904                 /*******************************
  905                 *            MESSAGES          *
  906                 *******************************/
  907:- multifile
  908    prolog:message//1.  909
  910prolog:message(predicate_option_error(Formal, Location)) -->
  911    error_location(Location),
  912    '$messages':term_message(Formal). % TBD: clean interface
  913prolog:message(check_options(new(Decls))) -->
  914    [ 'Inferred declarations:'-[], nl ],
  915    new_decls(Decls).
  916
  917error_location(file_char_count(File, CharPos)) -->
  918    { filepos_line(File, CharPos, Line, LinePos) },
  919    [ '~w:~d:~d: '-[File, Line, LinePos] ].
  920error_location(clause(ClauseRef)) -->
  921    { clause_property(ClauseRef, file(File)),
  922      clause_property(ClauseRef, line_count(Line))
  923    },
  924    !,
  925    [ '~w:~d: '-[File, Line] ].
  926error_location(clause(ClauseRef)) -->
  927    [ 'Clause ~q: '-[ClauseRef] ].
  928
  929filepos_line(File, CharPos, Line, LinePos) :-
  930    setup_call_cleanup(
  931        ( open(File, read, In),
  932          open_null_stream(Out)
  933        ),
  934        ( Skip is CharPos-1,
  935          copy_stream_data(In, Out, Skip),
  936          stream_property(In, position(Pos)),
  937          stream_position_data(line_count, Pos, Line),
  938          stream_position_data(line_position, Pos, LinePos)
  939        ),
  940        ( close(Out),
  941          close(In)
  942        )).
  943
  944new_decls([]) --> [].
  945new_decls([H|T]) -->
  946    [ '    :- ~q'-[H], nl ],
  947    new_decls(T).
  948
  949
  950                 /*******************************
  951                 *      SYSTEM DECLARATIONS     *
  952                 *******************************/
  953
  954:- use_module(library(dialect/swi/syspred_options)).