Simplify the interpreter for trivial inits and no letrec
[bpt/guile.git] / libguile / modules.c
CommitLineData
917b0e72 1/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
608860a5 2 *
73be1d9e 3 * This library is free software; you can redistribute it and/or
53befeb7
NJ
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
1ffa265b 7 *
53befeb7
NJ
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e
MV
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
1ffa265b 12 *
73be1d9e
MV
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
53befeb7
NJ
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16 * 02110-1301 USA
73be1d9e 17 */
6e8d25a6 18
6e8d25a6 19
1ffa265b 20\f
dbb605f5
LC
21#ifdef HAVE_CONFIG_H
22# include <config.h>
23#endif
1ffa265b 24
d02b98e9
MV
25#include <stdarg.h>
26
a0599745 27#include "libguile/_scm.h"
1ffa265b 28
a0599745 29#include "libguile/eval.h"
fb43bf74 30#include "libguile/smob.h"
a0599745 31#include "libguile/procprop.h"
152abe96
MD
32#include "libguile/vectors.h"
33#include "libguile/hashtab.h"
34#include "libguile/struct.h"
35#include "libguile/variable.h"
7f763132 36#include "libguile/fluids.h"
d02b98e9 37#include "libguile/deprecation.h"
1ffa265b 38
a0599745 39#include "libguile/modules.h"
1ffa265b 40
86d31dfe 41int scm_module_system_booted_p = 0;
e3365c07 42
92c2555f 43scm_t_bits scm_module_tag;
e3365c07 44
1c1a0823 45/* The current module, a fluid. */
1ffa265b
MD
46static SCM the_module;
47
1c1a0823
AW
48/* Most of the module system is implemented in Scheme. These bindings from
49 boot-9 are needed to provide the Scheme interface. */
3ac8359a 50static SCM the_root_module_var;
1c1a0823 51static SCM module_make_local_var_x_var;
57ced5b9 52static SCM define_module_star_var;
993dae86
AW
53static SCM process_use_modules_var;
54static SCM resolve_module_var;
55static SCM module_public_interface_var;
56static SCM module_export_x_var;
57static SCM default_duplicate_binding_procedures_var;
58
ef8e9356
AW
59/* The #:ensure keyword. */
60static SCM k_ensure;
61
3ac8359a 62
7ab42fa2
AW
63static SCM unbound_variable (const char *func, SCM sym)
64{
4a655e50 65 scm_error (scm_from_latin1_symbol ("unbound-variable"), func,
7ab42fa2
AW
66 "Unbound variable: ~S", scm_list_1 (sym), SCM_BOOL_F);
67}
68
f39fc3b3
AW
69SCM
70scm_the_root_module (void)
3ac8359a
NJ
71{
72 if (scm_module_system_booted_p)
73 return SCM_VARIABLE_REF (the_root_module_var);
74 else
75 return SCM_BOOL_F;
76}
77
55000e5f
MV
78SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
79 (),
80 "Return the current module.")
81#define FUNC_NAME s_scm_current_module
1ffa265b 82{
62e15979
AW
83 if (scm_module_system_booted_p)
84 return scm_fluid_ref (the_module);
85 else
86 return SCM_BOOL_F;
1ffa265b 87}
55000e5f 88#undef FUNC_NAME
1ffa265b 89
86d31dfe 90static void scm_post_boot_init_modules (void);
1ffa265b 91
55000e5f
MV
92SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
93 (SCM module),
9401323e 94 "Set the current module to @var{module} and return\n"
55000e5f
MV
95 "the previous current module.")
96#define FUNC_NAME s_scm_set_current_module
1ffa265b 97{
55000e5f
MV
98 SCM old;
99
86d31dfe
MV
100 if (!scm_module_system_booted_p)
101 scm_post_boot_init_modules ();
102
103 SCM_VALIDATE_MODULE (SCM_ARG1, module);
55000e5f
MV
104
105 old = scm_current_module ();
106 scm_fluid_set_x (the_module, module);
107
1ffa265b
MD
108 return old;
109}
55000e5f 110#undef FUNC_NAME
1ffa265b 111
e3365c07
MD
112SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0,
113 (),
1e6808ea
MG
114 "Return a specifier for the environment that contains\n"
115 "implementation--defined bindings, typically a superset of those\n"
116 "listed in the report. The intent is that this procedure will\n"
117 "return the environment in which the implementation would\n"
118 "evaluate expressions dynamically typed by the user.")
e3365c07
MD
119#define FUNC_NAME s_scm_interaction_environment
120{
aa767bc5 121 return scm_current_module ();
e3365c07
MD
122}
123#undef FUNC_NAME
124
1ffa265b 125SCM
d02b98e9
MV
126scm_c_call_with_current_module (SCM module,
127 SCM (*func)(void *), void *data)
1ffa265b 128{
d02b98e9 129 return scm_c_with_fluid (the_module, module, func, data);
1ffa265b
MD
130}
131
cb1cfc42 132void
661ae7ab 133scm_dynwind_current_module (SCM module)
cb1cfc42 134{
661ae7ab 135 scm_dynwind_fluid (the_module, module);
cb1cfc42 136}
06e80f59
HWN
137
138/*
139 convert "A B C" to scheme list (A B C)
140 */
d02b98e9
MV
141static SCM
142convert_module_name (const char *name)
281004cc 143{
d02b98e9
MV
144 SCM list = SCM_EOL;
145 SCM *tail = &list;
281004cc 146
d02b98e9
MV
147 const char *ptr;
148 while (*name)
149 {
150 while (*name == ' ')
151 name++;
152 ptr = name;
153 while (*ptr && *ptr != ' ')
154 ptr++;
155 if (ptr > name)
156 {
25d50a05 157 SCM sym = scm_from_utf8_symboln (name, ptr-name);
cc95e00a 158 *tail = scm_cons (sym, SCM_EOL);
d02b98e9
MV
159 tail = SCM_CDRLOC (*tail);
160 }
161 name = ptr;
162 }
163
164 return list;
1ffa265b
MD
165}
166
9e57344b 167SCM
d02b98e9 168scm_c_resolve_module (const char *name)
9e57344b 169{
d02b98e9 170 return scm_resolve_module (convert_module_name (name));
9e57344b
MV
171}
172
55000e5f 173SCM
d02b98e9 174scm_resolve_module (SCM name)
55000e5f 175{
fdc28395 176 return scm_call_1 (SCM_VARIABLE_REF (resolve_module_var), name);
55000e5f
MV
177}
178
179SCM
d02b98e9
MV
180scm_c_define_module (const char *name,
181 void (*init)(void *), void *data)
55000e5f 182{
57ced5b9
AW
183 SCM module = scm_call_1 (SCM_VARIABLE_REF (define_module_star_var),
184 convert_module_name (name));
d02b98e9
MV
185 if (init)
186 scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
187 return module;
55000e5f
MV
188}
189
d02b98e9
MV
190void
191scm_c_use_module (const char *name)
90184345 192{
fdc28395 193 scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var),
b64f4200 194 scm_list_1 (scm_list_1 (convert_module_name (name))));
90184345
MD
195}
196
608860a5
LC
197SCM
198scm_module_export (SCM module, SCM namelist)
06e80f59 199{
8c330007
MD
200 return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
201 module, namelist);
06e80f59
HWN
202}
203
eb880cef
MV
204
205/*
206 @code{scm_c_export}(@var{name-list})
207
208 @code{scm_c_export} exports the named bindings from the current
209 module, making them visible to users of the module. This function
210 takes a list of string arguments, terminated by NULL, e.g.
211
212 @example
213 scm_c_export ("add-double-record", "bamboozle-money", NULL);
214 @end example
215*/
d02b98e9
MV
216void
217scm_c_export (const char *name, ...)
281004cc 218{
eb880cef 219 if (name)
d02b98e9 220 {
eb880cef 221 va_list ap;
25d50a05 222 SCM names = scm_cons (scm_from_utf8_symbol (name), SCM_EOL);
eb880cef
MV
223 SCM *tail = SCM_CDRLOC (names);
224 va_start (ap, name);
225 while (1)
226 {
227 const char *n = va_arg (ap, const char *);
228 if (n == NULL)
229 break;
25d50a05 230 *tail = scm_cons (scm_from_utf8_symbol (n), SCM_EOL);
eb880cef
MV
231 tail = SCM_CDRLOC (*tail);
232 }
233 va_end (ap);
608860a5 234 scm_module_export (scm_current_module (), names);
d02b98e9 235 }
281004cc
MD
236}
237
06e80f59 238
152abe96
MD
239/*
240 * C level implementation of the standard eval closure
241 *
dd18d312
NJ
242 * This increases loading speed substantially. The code may be
243 * replaced by something based on environments.[ch], in a future
244 * release.
152abe96
MD
245 */
246
608860a5
LC
247/* Return the list of default duplicate binding handlers (procedures). */
248static inline SCM
249default_duplicate_binding_handlers (void)
250{
251 SCM get_handlers;
252
253 get_handlers = SCM_VARIABLE_REF (default_duplicate_binding_procedures_var);
254
255 return (scm_call_0 (get_handlers));
256}
257
258/* Resolve the import of SYM in MODULE, where SYM is currently provided by
259 both IFACE1 as VAR1 and IFACE2 as VAR2. Return the variable chosen by the
260 duplicate binding handlers or `#f'. */
261static inline SCM
262resolve_duplicate_binding (SCM module, SCM sym,
263 SCM iface1, SCM var1,
264 SCM iface2, SCM var2)
265{
319dd089
AW
266 SCM args[8];
267 SCM handlers;
608860a5
LC
268 SCM result = SCM_BOOL_F;
269
319dd089
AW
270 if (scm_is_eq (var1, var2))
271 return var1;
272
273 args[0] = module;
274 args[1] = sym;
275 args[2] = iface1;
276 args[3] = SCM_VARIABLE_REF (var1);
277 if (SCM_UNBNDP (args[3]))
278 args[3] = SCM_BOOL_F;
279 args[4] = iface2;
280 args[5] = SCM_VARIABLE_REF (var2);
281 if (SCM_UNBNDP (args[5]))
282 args[5] = SCM_BOOL_F;
283 args[6] = scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_BOOL_F);
284 args[7] = SCM_BOOL_F;
285
286 handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
287 if (scm_is_false (handlers))
288 handlers = default_duplicate_binding_handlers ();
289
290 for (; scm_is_pair (handlers); handlers = SCM_CDR (handlers))
608860a5 291 {
319dd089
AW
292 if (scm_is_true (args[6]))
293 {
294 args[7] = SCM_VARIABLE_REF (args[6]);
295 if (SCM_UNBNDP (args[7]))
296 args[7] = SCM_BOOL_F;
297 }
298
299 result = scm_call_n (SCM_CAR (handlers), args, 8);
300
301 if (scm_is_true (result))
302 return result;
608860a5 303 }
608860a5 304
319dd089 305 return SCM_BOOL_F;
608860a5
LC
306}
307
e8065fe4
AW
308/* No lock is needed for access to this variable, as there are no
309 threads before modules are booted. */
73dea589
AW
310SCM scm_pre_modules_obarray;
311
608860a5
LC
312/* Lookup SYM as an imported variable of MODULE. */
313static inline SCM
314module_imported_variable (SCM module, SCM sym)
315{
316#define SCM_BOUND_THING_P scm_is_true
317 register SCM var, imports;
318
319 /* Search cached imported bindings. */
320 imports = SCM_MODULE_IMPORT_OBARRAY (module);
321 var = scm_hashq_ref (imports, sym, SCM_UNDEFINED);
322 if (SCM_BOUND_THING_P (var))
323 return var;
324
325 {
326 /* Search the use list for yet uncached imported bindings, possibly
327 resolving duplicates as needed and caching the result in the import
328 obarray. */
329 SCM uses;
330 SCM found_var = SCM_BOOL_F, found_iface = SCM_BOOL_F;
331
332 for (uses = SCM_MODULE_USES (module);
333 scm_is_pair (uses);
334 uses = SCM_CDR (uses))
335 {
336 SCM iface;
337
338 iface = SCM_CAR (uses);
339 var = scm_module_variable (iface, sym);
340
341 if (SCM_BOUND_THING_P (var))
342 {
343 if (SCM_BOUND_THING_P (found_var))
344 {
345 /* SYM is a duplicate binding (imported more than once) so we
346 need to resolve it. */
319dd089
AW
347 found_var = resolve_duplicate_binding (module, sym,
348 found_iface, found_var,
349 iface, var);
350
351 /* Note that it could be that FOUND_VAR doesn't belong
352 either to FOUND_IFACE or to IFACE, if it was created
353 by merge-generics. The right thing to do there would
354 be to treat the import obarray as the iface, but the
355 import obarray isn't actually a module. Oh well. */
608860a5
LC
356 if (scm_is_eq (found_var, var))
357 found_iface = iface;
358 }
359 else
360 /* Keep track of the variable we found and check for other
361 occurences of SYM in the use list. */
362 found_var = var, found_iface = iface;
363 }
364 }
365
366 if (SCM_BOUND_THING_P (found_var))
367 {
368 /* Save the lookup result for future reference. */
369 (void) scm_hashq_set_x (imports, sym, found_var);
370 return found_var;
371 }
372 }
373
374 return SCM_BOOL_F;
375#undef SCM_BOUND_THING_P
376}
377
378SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
379 (SCM module, SCM sym),
380 "Return the variable bound to @var{sym} in @var{module}. Return "
381 "@code{#f} is @var{sym} is not bound locally in @var{module}.")
382#define FUNC_NAME s_scm_module_local_variable
152abe96 383{
dc187f33 384#define SCM_BOUND_THING_P(b) \
7888309b 385 (scm_is_true (b))
dc187f33 386
608860a5
LC
387 register SCM b;
388
608860a5
LC
389 if (scm_module_system_booted_p)
390 SCM_VALIDATE_MODULE (1, module);
391
392 SCM_VALIDATE_SYMBOL (2, sym);
393
165a7596
AW
394 if (scm_is_false (module))
395 return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
608860a5 396
152abe96 397 /* 1. Check module obarray */
608860a5 398 b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
dc187f33 399 if (SCM_BOUND_THING_P (b))
152abe96 400 return b;
608860a5 401
3be87279
AW
402 /* At this point we should just be able to return #f, but there is the
403 possibility that a custom binder establishes a mapping for this
404 variable.
405
406 However a custom binder should be called only if there is no
407 imported binding with the name SYM. So here instead of the order:
408
409 2. Search imported bindings. In order to be consistent with
410 `module-variable', the binder gets called only when no
411 imported binding matches SYM.
412
413 3. Query the custom binder.
414
415 we first check if there is a binder at all, and if not, just return
416 #f directly.
417 */
608860a5 418
152abe96 419 {
e3365c07 420 SCM binder = SCM_MODULE_BINDER (module);
608860a5 421
7888309b 422 if (scm_is_true (binder))
152abe96 423 {
3be87279
AW
424 /* 2. */
425 b = module_imported_variable (module, sym);
426 if (SCM_BOUND_THING_P (b))
427 return SCM_BOOL_F;
428
429 /* 3. */
fdc28395 430 b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
dc187f33 431 if (SCM_BOUND_THING_P (b))
152abe96
MD
432 return b;
433 }
434 }
608860a5
LC
435
436 return SCM_BOOL_F;
437
438#undef SCM_BOUND_THING_P
439}
440#undef FUNC_NAME
441
442SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
443 (SCM module, SCM sym),
444 "Return the variable bound to @var{sym} in @var{module}. This "
445 "may be both a local variable or an imported variable. Return "
446 "@code{#f} is @var{sym} is not bound in @var{module}.")
447#define FUNC_NAME s_scm_module_variable
448{
449#define SCM_BOUND_THING_P(b) \
450 (scm_is_true (b))
451
452 register SCM var;
453
454 if (scm_module_system_booted_p)
455 SCM_VALIDATE_MODULE (1, module);
456
457 SCM_VALIDATE_SYMBOL (2, sym);
458
73dea589
AW
459 if (scm_is_false (module))
460 return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
461
608860a5
LC
462 /* 1. Check module obarray */
463 var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
464 if (SCM_BOUND_THING_P (var))
465 return var;
466
467 /* 2. Search among the imported variables. */
468 var = module_imported_variable (module, sym);
469 if (SCM_BOUND_THING_P (var))
470 return var;
471
152abe96 472 {
608860a5
LC
473 /* 3. Query the custom binder. */
474 SCM binder;
475
476 binder = SCM_MODULE_BINDER (module);
477 if (scm_is_true (binder))
152abe96 478 {
608860a5
LC
479 var = scm_call_3 (binder, module, sym, SCM_BOOL_F);
480 if (SCM_BOUND_THING_P (var))
481 return var;
152abe96 482 }
152abe96 483 }
608860a5
LC
484
485 return SCM_BOOL_F;
486
dc187f33 487#undef SCM_BOUND_THING_P
152abe96 488}
608860a5 489#undef FUNC_NAME
152abe96 490
fb43bf74 491SCM
62e15979
AW
492scm_module_ensure_local_variable (SCM module, SCM sym)
493#define FUNC_NAME "module-ensure-local-variable"
152abe96 494{
62e15979 495 if (SCM_LIKELY (scm_module_system_booted_p))
86d31dfe 496 {
62e15979
AW
497 SCM_VALIDATE_MODULE (1, module);
498 SCM_VALIDATE_SYMBOL (2, sym);
499
fdc28395 500 return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var),
62e15979 501 module, sym);
86d31dfe 502 }
152abe96 503
62e15979
AW
504 {
505 SCM handle, var;
152abe96 506
62e15979
AW
507 handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
508 sym, SCM_BOOL_F);
509 var = SCM_CDR (handle);
e4da0740 510
62e15979
AW
511 if (scm_is_false (var))
512 {
513 var = scm_make_variable (SCM_UNDEFINED);
514 SCM_SETCDR (handle, var);
515 }
86d31dfe 516
62e15979
AW
517 return var;
518 }
daedb492
AW
519}
520#undef FUNC_NAME
521
4f692ace 522SCM_SYMBOL (sym_macroexpand, "macroexpand");
b7e6589f 523
5f161164
AW
524SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
525 (SCM module),
526 "Returns the syntax expander for the given module.")
527#define FUNC_NAME s_scm_module_transformer
d02b98e9 528{
b7e6589f 529 if (SCM_UNLIKELY (scm_is_false (module)))
4f692ace
AW
530 {
531 SCM v = scm_hashq_ref (scm_pre_modules_obarray,
532 sym_macroexpand,
b7e6589f
AW
533 SCM_BOOL_F);
534 if (scm_is_false (v))
4f692ace
AW
535 SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL);
536 return SCM_VARIABLE_REF (v);
b7e6589f 537 }
d02b98e9 538 else
5f161164
AW
539 {
540 SCM_VALIDATE_MODULE (SCM_ARG1, module);
541 return SCM_MODULE_TRANSFORMER (module);
542 }
d02b98e9 543}
5f161164 544#undef FUNC_NAME
d02b98e9
MV
545
546SCM
547scm_current_module_transformer ()
548{
b7e6589f 549 return scm_module_transformer (scm_current_module ());
d02b98e9
MV
550}
551
109c2c9f
MD
552SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
553 (SCM module, SCM sym),
608860a5
LC
554 "Return the module or interface from which @var{sym} is imported "
555 "in @var{module}. If @var{sym} is not imported (i.e., it is not "
556 "defined in @var{module} or it is a module-local binding instead "
557 "of an imported one), then @code{#f} is returned.")
109c2c9f
MD
558#define FUNC_NAME s_scm_module_import_interface
559{
608860a5
LC
560 SCM var, result = SCM_BOOL_F;
561
562 SCM_VALIDATE_MODULE (1, module);
563 SCM_VALIDATE_SYMBOL (2, sym);
564
565 var = scm_module_variable (module, sym);
566 if (scm_is_true (var))
109c2c9f 567 {
608860a5
LC
568 /* Look for the module that provides VAR. */
569 SCM local_var;
570
571 local_var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym,
572 SCM_UNDEFINED);
573 if (scm_is_eq (local_var, var))
574 result = module;
575 else
576 {
577 /* Look for VAR among the used modules. */
578 SCM uses, imported_var;
579
580 for (uses = SCM_MODULE_USES (module);
581 scm_is_pair (uses) && scm_is_false (result);
582 uses = SCM_CDR (uses))
583 {
584 imported_var = scm_module_variable (SCM_CAR (uses), sym);
585 if (scm_is_eq (imported_var, var))
586 result = SCM_CAR (uses);
587 }
588 }
109c2c9f 589 }
608860a5
LC
590
591 return result;
109c2c9f
MD
592}
593#undef FUNC_NAME
594
993dae86
AW
595SCM
596scm_module_public_interface (SCM module)
dc68fdb9 597{
993dae86 598 return scm_call_1 (SCM_VARIABLE_REF (module_public_interface_var), module);
dc68fdb9 599}
dc68fdb9 600
86d31dfe
MV
601SCM
602scm_c_module_lookup (SCM module, const char *name)
603{
25d50a05 604 return scm_module_lookup (module, scm_from_utf8_symbol (name));
86d31dfe
MV
605}
606
607SCM
608scm_module_lookup (SCM module, SCM sym)
609#define FUNC_NAME "module-lookup"
610{
611 SCM var;
62e15979 612 var = scm_module_variable (module, sym);
7888309b 613 if (scm_is_false (var))
7ab42fa2 614 unbound_variable (FUNC_NAME, sym);
86d31dfe
MV
615 return var;
616}
617#undef FUNC_NAME
618
619SCM
620scm_c_lookup (const char *name)
621{
25d50a05 622 return scm_lookup (scm_from_utf8_symbol (name));
86d31dfe
MV
623}
624
625SCM
626scm_lookup (SCM sym)
627{
62e15979 628 return scm_module_lookup (scm_current_module (), sym);
86d31dfe
MV
629}
630
ef8e9356
AW
631SCM
632scm_public_variable (SCM module_name, SCM name)
633{
634 SCM mod, iface;
635
636 mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
637 k_ensure, SCM_BOOL_F);
638
639 if (scm_is_false (mod))
640 scm_misc_error ("public-lookup", "Module named ~s does not exist",
641 scm_list_1 (module_name));
642
643 iface = scm_module_public_interface (mod);
644
645 if (scm_is_false (iface))
646 scm_misc_error ("public-lookup", "Module ~s has no public interface",
647 scm_list_1 (mod));
648
649 return scm_module_variable (iface, name);
650}
651
652SCM
653scm_private_variable (SCM module_name, SCM name)
654{
655 SCM mod;
656
657 mod = scm_call_3 (scm_variable_ref (resolve_module_var), module_name,
658 k_ensure, SCM_BOOL_F);
659
660 if (scm_is_false (mod))
661 scm_misc_error ("private-lookup", "Module named ~s does not exist",
662 scm_list_1 (module_name));
663
664 return scm_module_variable (mod, name);
665}
666
667SCM
668scm_c_public_variable (const char *module_name, const char *name)
669{
670 return scm_public_variable (convert_module_name (module_name),
25d50a05 671 scm_from_utf8_symbol (name));
ef8e9356
AW
672}
673
674SCM
675scm_c_private_variable (const char *module_name, const char *name)
676{
677 return scm_private_variable (convert_module_name (module_name),
25d50a05 678 scm_from_utf8_symbol (name));
ef8e9356
AW
679}
680
681SCM
682scm_public_lookup (SCM module_name, SCM name)
683{
684 SCM var;
685
686 var = scm_public_variable (module_name, name);
687
688 if (scm_is_false (var))
689 scm_misc_error ("public-lookup", "No variable bound to ~s in module ~s",
690 scm_list_2 (name, module_name));
691
692 return var;
693}
694
695SCM
696scm_private_lookup (SCM module_name, SCM name)
697{
698 SCM var;
699
700 var = scm_private_variable (module_name, name);
701
702 if (scm_is_false (var))
703 scm_misc_error ("private-lookup", "No variable bound to ~s in module ~s",
704 scm_list_2 (name, module_name));
705
706 return var;
707}
708
709SCM
710scm_c_public_lookup (const char *module_name, const char *name)
711{
712 return scm_public_lookup (convert_module_name (module_name),
25d50a05 713 scm_from_utf8_symbol (name));
ef8e9356
AW
714}
715
716SCM
717scm_c_private_lookup (const char *module_name, const char *name)
718{
719 return scm_private_lookup (convert_module_name (module_name),
25d50a05 720 scm_from_utf8_symbol (name));
ef8e9356
AW
721}
722
723SCM
724scm_public_ref (SCM module_name, SCM name)
725{
726 return scm_variable_ref (scm_public_lookup (module_name, name));
727}
728
729SCM
730scm_private_ref (SCM module_name, SCM name)
731{
732 return scm_variable_ref (scm_private_lookup (module_name, name));
733}
734
735SCM
736scm_c_public_ref (const char *module_name, const char *name)
737{
738 return scm_public_ref (convert_module_name (module_name),
25d50a05 739 scm_from_utf8_symbol (name));
ef8e9356
AW
740}
741
742SCM
743scm_c_private_ref (const char *module_name, const char *name)
744{
745 return scm_private_ref (convert_module_name (module_name),
25d50a05 746 scm_from_utf8_symbol (name));
ef8e9356
AW
747}
748
86d31dfe
MV
749SCM
750scm_c_module_define (SCM module, const char *name, SCM value)
751{
25d50a05 752 return scm_module_define (module, scm_from_utf8_symbol (name), value);
86d31dfe
MV
753}
754
755SCM
756scm_module_define (SCM module, SCM sym, SCM value)
757#define FUNC_NAME "module-define"
758{
759 SCM var;
86d31dfe 760
62e15979 761 var = scm_module_ensure_local_variable (module, sym);
86d31dfe 762 SCM_VARIABLE_SET (var, value);
62e15979 763
86d31dfe
MV
764 return var;
765}
766#undef FUNC_NAME
767
768SCM
769scm_c_define (const char *name, SCM value)
770{
25d50a05 771 return scm_define (scm_from_utf8_symbol (name), value);
86d31dfe
MV
772}
773
c7a2a803
AW
774SCM_DEFINE (scm_define, "define!", 2, 0, 0,
775 (SCM sym, SCM value),
776 "Define @var{sym} to be @var{value} in the current module."
777 "Returns the variable itself. Note that this is a procedure, "
778 "not a macro.")
779#define FUNC_NAME s_scm_define
86d31dfe 780{
c7a2a803 781 SCM_VALIDATE_SYMBOL (SCM_ARG1, sym);
62e15979
AW
782
783 return scm_module_define (scm_current_module (), sym, value);
86d31dfe 784}
c7a2a803 785#undef FUNC_NAME
86d31dfe 786
608860a5
LC
787SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
788 (SCM module, SCM variable),
789 "Return the symbol under which @var{variable} is bound in "
790 "@var{module} or @var{#f} if @var{variable} is not visible "
791 "from @var{module}. If @var{module} is @code{#f}, then the "
792 "pre-module obarray is used.")
793#define FUNC_NAME s_scm_module_reverse_lookup
86d31dfe
MV
794{
795 SCM obarray;
c014a02e 796 long i, n;
86d31dfe 797
7888309b 798 if (scm_is_false (module))
86d31dfe
MV
799 obarray = scm_pre_modules_obarray;
800 else
801 {
802 SCM_VALIDATE_MODULE (1, module);
803 obarray = SCM_MODULE_OBARRAY (module);
804 }
805
1606312f
LC
806 SCM_VALIDATE_VARIABLE (SCM_ARG2, variable);
807
6dc1cd1e
MV
808 if (!SCM_HASHTABLE_P (obarray))
809 return SCM_BOOL_F;
810
86d31dfe
MV
811 /* XXX - We do not use scm_hash_fold here to avoid searching the
812 whole obarray. We should have a scm_hash_find procedure. */
813
c35738c1 814 n = SCM_HASHTABLE_N_BUCKETS (obarray);
86d31dfe
MV
815 for (i = 0; i < n; ++i)
816 {
4057a3e0 817 SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle;
d2e53ed6 818 while (!scm_is_null (ls))
86d31dfe
MV
819 {
820 handle = SCM_CAR (ls);
741e83fc 821
a141db86
AW
822 if (scm_is_eq (SCM_CDR (handle), variable))
823 return SCM_CAR (handle);
741e83fc 824
86d31dfe
MV
825 ls = SCM_CDR (ls);
826 }
827 }
828
1606312f
LC
829 if (!scm_is_false (module))
830 {
831 /* Try the `uses' list. */
832 SCM uses = SCM_MODULE_USES (module);
833 while (scm_is_pair (uses))
834 {
835 SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
836 if (scm_is_true (sym))
837 return sym;
838 uses = SCM_CDR (uses);
839 }
840 }
86d31dfe
MV
841
842 return SCM_BOOL_F;
843}
844#undef FUNC_NAME
845
846SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0,
847 (),
848 "Return the obarray that is used for all new bindings before "
849 "the module system is booted. The first call to "
850 "@code{set-current-module} will boot the module system.")
851#define FUNC_NAME s_scm_get_pre_modules_obarray
852{
853 return scm_pre_modules_obarray;
854}
855#undef FUNC_NAME
856
d02b98e9
MV
857SCM_SYMBOL (scm_sym_system_module, "system-module");
858
86d31dfe
MV
859void
860scm_modules_prehistory ()
861{
917b0e72 862 scm_pre_modules_obarray = scm_c_make_hash_table (1790);
86d31dfe
MV
863}
864
1ffa265b
MD
865void
866scm_init_modules ()
867{
a0599745 868#include "libguile/modules.x"
86d31dfe
MV
869 module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
870 SCM_UNDEFINED);
f39448c5 871 the_module = scm_make_fluid ();
1ffa265b
MD
872}
873
86d31dfe 874static void
1ffa265b
MD
875scm_post_boot_init_modules ()
876{
86d31dfe 877 SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
904a077d 878 scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
d02b98e9 879
f39448c5 880 resolve_module_var = scm_c_lookup ("resolve-module");
57ced5b9 881 define_module_star_var = scm_c_lookup ("define-module*");
f39448c5
AW
882 process_use_modules_var = scm_c_lookup ("process-use-modules");
883 module_export_x_var = scm_c_lookup ("module-export!");
884 the_root_module_var = scm_c_lookup ("the-root-module");
885 default_duplicate_binding_procedures_var =
886 scm_c_lookup ("default-duplicate-binding-procedures");
993dae86 887 module_public_interface_var = scm_c_lookup ("module-public-interface");
ef8e9356 888 k_ensure = scm_from_locale_keyword ("ensure");
d02b98e9 889
e3365c07 890 scm_module_system_booted_p = 1;
1ffa265b 891}
89e00824
ML
892
893/*
894 Local Variables:
895 c-file-style: "gnu"
896 End:
897*/