← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to libguile/modules.c

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
Import upstream version 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libguile/modules.c
 
1
/* Copyright (C) 1998,2000,2001,2002, 2003, 2004, 2006 Free Software Foundation, Inc.
 
2
 * 
 
3
 * This library is free software; you can redistribute it and/or
 
4
 * modify it under the terms of the GNU Lesser General Public
 
5
 * License as published by the Free Software Foundation; either
 
6
 * version 2.1 of the License, or (at your option) any later version.
 
7
 *
 
8
 * This library is distributed in the hope that it will be useful,
 
9
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
11
 * Lesser General Public License for more details.
 
12
 *
 
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
 
15
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
16
 */
 
17
 
 
18
 
 
19
 
 
20
 
 
21
#include <stdarg.h>
 
22
 
 
23
#include "libguile/_scm.h"
 
24
 
 
25
#include "libguile/eval.h"
 
26
#include "libguile/smob.h"
 
27
#include "libguile/procprop.h"
 
28
#include "libguile/vectors.h"
 
29
#include "libguile/hashtab.h"
 
30
#include "libguile/struct.h"
 
31
#include "libguile/variable.h"
 
32
#include "libguile/fluids.h"
 
33
#include "libguile/deprecation.h"
 
34
 
 
35
#include "libguile/modules.h"
 
36
 
 
37
int scm_module_system_booted_p = 0;
 
38
 
 
39
scm_t_bits scm_module_tag;
 
40
 
 
41
static SCM the_module;
 
42
 
 
43
SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
 
44
            (),
 
45
            "Return the current module.")
 
46
#define FUNC_NAME s_scm_current_module
 
47
{
 
48
  return scm_fluid_ref (the_module);
 
49
}
 
50
#undef FUNC_NAME
 
51
 
 
52
static void scm_post_boot_init_modules (void);
 
53
 
 
54
SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
 
55
            (SCM module),
 
56
            "Set the current module to @var{module} and return\n"
 
57
            "the previous current module.")
 
58
#define FUNC_NAME s_scm_set_current_module
 
59
{
 
60
  SCM old;
 
61
 
 
62
  if (!scm_module_system_booted_p)
 
63
    scm_post_boot_init_modules ();
 
64
 
 
65
  SCM_VALIDATE_MODULE (SCM_ARG1, module);
 
66
 
 
67
  old = scm_current_module ();
 
68
  scm_fluid_set_x (the_module, module);
 
69
 
 
70
  return old;
 
71
}
 
72
#undef FUNC_NAME
 
73
 
 
74
SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0,
 
75
            (),
 
76
            "Return a specifier for the environment that contains\n"
 
77
            "implementation--defined bindings, typically a superset of those\n"
 
78
            "listed in the report.  The intent is that this procedure will\n"
 
79
            "return the environment in which the implementation would\n"
 
80
            "evaluate expressions dynamically typed by the user.")
 
81
#define FUNC_NAME s_scm_interaction_environment
 
82
{
 
83
  return scm_current_module ();
 
84
}
 
85
#undef FUNC_NAME
 
86
 
 
87
SCM
 
88
scm_c_call_with_current_module (SCM module,
 
89
                                SCM (*func)(void *), void *data)
 
90
{
 
91
  return scm_c_with_fluid (the_module, module, func, data);
 
92
}
 
93
 
 
94
void
 
95
scm_dynwind_current_module (SCM module)
 
96
{
 
97
  scm_dynwind_fluid (the_module, module);
 
98
}
 
99
 
 
100
/*
 
101
  convert "A B C" to scheme list (A B C)
 
102
 */
 
103
static SCM
 
104
convert_module_name (const char *name)
 
105
{
 
106
  SCM list = SCM_EOL;
 
107
  SCM *tail = &list;
 
108
 
 
109
  const char *ptr;
 
110
  while (*name)
 
111
    {
 
112
      while (*name == ' ')
 
113
        name++;
 
114
      ptr = name;
 
115
      while (*ptr && *ptr != ' ')
 
116
        ptr++;
 
117
      if (ptr > name)
 
118
        {
 
119
          SCM sym = scm_from_locale_symboln (name, ptr-name);
 
120
          *tail = scm_cons (sym, SCM_EOL);
 
121
          tail = SCM_CDRLOC (*tail);
 
122
        }
 
123
      name = ptr;
 
124
    }
 
125
 
 
126
  return list;
 
127
}
 
128
 
 
129
static SCM process_define_module_var;
 
130
static SCM process_use_modules_var;
 
131
static SCM resolve_module_var;
 
132
 
 
133
SCM
 
134
scm_c_resolve_module (const char *name)
 
135
{
 
136
  return scm_resolve_module (convert_module_name (name));
 
137
}
 
138
 
 
139
SCM
 
140
scm_resolve_module (SCM name)
 
141
{
 
142
  return scm_call_1 (SCM_VARIABLE_REF (resolve_module_var), name);
 
143
}
 
144
 
 
145
SCM
 
146
scm_c_define_module (const char *name,
 
147
                     void (*init)(void *), void *data)
 
148
{
 
149
  SCM module = scm_call_1 (SCM_VARIABLE_REF (process_define_module_var),
 
150
                           scm_list_1 (convert_module_name (name)));
 
151
  if (init)
 
152
    scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
 
153
  return module;
 
154
}
 
155
 
 
156
void
 
157
scm_c_use_module (const char *name)
 
158
{
 
159
  scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var),
 
160
              scm_list_1 (scm_list_1 (convert_module_name (name))));
 
161
}
 
162
 
 
163
static SCM module_export_x_var;
 
164
 
 
165
 
 
166
/*
 
167
  TODO: should export this function? --hwn.
 
168
 */
 
169
static SCM
 
170
scm_export (SCM module, SCM namelist)
 
171
{
 
172
  return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
 
173
                     module, namelist);
 
174
}
 
175
 
 
176
 
 
177
/*
 
178
  @code{scm_c_export}(@var{name-list})
 
179
 
 
180
  @code{scm_c_export} exports the named bindings from the current
 
181
  module, making them visible to users of the module. This function
 
182
  takes a list of string arguments, terminated by NULL, e.g.
 
183
 
 
184
  @example
 
185
    scm_c_export ("add-double-record", "bamboozle-money", NULL);
 
186
  @end example
 
187
*/
 
188
void
 
189
scm_c_export (const char *name, ...)
 
190
{
 
191
  if (name)
 
192
    {
 
193
      va_list ap;
 
194
      SCM names = scm_cons (scm_from_locale_symbol (name), SCM_EOL);
 
195
      SCM *tail = SCM_CDRLOC (names);
 
196
      va_start (ap, name);
 
197
      while (1)
 
198
        {
 
199
          const char *n = va_arg (ap, const char *);
 
200
          if (n == NULL)
 
201
            break;
 
202
          *tail = scm_cons (scm_from_locale_symbol (n), SCM_EOL);
 
203
          tail = SCM_CDRLOC (*tail);
 
204
        }
 
205
      va_end (ap);
 
206
      scm_export (scm_current_module(), names);
 
207
    }
 
208
}
 
209
 
 
210
 
 
211
/* Environments */
 
212
 
 
213
SCM
 
214
scm_top_level_env (SCM thunk)
 
215
{
 
216
  if (SCM_IMP (thunk))
 
217
    return SCM_EOL;
 
218
  else
 
219
    return scm_cons (thunk, SCM_EOL);
 
220
}
 
221
 
 
222
SCM
 
223
scm_env_top_level (SCM env)
 
224
{
 
225
  while (scm_is_pair (env))
 
226
    {
 
227
      SCM car_env = SCM_CAR (env);
 
228
      if (!scm_is_pair (car_env) && scm_is_true (scm_procedure_p (car_env)))
 
229
        return car_env;
 
230
      env = SCM_CDR (env);
 
231
    }
 
232
  return SCM_BOOL_F;
 
233
}
 
234
 
 
235
SCM_SYMBOL (sym_module, "module");
 
236
 
 
237
static SCM the_root_module_var;
 
238
 
 
239
static SCM
 
240
the_root_module ()
 
241
{
 
242
  if (scm_module_system_booted_p)
 
243
    return SCM_VARIABLE_REF (the_root_module_var);
 
244
  else
 
245
    return SCM_BOOL_F;
 
246
}
 
247
 
 
248
SCM
 
249
scm_lookup_closure_module (SCM proc)
 
250
{
 
251
  if (scm_is_false (proc))
 
252
    return the_root_module ();
 
253
  else if (SCM_EVAL_CLOSURE_P (proc))
 
254
    return SCM_PACK (SCM_SMOB_DATA (proc));
 
255
  else
 
256
    {
 
257
      SCM mod = scm_procedure_property (proc, sym_module);
 
258
      if (scm_is_false (mod))
 
259
        mod = the_root_module ();
 
260
      return mod;
 
261
    }
 
262
}
 
263
 
 
264
SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0,
 
265
            (SCM env),
 
266
            "Return the module of @var{ENV}, a lexical environment.")
 
267
#define FUNC_NAME s_scm_env_module
 
268
{
 
269
  return scm_lookup_closure_module (scm_env_top_level (env));
 
270
}
 
271
#undef FUNC_NAME
 
272
 
 
273
/*
 
274
 * C level implementation of the standard eval closure
 
275
 *
 
276
 * This increases loading speed substantially.
 
277
 * The code will be replaced by the low-level environments in next release.
 
278
 */
 
279
 
 
280
static SCM module_make_local_var_x_var;
 
281
 
 
282
static SCM
 
283
module_variable (SCM module, SCM sym)
 
284
{
 
285
#define SCM_BOUND_THING_P(b) \
 
286
  (scm_is_true (b))
 
287
 
 
288
  /* 1. Check module obarray */
 
289
  SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
 
290
  if (SCM_BOUND_THING_P (b))
 
291
    return b;
 
292
  {
 
293
    SCM binder = SCM_MODULE_BINDER (module);
 
294
    if (scm_is_true (binder))
 
295
      /* 2. Custom binder */
 
296
      {
 
297
        b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 
298
        if (SCM_BOUND_THING_P (b))
 
299
          return b;
 
300
      }
 
301
  }
 
302
  {
 
303
    /* 3. Search the use list */
 
304
    SCM uses = SCM_MODULE_USES (module);
 
305
    while (scm_is_pair (uses))
 
306
      {
 
307
        b = module_variable (SCM_CAR (uses), sym);
 
308
        if (SCM_BOUND_THING_P (b))
 
309
          return b;
 
310
        uses = SCM_CDR (uses);
 
311
      }
 
312
    return SCM_BOOL_F;
 
313
  }
 
314
#undef SCM_BOUND_THING_P
 
315
}
 
316
 
 
317
scm_t_bits scm_tc16_eval_closure;
 
318
 
 
319
#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<16)
 
320
#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \
 
321
  (SCM_CELL_WORD_0 (e) & SCM_F_EVAL_CLOSURE_INTERFACE)
 
322
 
 
323
/* NOTE: This function may be called by a smob application
 
324
   or from another C function directly. */
 
325
SCM
 
326
scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
 
327
{
 
328
  SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
 
329
  if (scm_is_true (definep))
 
330
    {
 
331
      if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
 
332
        return SCM_BOOL_F;
 
333
      return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var),
 
334
                         module, sym);
 
335
    }
 
336
  else
 
337
    return module_variable (module, sym);
 
338
}
 
339
 
 
340
SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
 
341
            (SCM module),
 
342
            "Return an eval closure for the module @var{module}.")
 
343
#define FUNC_NAME s_scm_standard_eval_closure
 
344
{
 
345
  SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module));
 
346
}
 
347
#undef FUNC_NAME
 
348
 
 
349
 
 
350
SCM_DEFINE (scm_standard_interface_eval_closure,
 
351
            "standard-interface-eval-closure", 1, 0, 0,
 
352
            (SCM module),
 
353
            "Return a interface eval closure for the module @var{module}. "
 
354
            "Such a closure does not allow new bindings to be added.")
 
355
#define FUNC_NAME s_scm_standard_interface_eval_closure
 
356
{
 
357
  SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | SCM_F_EVAL_CLOSURE_INTERFACE,
 
358
                      SCM_UNPACK (module));
 
359
}
 
360
#undef FUNC_NAME
 
361
 
 
362
SCM
 
363
scm_module_lookup_closure (SCM module)
 
364
{
 
365
  if (scm_is_false (module))
 
366
    return SCM_BOOL_F;
 
367
  else
 
368
    return SCM_MODULE_EVAL_CLOSURE (module);
 
369
}
 
370
 
 
371
SCM
 
372
scm_current_module_lookup_closure ()
 
373
{
 
374
  if (scm_module_system_booted_p)
 
375
    return scm_module_lookup_closure (scm_current_module ());
 
376
  else
 
377
    return SCM_BOOL_F;
 
378
}
 
379
 
 
380
SCM
 
381
scm_module_transformer (SCM module)
 
382
{
 
383
  if (scm_is_false (module))
 
384
    return SCM_BOOL_F;
 
385
  else
 
386
    return SCM_MODULE_TRANSFORMER (module);
 
387
}
 
388
 
 
389
SCM
 
390
scm_current_module_transformer ()
 
391
{
 
392
  if (scm_module_system_booted_p)
 
393
    return scm_module_transformer (scm_current_module ());
 
394
  else
 
395
    return SCM_BOOL_F;
 
396
}
 
397
 
 
398
SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 
399
            (SCM module, SCM sym),
 
400
            "")
 
401
#define FUNC_NAME s_scm_module_import_interface
 
402
{
 
403
#define SCM_BOUND_THING_P(b) (scm_is_true (b))
 
404
  SCM uses;
 
405
  SCM_VALIDATE_MODULE (SCM_ARG1, module);
 
406
  /* Search the use list */
 
407
  uses = SCM_MODULE_USES (module);
 
408
  while (scm_is_pair (uses))
 
409
    {
 
410
      SCM _interface = SCM_CAR (uses);
 
411
      /* 1. Check module obarray */
 
412
      SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (_interface), sym, SCM_BOOL_F);
 
413
      if (SCM_BOUND_THING_P (b))
 
414
        return _interface;
 
415
      {
 
416
        SCM binder = SCM_MODULE_BINDER (_interface);
 
417
        if (scm_is_true (binder))
 
418
          /* 2. Custom binder */
 
419
          {
 
420
            b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F);
 
421
            if (SCM_BOUND_THING_P (b))
 
422
              return _interface;
 
423
          }
 
424
      }
 
425
      /* 3. Search use list recursively. */
 
426
      _interface = scm_module_import_interface (_interface, sym);
 
427
      if (scm_is_true (_interface))
 
428
        return _interface;
 
429
      uses = SCM_CDR (uses);
 
430
    }
 
431
  return SCM_BOOL_F;
 
432
}
 
433
#undef FUNC_NAME
 
434
 
 
435
/* scm_sym2var
 
436
 *
 
437
 * looks up the variable bound to SYM according to PROC.  PROC should be
 
438
 * a `eval closure' of some module.
 
439
 *
 
440
 * When no binding exists, and DEFINEP is true, create a new binding
 
441
 * with a initial value of SCM_UNDEFINED.  Return `#f' when DEFINEP as
 
442
 * false and no binding exists.
 
443
 *
 
444
 * When PROC is `#f', it is ignored and the binding is searched for in
 
445
 * the scm_pre_modules_obarray (a `eq' hash table).
 
446
 */
 
447
 
 
448
SCM scm_pre_modules_obarray;
 
449
 
 
450
SCM 
 
451
scm_sym2var (SCM sym, SCM proc, SCM definep)
 
452
#define FUNC_NAME "scm_sym2var"
 
453
{
 
454
  SCM var;
 
455
 
 
456
  if (SCM_NIMP (proc))
 
457
    {
 
458
      if (SCM_EVAL_CLOSURE_P (proc))
 
459
        {
 
460
          /* Bypass evaluator in the standard case. */
 
461
          var = scm_eval_closure_lookup (proc, sym, definep);
 
462
        }
 
463
      else
 
464
        var = scm_call_2 (proc, sym, definep);
 
465
    }
 
466
  else
 
467
    {
 
468
      SCM handle;
 
469
 
 
470
      if (scm_is_false (definep))
 
471
        var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F);
 
472
      else
 
473
        {
 
474
          handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
 
475
                                              sym, SCM_BOOL_F);
 
476
          var = SCM_CDR (handle);
 
477
          if (scm_is_false (var))
 
478
            {
 
479
              var = scm_make_variable (SCM_UNDEFINED);
 
480
              SCM_SETCDR (handle, var);
 
481
            }
 
482
        }
 
483
    }
 
484
 
 
485
  if (scm_is_true (var) && !SCM_VARIABLEP (var))
 
486
    SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym));
 
487
 
 
488
  return var;
 
489
}
 
490
#undef FUNC_NAME
 
491
 
 
492
SCM
 
493
scm_c_module_lookup (SCM module, const char *name)
 
494
{
 
495
  return scm_module_lookup (module, scm_from_locale_symbol (name));
 
496
}
 
497
 
 
498
SCM
 
499
scm_module_lookup (SCM module, SCM sym)
 
500
#define FUNC_NAME "module-lookup"
 
501
{
 
502
  SCM var;
 
503
  SCM_VALIDATE_MODULE (1, module);
 
504
 
 
505
  var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
 
506
  if (scm_is_false (var))
 
507
    SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym));
 
508
  return var;
 
509
}
 
510
#undef FUNC_NAME
 
511
 
 
512
SCM
 
513
scm_c_lookup (const char *name)
 
514
{
 
515
  return scm_lookup (scm_from_locale_symbol (name));
 
516
}
 
517
 
 
518
SCM
 
519
scm_lookup (SCM sym)
 
520
{
 
521
  SCM var = 
 
522
    scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
 
523
  if (scm_is_false (var))
 
524
    scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym));
 
525
  return var;
 
526
}
 
527
 
 
528
SCM
 
529
scm_c_module_define (SCM module, const char *name, SCM value)
 
530
{
 
531
  return scm_module_define (module, scm_from_locale_symbol (name), value);
 
532
}
 
533
 
 
534
SCM
 
535
scm_module_define (SCM module, SCM sym, SCM value)
 
536
#define FUNC_NAME "module-define"
 
537
{
 
538
  SCM var;
 
539
  SCM_VALIDATE_MODULE (1, module);
 
540
 
 
541
  var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_T);
 
542
  SCM_VARIABLE_SET (var, value);
 
543
  return var;
 
544
}
 
545
#undef FUNC_NAME
 
546
 
 
547
SCM
 
548
scm_c_define (const char *name, SCM value)
 
549
{
 
550
  return scm_define (scm_from_locale_symbol (name), value);
 
551
}
 
552
 
 
553
SCM
 
554
scm_define (SCM sym, SCM value)
 
555
{
 
556
  SCM var =
 
557
    scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T);
 
558
  SCM_VARIABLE_SET (var, value);
 
559
  return var;
 
560
}
 
561
 
 
562
SCM
 
563
scm_module_reverse_lookup (SCM module, SCM variable)
 
564
#define FUNC_NAME "module-reverse-lookup"
 
565
{
 
566
  SCM obarray;
 
567
  long i, n;
 
568
 
 
569
  if (scm_is_false (module))
 
570
    obarray = scm_pre_modules_obarray;
 
571
  else
 
572
    {
 
573
      SCM_VALIDATE_MODULE (1, module);
 
574
      obarray = SCM_MODULE_OBARRAY (module);
 
575
    }
 
576
 
 
577
  if (!SCM_HASHTABLE_P (obarray))
 
578
      return SCM_BOOL_F;
 
579
 
 
580
  /* XXX - We do not use scm_hash_fold here to avoid searching the
 
581
     whole obarray.  We should have a scm_hash_find procedure. */
 
582
 
 
583
  n = SCM_HASHTABLE_N_BUCKETS (obarray);
 
584
  for (i = 0; i < n; ++i)
 
585
    {
 
586
      SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle;
 
587
      while (!scm_is_null (ls))
 
588
        {
 
589
          handle = SCM_CAR (ls);
 
590
          if (SCM_CDR (handle) == variable)
 
591
            return SCM_CAR (handle);
 
592
          ls = SCM_CDR (ls);
 
593
        }
 
594
    }
 
595
 
 
596
  /* Try the `uses' list. 
 
597
   */
 
598
  {
 
599
    SCM uses = SCM_MODULE_USES (module);
 
600
    while (scm_is_pair (uses))
 
601
      {
 
602
        SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
 
603
        if (scm_is_true (sym))
 
604
          return sym;
 
605
        uses = SCM_CDR (uses);
 
606
      }
 
607
  }
 
608
 
 
609
  return SCM_BOOL_F;
 
610
}
 
611
#undef FUNC_NAME
 
612
 
 
613
SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0,
 
614
            (),
 
615
            "Return the obarray that is used for all new bindings before "
 
616
            "the module system is booted.  The first call to "
 
617
            "@code{set-current-module} will boot the module system.")
 
618
#define FUNC_NAME s_scm_get_pre_modules_obarray
 
619
{
 
620
  return scm_pre_modules_obarray;
 
621
}
 
622
#undef FUNC_NAME
 
623
 
 
624
SCM_SYMBOL (scm_sym_system_module, "system-module");
 
625
 
 
626
SCM
 
627
scm_system_module_env_p (SCM env)
 
628
{
 
629
  SCM proc = scm_env_top_level (env);
 
630
  if (scm_is_false (proc))
 
631
    return SCM_BOOL_T;
 
632
  return ((scm_is_true (scm_procedure_property (proc,
 
633
                                                scm_sym_system_module)))
 
634
          ? SCM_BOOL_T
 
635
          : SCM_BOOL_F);
 
636
}
 
637
 
 
638
void
 
639
scm_modules_prehistory ()
 
640
{
 
641
  scm_pre_modules_obarray 
 
642
    = scm_permanent_object (scm_c_make_hash_table (1533));
 
643
}
 
644
 
 
645
void
 
646
scm_init_modules ()
 
647
{
 
648
#include "libguile/modules.x"
 
649
  module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
 
650
                                            SCM_UNDEFINED);
 
651
  scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
 
652
  scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
 
653
  scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
 
654
 
 
655
  the_module = scm_permanent_object (scm_make_fluid ());
 
656
}
 
657
 
 
658
static void
 
659
scm_post_boot_init_modules ()
 
660
{
 
661
#define PERM(x) scm_permanent_object(x)
 
662
 
 
663
  SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
 
664
  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
 
665
 
 
666
  resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
 
667
  process_define_module_var = PERM (scm_c_lookup ("process-define-module"));
 
668
  process_use_modules_var = PERM (scm_c_lookup ("process-use-modules"));
 
669
  module_export_x_var = PERM (scm_c_lookup ("module-export!"));
 
670
  the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
 
671
 
 
672
  scm_module_system_booted_p = 1;
 
673
}
 
674
 
 
675
/*
 
676
  Local Variables:
 
677
  c-file-style: "gnu"
 
678
  End:
 
679
*/