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