1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2011-2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(predicate_options, 36 [ predicate_options/3, % +PI, +Arg, +Options 37 assert_predicate_options/4, % +PI, +Arg, +Options, ?New 38 39 current_option_arg/2, % ?PI, ?Arg 40 current_predicate_option/3, % ?PI, ?Arg, ?Option 41 check_predicate_option/3, % +PI, +Arg, +Option 42 % Create declarations 43 current_predicate_options/3, % ?PI, ?Arg, ?Options 44 retractall_predicate_options/0, 45 derived_predicate_options/3, % :PI, ?Arg, ?Options 46 derived_predicate_options/1, % +Module 47 % Checking 48 check_predicate_options/0, 49 derive_predicate_options/0, 50 check_predicate_options/1 % :PredicateIndicator 51 ]). 52:- autoload(library(apply),[maplist/3]). 53:- autoload(library(debug),[debug/3]). 54:- autoload(library(error), 55 [ existence_error/2, 56 must_be/2, 57 instantiation_error/1, 58 uninstantiation_error/1, 59 is_of_type/2 60 ]). 61:- 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(M:Head, Option) :- 307 pred_option(M: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(Type, Arg) :- 341 must_be(Type, Arg). 342 343systempredicate_option_mode(Mode, Arg) :- 344 var(Arg), 345 !, 346 add_attr(Arg, option_mode(Mode)). 347systempredicate_option_mode(Mode, Arg) :- 348 check_mode(Mode, Arg). 349 350check_mode(input, Arg) :- 351 ( nonvar(Arg) 352 -> true 353 ; instantiation_error(Arg) 354 ). 355check_mode(output, Arg) :- 356 ( var(Arg) 357 -> true 358 ; uninstantiation_error(Arg) 359 ). 360 361attr_unify_hook([], _). 362attr_unify_hook([H|T], Var) :- 363 option_hook(H, Var), 364 attr_unify_hook(T, Var). 365 366option_hook(option_type(Type), Value) :- 367 is_of_type(Type, Value). 368option_hook(option_mode(Mode), Value) :- 369 check_mode(Mode, Value). 370 371 372attribute_goals(Var) --> 373 { get_attr(Var, predicate_options, Attrs) }, 374 option_goals(Attrs, Var). 375 376option_goals([], _) --> []. 377option_goals([H|T], Var) --> 378 option_goal(H, Var), 379 option_goals(T, Var). 380 381option_goal(option_type(Type), Var) --> [predicate_option_type(Type, Var)]. 382option_goal(option_mode(Mode), Var) --> [predicate_option_mode(Mode, Var)]. 383 384 385 /******************************* 386 * OUTPUT DECLARATIONS * 387 *******************************/
397current_predicate_options(PI, Arg, Options) :- 398 define_predicate(PI), 399 setof(Arg-Option, 400 current_predicate_option_decl(PI, Arg, Option), 401 Options0), 402 group_pairs_by_key(Options0, Grouped), 403 member(Arg-Options, Grouped). 404 405current_predicate_option_decl(PI, Arg, Option) :- 406 current_predicate_option(PI, Arg, Option0), 407 Option0 =.. [Name|Values], 408 maplist(mode_and_type, Values, Types), 409 Option =.. [Name|Types]. 410 411mode_and_type(Value, ModeAndType) :- 412 copy_term(Value,_,Goals), 413 ( memberchk(predicate_option_mode(output, _), Goals) 414 -> ModeAndType = -(Type) 415 ; ModeAndType = Type 416 ), 417 ( memberchk(predicate_option_type(Type, _), Goals) 418 -> true 419 ; Type = any 420 ). 421 422define_predicate(PI) :- 423 ground(PI), 424 !, 425 PI = M:Name/Arity, 426 functor(Head, Name, Arity), 427 once(predicate_property(M:Head, _)). 428define_predicate(_).
436derived_predicate_options(PI, Arg, Options) :- 437 define_predicate(PI), 438 setof(Arg-Option, 439 derived_predicate_option(PI, Arg, Option), 440 Options0), 441 group_pairs_by_key(Options0, Grouped), 442 member(Arg-Options1, Grouped), 443 PI = M:_, 444 phrase(expand_pass_to_options(Options1, M), Options2), 445 sort(Options2, Options). 446 447derived_predicate_option(PI, Arg, Decl) :- 448 current_option_arg(PI, Arg, DefM), 449 PI = _:Name/Arity, 450 functor(Head, Name, Arity), 451 has_dynamic_option_decl(DefM), 452 ( has_static_option_decl(DefM), 453 DefM:'$pred_option'(Head, Decl, _, []) 454 ; DefM:'$dyn_pred_option'(Head, Decl, _, []) 455 ).
pass_to(PI,Arg) if PI does not refer to a
public predicate.462expand_pass_to_options([], _) --> []. 463expand_pass_to_options([H|T], M) --> 464 expand_pass_to(H, M), 465 expand_pass_to_options(T, M). 466 467expand_pass_to(pass_to(PI, Arg), Module) --> 468 { strip_module(Module:PI, M, Name/Arity), 469 functor(Head, Name, Arity), 470 \+ ( predicate_property(M:Head, exported) 471 ; predicate_property(M:Head, public) 472 ; M == system 473 ), 474 !, 475 current_predicate_options(M:Name/Arity, Arg, Options) 476 }, 477 list(Options). 478expand_pass_to(Option, _) --> 479 [Option]. 480 481list([]) --> []. 482list([H|T]) --> [H], list(T).
current_output stream.489derived_predicate_options(Module) :- 490 var(Module), 491 !, 492 forall(current_module(Module), 493 derived_predicate_options(Module)). 494derived_predicate_options(Module) :- 495 findall(predicate_options(Module:PI, Arg, Options), 496 ( derived_predicate_options(Module:PI, Arg, Options), 497 PI = Name/Arity, 498 functor(Head, Name, Arity), 499 ( predicate_property(Module:Head, exported) 500 -> true 501 ; predicate_property(Module:Head, public) 502 ) 503 ), 504 Decls0), 505 maplist(qualify_decl(Module), Decls0, Decls1), 506 sort(Decls1, Decls), 507 ( Decls \== [] 508 -> format('~N~n~n% Predicate option declarations for module ~q~n~n', 509 [Module]), 510 forall(member(Decl, Decls), 511 portray_clause((:-Decl))) 512 ; true 513 ). 514 515qualify_decl(M, 516 predicate_options(PI0, Arg, Options0), 517 predicate_options(PI1, Arg, Options1)) :- 518 qualify(PI0, M, PI1), 519 maplist(qualify_option(M), Options0, Options1). 520 521qualify_option(M, pass_to(PI0, Arg), pass_to(PI1, Arg)) :- 522 !, 523 qualify(PI0, M, PI1). 524qualify_option(_, Opt, Opt). 525 526qualify(M:Term, M, Term) :- !. 527qualify(QTerm, _, QTerm). 528 529 530 /******************************* 531 * CLEANUP * 532 *******************************/
538retractall_predicate_options :- 539 forall(retract(dyn_option_decl(_,M,_)), 540 abolish(M:'$dyn_pred_option'/4)). 541 542 543 /******************************* 544 * COMPILE-TIME CHECKER * 545 *******************************/ 546 547 548:- thread_local 549 new_decl/1.
565check_predicate_options :-
566 forall(current_module(Module),
567 check_predicate_options_module(Module)).579derive_predicate_options :- 580 derive_predicate_options(NewDecls), 581 ( NewDecls == [] 582 -> true 583 ; print_message(informational, check_options(new(NewDecls))), 584 new_decls(NewDecls), 585 derive_predicate_options 586 ). 587 588new_decls([]). 589new_decls([predicate_options(PI, A, O)|T]) :- 590 assert_predicate_options(PI, A, O, _), 591 new_decls(T). 592 593 594derive_predicate_options(NewDecls) :- 595 call_cleanup( 596 ( forall( 597 current_module(Module), 598 forall( 599 ( predicate_in_module(Module, PI), 600 PI = Name/Arity, 601 functor(Head, Name, Arity), 602 catch(Module:clause(Head, Body, Ref), _, fail) 603 ), 604 check_clause((Head:-Body), Module, Ref, decl))), 605 ( setof(Decl, retract(new_decl(Decl)), NewDecls) 606 -> true 607 ; NewDecls = [] 608 ) 609 ), 610 retractall(new_decl(_))). 611 612 613check_predicate_options_module(Module) :- 614 forall(predicate_in_module(Module, PI), 615 check_predicate_options(Module:PI)). 616 617predicate_in_module(Module, PI) :- 618 current_predicate(Module:PI), 619 PI = Name/Arity, 620 functor(Head, Name, Arity), 621 \+ predicate_property(Module:Head, imported_from(_)).
628check_predicate_options(Module:Name/Arity) :-
629 debug(predicate_options, 'Checking ~q', [Module:Name/Arity]),
630 functor(Head, Name, Arity),
631 forall(catch(Module:clause(Head, Body, Ref), _, fail),
632 check_clause((Head:-Body), Module, Ref, check)).
643check_clause((Head:-Body), M, ClauseRef, Action) :-
644 !,
645 catch(check_body(Body, M, _, Action), E, true),
646 ( var(E)
647 -> option_decl(M:Head, Action)
648 ; ( clause_info(ClauseRef, File, TermPos, _NameOffset),
649 TermPos = term_position(_,_,_,_,[_,BodyPos]),
650 catch(check_body(Body, M, BodyPos, Action),
651 error(Formal, ArgPos), true),
652 compound(ArgPos),
653 arg(1, ArgPos, CharCount),
654 integer(CharCount)
655 -> Location = file_char_count(File, CharCount)
656 ; Location = clause(ClauseRef),
657 E = error(Formal, _)
658 ),
659 print_message(error, predicate_option_error(Formal, Location))
660 ).665:- multifile 666 prolog:called_by/4, % +Goal, +Module, +Context, -Called 667 prolog:called_by/2. % +Goal, -Called 668 669check_body(Var, _, _, _) :- 670 var(Var), 671 !. 672check_body(M:G, _, term_position(_,_,_,_,[_,Pos]), Action) :- 673 !, 674 check_body(G, M, Pos, Action). 675check_body((A,B), M, term_position(_,_,_,_,[PA,PB]), Action) :- 676 !, 677 check_body(A, M, PA, Action), 678 check_body(B, M, PB, Action). 679check_body(A=B, _, _, _) :- % partial evaluation 680 unify_with_occurs_check(A,B), 681 !. 682check_body(Goal, M, term_position(_,_,_,_,ArgPosList), Action) :- 683 callable(Goal), 684 functor(Goal, Name, Arity), 685 ( '$get_predicate_attribute'(M:Goal, imported, DefM) 686 -> true 687 ; DefM = M 688 ), 689 ( eval_option_pred(DefM:Goal) 690 -> true 691 ; current_option_arg(DefM:Name/Arity, OptArg), 692 !, 693 arg(OptArg, Goal, Options), 694 nth1(OptArg, ArgPosList, ArgPos), 695 check_options(DefM:Name/Arity, OptArg, Options, ArgPos, Action) 696 ). 697check_body(Goal, M, _, Action) :- 698 ( ( predicate_property(M:Goal, imported_from(IM)) 699 -> true 700 ; IM = M 701 ), 702 prolog:called_by(Goal, IM, M, Called) 703 ; prolog:called_by(Goal, Called) 704 ), 705 !, 706 check_called_by(Called, M, Action). 707check_body(Meta, M, term_position(_,_,_,_,ArgPosList), Action) :- 708 '$get_predicate_attribute'(M:Meta, meta_predicate, Head), 709 !, 710 check_meta_args(1, Head, Meta, M, ArgPosList, Action). 711check_body(_, _, _, _). 712 713check_meta_args(I, Head, Meta, M, [ArgPos|ArgPosList], Action) :- 714 arg(I, Head, AS), 715 !, 716 ( AS == 0 717 -> arg(I, Meta, MA), 718 check_body(MA, M, ArgPos, Action) 719 ; true 720 ), 721 succ(I, I2), 722 check_meta_args(I2, Head, Meta, M, ArgPosList, Action). 723check_meta_args(_,_,_,_, _, _).
729check_called_by([], _, _). 730check_called_by([H|T], M, Action) :- 731 ( H = G+N 732 -> ( extend(G, N, G2) 733 -> check_body(G2, M, _, Action) 734 ; true 735 ) 736 ; check_body(H, M, _, Action) 737 ), 738 check_called_by(T, M, Action). 739 740extend(Goal, N, GoalEx) :- 741 callable(Goal), 742 Goal =.. List, 743 length(Extra, N), 744 append(List, Extra, ListEx), 745 GoalEx =.. ListEx.
pass_to(PI, OptArg).755check_options(PI, OptArg, QOptions, ArgPos, Action) :- 756 debug(predicate_options, '\tChecking call to ~q', [PI]), 757 remove_qualifier(QOptions, Options), 758 must_be(list_or_partial_list, Options), 759 check_option_list(Options, PI, OptArg, Options, ArgPos, Action). 760 761remove_qualifier(X, X) :- 762 var(X), 763 !. 764remove_qualifier(_:X, X) :- !. 765remove_qualifier(X, X). 766 767check_option_list(Var, PI, OptArg, _, _, _) :- 768 var(Var), 769 !, 770 annotate(Var, pass_to(PI, OptArg)). 771check_option_list([], _, _, _, _, _). 772check_option_list([H|T], PI, OptArg, Options, ArgPos, Action) :- 773 check_option(PI, OptArg, H, ArgPos, Action), 774 check_option_list(T, PI, OptArg, Options, ArgPos, Action). 775 776check_option(_, _, _, _, decl) :- !. 777check_option(PI, OptArg, Opt, ArgPos, _) :- 778 catch(check_predicate_option(PI, OptArg, Opt), E, true), 779 !, 780 ( var(E) 781 -> true 782 ; E = error(Formal,_), 783 throw(error(Formal,ArgPos)) 784 ). 785 786 787 /******************************* 788 * ANNOTATIONS * 789 *******************************/
796annotate(Var, Term) :- 797 ( get_attr(Var, predopts_analysis, Old) 798 -> put_attr(Var, predopts_analysis, [Term|Old]) 799 ; var(Var) 800 -> put_attr(Var, predopts_analysis, [Term]) 801 ; true 802 ). 803 804annotations(Var, Annotations) :- 805 get_attr(Var, predopts_analysis, Annotations). 806 807predopts_analysisattr_unify_hook(Opts, Value) :- 808 get_attr(Value, predopts_analysis, Others), 809 !, 810 append(Opts, Others, All), 811 put_attr(Value, predopts_analysis, All). 812predopts_analysisattr_unify_hook(_, _). 813 814 815 /******************************* 816 * PARTIAL EVAL * 817 *******************************/ 818 819eval_option_pred(swi_option:option(Opt, Options)) :- 820 processes(Opt, Spec), 821 annotate(Options, Spec). 822eval_option_pred(swi_option:option(Opt, Options, _Default)) :- 823 processes(Opt, Spec), 824 annotate(Options, Spec). 825eval_option_pred(swi_option:select_option(Opt, Options, Rest)) :- 826 ignore(unify_with_occurs_check(Rest, Options)), 827 processes(Opt, Spec), 828 annotate(Options, Spec). 829eval_option_pred(swi_option:select_option(Opt, Options, Rest, _Default)) :- 830 ignore(unify_with_occurs_check(Rest, Options)), 831 processes(Opt, Spec), 832 annotate(Options, Spec). 833eval_option_pred(swi_option:meta_options(_Cond, QOptionsIn, QOptionsOut)) :- 834 remove_qualifier(QOptionsIn, OptionsIn), 835 remove_qualifier(QOptionsOut, OptionsOut), 836 ignore(unify_with_occurs_check(OptionsIn, OptionsOut)). 837 838processes(Opt, Spec) :- 839 compound(Opt), 840 functor(Opt, OptName, 1), 841 Spec =.. [OptName,any]. 842 843 844 /******************************* 845 * NEW DECLARTIONS * 846 *******************************/
857option_decl(_, check) :- !. 858option_decl(M:_, _) :- 859 system_module(M), 860 !. 861option_decl(M:_, _) :- 862 has_static_option_decl(M), 863 !. 864option_decl(M:Head, _) :- 865 compound(Head), 866 arg(AP, Head, QA), 867 remove_qualifier(QA, A), 868 annotations(A, Annotations0), 869 functor(Head, Name, Arity), 870 PI = M:Name/Arity, 871 delete(Annotations0, pass_to(PI,AP), Annotations), 872 Annotations \== [], 873 Decl = predicate_options(PI, AP, Annotations), 874 ( new_decl(Decl) 875 -> true 876 ; assert_predicate_options(M:Name/Arity, AP, Annotations, false) 877 -> true 878 ; assertz(new_decl(Decl)), 879 debug(predicate_options(decl), '~q', [Decl]) 880 ), 881 fail. 882option_decl(_, _). 883 884system_module(system) :- !. 885system_module(Module) :- 886 sub_atom(Module, 0, _, _, $). 887 888 889 /******************************* 890 * MISC * 891 *******************************/ 892 893canonical_pi(M:Name//Arity, M:Name/PArity) :- 894 integer(Arity), 895 PArity is Arity+2. 896canonical_pi(PI, PI).
906resolve_module(Module:Name/Arity, DefM:Name/Arity) :- 907 functor(Head, Name, Arity), 908 ( '$get_predicate_attribute'(Module:Head, imported, M) 909 -> DefM = M 910 ; DefM = Module 911 ). 912 913 914 /******************************* 915 * MESSAGES * 916 *******************************/ 917:- multifile 918 prolog:message//1. 919 920prologmessage(predicate_option_error(Formal, Location)) --> 921 error_location(Location), 922 '$messages':term_message(Formal). % TBD: clean interface 923prologmessage(check_options(new(Decls))) --> 924 [ 'Inferred declarations:'-[], nl ], 925 new_decls(Decls). 926 927error_location(file_char_count(File, CharPos)) --> 928 { filepos_line(File, CharPos, Line, LinePos) }, 929 [ url(File:Line:LinePos), ': ' ]. 930error_location(clause(ClauseRef)) --> 931 { clause_property(ClauseRef, file(File)), 932 clause_property(ClauseRef, line_count(Line)) 933 }, 934 !, 935 [ url(File:Line), ': ' ]. 936error_location(clause(ClauseRef)) --> 937 [ 'Clause ~q: '-[ClauseRef] ]. 938 939filepos_line(File, CharPos, Line, LinePos) :- 940 setup_call_cleanup( 941 ( open(File, read, In), 942 open_null_stream(Out) 943 ), 944 ( Skip is CharPos-1, 945 copy_stream_data(In, Out, Skip), 946 stream_property(In, position(Pos)), 947 stream_position_data(line_count, Pos, Line), 948 stream_position_data(line_position, Pos, LinePos) 949 ), 950 ( close(Out), 951 close(In) 952 )). 953 954new_decls([]) --> []. 955new_decls([H|T]) --> 956 [ ' :- ~q'-[H], nl ], 957 new_decls(T). 958 959 960 /******************************* 961 * SYSTEM DECLARATIONS * 962 *******************************/
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.