34
35:- module(cohesive,
36 [ cohesive_module/4,
37 cohesive_module_rt/6,
38 freeze_cohesive_module_rt/6,
39 scope_t/1,
40 call_cm/3,
41 call_cm/5,
42 '$cohesive'/2
43 ]). 44
45:- use_module(library(apply)). 46:- use_module(library(extend_args)). 47:- use_module(library(normalize_head)). 48:- use_module(library(option)). 49:- use_module(library(sequence_list)). 50:- reexport(library(cohesive_op)). 51:- reexport(library(compound_expand)). 52:- init_expansors. 53
67
68:- multifile
69 '$cohesive'/2. 70
71:- meta_predicate
72 call_cm(0, +, -),
73 call_cm(0, +, ?, -, -). 74
75:- public freeze_cohesive_module_rt/6. 76
77aux_cohesive_module(M, F, A, CohM, CohesiveModule) :-
78 format(atom(CT), '__aux_cohm_~w:~w/~w', [M, F, A]),
79 CohesiveModule =.. [CT, CohM].
80
81aux_cohesive_pred(H, CohM, Scope, HExt) :-
82 H =.. [F|Args],
83 atom_concat('__aux_cohp_', F, FExt),
84 HExt =.. [FExt, CohM, Scope|Args].
85 86
87aux_cohesive_wrap(H, CM, CohM, HWrp) :-
88 extend_args('__aux_cohw_', H, [CM, CohM], HWrp).
89
94
95call_check_cohesive_module(H, Context, M, CohM, CheckCohM) :-
96 ( 97 '$defined_predicate'(Context:CheckCohM)
98 ->Context:CheckCohM
99 ; 100 '$defined_predicate'(Context:H),
101 cohesive_module(H, Context, M, CohM)
102 ).
103
104cohesive_module_rt(_, user, _, _, _, _) :- !.
105cohesive_module_rt(_, _, _, _, spublic, _).
106cohesive_module_rt(H, Context, M, CohM, sexport, CheckCohM) :-
107 call_check_cohesive_module(H, Context, M, CohM, CheckCohM).
108cohesive_module_rt(_, C, _, C, sprivat, _).
109
110cohesive_pred_pi(CM, PI) -->
111 { normalize_head(CM:PI, M:H),
112 aux_cohesive_pred(H, CohM, Scope, HExt),
113 functor(H, F, A),
114 aux_cohesive_module(M, F, A, CohM, CheckCohM),
115 aux_cohesive_wrap(H, Context, CohM, HWrp),
116 functor(HExt, FExt, AExt)
117 },
118 [ cohesive:'$cohesive'(H, M),
119 (:- module_transparent M:F/A),
120 (:- multifile M:FExt/AExt)
121 ],
122 ( {'$predicate_property'((discontiguous), M:H)}
123 ->[(:- discontiguous M:FExt/AExt)]
124 ; []
125 ),
126 [ ( H :- context_module(Context),
127 call(CM:HWrp)
128 ),
129 ( HWrp :-
130 freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM),
131 HExt
132 )
133 ].
134
135freeze_cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM) :-
136 ignore(( Context \= user,
137 138 freeze(CohM, freeze(Scope, once(cohesive_module_rt(H, Context, M, CohM, Scope, CheckCohM))))
139 )).
144
145call_cm(Goal, Context, CohM, HWrp, IM) :-
146 strip_module(Goal, _, Head),
147 predicate_property(Goal, implementation_module(IM)),
148 aux_cohesive_wrap(Head, Context, CohM, HWrp).
149
150call_cm(Goal, Context, CohM) :-
151 call_cm(Goal, Context, CohM, HWrp, IM),
152 IM:HWrp.
153
154coh_head_expansion(Scope, Head, IM:HeadExt) :-
155 prolog_load_context(module, CM),
156 predicate_property(CM:Head, implementation_module(IM)),
157 '$cohesive'(Head, IM),
158 159 aux_cohesive_pred(Head, CM, Scope, HeadExt).
160
164
165scope_t(spublic).
166scope_t(sexport).
167scope_t(sprivat).
168
169check_cohm_clause(Context, H, IM, Clause) :-
170 predicate_property(Context:H, implementation_module(IM)),
171 functor(H, F, A),
172 aux_cohesive_module(IM, F, A, CohM, CheckCohM),
173 ( 174 175 176 Clause = Context:CheckCohM,
177 aux_cohesive_pred(H, CohM, _Scope, HExt),
178 cohesive_module(H, Context, IM, CohM),
179 ( CohM \= Context
180 ->once(clause(IM:HExt, _))
181 ; true
182 )
183 ).
184
185check_cohm_clauses(Context, ClauseL) :-
186 findall(Clause,
187 ( '$cohesive'(H, IM),
188 check_cohm_clause(Context, H, IM, Clause)
189 ), ClauseL, [end_of_file]).
190
191term_expansion(end_of_file, ClauseL) :-
192 prolog_load_context(module, Context),
193 module_property(Context, file(File)),
194 prolog_load_context(source, File),
195 check_cohm_clauses(Context, ClauseL).
196term_expansion((:- cohesive_pred PIs), ClauseL) :-
197 prolog_load_context(module, CM),
198 sequence_list(PIs, PIL, []),
199 foldl(cohesive_pred_pi(CM), PIL, ClauseL, []).
200term_expansion(Scope::Head :- Body, HeadExt :- Body) :-
201 scope_t(Scope),
202 coh_head_expansion(Scope, Head, HeadExt).
203term_expansion(Scope::Head, HeadExt) :-
204 scope_t(Scope),
205 coh_head_expansion(Scope, Head, HeadExt).
206term_expansion((::Head :- Body), (HeadExt :- Body)) :-
207 coh_head_expansion(sexport, Head, HeadExt).
208term_expansion(::Head, HeadExt) :-
209 coh_head_expansion(sexport, Head, HeadExt).
210term_expansion((Head :- Body), (HeadExt :- Body)) :-
211 coh_head_expansion(sprivat, Head, HeadExt).
212term_expansion(Head, HeadExt) :-
213 coh_head_expansion(sprivat, Head, HeadExt).
214
215:- thread_local
216 cm_db/2.
220cohesive_module(H, Context, IM, CohM) :-
221 setup_call_cleanup(
222 prolog_current_choice(CP),
223 cohesive_module_1st(CP, H, Context, IM, CohM),
224 retractall(cm_db(_, CP))).
225
226cohesive_module_1st(CP, _, Context, _, Context) :-
227 assertz(cm_db(Context, CP)).
228cohesive_module_1st(CP, H, Context, IM, CM) :-
229 '$load_context_module'(File, Context, _),
230 module_property(M, file(File)),
231 \+ cm_db(M, CP),
232 predicate_property(M:H, implementation_module(IM)),
233 cohesive_module_rec(CP, H, M, IM, CM).
234
235cohesive_module_rec(CP, _, Context, _, Context) :-
236 assertz(cm_db(Context, CP)).
237cohesive_module_rec(CP, H, C, IM, CM) :-
238 '$load_context_module'(File, C, Options),
239 option(reexport(true), Options),
240 module_property(M, file(File)),
241 \+ cm_db(M, CP),
242 predicate_property(M:H, implementation_module(IM)),
243 cohesive_module_rec(CP, H, M, IM, CM)