lily/ly-module.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2002--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "lily-guile.hh"
  21 #include "warn.hh"
  22 #include "main.hh"
  23 #include "std-string.hh"
  24 #include "protected-scm.hh"
  25
  26 SCM
  27 ly_make_module (bool safe)
  28 {
  29   SCM mod = SCM_EOL;
  30   if (!safe)
  31     {
  32       /* Look up (evaluate) Scheme make-module function and call it */
  33
  34       SCM maker = ly_lily_module_constant ("make-module");
  35       mod = scm_call_0 (maker);
  36       /*
  37         Look up and call Guile module-export-all! or, when using
  38         Guile V1.8, the compatible shim defined in lily.scm.
  39       */
  40       SCM module_export_all_x = ly_lily_module_constant ("module-export-all!");
  41       scm_call_1 (module_export_all_x, mod);
  42
  43       /*
  44         Evaluate Guile module "the-root-module",
  45         and ensure we inherit definitions from it and the "lily" module
  46         N.B. this used to be "the-scm-module" and is deprecated in
  47         Guile V1.9/2.0
  48       */
  49       SCM scm_module = ly_lily_module_constant ("the-root-module");
  50       ly_use_module (mod, scm_module);
  51       ly_use_module (mod, global_lily_module);
  52     }
  53   else
  54     {
  55       /* Evaluate and call make-safe-lilypond-module */
  56       SCM proc = ly_lily_module_constant ("make-safe-lilypond-module");
  57       mod = scm_call_0 (proc);
  58     }
  59
  60   return mod;
  61 }
  62
  63 SCM
  64 ly_use_module (SCM mod, SCM used)
  65 {
  66   /*
  67     Pick up the module's interface definition.
  68     TODO - Replace inline evaluations (interpreted)
  69     with guile API calls if these become available.
  70   */
  71   SCM scm_module_use = ly_symbol2scm ("module-use!");
  72   SCM scm_module_public_interface = ly_symbol2scm ("module-public-interface");
  73   SCM iface = scm_list_2 (scm_module_public_interface, used);
  74   /*
  75     Set up to interpret
  76     '(module_use! <mod> (module-public-interface <used>))'
  77   */
  78   SCM expr = scm_list_3 (scm_module_use, mod, iface);
  79   /*
  80     Now return SCM value, this is the result of interpreting
  81     '(eval (module-use! <mod> (module-public-interface <used>)) "lily")'
  82   */
  83   return scm_eval (expr, global_lily_module);
  84 }
  85
  86 #define FUNC_NAME __FUNCTION__
  87
  88 SCM
  89 ly_module_symbols (SCM mod)
  90 {
  91   SCM_VALIDATE_MODULE (1, mod);
  92
  93   SCM obarr = SCM_MODULE_OBARRAY (mod);
  94   return ly_hash_table_keys (obarr);
  95 }
  96
  97 static SCM
  98 entry_to_alist (void * /* closure */,
  99                 SCM key,
 100                 SCM val,
 101                 SCM result)
 102 {
 103   if (scm_variable_bound_p (val) == SCM_BOOL_T)
 104     return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
 105   programming_error ("unbound variable in module");
 106   return result;
 107 }
 108
 109 LY_DEFINE (ly_module_2_alist, "ly:module->alist",
 110            1, 0, 0, (SCM mod),
 111            "Dump the contents of module @var{mod} as an alist.")
 112 {
 113   SCM_VALIDATE_MODULE (1, mod);
 114   SCM obarr = SCM_MODULE_OBARRAY (mod);
 115
 116   return scm_internal_hash_fold ((scm_t_hash_fold_fn) &entry_to_alist,
 117                                  NULL, SCM_EOL, obarr);
 118 }
 119
 120 void
 121 ly_export (SCM module, SCM namelist)
 122 {
 123   static SCM export_function;
 124   if (!export_function)
 125     export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
 126
 127   scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist);
 128 }
 129
 130 void
 131 ly_reexport_module (SCM mod)
 132 {
 133   ly_export (mod, ly_module_symbols (mod));
 134 }