This is the mail archive of the guile@cygnus.com mailing list for the guile project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
> Both an environment and a module? Is the module not part of the
> environment? (I would expect a closure to capture the module in
> which it is created.)
I think you are right. A module /is a/ special environment that is also
responsible to encapsulate its bindings (some are private, some are
public): "top level environment" or "interpreter environment" are good
names for this special environment.
Languages like oberon call this special environment a "module", others
like C and MIT scheme don't support modules but only top level environments
(no encapsulation). In Scheme48 a module is called a "structure". And in
Java and Eiffel there are no modules at all. In Java and Eiffel you find
packages that group "classes" which can compared with the modules I am trying
to implement in guile.
Some people on this list have already noted the similarity between
classes and modules and indeed, in Java a module /is a/ class and a class
/is a/ module. These modules (classes) are grouped by (in) packages.
So I think I have to MIT scheme implement environments first. MIT
scheme already has first class environments and R5RS requires that
eval takes an environment as an argument (eval <list> <environment>).
After that I will take a look at Jim Blandy's proposal -- I don't
understand why he thinks it is neccesary to implement many types of
environments, I think we just need one environment type and a module
type which /has/ one or more (top level) environments. The functions
and the data should go into the module type, not into the
environments, but I am not sure about that at the moment. I think a
"top level" environment is not much more than a simple and stupid
obarray.
Anyway, I've cleaned up symbols.c and modules.c. The guile reader
now calls scm_intern() to create an undefined symbol in scm_weak_symhash.
(Functions scm_intern, scm_intern_symbolname* -- the functions scm_sysintern*
are for convenience and should go away soon)
After that the evaluator is called, which tries to look up symbols using
the function scm_sym2vcell, which should call a function on scheme level
or the default function, if the default module system is used. This scheme
level function will receive the current module smob plus the symbol to look up
and it will return the vcell (a pair) plus the environment where the symbol
was found.
-------------------- symbol.c --------------------
/* NUM_HASH_BUCKETS is the number of symbol hash table buckets.
*/
#define NUM_HASH_BUCKETS 137
int scm_symhash_dim = NUM_HASH_BUCKETS;
unsigned long
scm_strhash (str, len, n)
unsigned char *str;
scm_sizet len;
unsigned long n;
{
if (len > 5)
{
scm_sizet i = 5;
unsigned long h = (NUM_HASH_BUCKETS * 2)% n;
while (i--)
h = ((h << 8) + ((unsigned) (scm_downcase (str[h % len])))) % n;
return h;
}
else
{
scm_sizet i = len;
unsigned long h = 0;
while (i)
h = ((h << 8) + ((unsigned) (scm_downcase (str[--i])))) % n;
return h;
}
}
/*
* Copy symbol to obarray
*/
SCM scm_intern_symbol_internal (obarray, symbol, scm_hash, init)
SCM symbol;
SCM obarray;
scm_sizet scm_hash;
SCM init;
{
SCM sym;
sym = scm_acons (symbol, init,
SCM_VELTS (obarray)[scm_hash]);
SCM_VELTS (obarray)[scm_hash] = sym;
return SCM_CAR (sym);
}
SCM scm_intern_symbol_internal0 (obarray, symbol, init)
SCM symbol;
SCM obarray;
SCM init;
{
SCM sym;
scm_sizet scm_hash;
scm_hash = SCM_HASHCODE (symbol);
return scm_intern_symbol_internal (obarray, symbol, scm_hash, init);
}
/*
* Look up `name' (with length `len') in `obarray' (at position `scm_hash')
* and return the pair (name . value) or #f
* Only used by scm_lookup_symbolname()
*/
SCM
scm_lookup_symbolname0 (name, len, obarray, scm_hash)
char *name;
scm_sizet len;
SCM obarray;
SCM scm_hash;
{
SCM lsym;
SCM z;
register unsigned char *tmp;
register scm_sizet i;
SCM_REDEFER_INTS;
tmp = name;
i = len;
for (lsym = SCM_VELTS (obarray)[scm_hash];
SCM_NIMP (lsym);
lsym = SCM_CDR (lsym))
{
register unsigned char *tmp;
register size_t i;
z = SCM_CAR (lsym);
z = SCM_CAR (z);
tmp = SCM_UCHARS (z);
if (SCM_LENGTH (z) != len)
goto trynext;
for (i = len; i--;)
if (((unsigned char *) name)[i] != tmp[i])
goto trynext;
{
SCM a;
a = SCM_CAR (lsym);
SCM_REALLOW_INTS;
return a;
}
trynext:;
}
SCM_REALLOW_INTS;
return SCM_BOOL_F;
}
/*
* Intern the symbol `name' in `obarray'. If obarray is #f, create
* a symbol listed in no obarray and return (name . SCM_UNDEFINED).
*/
SCM
scm_intern_symbolname0 (name, len, obarray, scm_hash)
char *name;
scm_sizet len;
SCM obarray;
SCM scm_hash;
{
SCM lsym;
SCM_REDEFER_INTS;
/* make sure that symbol is already listed in weak_symhash */
if (SCM_NIMP (obarray) && (obarray != scm_weak_symhash))
{
SCM vcell;
vcell = scm_lookup_symbolname0 (name, len, scm_weak_symhash, scm_hash);
if (SCM_IMP (vcell))
{
abort();
}
}
/* make sure that the symbol ist not listed in obarray */
if (SCM_NIMP (obarray))
{
SCM vcell;
vcell = scm_lookup_symbolname0 (name, len, obarray, scm_hash);
if (SCM_NIMP (vcell))
{
abort();
}
}
lsym = scm_makfromstr (name, len, SCM_SYMBOL_SLOTS);
SCM_SETLENGTH (lsym, (long) len, scm_tc7_msymbol);
SCM_SYMBOL_PROPS (lsym) = SCM_EOL;
if (obarray == SCM_BOOL_F)
{
SCM answer;
SCM_SYMBOL_HASH (lsym) = scm_strhash (name, len, 1019);
SCM_REALLOW_INTS;
SCM_NEWCELL (answer);
SCM_DEFER_INTS;
SCM_SETCAR (answer, lsym);
SCM_SETCDR (answer, SCM_UNDEFINED);
SCM_REALLOW_INTS;
return answer;
}
else
{
SCM a;
SCM b;
SCM_SYMBOL_HASH (lsym) = scm_hash;
SCM_NEWCELL (a);
SCM_NEWCELL (b);
SCM_SETCAR (a, lsym);
SCM_SETCDR (a, SCM_UNDEFINED);
SCM_SETCAR (b, a);
SCM_SETCDR (b, SCM_VELTS(obarray)[scm_hash]);
SCM_VELTS(obarray)[scm_hash] = b;
SCM_REALLOW_INTS;
return SCM_CAR (b);
}
}
/*
* intern a symbol in weak symhash
*/
SCM
scm_intern (name, len)
char *name;
scm_sizet len;
{
SCM scm_hash;
SCM vcell;
scm_hash = scm_strhash (name, len, scm_symhash_dim);
vcell = scm_lookup_symbolname0 (name, len, scm_weak_symhash, scm_hash);
if (SCM_IMP (vcell))
{
/* Not in weak: intern it */
vcell = scm_intern_symbolname0 (name, len, scm_weak_symhash, scm_hash);
}
return vcell;
}
SCM
scm_intern0 (name)
char * name;
{
return scm_intern (name, strlen (name));
}
/*
* intern a symbol in symhash and weak_symhash
*/
static SCM
scm_sysintern_internal (name, len)
char *name;
scm_sizet len;
{
SCM scm_hash;
SCM easy_answer;
SCM vcell;
scm_hash = scm_strhash (name, len, scm_symhash_dim);
vcell = scm_lookup_symbolname0 (name, len, scm_weak_symhash, scm_hash);
if (SCM_IMP (vcell))
{
/* Not in weak: intern it */
vcell = scm_intern_symbolname0 (name, len, scm_weak_symhash, scm_hash);
}
easy_answer = scm_sym2vcell0 (vcell, scm_symhash, scm_hash);
if (SCM_IMP (easy_answer))
{
/* copy to symhash */
vcell = scm_intern_symbol_internal (scm_symhash, SCM_CAR (vcell), scm_hash, SCM_UNDEFINED );
}
return vcell;
}
/* Intern the symbol named NAME in scm_symhash, NAME is null-terminated. */
SCM
scm_sysintern0 (name)
char *name;
{
return scm_sysintern_internal (name, strlen (name));
}
/* Intern the symbol named NAME in scm_symhash, and give it the value
VAL. NAME is null-terminated.
SCM
scm_sysintern (name, val)
char *name;
SCM val;
{
SCM vcell = scm_sysintern0 (name);
SCM_SETCDR (vcell, val);
return vcell;
}
SCM_PROC(s_symbol_p, "symbol?", 1, 0, 0, scm_symbol_p);
SCM
scm_symbol_p(x)
SCM x;
{
if SCM_IMP(x) return SCM_BOOL_F;
return SCM_SYMBOLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_intern_symbol, "intern-symbol", 3, 0, 0, scm_intern_symbol);
SCM
scm_intern_symbol(obarray, symbol, init)
SCM obarray, symbol, init;
{
SCM vcell;
scm_sizet scm_hash;
scm_hash = SCM_HASHCODE (symbol);
vcell = scm_sym2vcell0 (symbol, obarray, scm_hash);
if (SCM_IMP (vcell))
vcell = scm_intern_symbol_internal (obarray, symbol, scm_hash, init);
return vcell;
}
SCM
scm_sym2vcell0 (sym, obarray, scm_hash)
SCM sym;
SCM obarray;
scm_sizet scm_hash;
{
SCM lsym;
SCM z;
for (lsym = SCM_VELTS (obarray)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
{
z = SCM_CAR (lsym);
if (SCM_CAR (z) == sym)
{
SCM_ALLOW_INTS;
return z;
}
}
return SCM_BOOL_F;
}
/* -------------------------------------------------- */
/* FIXME: The following code should be implemented in scheme */
/*
* Look up symbol in current_useslist
*/
static SCM
scm_lookup_symbol_current_useslist (sym, scm_hash, mod_out)
SCM sym;
scm_sizet scm_hash;
SCM *mod_out;
{
SCM vcell;
SCM useslist;
SCM obarray;
/* traverse useslist */
for (useslist = scm_current_useslist;
SCM_NIMP (useslist);
useslist = SCM_CDR (useslist))
{
static SCM scm_sym2vcell0 ();
SCM module;
SCM public_obarray;
SCM friend_obarray;
SCM package;
module = SCM_CAR (useslist);
obarray = SCM_MODULE_OBARRAY (module);
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_IMP (vcell))
continue;
/* found it. is it visible? Look in public obarray first */
public_obarray = SCM_MODULE_PUBLIC_OBARRAY (module);
if (SCM_NIMP (scm_sym2vcell0 (sym, public_obarray, scm_hash)))
{
*mod_out = module;
return vcell;
}
/* Hmm, mabe we'll find it in our package */
package = SCM_MODULE_PACKAGE(module);
friend_obarray = SCM_MODULE_FRIEND_OBARRAY (module);
if ((scm_current_package == package) &&
(SCM_NIMP (scm_sym2vcell0 (sym, friend_obarray, scm_hash))))
{
*mod_out = module;
return vcell;
}
}
return SCM_BOOL_F;
}
/* scm_sym2vcell
* looks up the symbol in:
*
* modify: -1: current_obarray and symhash. Symbol will be `set!'.
* 1: look for symbol in current_ob, symhash and weak_symhash.
* Symbol can be re-`define'd
* 0: look for symbol in currend_obarray, symhash, foreign_hash,
* weak_symhash. Symbol is read-only.
*/
SCM
scm_sym2vcell (sym, mod, modify, found_in_module)
SCM sym;
int modify;
SCM mod;
SCM *found_in_module;
{
SCM lsym;
SCM *lsymp;
SCM z;
SCM obarray;
scm_sizet scm_hash;
SCM vcell;
SCM_DEFER_INTS;
scm_hash = SCM_HASHCODE (sym);
/* symbol in current module? */
obarray = SCM_MODULE_OBARRAY (mod);
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_NIMP (vcell))
{
SCM_ALLOW_INTS;
return vcell;
}
if (obarray != scm_symhash) /* not system module */
{
/* from useslist (cached)? */
obarray = SCM_MODULE_FOREIGN_OBARRAY (mod);
if (SCM_NIMP (obarray) && (modify != -1) )
{
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_NIMP (vcell))
{
if (modify == 1) /* copy symbol to current obarray */
{
vcell = scm_wta (sym,
"can't shadow foreign symbol. ", "");
}
else
{
mod = SCM_CDR (vcell);
if (found_in_module)
*found_in_module = mod;
/* FIXME: (sym . (module . vcell)) */
obarray = SCM_MODULE_OBARRAY (mod);
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_IMP (vcell))
abort();
}
SCM_ALLOW_INTS;
return vcell;
}
else
{
SCM module;
/* not cached, look into useslist */
vcell = scm_lookup_symbol_current_useslist (sym, scm_hash, &module);
if ( SCM_NIMP (vcell)) /* copy to foreign */
{
SCM new_vcell;
if (obarray != scm_current_foreign_obarray)
abort();
scm_intern_symbol_internal (obarray, SCM_CAR (vcell), scm_hash, module);
if (found_in_module)
*found_in_module = module;
return vcell;
}
}
/* Always look in scm_symhash */
obarray = scm_symhash;
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_NIMP (vcell))
{
SCM_ALLOW_INTS;
return vcell;
}
}
}
if (modify == -1)
{
vcell = scm_wta (sym, "symbol not found in current module", "");
}
/* It must be in weak_symhash */
for (lsym = *(lsymp = &SCM_VELTS (scm_weak_symhash)[scm_hash]);
SCM_NIMP (lsym);
lsym = *(lsymp = SCM_CDRLOC (lsym)))
{
SCM s;
z = SCM_CAR (lsym);
s = SCM_CAR (z);
if (s == sym)
{
if (modify == 1) /* define it */
{
/* copy symbol to current_obarray */
return scm_intern_symbol_internal (SCM_MODULE_OBARRAY(mod), s, scm_hash, SCM_UNDEFINED);
}
SCM_ALLOW_INTS;
return z;
}
}
/* not reached */
SCM_ALLOW_INTS;
abort ();
}
/* scm_sym2ovcell
* looks up the symbol in an arbitrary obarray.
*/
SCM
scm_sym2ovcell_soft (sym, obarray)
SCM sym;
SCM obarray;
{
SCM lsym, z;
scm_sizet scm_hash;
scm_hash = scm_strhash (SCM_UCHARS (sym),
(scm_sizet) SCM_LENGTH (sym),
SCM_LENGTH (obarray));
SCM_REDEFER_INTS;
for (lsym = SCM_VELTS (obarray)[scm_hash];
SCM_NIMP (lsym);
lsym = SCM_CDR (lsym))
{
z = SCM_CAR (lsym);
if (SCM_CAR (z) == sym)
{
SCM_REALLOW_INTS;
return z;
}
}
SCM_REALLOW_INTS;
return SCM_BOOL_F;
}
SCM
scm_sym2ovcell (sym, obarray)
SCM sym;
SCM obarray;
{
SCM answer;
answer = scm_sym2ovcell_soft (sym, obarray);
if (answer != SCM_BOOL_F)
return answer;
scm_wta (sym, "uninterned symbol? ", "");
return SCM_UNSPECIFIED; /* not reached */
}
-------------------- end of symbols.c --------------------
static long module_tag;
static SCM
make_module ()
{
struct module *new_module;
SCM module_smob;
SCM foreign = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
SCM obarray = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
SCM tag = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
new_module = (struct module *)
scm_must_malloc (sizeof (struct module), "module");
SCM_NEWCELL (module_smob);
SCM_SETCDR (module_smob, new_module);
SCM_SETCAR (module_smob, module_tag);
SCM_MODULE_OBARRAY (module_smob) = obarray;
SCM_MODULE_USESLIST (module_smob) = SCM_EOL;
SCM_MODULE_TAG_OBARRAY (module_smob) = public;
SCM_MODULE_FOREIGN_OBARRAY (module_smob) = foreign;
SCM_MODULE_PACKAGE (module_smob) = SCM_EOL;
SCM_MODULE_TIMESTAMP (module_smob) = 0;
return module_smob;
}
static SCM
mark_module (SCM module_smob)
{
struct module *module = (struct module *) SCM_CDR (module_smob);
scm_gc_mark (module->obarray);
scm_gc_mark (module->useslist);
scm_gc_mark (module->tag_obarray);
scm_gc_mark (module->foreign_obarray);
scm_gc_mark (module->package);
return SCM_BOOL_F;
}
static scm_sizet
free_module (SCM module_smob)
{
struct module *module = (struct module *) SCM_CDR (module_smob);
scm_sizet size = sizeof (struct module);
free (module);
return size;
}
static int
print_module (SCM module_smob, SCM port, scm_print_state *pstate)
{
struct module *module = (struct module *) SCM_CDR (module_smob);
scm_puts ("#<module ", port);
/* scm_display (module->name, port); */
scm_puts (">", port);
return 1;
}
static scm_smobfuns module_funs = {
mark_module, free_module, print_module, 0
};
/* ---------------------------------------- */
/* FIXME: The following code should be implemented in scheme */
SCM_PROC(s_export_symbols, "export", 1, 0, 0, scm_export_symbols);
SCM
scm_export_symbols(l)
SCM l;
{
SCM list;
SCM_ASSERT(scm_list_p(l), l, SCM_ARG1, s_export_symbols);
SCM_DEFER_INTS;
/* traverse list */
for (list = l; SCM_NIMP (list); list = SCM_CDR (list))
{
SCM s;
SCM lsym;
scm_sizet scm_hash;
s = SCM_CAR (list);
SCM_ASSERT (SCM_SYMBOLP(s), s, SCM_ARG1, s_export_symbols);
/* copy symbol to module_hash */
scm_hash = SCM_HASHCODE (s);
scm_intern_symbol (scm_module_tag_obarray, s, scm_hash,
#if 0
lsym = scm_sym2vcell0 (s, scm_current_obarray, scm_hash);
SCM_ASSERT (SCM_IMP(lsym), lsym, SCM_ARG1, s_export_symbols);
#endif
/* create an undefined symbol in public_hash */
lsym = scm_acons ( s, SCM_UNDEFINED,
SCM_VELTS (scm_current_public_obarray)[scm_hash]);
SCM_VELTS (scm_current_public_obarray)[scm_hash] = lsym;
}
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_friend_symbols, "friend", 1, 0, 0, scm_friend_symbols);
SCM
scm_friend_symbols(l)
SCM l;
{
SCM list;
SCM_ASSERT(scm_list_p(l), l, SCM_ARG1, s_export_symbols);
SCM_DEFER_INTS;
/* traverse list */
for (list = l; SCM_NIMP (list); list = SCM_CDR (list))
{
SCM s;
SCM lsym;
scm_sizet scm_hash;
s = SCM_CAR (list);
SCM_ASSERT (SCM_SYMBOLP(s), s, SCM_ARG1, s_export_symbols);
/* copy symbol to module_hash */
scm_hash = SCM_HASHCODE (s);
#if 0
lsym = scm_sym2vcell0 (s, scm_current_obarray, scm_hash);
SCM_ASSERT (SCM_IMP(lsym), lsym, SCM_ARG1, s_export_symbols);
#endif
/* create an undefined symbol in public_hash */
lsym = scm_acons (s, SCM_UNDEFINED,
SCM_VELTS (scm_current_friend_obarray)[scm_hash]);
SCM_VELTS (scm_current_friend_obarray)[scm_hash] = lsym;
}
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
/* read and evaluate a module, return handle */
static SCM
load_module (s, scm_hash)
SCM s;
scm_sizet scm_hash;
{
extern SCM scm_primitive_load_path();
scm_primitive_load_path(scm_makfromstr (SCM_UCHARS(s), SCM_LENGTH(s), 0));
return scm_sym2vcell0 (s, scm_module_hash, scm_hash);
}
SCM_PROC(s_module_ref, "module-ref", 2, 0, 0, scm_module_ref);
SCM
scm_module_ref(module, sym)
SCM module;
SCM sym;
{
SCM obarray;
SCM public_obarray;
SCM friend_obarray;
SCM vcell;
scm_sizet scm_hash;
SCM package;
/* find symbol in module */
scm_hash = SCM_SYMBOL_HASH (sym);
obarray = SCM_MODULE_OBARRAY(module);
vcell = scm_sym2vcell0 (sym, obarray, scm_hash);
if (SCM_IMP (vcell))
{
return scm_wta (sym, "Symbol not found!", "");
}
/* accessible? */
package = SCM_MODULE_PACKAGE(module);
public_obarray = SCM_MODULE_PUBLIC_OBARRAY (module);
friend_obarray = SCM_MODULE_FRIEND_OBARRAY (module);
if ((SCM_IMP (scm_sym2vcell0 (sym, public_obarray, scm_hash))) &&
((package != scm_current_package) ||
(SCM_IMP (scm_sym2vcell0 (sym, friend_obarray, scm_hash)))))
{
return scm_wta (sym, "the symbol is not accessible to you.", "");
}
return SCM_CDR(vcell);
}
SCM_PROC(s_module_define, "module-define", 2, 0, 0, scm_module_define);
SCM
scm_module_define(p, m)
SCM m, p;
{
SCM foreign;
SCM vcell;
scm_sizet scm_phash, scm_mhash;
scm_mhash = SCM_HASHCODE(m);
scm_phash = SCM_HASHCODE(p);
/* is module already defined? */
vcell = scm_sym2vcell0(m, scm_module_hash, scm_mhash);
if(SCM_NIMP(vcell)) /* clear module (remove all interned symbols) */
{
abort ();
/* FIXME: clear foreign hash also? (and useslist and public_obarray and friends_obarray*/
}
else /* create new module */
{
module = make_module();
/* copy (m . module) to module_hash obarray */
scm_intern_symbol_internal (scm_module_hash, scm_mhash, m, module);
/* find/create package symbol */
package = scm_sym2vcell0 (p, scm_package_hash, scm_phash);
if (SCM_IMP (package))
package = scm_intern_symbol_internal (scm_package_hash, p, scm_phash, scm_make_vector ((SCM) SCM_MKINUM(2), SCM_EOL)
/* set back pointer to package */
SCM_MODULE_PACKAGE(module) = package;
SCM_VELTS (package)[0] = scm_cons(module, SCM_VELTS (package)[0]);
}
scm_current_module = module;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_module_access, "module-access", 1, 0, 0, scm_module_access);
SCM
scm_module_access(s)
SCM s;
{
SCM mod;
SCM mcell;
scm_sizet scm_hash;
scm_hash = SCM_HASHCODE (s);
mcell = scm_sym2vcell0 (s, scm_module_hash, scm_hash);
if (SCM_IMP (mcell))
{
mcell = load_module (s, scm_hash);
if (SCM_IMP (mcell))
{
return scm_wta (mod, "module not found", "");
}
}
mod = SCM_CDR (mcell);
return mod;
}
SCM_PROC(s_module_open, "module-open", 1, 0, 0, scm_module_open);
SCM
scm_module_open(s)
SCM l;
{
SCM vcell;
vcell = scm_sym2vcell0 (s, scm_module_hash, SCM_SYMBOL_HASH (s));
if (SCM_IMP (vcell)) /* load it! */
{
vcell = load_module (mod, scm_hash);
if (SCM_IMP (mcell))
{
return scm_wta (mod, "module not found", "");
}
}
mod = SCM_CDR (mcell);
useslist = scm_cons (mod, useslist);
scm_current_useslist = useslist;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_module_open_all, "module-open-all", 1, 0, 0, scm_module_open_all);
SCM
scm_module_open_all(l)
SCM l;
{
unsigned char *name;
scm_sizet len;
scm_sizet scm_hash;
SCM lsym;
SCM useslist;
SCM_ASSERT(scm_list_p(l), l, SCM_ARG1, s_export_symbols);
useslist = SCM_EOL;
SCM_DEFER_INTS;
for (lsym = l;
SCM_NIMP (lsym);
lsym = SCM_CDR (lsym))
{
SCM psym;
SCM s;
SCM v;
SCM mcell;
SCM scell;
SCM mod;
SCM p;
s = SCM_CAR (lsym);
SCM_ASSERT ((SCM_TYP7 (s) == scm_tc7_msymbol), l,
SCM_ARG1, s_export_symbols);
/* ForAll Symbols in package-list */
for (psym = s; SCM_NIMP(psym); psym = SCM_CDR (psym))
{
p = SCM_CAR (psym);
mcell = scm_sym2vcell0 (p, scm_module_hash, SCM_SYMBOL_HASH (s));
if (SCM_IMP (mcell))
{
mcell = load_module (mod, scm_hash);
if (SCM_IMP (mcell))
{
return scm_wta (mod, "module not found", "");
}
}
mod = SCM_CDR (mcell);
useslist = scm_cons (mod, useslist);
}
}
scm_current_useslist = useslist;
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
void
scm_init_modules ()
{
/* create system module. note that the default module doesn't have
a foreign_obarray and its obarray must be scm_symhash */
module_tag = scm_newsmob (&module_funs);
scm_current_module = make_module();
scm_current_obarray = scm_symhash;
scm_current_useslist = SCM_EOL;
scm_current_friend_obarray = SCM_EOL;
scm_current_public_obarray = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_current_foreign_obarray = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_current_package = SCM_EOL;
scm_module_hash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_package_hash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
#include "modules.x"
}
--------------------------------------------------
This requires the following actions
1. Implement top level environments
2. Refine the module smob and move most of symbols.c and modules.c code to
scheme level
Jost
--