lily/ly-module.cc

   1 /*
   2   ly-module.cc --  implement guile module stuff.
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2002--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 */
   9
  10 #include "string.hh"
  11 #include "lily-guile.hh"
  12 #include "ly-module.hh"
  13 #include "protected-scm.hh"
  14
  15 #define FUNC_NAME __FUNCTION__
  16
  17 static int module_count;
  18
  19 void
  20 ly_init_anonymous_module (void * data)
  21 {
  22   (void) data;
  23   scm_c_use_module ("lily");
  24 }
  25
  26 Protected_scm anon_modules;
  27
  28 SCM
  29 ly_make_anonymous_module ()
  30 {
  31   String s = "*anonymous-ly-" + to_string (module_count++) +  "*";
  32   SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
  33   anon_modules = scm_cons (mod, anon_modules);
  34   return mod;
  35 }
  36
  37 void
  38 ly_clear_anonymous_modules ()
  39 {
  40   SCM s = anon_modules;
  41   anon_modules = SCM_EOL;
  42
  43   for (; gh_pair_p (s) ; s = gh_cdr (s))
  44     {
  45       SCM tab= scm_c_make_hash_table (2);
  46       /* UGH. */
  47       SCM_STRUCT_DATA (gh_car (s))[scm_module_index_obarray]
  48         = (long unsigned int) tab;
  49     }
  50 }
  51
  52 #define FUNC_NAME __FUNCTION__
  53
  54 static SCM
  55 ly_module_define (void *closure, SCM key, SCM val, SCM result)
  56 {
  57   (void) result;
  58   SCM module = (SCM) closure;
  59   scm_module_define (module, key, scm_variable_ref (val));
  60   return SCM_EOL;
  61 }
  62
  63 /* Ugh signature of scm_internal_hash_fold () is inaccurate.  */
  64 typedef SCM (*Hash_cl_func)();
  65
  66 void
  67 ly_import_module (SCM dest, SCM src)
  68 {
  69   SCM_VALIDATE_MODULE (1, src);
  70   scm_internal_hash_fold ((Hash_cl_func) &ly_module_define, (void*) dest,
  71                           SCM_EOL, SCM_MODULE_OBARRAY (src));
  72 }
  73
  74 static SCM
  75 accumulate_symbol (void *closure, SCM key, SCM val, SCM result)
  76 {
  77   (void) closure;
  78   (void) val;
  79   return scm_cons (key, result);
  80 }
  81
  82 SCM
  83 ly_module_symbols (SCM mod)
  84 {
  85   SCM_VALIDATE_MODULE (1, mod);
  86
  87   SCM obarr= SCM_MODULE_OBARRAY (mod);
  88   return scm_internal_hash_fold ((Hash_cl_func) &accumulate_symbol,
  89                                  NULL, SCM_EOL, obarr);
  90 }
  91
  92 static SCM
  93 entry_to_alist (void *closure, SCM key, SCM val, SCM result)
  94 {
  95   (void) closure;
  96   return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
  97 }
  98
  99 SCM
 100 ly_module_to_alist (SCM mod)
 101 {
 102   SCM_VALIDATE_MODULE (1, mod);
 103
 104
 105   SCM obarr= SCM_MODULE_OBARRAY (mod);
 106
 107   return scm_internal_hash_fold ((Hash_cl_func) &entry_to_alist, NULL, SCM_EOL, obarr);
 108 }
 109
 110 /* Lookup SYM, but don't give error when it is not defined.  */
 111 SCM
 112 ly_module_lookup (SCM module, SCM sym)
 113 {
 114 #define FUNC_NAME __FUNCTION__
 115   SCM_VALIDATE_MODULE (1, module);
 116
 117   return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
 118 #undef FUNC_NAME
 119 }
 120
 121 SCM
 122 ly_modules_lookup (SCM modules, SCM sym)
 123 {
 124   for (SCM s = gh_car (modules); SCM_MODULEP (s); s = ly_cdr (s))
 125     {
 126       SCM v = scm_sym2var (sym, scm_module_lookup_closure (s), SCM_UNDEFINED);
 127       if (v != SCM_UNDEFINED)
 128         return v;
 129     }
 130   return SCM_UNDEFINED;
 131 }
 132
 133
 134 SCM export_function;
 135
 136 void
 137 ly_export (SCM module, SCM namelist)
 138 {
 139   if (!export_function)
 140     export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
 141
 142   scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist);
 143 }
 144
 145 void
 146 ly_reexport_module (SCM mod)
 147 {
 148   ly_export (mod, ly_module_symbols (mod));
 149 }