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