34
35:- module(assrt_meta, []). 36
37:- use_module(library(assertions)). 38:- use_module(library(assertions_op)). 39:- use_module(library(location_utils)). 40:- use_module(library(predicate_from)). 41:- use_module(library(globprops)). 42:- init_expansors. 43
44:- create_prolog_flag(assrt_meta_pred, none, [type(atom)]). 45
46:- meta_predicate
47 with_amp(0, +, +). 48
49:- table
50 am_head_prop_idx/5. 51
52meta_has_mode_info(Meta) :-
53 arg(_, Meta, Spec),
54 memberchk(Spec, [+,-]),
55 !.
56
57with_amp(Goal, OldFlag, NewFlag) :-
58 setup_call_cleanup(
59 set_prolog_flag(assrt_meta_pred, NewFlag),
60 Goal,
61 set_prolog_flag(assrt_meta_pred, OldFlag)).
62
63am_head_prop_idx(Head, M, Meta, From) :-
64 current_prolog_flag(assrt_meta_pred, Flag),
65 Flag \= none,
66 copy_term_nat(Head, Term),
67 with_amp(am_head_prop_idx(Flag, Term, M, Meta, From), Flag, none),
68 Head = Term.
69
70black_list_module(rtchecks_rt).
71black_list_module(ctrtchecks).
72black_list_module(qualify_meta_goal).
73black_list_module(assertions).
74
75am_head_prop_idx(Flag, Head, M, Meta, From) :-
76 var(Meta),
77 !,
78 Pred = M:Head,
79 ( var(Head)
80 ->module_property(M, class(user)),
81 current_predicate(M:F/A),
82 functor(Head, F, A)
83 ; functor(Head, F, A),
84 current_predicate(M:F/A), 85 module_property(M, class(user))
86 ),
87 \+ black_list_module(M),
88 predicate_property(Pred, implementation_module(M)),
89 90 \+ predicate_property(Pred, nodebug),
91 '$predicate_property'(meta_predicate(Meta), Pred),
92 93 meta_has_mode_info(Meta),
94 ( Flag = all
95 ->
96 \+ ( prop_asr(Head, M, check, _, _, _, Asr),
97 prop_asr(glob, no_meta_modes(_), _, Asr)
98 )
99 ; Flag = specific
100 ->once(( prop_asr(Head, M, check, _, _, _, Asr),
101 prop_asr(glob, meta_modes(_), _, Asr)
102 ))
103 ),
104 findall(From1,
105 once(( property_from(M:Pred, meta_predicate, From1)
106 ; predicate_from(Pred, From1)
107 )), [From]).
108am_head_prop_idx(_, _, _, _, _).
109
110assertions:asr_head_prop(am_asr(M, H, S, F), M, H, check, (comp), [], M, F) :-
111 am_head_prop_idx(H, M, S, F).
112assertions:asr_glob(am_asr(M, H, S, F), assrt_meta,
113 check_call(rt, [am_asr2(M, H, S, F)], _), F) :-
114 am_head_prop_idx(H, M, S, F).
115
116assertions:asr_aprop(am_asr2(M, H, _, From), head, M:H, From).
117assertions:asr_aprop(am_asr2(_, _, _, From), stat, check, From).
118assertions:asr_aprop(am_asr2(_, _, _, From), type, pred, From).
119assertions:asr_aprop(am_asr2(M, H, Meta, From), Type, Prop, From) :-
120 (nonvar(Type) -> memberchk(Type, [call, succ]) ; true),
121 assertions:current_decomposed_assertion(pred