1 /*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 File: modules.c *
12 * Last rev: *
13 * mods: *
14 * comments: module support *
15 * *
16 *************************************************************************/
17 #ifdef SCCS
18 static char SccsId[] = "%W% %G%";
19 #endif
20
21 #include "Yap.h"
22 #include "Yatom.h"
23 #include "YapHeap.h"
24
25 STATIC_PROTO(Int p_current_module, (void));
26 STATIC_PROTO(Int p_current_module1, (void));
27
28
29 inline static ModEntry *
FetchModuleEntry(Atom at)30 FetchModuleEntry(Atom at)
31 /* get predicate entry for ap/arity; create it if neccessary. */
32 {
33 Prop p0;
34 AtomEntry *ae = RepAtom(at);
35
36 READ_LOCK(ae->ARWLock);
37 p0 = ae->PropsOfAE;
38 while (p0) {
39 ModEntry *me = RepModProp(p0);
40 if ( me->KindOfPE == ModProperty
41 ) {
42 READ_UNLOCK(ae->ARWLock);
43 return me;
44 }
45 p0 = me->NextOfPE;
46 }
47 READ_UNLOCK(ae->ARWLock);
48 return NULL;
49 }
50
51 inline static ModEntry *
GetModuleEntry(Atom at)52 GetModuleEntry(Atom at)
53 /* get predicate entry for ap/arity; create it if neccessary. */
54 {
55 Prop p0;
56 AtomEntry *ae = RepAtom(at);
57 ModEntry *new;
58
59 p0 = ae->PropsOfAE;
60 while (p0) {
61 ModEntry *me = RepModProp(p0);
62 if ( me->KindOfPE == ModProperty
63 ) {
64 return me;
65 }
66 p0 = me->NextOfPE;
67 }
68 new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
69 INIT_RWLOCK(new->ModRWLock);
70 new->KindOfPE = ModProperty;
71 new->PredForME = NULL;
72 new->NextME = CurrentModules;
73 CurrentModules = new;
74 new->AtomOfME = ae;
75 new->NextOfPE = ae->PropsOfAE;
76 ae->PropsOfAE = AbsModProp(new);
77 return new;
78 }
79
80
81 #define ByteAdr(X) ((char *) &(X))
82 Term
Yap_Module_Name(PredEntry * ap)83 Yap_Module_Name(PredEntry *ap)
84 {
85 Term mod;
86 if (!ap->ModuleOfPred)
87 /* If the system predicate is a metacall I should return the
88 module for the metacall, which I will suppose has to be
89 reachable from the current module anyway.
90
91 So I will return the current module in case the system
92 predicate is a meta-call. Otherwise it will still work.
93 */
94 mod = CurrentModule;
95 else {
96 mod = ap->ModuleOfPred;
97 }
98 if (mod) return mod;
99 return TermProlog;
100 }
101
102 static ModEntry *
LookupModule(Term a)103 LookupModule(Term a)
104 {
105 Atom at;
106 ModEntry *me;
107
108 /* prolog module */
109 if (a == 0)
110 return GetModuleEntry(AtomOfTerm(TermProlog));
111 at = AtomOfTerm(a);
112 me = GetModuleEntry(at);
113 return me;
114 }
115
116 Term
Yap_Module(Term tmod)117 Yap_Module(Term tmod)
118 {
119 LookupModule(tmod);
120 return tmod;
121 }
122
123 struct pred_entry *
Yap_ModulePred(Term mod)124 Yap_ModulePred(Term mod)
125 {
126 ModEntry *me;
127 if (!(me = LookupModule(mod)))
128 return NULL;
129 return me->PredForME;
130 }
131
132 void
Yap_NewModulePred(Term mod,struct pred_entry * ap)133 Yap_NewModulePred(Term mod, struct pred_entry *ap)
134 {
135 ModEntry *me;
136
137 if (!(me = LookupModule(mod)))
138 return;
139 WRITE_LOCK(me->ModRWLock);
140 ap->NextPredOfModule = me->PredForME;
141 me->PredForME = ap;
142 WRITE_UNLOCK(me->ModRWLock);
143 }
144
145 static Int
p_current_module(void)146 p_current_module(void)
147 { /* $current_module(Old,New) */
148 Term t;
149
150 if (CurrentModule) {
151 if(!Yap_unify_constant(ARG1, CurrentModule))
152 return FALSE;
153 } else {
154 if (!Yap_unify_constant(ARG1, TermProlog))
155 return FALSE;
156 }
157 t = Deref(ARG2);
158 if (IsVarTerm(t) || !IsAtomTerm(t))
159 return FALSE;
160 if (t == TermProlog) {
161 CurrentModule = PROLOG_MODULE;
162 } else {
163 CurrentModule = t;
164 LookupModule(CurrentModule);
165 }
166 return TRUE;
167 }
168
169 static Int
p_current_module1(void)170 p_current_module1(void)
171 { /* $current_module(Old) */
172 if (CurrentModule)
173 return Yap_unify_constant(ARG1, CurrentModule);
174 return Yap_unify_constant(ARG1, TermProlog);
175 }
176
177 static Int
p_change_module(void)178 p_change_module(void)
179 { /* $change_module(New) */
180 Term mod = Deref(ARG1);
181 LookupModule(mod);
182 CurrentModule = mod;
183 return TRUE;
184 }
185
186 static Int
cont_current_module(void)187 cont_current_module(void)
188 {
189 ModEntry *imod = (ModEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1)), *next;
190 Term t = MkAtomTerm(imod->AtomOfME);
191 next = imod->NextME;
192
193 /* ARG1 is unbound */
194 Yap_unify(ARG1,t);
195 if (!next)
196 cut_succeed();
197 EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)next);
198 return TRUE;
199 }
200
201 static Int
init_current_module(void)202 init_current_module(void)
203 { /* current_module(?ModuleName) */
204 Term t = Deref(ARG1);
205 if (!IsVarTerm(t)) {
206 if (!IsAtomTerm(t)) {
207 Yap_Error(TYPE_ERROR_ATOM,t,"module name must be an atom");
208 return FALSE;
209 }
210 if (FetchModuleEntry(AtomOfTerm(t)) != NULL)
211 cut_succeed();
212 cut_fail();
213 }
214 EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)CurrentModules);
215 return cont_current_module();
216 }
217
218 static Int
p_strip_module(void)219 p_strip_module(void)
220 {
221 Term t1 = Deref(ARG1), t2, tmod = CurrentModule;
222 if (tmod == PROLOG_MODULE) {
223 tmod = TermProlog;
224 }
225 if (IsVarTerm(t1) ||
226 !IsApplTerm(t1) ||
227 FunctorOfTerm(t1) != FunctorModule ||
228 IsVarTerm(t2 = ArgOfTerm(1,t1)) ||
229 !IsAtomTerm(t2)) {
230 return Yap_unify(ARG3, t1) &&
231 Yap_unify(ARG2, tmod);
232 }
233 do {
234 tmod = t2;
235 t1 = ArgOfTerm(2,t1);
236 } while (!IsVarTerm(t1) &&
237 IsApplTerm(t1) &&
238 FunctorOfTerm(t1) == FunctorModule &&
239 !IsVarTerm(t2 = ArgOfTerm(1,t1)) &&
240 IsAtomTerm(t2));
241 return Yap_unify(ARG3, t1) &&
242 Yap_unify(ARG2, tmod);
243 }
244
245 static Int
p_context_module(void)246 p_context_module(void)
247 {
248 yamop *parentcp = P;
249 CELL *yenv;
250 PredEntry *ap = EnvPreg(parentcp);
251 if (ap->ModuleOfPred &&
252 !(ap->PredFlags & MetaPredFlag))
253 return Yap_unify(ARG1, ap->ModuleOfPred);
254 parentcp = CP;
255 yenv = ENV;
256 do {
257 ap = EnvPreg(parentcp);
258 if (ap->ModuleOfPred &&
259 !(ap->PredFlags & MetaPredFlag))
260 return Yap_unify(ARG1, ap->ModuleOfPred);
261 parentcp = (yamop *)yenv[E_CP];
262 yenv = (CELL *)yenv[E_E];
263 } while(yenv);
264 return Yap_unify(ARG1, CurrentModule);
265 }
266
267 Term
Yap_StripModule(Term t,Term * modp)268 Yap_StripModule(Term t, Term *modp)
269 {
270 Term tmod;
271
272 tmod = CurrentModule;
273 restart:
274 if (IsVarTerm(t)) {
275 return 0L;
276 } else if (IsAtomTerm(t)) {
277 *modp = tmod;
278 return t;
279 } else if (IsApplTerm(t)) {
280 Functor fun = FunctorOfTerm(t);
281 if (fun == FunctorModule) {
282 tmod = ArgOfTerm(1, t);
283 if (IsVarTerm(tmod) ) {
284 return 0L;
285 }
286 if (!IsAtomTerm(tmod) ) {
287 return 0L;
288 }
289 t = ArgOfTerm(2, t);
290 goto restart;
291 }
292 *modp = tmod;
293 return t;
294 }
295 return 0L;
296 }
297
298
299
300 void
Yap_InitModulesC(void)301 Yap_InitModulesC(void)
302 {
303 Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag|HiddenPredFlag);
304 Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag|HiddenPredFlag);
305 Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag|HiddenPredFlag);
306 Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag|SyncPredFlag|HiddenPredFlag);
307 Yap_InitCPred("context_module", 1, p_context_module, 0);
308 Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
309 SafePredFlag|SyncPredFlag|HiddenPredFlag);
310 }
311
312
313 void
Yap_InitModules(void)314 Yap_InitModules(void)
315 {
316 LookupModule(MkAtomTerm(AtomProlog));
317 LookupModule(USER_MODULE);
318 LookupModule(IDB_MODULE);
319 LookupModule(ATTRIBUTES_MODULE);
320 LookupModule(CHARSIO_MODULE);
321 LookupModule(TERMS_MODULE);
322 LookupModule(SYSTEM_MODULE);
323 LookupModule(READUTIL_MODULE);
324 LookupModule(HACKS_MODULE);
325 LookupModule(ARG_MODULE);
326 LookupModule(GLOBALS_MODULE);
327 CurrentModule = PROLOG_MODULE;
328 }
329