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().
144:- multifile option_decl/3, pred_option/3. 145:- dynamic dyn_option_decl/3.
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)), _)).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 *******************************/
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(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).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 336systempredicate_option_type(Type, Arg) :- 337 var(Arg), 338 !, 339 add_attr(Arg, option_type(Type)). 340systempredicate_option_type(callable+_N, Arg) :- 341 !, 342 must_be(callable, Arg). 343systempredicate_option_type(list, Arg) :- 344 !, 345 must_be(list_or_partial_list, Arg). 346systempredicate_option_type(list(Type), Arg) :- 347 !, 348 must_be(list_or_partial_list(Type), Arg). 349systempredicate_option_type(Type, Arg) :- 350 must_be(Type, Arg). 351 352systempredicate_option_mode(_Mode, Arg) :- 353 var(Arg), 354 !. 355systempredicate_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 *******************************/
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(_).
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 ).
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).
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 *******************************/
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.
573check_predicate_options :-
574 forall(current_module(Module),
575 check_predicate_options_module(Module)).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(_)).
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)).
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 ).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(_,_,_,_, _, _).
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.
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 *******************************/
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_analysisattr_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_analysisattr_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 *******************************/
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).
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 932prologmessage(predicate_option_error(Formal, Location)) --> 933 error_location(Location), 934 '$messages':term_message(Formal). % TBD: clean interface 935prologmessage(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 *******************************/
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
typeusing the valuestextandbinary. 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.
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.