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-modules.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   scm_c_use_module ("lily");
  23 }
  24
  25 Protected_scm anon_modules;
  26
  27 SCM
  28 ly_make_anonymous_module ()
  29 {
  30   String s = "*anonymous-ly-" + to_string (module_count++) +  "*";
  31   SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
  32   anon_modules = scm_cons (mod, anon_modules);
  33   return mod;
  34 }
  35
  36 void
  37 ly_clear_anonymous_modules ()
  38 {
  39   SCM s = anon_modules;
  40   anon_modules = SCM_EOL;
  41
  42   for (; gh_pair_p (s) ; s = gh_cdr (s))
  43     {
  44       SCM tab= scm_c_make_hash_table (2);
  45       /*
  46         UGH.
  47       */
  48
  49       SCM_STRUCT_DATA(gh_car(s))[scm_module_index_obarray] = (long unsigned int) tab;
  50     }
  51 }
  52
  53 #define FUNC_NAME __FUNCTION__
  54
  55 SCM
  56 define_one_var (void * closure, SCM key, SCM val, SCM result)
  57 {
  58   SCM dest =  (SCM) closure;
  59   scm_module_define (dest, key, scm_variable_ref (val));
  60   return SCM_EOL;
  61 }
  62
  63 /*
  64   Ugh signature of scm_internal_hash_fold () is inaccurate.
  65  */
  66 typedef SCM (*Hash_cl_func)();
  67
  68 void
  69 ly_copy_module_variables (SCM dest, SCM src)
  70 {
  71   SCM_VALIDATE_MODULE (1, src);
  72
  73   SCM obarr= SCM_MODULE_OBARRAY(src);
  74   scm_internal_hash_fold ((Hash_cl_func) &define_one_var, (void*) dest, SCM_EOL, obarr);
  75 }
  76
  77 SCM
  78 accumulate_symbol (void * closure, SCM key, SCM val, SCM result)
  79 {
  80   return scm_cons (key, result);
  81 }
  82
  83 SCM
  84 ly_module_symbols (SCM mod)
  85 {
  86   SCM_VALIDATE_MODULE (1, mod);
  87
  88   SCM obarr= SCM_MODULE_OBARRAY(mod);
  89   return scm_internal_hash_fold ((Hash_cl_func) &accumulate_symbol, NULL, SCM_EOL, obarr);
  90 }
  91
  92 SCM
  93 entry_to_alist (void * closure, SCM key, SCM val, SCM result)
  94 {
  95   return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
  96 }
  97
  98 SCM
  99 ly_module_to_alist (SCM mod)
 100 {
 101   SCM_VALIDATE_MODULE (1, mod);
 102
 103
 104   SCM obarr= SCM_MODULE_OBARRAY(mod);
 105
 106   return scm_internal_hash_fold ((Hash_cl_func) &entry_to_alist, NULL, SCM_EOL, obarr);
 107 }
 108
 109 /*
 110   Lookup SYM, but don't give error when it is not defined.
 111  */
 112 SCM
 113 ly_module_lookup (SCM module, SCM sym)
 114 {
 115 #define FUNC_NAME __FUNCTION__
 116   SCM_VALIDATE_MODULE (1, module);
 117
 118   return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
 119 #undef FUNC_NAME
 120 }
 121
 122 SCM export_function;
 123
 124 void
 125 ly_export (SCM module, SCM namelist)
 126 {
 127   if (!export_function)
 128     {
 129       export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
 130     }
 131
 132   scm_call_2 (SCM_VARIABLE_REF (export_function),
 133               module, namelist);
 134 }
 135
 136 void
 137 ly_reexport_module (SCM mod)
 138 {
 139   ly_export (mod, ly_module_symbols (mod));
 140 }