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 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
  14 static int module_count;
  15
  16 void
  17 ly_init_anonymous_module (void * data)
  18 {
  19   scm_c_use_module ("lily");
  20 }
  21
  22 SCM
  23 ly_make_anonymous_module ()
  24 {
  25   String s = "*anonymous-ly-" + to_string (module_count++) +  "*";
  26   SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
  27   return mod;
  28 }
  29
  30 void
  31 ly_copy_module_variables (SCM dest, SCM src)
  32 {
  33   SCM obarr= SCM_MODULE_OBARRAY(src);
  34   SCM syms = SCM_EOL;
  35
  36   for (int i = 0;  i < SCM_VECTOR_LENGTH (obarr); i++)
  37     {
  38       for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
  39            gh_pair_p (s); s = gh_cdr (s))
  40         {
  41           scm_module_define (dest, gh_caar (s), scm_variable_ref (gh_cdar(s)));
  42         }
  43     }
  44 }
  45
  46 SCM
  47 ly_module_symbols (SCM mod)
  48 {
  49   SCM obarr= SCM_MODULE_OBARRAY(mod);
  50   SCM syms = SCM_EOL;
  51
  52   for (int i = 0;  i < SCM_VECTOR_LENGTH (obarr); i++)
  53     {
  54       for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
  55            gh_pair_p (s); s = gh_cdr (s))
  56         {
  57           syms = scm_cons (gh_caar (s), syms);
  58         }
  59     }
  60   return syms;
  61 }
  62
  63
  64
  65 SCM
  66 ly_module_to_alist (SCM mod)
  67 {
  68   SCM obarr= SCM_MODULE_OBARRAY(mod);
  69   SCM alist = SCM_EOL;
  70
  71   for (int i = 0;  i < SCM_VECTOR_LENGTH (obarr); i++)
  72     {
  73       for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
  74            gh_pair_p (s); s = gh_cdr (s))
  75         {
  76           alist = scm_acons (gh_caar (s), scm_variable_ref (gh_cdar (s)),
  77                                                             alist);
  78         }
  79     }
  80   return alist;
  81 }
  82
  83 /*
  84   Lookup SYM, but don't give error when it is not defined.
  85  */
  86 SCM
  87 ly_module_lookup (SCM module, SCM sym)
  88 {
  89   SCM var;
  90 #define FUNC_NAME __FUNCTION__
  91   SCM_VALIDATE_MODULE (1, module);
  92
  93   var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
  94   return var;
  95 }
  96
  97 SCM export_function ;
  98
  99 void
 100 ly_export (SCM module, SCM namelist)
 101 {
 102   if (!export_function)
 103     {
 104       export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
 105     }
 106
 107   scm_call_2 (SCM_VARIABLE_REF (export_function),
 108               module, namelist);
 109 }
 110
 111 void
 112 ly_reexport_module (SCM mod)
 113 {
 114   ly_export (mod, ly_module_symbols (mod));
 115 }