/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- module_print
- init_module
- make_module
- lookup_module
- lookup_module_create
- Scm_MakeModule
- Scm_FindBinding
- Scm_SymbolValue
- Scm_Define
- Scm_DefineConst
- Scm_ImportModules
- Scm_ExportSymbols
- Scm_ExportAll
- Scm_ExtendModule
- Scm_FindModule
- Scm_AllModules
- Scm_SelectModule
- Scm_ModuleNameToPath
- Scm_PathToModuleName
- Scm_NullModule
- Scm_SchemeModule
- Scm_GaucheModule
- Scm_GaucheInternalModule
- Scm_UserModule
- Scm_CurrentModule
- Scm__InitModule
1 /*
2 * module.c - module implementation
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: module.c,v 1.60 2005/10/13 08:14:13 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38 #include "gauche/builtin-syms.h"
39
40 /*
41 * Modules
42 *
43 * A module maps symbols to global locations.
44 * The mapping is resolved at the compile time.
45 * Scheme's current-module is therefore a syntax, instead of
46 * a procedure, to capture compile-time information.
47 *
48 * Modules are registered to global hash table using their names
49 * as keys, so that the module is retrieved by its name. The exception
50 * is "anonymous modules", which have '#' as the name field
51 * and not registered in the global table. Anonymous modules are especially
52 * useful for certain applications that need temporary, segregated
53 * namespace---for example, a 'sandbox' environment to evaluate an
54 * expression sent over the network during a session.
55 * The anonymous namespace will be garbage-collected if nobody references
56 * it, recovering its resouces.
57 */
58
59 /* Mutex of module operation
60 *
61 * [SK] Each module used to have a mutex for accesses to it. I changed it
62 * to use a single global lock (modules.mutex), based on the following
63 * observations:
64 *
65 * - Profiling showed mutex_lock was taking around 10% of program loading
66 * phase in the previous version.
67 *
68 * - Module operations almost always occur during program loading and
69 * interactive session. Having giant lock for module operations won't
70 * affect normal runtime performance.
71 *
72 * Benchmark showed the change made program loading 30% faster.
73 */
74
75 static void module_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
76 {
77 Scm_Printf(port, "#<module %A>", SCM_MODULE(obj)->name);
78 }
79
80 SCM_DEFINE_BUILTIN_CLASS(Scm_ModuleClass,
81 module_print, NULL, NULL, NULL,
82 SCM_CLASS_COLLECTION_CPL);
83
84 /* Global module table */
85 static struct {
86 ScmObj anon_name; /* Name used for anonymous modules.
87 Symbol '#', set by init */
88 ScmHashTable *table; /* Maps name -> module. */
89 ScmInternalMutex mutex; /* Lock for table. Only register_module and
90 lookup_module may hold the lock. */
91 } modules = { SCM_UNBOUND, NULL };
92
93 /* Predefined modules - slots will be initialized by Scm__InitModule */
94 #define DEFINE_STATIC_MODULE(cname) \
95 static ScmModule cname = { { NULL } }
96
97 DEFINE_STATIC_MODULE(nullModule); /* #<module null> */
98 DEFINE_STATIC_MODULE(schemeModule); /* #<module scheme> */
99 DEFINE_STATIC_MODULE(gaucheModule); /* #<module gauche> */
100 DEFINE_STATIC_MODULE(internalModule); /* #<module gauche.internal> */
101 DEFINE_STATIC_MODULE(gfModule); /* #<module gauche.gf> */
102 DEFINE_STATIC_MODULE(userModule); /* #<module user> */
103
104 static ScmObj defaultParents = SCM_NIL; /* will be initialized */
105 static ScmObj defaultMpl = SCM_NIL; /* will be initialized */
106
107 /*----------------------------------------------------------------------
108 * Constructor
109 */
110
111 static void init_module(ScmModule *m, ScmSymbol *name)
112 {
113 m->name = name;
114 m->imported = m->exported = SCM_NIL;
115 m->exportAll = FALSE;
116 m->parents = defaultParents;
117 m->mpl = Scm_Cons(SCM_OBJ(m), defaultMpl);
118 m->table = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0));
119 }
120
121 /* Internal */
122 static ScmObj make_module(ScmSymbol *name)
123 {
124 ScmModule *m;
125 m = SCM_NEW(ScmModule);
126 SCM_SET_CLASS(m, SCM_CLASS_MODULE);
127 init_module(m, name);
128 return SCM_OBJ(m);
129 }
130
131 /* Internal. Lookup module with name N from the table. */
132 static ScmModule *lookup_module(ScmSymbol *name)
133 {
134 ScmHashEntry *e;
135 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
136 e = Scm_HashTableGet(modules.table, SCM_OBJ(name));
137 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
138 if (e) return SCM_MODULE(e->value);
139 else return NULL;
140 }
141
142 /* Internal. Lookup module, and if there's none, create one. */
143 static ScmModule *lookup_module_create(ScmSymbol *name, int *created)
144 {
145 ScmHashEntry *e;
146 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
147 e = Scm_HashTableAdd(modules.table, SCM_OBJ(name), SCM_FALSE);
148 if (e->value == SCM_FALSE) {
149 e->value = make_module(name);
150 *created = TRUE;
151 } else {
152 *created = FALSE;
153 }
154 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
155 return SCM_MODULE(e->value);
156 }
157
158 ScmObj Scm_MakeModule(ScmSymbol *name, int error_if_exists)
159 {
160 ScmObj r;
161 if (name == NULL) name = SCM_SYMBOL(modules.anon_name);
162 if (SCM_EQ(SCM_OBJ(name), modules.anon_name)) {
163 r = make_module(name);
164 } else {
165 int created;
166 r = SCM_OBJ(lookup_module_create(name, &created));
167 if (!created) {
168 if (error_if_exists) {
169 Scm_Error("couldn't create module '%S': named module already exists",
170 SCM_OBJ(name));
171 } else {
172 r = SCM_FALSE;
173 }
174 }
175 }
176 return r;
177 }
178
179 /*----------------------------------------------------------------------
180 * Finding and modifying bindings
181 */
182
183 #define SEARCHED_ARRAY_SIZE 64
184
185 ScmGloc *Scm_FindBinding(ScmModule *module, ScmSymbol *symbol,
186 int stay_in_module)
187 {
188 ScmHashEntry *e;
189 ScmModule *m = module;
190 ScmObj p, mp;
191 ScmGloc *gloc = NULL;
192
193 /* keep record of searched modules. we use stack array for small # of
194 modules, in order to avoid consing for typical cases. */
195 ScmObj searched[SEARCHED_ARRAY_SIZE];
196 int num_searched = 0, i;
197 ScmObj more_searched = SCM_NIL;
198
199 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
200
201 /* first, search from the specified module.
202 NB: we directly check gloc->value instead of calling
203 SCM_GLOC_GET, since this check is merely to eliminate
204 the GLOC inserted by export. */
205 e = Scm_HashTableGet(m->table, SCM_OBJ(symbol));
206 if (e) {
207 gloc = SCM_GLOC(e->value);
208 if (!SCM_UNBOUNDP(gloc->value)) goto found;
209 }
210
211 if (!stay_in_module) {
212 /* Next, search from imported modules */
213 SCM_FOR_EACH(p, module->imported) {
214 SCM_ASSERT(SCM_MODULEP(SCM_CAR(p)));
215 SCM_FOR_EACH(mp, SCM_MODULE(SCM_CAR(p))->mpl) {
216 ScmGloc *g;
217
218 SCM_ASSERT(SCM_MODULEP(SCM_CAR(mp)));
219
220 for (i=0; i<num_searched; i++) {
221 if (SCM_EQ(SCM_CAR(mp), searched[i])) goto skip;
222 }
223 if (!SCM_NULLP(more_searched)) {
224 if (!SCM_FALSEP(Scm_Memq(SCM_CAR(mp), more_searched))) {
225 goto skip;
226 }
227 }
228
229 m = SCM_MODULE(SCM_CAR(mp));
230 e = Scm_HashTableGet(m->table, SCM_OBJ(symbol));
231 /* see above comment about the check of gloc->value */
232 if (e && (g = SCM_GLOC(e->value))->exported
233 && !SCM_UNBOUNDP(g->value)) {
234 gloc = g;
235 goto found;
236 }
237
238 if (num_searched < SEARCHED_ARRAY_SIZE) {
239 searched[num_searched++] = SCM_OBJ(m);
240 } else {
241 more_searched = Scm_Cons(SCM_OBJ(m), more_searched);
242 }
243 }
244 skip:;
245 }
246 /* Then, search from parent modules */
247 SCM_ASSERT(SCM_PAIRP(module->mpl));
248 SCM_FOR_EACH(mp, SCM_CDR(module->mpl)) {
249 SCM_ASSERT(SCM_MODULEP(SCM_CAR(mp)));
250 m = SCM_MODULE(SCM_CAR(mp));
251 e = Scm_HashTableGet(m->table, SCM_OBJ(symbol));
252 if (e) { gloc = SCM_GLOC(e->value); goto found; }
253 }
254 }
255 found:
256 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
257 return gloc;
258 }
259
260 ScmObj Scm_SymbolValue(ScmModule *module, ScmSymbol *symbol)
261 {
262 ScmGloc *g = Scm_FindBinding(module, symbol, FALSE);
263 if (g == NULL) return SCM_UNBOUND;
264 else return SCM_GLOC_GET(g);
265 }
266
267 /*
268 * Definition.
269 * TODO: consolidate the common code between Scm_Define and Scm_DefineConst.
270 */
271 ScmObj Scm_Define(ScmModule *module, ScmSymbol *symbol, ScmObj value)
272 {
273 ScmGloc *g;
274 ScmHashEntry *e;
275 int redefining = FALSE;
276
277 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
278 e = Scm_HashTableGet(module->table, SCM_OBJ(symbol));
279 if (e) {
280 g = SCM_GLOC(e->value);
281 if (SCM_GLOC_CONST_P(g)) {
282 redefining = TRUE;
283 g->setter = NULL;
284 }
285 SCM_GLOC_SET(g, value);
286 } else {
287 g = SCM_GLOC(Scm_MakeGloc(symbol, module));
288 SCM_GLOC_SET(g, value);
289 Scm_HashTablePut(module->table, SCM_OBJ(symbol), SCM_OBJ(g));
290 /* If module is marked 'export-all', export this binding by default */
291 if (module->exportAll) {
292 g->exported = TRUE;
293 module->exported = Scm_Cons(SCM_OBJ(g->name), module->exported);
294 }
295 }
296 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
297
298 if (redefining) {
299 Scm_Warn("redefining constant %S::%S", g->module, g->name);
300 }
301 return SCM_OBJ(g);
302 }
303
304 ScmObj Scm_DefineConst(ScmModule *module, ScmSymbol *symbol, ScmObj value)
305 {
306 ScmGloc *g;
307 ScmHashEntry *e;
308 ScmObj oldval = SCM_UNDEFINED;
309 int redefining = FALSE;
310
311 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
312 e = Scm_HashTableGet(module->table, SCM_OBJ(symbol));
313 /* NB: this function bypasses check of gloc setter */
314 if (e) {
315 g = SCM_GLOC(e->value);
316 if (SCM_GLOC_CONST_P(g)) {
317 redefining = TRUE;
318 oldval = g->value;
319 }
320 g->setter = Scm_GlocConstSetter;
321 g->value = value;
322 } else {
323 g = SCM_GLOC(Scm_MakeConstGloc(symbol, module));
324 g->value = value;
325 Scm_HashTablePut(module->table, SCM_OBJ(symbol), SCM_OBJ(g));
326 /* If module is marked 'export-all', export this binding by default */
327 if (module->exportAll) {
328 g->exported = TRUE;
329 module->exported = Scm_Cons(SCM_OBJ(g->name), module->exported);
330 }
331 }
332 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
333
334 if (redefining && !Scm_EqualP(value, oldval)) {
335 Scm_Warn("redefining constant %S::%S", g->module->name, g->name);
336 }
337 return SCM_OBJ(g);
338 }
339
340 ScmObj Scm_ImportModules(ScmModule *module, ScmObj list)
341 {
342 ScmObj lp;
343 ScmModule *mod;
344 ScmSymbol *name = NULL;
345 SCM_FOR_EACH(lp, list) {
346 if (SCM_SYMBOLP(SCM_CAR(lp))) {
347 name = SCM_SYMBOL(SCM_CAR(lp));
348 } else if (SCM_IDENTIFIERP(SCM_CAR(lp))) {
349 name = SCM_IDENTIFIER(SCM_CAR(lp))->name;
350 } else {
351 Scm_Error("module name required, but got %S", SCM_CAR(lp));
352 }
353 mod = Scm_FindModule(name, 0);
354 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
355 module->imported =
356 Scm_Cons(SCM_OBJ(mod),
357 Scm_DeleteX(SCM_OBJ(mod), module->imported, SCM_CMP_EQ));
358 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
359 }
360 return module->imported;
361 }
362
363 ScmObj Scm_ExportSymbols(ScmModule *module, ScmObj list)
364 {
365 ScmObj lp, syms, badsym = SCM_FALSE;
366 int error = FALSE;
367 ScmSymbol *s;
368 ScmHashEntry *e;
369 ScmGloc *g;
370
371 /* We used to do something like
372 * (set! (module-exports module)
373 * (delete-duplicates (union (module-exports module) list)))
374 * This is slow when we export lots of symbols. As of 0.8.6,
375 * each GLOC has exported flag, so we can check whether a binding
376 * is exported or not in O(1). Module-exports list is kept
377 * for backward compatibility.
378 */
379 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
380 syms = module->exported;
381 SCM_FOR_EACH(lp, list) {
382 if (!SCM_SYMBOLP(SCM_CAR(lp))) {
383 error = TRUE;
384 badsym = SCM_CAR(lp);
385 break;
386 }
387 s = SCM_SYMBOL(SCM_CAR(lp));
388 e = Scm_HashTableAdd(module->table, SCM_OBJ(s), SCM_UNBOUND);
389 if (SCM_GLOCP(e->value)) {
390 g = SCM_GLOC(e->value);
391 if (!g->exported) {
392 syms = Scm_Cons(SCM_OBJ(s), syms);
393 g->exported = TRUE;
394 }
395 } else {
396 g = SCM_GLOC(Scm_MakeGloc(s, module));
397 g->exported = TRUE;
398 e->value = SCM_OBJ(g);
399 syms = Scm_Cons(SCM_OBJ(s), syms);
400 }
401 }
402 if (!error) module->exported = syms;
403 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
404 if (error) Scm_Error("symbol required, but got %S", badsym);
405 return syms;
406 }
407
408 ScmObj Scm_ExportAll(ScmModule *module)
409 {
410 ScmHashIter iter;
411 ScmHashEntry *e;
412
413 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
414 if (!module->exportAll) {
415 /* Mark the module 'export-all' so that the new bindings would get
416 exported mark by default. */
417 module->exportAll = TRUE;
418
419 /* Scan the module and mark all existing bindings as exported. */
420 Scm_HashIterInit(module->table, &iter);
421 while ((e = Scm_HashIterNext(&iter)) != NULL) {
422 ScmGloc *g = SCM_GLOC(e->value);
423 if (!g->exported) {
424 g->exported = TRUE;
425 module->exported =
426 Scm_Cons(SCM_OBJ(g->name), module->exported);
427 }
428 }
429 }
430 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
431 return SCM_OBJ(module);
432 }
433
434 /*----------------------------------------------------------------------
435 * Extending (inheriting) modules
436 */
437
438 /* Module inheritance obeys the same rule as class inheritance,
439 hence we use monotonic merge. */
440 /* NB: ExtendModule alters module's precedence list, and may cause
441 unwanted side effects when used carelessly. */
442
443 ScmObj Scm_ExtendModule(ScmModule *module, ScmObj supers)
444 {
445 ScmObj mpl, seqh = SCM_NIL, seqt = SCM_NIL, sp;
446
447 SCM_FOR_EACH(sp, supers) {
448 if (!SCM_MODULEP(SCM_CAR(sp))) {
449 Scm_Error("non-module object found in the extend syntax: %S",
450 SCM_CAR(sp));
451 }
452 SCM_APPEND1(seqh, seqt, SCM_MODULE(SCM_CAR(sp))->mpl);
453 }
454 SCM_APPEND1(seqh, seqt, supers);
455 module->parents = supers;
456 mpl = Scm_MonotonicMerge(SCM_OBJ(module), seqh);
457 if (SCM_FALSEP(mpl)) {
458 Scm_Error("can't extend those modules simultaneously because of inconsistent precedence lists: %S", supers);
459 }
460 module->mpl = mpl;
461 return mpl;
462 }
463
464 /*----------------------------------------------------------------------
465 * Finding modules
466 */
467
468 ScmModule *Scm_FindModule(ScmSymbol *name, int flags)
469 {
470 ScmModule *m;
471 int created;
472
473 if (flags & SCM_FIND_MODULE_CREATE) {
474 m = lookup_module_create(name, &created);
475 SCM_ASSERT(m != NULL);
476 return m;
477 } else {
478 m = lookup_module(name);
479 if (m == NULL) {
480 if (flags & SCM_FIND_MODULE_QUIET) {
481 return NULL;
482 } else {
483 Scm_Error("no such module: %S", name);
484 }
485 } else {
486 return m;
487 }
488 }
489 }
490
491 ScmObj Scm_AllModules(void)
492 {
493 ScmObj h = SCM_NIL, t = SCM_NIL;
494 ScmHashIter iter;
495 ScmHashEntry *e;
496
497 (void)SCM_INTERNAL_MUTEX_LOCK(modules.mutex);
498 Scm_HashIterInit(modules.table, &iter);
499 while ((e = Scm_HashIterNext(&iter)) != NULL) {
500 SCM_APPEND1(h, t, e->value);
501 }
502 (void)SCM_INTERNAL_MUTEX_UNLOCK(modules.mutex);
503 return h;
504 }
505
506 void Scm_SelectModule(ScmModule *mod)
507 {
508 SCM_ASSERT(SCM_MODULEP(mod));
509 Scm_VM()->module = mod;
510 }
511
512 /*----------------------------------------------------------------------
513 * Module and pathnames
514 */
515
516 /* Convert module name and pathname (mod load-path) and vice versa.
517 The default conversion is pretty straightforward, e.g.
518 util.list <=> "util/list" etc. However, modules and files can
519 have many-to-many mapping, and I'd like to reserve the room
520 of future extensions. Eventually there will be some special
521 mapping table so the programmer can register exceptional mappings. */
522
523 ScmObj Scm_ModuleNameToPath(ScmSymbol *name)
524 {
525 const ScmStringBody *b = SCM_STRING_BODY(SCM_SYMBOL_NAME(name));
526 char *buf = SCM_NEW_ATOMIC2(char *, SCM_STRING_BODY_SIZE(b)+1);
527 char *p = buf, *e = buf + SCM_STRING_BODY_SIZE(b);
528 memcpy(buf, SCM_STRING_BODY_START(b), SCM_STRING_BODY_SIZE(b));
529 while (p < e) {
530 int n = SCM_CHAR_NFOLLOWS(*p);
531 if (*p == '.') *p++ = '/';
532 else p += n+1;
533 }
534 *e = '\0';
535 return Scm_MakeString(buf, SCM_STRING_BODY_SIZE(b),
536 SCM_STRING_BODY_LENGTH(b), 0);
537 }
538
539 ScmObj Scm_PathToModuleName(ScmString *path)
540 {
541 const ScmStringBody *b = SCM_STRING_BODY(path);
542 char *buf = SCM_NEW_ATOMIC2(char *, SCM_STRING_BODY_SIZE(b)+1);
543 char *p = buf, *e = buf + SCM_STRING_BODY_SIZE(b);
544 memcpy(buf, SCM_STRING_BODY_START(b), SCM_STRING_BODY_SIZE(b));
545 while (p < e) {
546 int n = SCM_CHAR_NFOLLOWS(*p);
547 if (*p == '/') *p++ = '.';
548 else if (*p == '.') Scm_Error("bad pathname for module path: %S", path);
549 else p += n+1;
550 }
551 *e = '\0';
552 return SCM_INTERN(buf);
553 }
554
555
556 /*----------------------------------------------------------------------
557 * Predefined modules and initialization
558 */
559
560 ScmModule *Scm_NullModule(void)
561 {
562 return &nullModule;
563 }
564
565 ScmModule *Scm_SchemeModule(void)
566 {
567 return &schemeModule;
568 }
569
570 ScmModule *Scm_GaucheModule(void)
571 {
572 return &gaucheModule;
573 }
574
575 ScmModule *Scm_GaucheInternalModule(void)
576 {
577 return &internalModule;
578 }
579
580 ScmModule *Scm_UserModule(void)
581 {
582 return &userModule;
583 }
584
585 ScmModule *Scm_CurrentModule(void)
586 {
587 return Scm_VM()->module;
588 }
589
590 /* NB: we don't need to lock the global module table in initialization */
591 #define INIT_MOD(mod, mname, mpl) \
592 do { \
593 SCM_SET_CLASS(&mod, SCM_CLASS_MODULE); \
594 init_module(&mod, SCM_SYMBOL(mname)); \
595 Scm_HashTablePut(modules.table, SCM_OBJ((mod).name), SCM_OBJ(&mod));\
596 mod.parents = (SCM_NULLP(mpl)? SCM_NIL : SCM_LIST1(SCM_CAR(mpl))); \
597 mpl = mod.mpl = Scm_Cons(SCM_OBJ(&mod), mpl); \
598 } while (0)
599
600 void Scm__InitModule(void)
601 {
602 ScmObj mpl = SCM_NIL;
603
604 (void)SCM_INTERNAL_MUTEX_INIT(modules.mutex);
605 modules.table = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 64));
606
607 /* standard module chain */
608 INIT_MOD(nullModule, SCM_SYM_NULL, mpl);
609 INIT_MOD(schemeModule, SCM_SYM_SCHEME, mpl);
610 INIT_MOD(gaucheModule, SCM_SYM_GAUCHE, mpl);
611 INIT_MOD(gfModule, SCM_SYM_GAUCHE_GF, mpl);
612 INIT_MOD(userModule, SCM_SYM_USER, mpl);
613
614 mpl = SCM_CDR(mpl); /* default mpl doesn't include user module */
615 defaultParents = SCM_LIST1(SCM_CAR(mpl));
616 defaultMpl = mpl;
617 modules.anon_name = SCM_SYM_SHARP;
618
619 /* other modules */
620 mpl = defaultMpl;
621 INIT_MOD(internalModule, SCM_SYM_GAUCHE_INTERNAL, mpl);
622 }