libguile/modules.c

   1 /* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012 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 License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * 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
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21 #ifdef HAVE_CONFIG_H
  22 # include <config.h>
  23 #endif
  24
  25 #include <stdarg.h>
  26
  27 #include "libguile/_scm.h"
  28
  29 #include "libguile/eval.h"
  30 #include "libguile/smob.h"
  31 #include "libguile/procprop.h"
  32 #include "libguile/vectors.h"
  33 #include "libguile/hashtab.h"
  34 #include "libguile/struct.h"
  35 #include "libguile/variable.h"
  36 #include "libguile/fluids.h"
  37 #include "libguile/deprecation.h"
  38
  39 #include "libguile/modules.h"
  40
  41 int scm_module_system_booted_p = 0;
  42
  43 scm_t_bits scm_module_tag;
  44
  45 /* The current module, a fluid. */
  46 static SCM the_module;
  47
  48 /* Most of the module system is implemented in Scheme. These bindings from
  49    boot-9 are needed to provide the Scheme interface. */
  50 static SCM the_root_module_var;
  51 static SCM module_make_local_var_x_var;
  52 static SCM define_module_star_var;
  53 static SCM process_use_modules_var;
  54 static SCM resolve_module_var;
  55 static SCM module_public_interface_var;
  56 static SCM module_export_x_var;
  57 static SCM default_duplicate_binding_procedures_var;
  58
  59 /* The #:ensure keyword.  */
  60 static SCM k_ensure;
  61
  62
  63 static SCM unbound_variable (const char *func, SCM sym)
  64 {
  65   scm_error (scm_from_latin1_symbol ("unbound-variable"), func,
  66              "Unbound variable: ~S", scm_list_1 (sym), SCM_BOOL_F);
  67 }
  68
  69 SCM
  70 scm_the_root_module (void)
  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
  78 SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
  79             (),
  80             "Return the current module.")
  81 #define FUNC_NAME s_scm_current_module
  82 {
  83   if (scm_module_system_booted_p)
  84     return scm_fluid_ref (the_module);
  85   else
  86     return SCM_BOOL_F;
  87 }
  88 #undef FUNC_NAME
  89
  90 static void scm_post_boot_init_modules (void);
  91
  92 SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
  93             (SCM module),
  94             "Set the current module to @var{module} and return\n"
  95             "the previous current module.")
  96 #define FUNC_NAME s_scm_set_current_module
  97 {
  98   SCM old;
  99
 100   if (!scm_module_system_booted_p)
 101     scm_post_boot_init_modules ();
 102
 103   SCM_VALIDATE_MODULE (SCM_ARG1, module);
 104
 105   old = scm_current_module ();
 106   scm_fluid_set_x (the_module, module);
 107
 108   return old;
 109 }
 110 #undef FUNC_NAME
 111
 112 SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0,
 113             (),
 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.")
 119 #define FUNC_NAME s_scm_interaction_environment
 120 {
 121   return scm_current_module ();
 122 }
 123 #undef FUNC_NAME
 124
 125 SCM
 126 scm_c_call_with_current_module (SCM module,
 127                                 SCM (*func)(void *), void *data)
 128 {
 129   return scm_c_with_fluid (the_module, module, func, data);
 130 }
 131
 132 void
 133 scm_dynwind_current_module (SCM module)
 134 {
 135   scm_dynwind_fluid (the_module, module);
 136 }
 137
 138 /*
 139   convert "A B C" to scheme list (A B C)
 140  */
 141 static SCM
 142 convert_module_name (const char *name)
 143 {
 144   SCM list = SCM_EOL;
 145   SCM *tail = &list;
 146
 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         {
 157           SCM sym = scm_from_utf8_symboln (name, ptr-name);
 158           *tail = scm_cons (sym, SCM_EOL);
 159           tail = SCM_CDRLOC (*tail);
 160         }
 161       name = ptr;
 162     }
 163
 164   return list;
 165 }
 166
 167 SCM
 168 scm_c_resolve_module (const char *name)
 169 {
 170   return scm_resolve_module (convert_module_name (name));
 171 }
 172
 173 SCM
 174 scm_resolve_module (SCM name)
 175 {
 176   return scm_call_1 (SCM_VARIABLE_REF (resolve_module_var), name);
 177 }
 178
 179 SCM
 180 scm_c_define_module (const char *name,
 181                      void (*init)(void *), void *data)
 182 {
 183   SCM module = scm_call_1 (SCM_VARIABLE_REF (define_module_star_var),
 184                            convert_module_name (name));
 185   if (init)
 186     scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
 187   return module;
 188 }
 189
 190 void
 191 scm_c_use_module (const char *name)
 192 {
 193   scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var),
 194               scm_list_1 (scm_list_1 (convert_module_name (name))));
 195 }
 196
 197 SCM
 198 scm_module_export (SCM module, SCM namelist)
 199 {
 200   return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
 201                      module, namelist);
 202 }
 203
 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 */
 216 void
 217 scm_c_export (const char *name, ...)
 218 {
 219   if (name)
 220     {
 221       va_list ap;
 222       SCM names = scm_cons (scm_from_utf8_symbol (name), SCM_EOL);
 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;
 230           *tail = scm_cons (scm_from_utf8_symbol (n), SCM_EOL);
 231           tail = SCM_CDRLOC (*tail);
 232         }
 233       va_end (ap);
 234       scm_module_export (scm_current_module (), names);
 235     }
 236 }
 237
 238
 239 /*
 240  * C level implementation of the standard eval closure
 241  *
 242  * This increases loading speed substantially.  The code may be
 243  * replaced by something based on environments.[ch], in a future
 244  * release.
 245  */
 246
 247 /* Return the list of default duplicate binding handlers (procedures).  */
 248 static inline SCM
 249 default_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'.  */
 261 static inline SCM
 262 resolve_duplicate_binding (SCM module, SCM sym,
 263                            SCM iface1, SCM var1,
 264                            SCM iface2, SCM var2)
 265 {
 266   SCM args[8];
 267   SCM handlers;
 268   SCM result = SCM_BOOL_F;
 269
 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))
 291     {
 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;
 303     }
 304
 305   return SCM_BOOL_F;
 306 }
 307
 308 /* No lock is needed for access to this variable, as there are no
 309    threads before modules are booted.  */
 310 SCM scm_pre_modules_obarray;
 311
 312 /* Lookup SYM as an imported variable of MODULE.  */
 313 static inline SCM
 314 module_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.  */
 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.  */
 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
 378 SCM_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
 383 {
 384 #define SCM_BOUND_THING_P(b) \
 385   (scm_is_true (b))
 386
 387   register SCM b;
 388
 389   if (scm_module_system_booted_p)
 390     SCM_VALIDATE_MODULE (1, module);
 391
 392   SCM_VALIDATE_SYMBOL (2, sym);
 393
 394   if (scm_is_false (module))
 395     return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
 396
 397   /* 1. Check module obarray */
 398   b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
 399   if (SCM_BOUND_THING_P (b))
 400     return b;
 401
 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   */
 418
 419   {
 420     SCM binder = SCM_MODULE_BINDER (module);
 421
 422     if (scm_is_true (binder))
 423       {
 424         /* 2. */
 425         b = module_imported_variable (module, sym);
 426         if (SCM_BOUND_THING_P (b))
 427           return SCM_BOOL_F;
 428
 429         /* 3. */
 430         b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 431         if (SCM_BOUND_THING_P (b))
 432           return b;
 433       }
 434   }
 435
 436   return SCM_BOOL_F;
 437
 438 #undef SCM_BOUND_THING_P
 439 }
 440 #undef FUNC_NAME
 441
 442 SCM_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
 459   if (scm_is_false (module))
 460     return scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_UNDEFINED);
 461
 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
 472   {
 473     /* 3. Query the custom binder.  */
 474     SCM binder;
 475
 476     binder = SCM_MODULE_BINDER (module);
 477     if (scm_is_true (binder))
 478       {
 479         var = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 480         if (SCM_BOUND_THING_P (var))
 481           return var;
 482       }
 483   }
 484
 485   return SCM_BOOL_F;
 486
 487 #undef SCM_BOUND_THING_P
 488 }
 489 #undef FUNC_NAME
 490
 491 SCM
 492 scm_module_ensure_local_variable (SCM module, SCM sym)
 493 #define FUNC_NAME "module-ensure-local-variable"
 494 {
 495   if (SCM_LIKELY (scm_module_system_booted_p))
 496     {
 497       SCM_VALIDATE_MODULE (1, module);
 498       SCM_VALIDATE_SYMBOL (2, sym);
 499
 500       return scm_call_2 (SCM_VARIABLE_REF (module_make_local_var_x_var),
 501                          module, sym);
 502     }
 503
 504   {
 505     SCM handle, var;
 506
 507     handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
 508                                         sym, SCM_BOOL_F);
 509     var = SCM_CDR (handle);
 510
 511     if (scm_is_false (var))
 512       {
 513         var = scm_make_variable (SCM_UNDEFINED);
 514         SCM_SETCDR (handle, var);
 515       }
 516
 517     return var;
 518   }
 519 }
 520 #undef FUNC_NAME
 521
 522 SCM_SYMBOL (sym_macroexpand, "macroexpand");
 523
 524 SCM_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
 528 {
 529   if (SCM_UNLIKELY (scm_is_false (module)))
 530     {
 531       SCM v = scm_hashq_ref (scm_pre_modules_obarray,
 532                              sym_macroexpand,
 533                              SCM_BOOL_F);
 534       if (scm_is_false (v))
 535         SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL);
 536       return SCM_VARIABLE_REF (v);
 537     }
 538   else
 539     {
 540       SCM_VALIDATE_MODULE (SCM_ARG1, module);
 541       return SCM_MODULE_TRANSFORMER (module);
 542     }
 543 }
 544 #undef FUNC_NAME
 545
 546 SCM
 547 scm_current_module_transformer ()
 548 {
 549   return scm_module_transformer (scm_current_module ());
 550 }
 551
 552 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 553             (SCM module, SCM sym),
 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.")
 558 #define FUNC_NAME s_scm_module_import_interface
 559 {
 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))
 567     {
 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         }
 589     }
 590
 591   return result;
 592 }
 593 #undef FUNC_NAME
 594
 595 SCM
 596 scm_module_public_interface (SCM module)
 597 {
 598   return scm_call_1 (SCM_VARIABLE_REF (module_public_interface_var), module);
 599 }
 600
 601 SCM
 602 scm_c_module_lookup (SCM module, const char *name)
 603 {
 604   return scm_module_lookup (module, scm_from_utf8_symbol (name));
 605 }
 606
 607 SCM
 608 scm_module_lookup (SCM module, SCM sym)
 609 #define FUNC_NAME "module-lookup"
 610 {
 611   SCM var;
 612   var = scm_module_variable (module, sym);
 613   if (scm_is_false (var))
 614     unbound_variable (FUNC_NAME, sym);
 615   return var;
 616 }
 617 #undef FUNC_NAME
 618
 619 SCM
 620 scm_c_lookup (const char *name)
 621 {
 622   return scm_lookup (scm_from_utf8_symbol (name));
 623 }
 624
 625 SCM
 626 scm_lookup (SCM sym)
 627 {
 628   return scm_module_lookup (scm_current_module (), sym);
 629 }
 630
 631 SCM
 632 scm_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
 652 SCM
 653 scm_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
 667 SCM
 668 scm_c_public_variable (const char *module_name, const char *name)
 669 {
 670   return scm_public_variable (convert_module_name (module_name),
 671                               scm_from_utf8_symbol (name));
 672 }
 673
 674 SCM
 675 scm_c_private_variable (const char *module_name, const char *name)
 676 {
 677   return scm_private_variable (convert_module_name (module_name),
 678                                scm_from_utf8_symbol (name));
 679 }
 680
 681 SCM
 682 scm_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
 695 SCM
 696 scm_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
 709 SCM
 710 scm_c_public_lookup (const char *module_name, const char *name)
 711 {
 712   return scm_public_lookup (convert_module_name (module_name),
 713                             scm_from_utf8_symbol (name));
 714 }
 715
 716 SCM
 717 scm_c_private_lookup (const char *module_name, const char *name)
 718 {
 719   return scm_private_lookup (convert_module_name (module_name),
 720                              scm_from_utf8_symbol (name));
 721 }
 722
 723 SCM
 724 scm_public_ref (SCM module_name, SCM name)
 725 {
 726   return scm_variable_ref (scm_public_lookup (module_name, name));
 727 }
 728
 729 SCM
 730 scm_private_ref (SCM module_name, SCM name)
 731 {
 732   return scm_variable_ref (scm_private_lookup (module_name, name));
 733 }
 734
 735 SCM
 736 scm_c_public_ref (const char *module_name, const char *name)
 737 {
 738   return scm_public_ref (convert_module_name (module_name),
 739                          scm_from_utf8_symbol (name));
 740 }
 741
 742 SCM
 743 scm_c_private_ref (const char *module_name, const char *name)
 744 {
 745   return scm_private_ref (convert_module_name (module_name),
 746                           scm_from_utf8_symbol (name));
 747 }
 748
 749 SCM
 750 scm_c_module_define (SCM module, const char *name, SCM value)
 751 {
 752   return scm_module_define (module, scm_from_utf8_symbol (name), value);
 753 }
 754
 755 SCM
 756 scm_module_define (SCM module, SCM sym, SCM value)
 757 #define FUNC_NAME "module-define"
 758 {
 759   SCM var;
 760
 761   var = scm_module_ensure_local_variable (module, sym);
 762   SCM_VARIABLE_SET (var, value);
 763
 764   return var;
 765 }
 766 #undef FUNC_NAME
 767
 768 SCM
 769 scm_c_define (const char *name, SCM value)
 770 {
 771   return scm_define (scm_from_utf8_symbol (name), value);
 772 }
 773
 774 SCM_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
 780 {
 781   SCM_VALIDATE_SYMBOL (SCM_ARG1, sym);
 782
 783   return scm_module_define (scm_current_module (), sym, value);
 784 }
 785 #undef FUNC_NAME
 786
 787 SCM_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
 794 {
 795   SCM obarray;
 796   long i, n;
 797
 798   if (scm_is_false (module))
 799     obarray = scm_pre_modules_obarray;
 800   else
 801     {
 802       SCM_VALIDATE_MODULE (1, module);
 803       obarray = SCM_MODULE_OBARRAY (module);
 804     }
 805
 806   SCM_VALIDATE_VARIABLE (SCM_ARG2, variable);
 807
 808   if (!SCM_HASHTABLE_P (obarray))
 809       return SCM_BOOL_F;
 810
 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
 814   n = SCM_HASHTABLE_N_BUCKETS (obarray);
 815   for (i = 0; i < n; ++i)
 816     {
 817       SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle;
 818       while (!scm_is_null (ls))
 819         {
 820           handle = SCM_CAR (ls);
 821
 822           if (scm_is_eq (SCM_CDR (handle), variable))
 823             return SCM_CAR (handle);
 824
 825           ls = SCM_CDR (ls);
 826         }
 827     }
 828
 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     }
 841
 842   return SCM_BOOL_F;
 843 }
 844 #undef FUNC_NAME
 845
 846 SCM_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
 857 SCM_SYMBOL (scm_sym_system_module, "system-module");
 858
 859 void
 860 scm_modules_prehistory ()
 861 {
 862   scm_pre_modules_obarray = scm_c_make_hash_table (1790);
 863 }
 864
 865 void
 866 scm_init_modules ()
 867 {
 868 #include "libguile/modules.x"
 869   module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
 870                                             SCM_UNDEFINED);
 871   the_module = scm_make_fluid ();
 872 }
 873
 874 static void
 875 scm_post_boot_init_modules ()
 876 {
 877   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
 878   scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
 879
 880   resolve_module_var = scm_c_lookup ("resolve-module");
 881   define_module_star_var = scm_c_lookup ("define-module*");
 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");
 887   module_public_interface_var = scm_c_lookup ("module-public-interface");
 888   k_ensure = scm_from_locale_keyword ("ensure");
 889
 890   scm_module_system_booted_p = 1;
 891 }
 892
 893 /*
 894   Local Variables:
 895   c-file-style: "gnu"
 896   End:
 897 */