This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/modules.c
2002-09-17 00:14:23 +00:00

152 lines
3.7 KiB
C

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
File: modules.c *
* Last rev: *
* mods: *
* comments: module support *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "Heap.h"
STATIC_PROTO(Int p_current_module, (void));
STATIC_PROTO(Int p_current_module1, (void));
STD_PROTO(void InitModules, (void));
#define ByteAdr(X) ((char *) &(X))
Term
Module_Name(CODEADDR cap)
{
PredEntry *ap = (PredEntry *)cap;
if (!ap->ModuleOfPred)
/* If the system predicate is a metacall I should return the
module for the metacall, which I will suppose has to be
reachable from the current module anyway.
So I will return the current module in case the system
predicate is a meta-call. Otherwise it will still work.
*/
return(ModuleName[CurrentModule]);
else {
return (ModuleName[ap->ModuleOfPred]);
}
}
SMALLUNSGN
LookupModule(Term a)
{
unsigned int i;
for (i = 0; i < NoOfModules; ++i)
if (ModuleName[i] == a)
return (i);
ModuleName[i = NoOfModules++] = a;
if (NoOfModules == MaxModules) {
Error(SYSTEM_ERROR,a,"number of modules overflowed");
}
return (i);
}
static Int
p_current_module(void)
{ /* $current_module(Old,New) */
Term t;
unsigned int i;
if (!unify_constant(ARG1, ModuleName[CurrentModule]))
return (0);
t = Deref(ARG2);
if (IsVarTerm(t) || !IsAtomTerm(t))
return (0);
for (i = 0; i < NoOfModules; ++i)
if (ModuleName[i] == t) {
CurrentModule = i;
return (TRUE);
}
CurrentModule = NoOfModules;
ModuleName[NoOfModules++] = t;
return (TRUE);
}
static Int
p_current_module1(void)
{ /* $current_module(Old) */
if (!unify_constant(ARG1, ModuleName[CurrentModule]))
return (0);
return (1);
}
static Int
p_change_module(void)
{ /* $change_module(New) */
SMALLUNSGN mod = LookupModule(Deref(ARG1));
CurrentModule = mod;
return (TRUE);
}
static Int
p_module_number(void)
{ /* $module_number(Mod,Num) */
Term tname = Deref(ARG1);
Term t;
if (IsVarTerm(tname)) {
return(unify(tname, ModuleName[IntOfTerm(Deref(ARG2))]));
}else {
t = MkIntTerm(LookupModule(Deref(ARG1)));
unify(t,ARG2);
ARG2 = t;
}
return(TRUE);
}
static Int
cont_current_module(void)
{
Int mod = IntOfTerm(EXTRA_CBACK_ARG(1,1));
Term t = ModuleName[mod];
if (mod == NoOfModules) {
cut_fail();
}
EXTRA_CBACK_ARG(1,1) = MkIntTerm(mod+1);
return(unify(ARG1,t));
}
static Int
init_current_module(void)
{ /* current_module(?ModuleName) */
EXTRA_CBACK_ARG(1,1) = MkIntTerm(0);
return (cont_current_module());
}
void
InitModules(void)
{
ModuleName[PrimitivesModule = 0] =
MkAtomTerm(LookupAtom("prolog"));
ModuleName[1] =
MkAtomTerm(LookupAtom("user"));
NoOfModules = 2;
CurrentModule = 0;
InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
InitCPred("$module_number", 2, p_module_number, SafePredFlag);
InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
SafePredFlag|SyncPredFlag);
}