lily/ly-module.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2002--2011 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
  27
  28 SCM
  29 ly_make_module (bool safe)
  30 {
  31   SCM mod = SCM_EOL;
  32   if (!safe)
  33     {
  34       /* Look up (evaluate) Scheme make-module function and call it */
  35
  36       SCM maker = ly_lily_module_constant ("make-module");
  37       mod = scm_call_0 (maker);
  38       /*
  39         Look up and call Guile module-export-all! or, when using
  40         Guile V1.8, the compatible shim defined in lily.scm.
  41       */
  42       SCM module_export_all_x = ly_lily_module_constant ("module-export-all!");
  43       scm_call_1 (module_export_all_x, mod);
  44
  45       /*
  46         Evaluate Guile module "the-root-module",
  47         and ensure we inherit definitions from it and the "lily" module
  48         N.B. this used to be "the-scm-module" and is deprecated in
  49         Guile V1.9/2.0
  50       */
  51       SCM scm_module = ly_lily_module_constant ("the-root-module");
  52       ly_use_module (mod, scm_module);
  53       ly_use_module (mod, global_lily_module);
  54     }
  55   else
  56     {
  57       /* Evaluate and call make-safe-lilypond-module */
  58       SCM proc = ly_lily_module_constant ("make-safe-lilypond-module");
  59       mod = scm_call_0 (proc);
  60     }
  61
  62   return mod;
  63 }
  64
  65 SCM
  66 ly_use_module (SCM mod, SCM used)
  67 {
  68   /*
  69     Pick up the module's interface definition.
  70     TODO - Replace inline evaluations (interpreted)
  71     with guile API calls if these become available.
  72   */
  73   SCM scm_module_use = ly_symbol2scm ("module-use!");
  74   SCM scm_module_public_interface = ly_symbol2scm ("module-public-interface");
  75   SCM iface = scm_list_2 (scm_module_public_interface, used);
  76   /*
  77     Set up to interpret
  78     '(module_use! <mod> (module-public-interface <used>))'
  79   */
  80   SCM expr = scm_list_3 (scm_module_use, mod, iface);
  81   /*
  82     Now return SCM value, this is the result of interpreting
  83     '(eval (module-use! <mod> (module-public-interface <used>)) "lily")'
  84   */
  85   return scm_eval (expr, global_lily_module);
  86 }
  87
  88 #define FUNC_NAME __FUNCTION__
  89
  90
  91 SCM
  92 ly_module_symbols (SCM mod)
  93 {
  94   SCM_VALIDATE_MODULE (1, mod);
  95
  96   SCM obarr = SCM_MODULE_OBARRAY (mod);
  97   return ly_hash_table_keys (obarr);
  98 }
  99
 100 static SCM
 101 entry_to_alist (void * /* closure */,
 102                 SCM key,
 103                 SCM val,
 104                 SCM result)
 105 {
 106   if (scm_variable_bound_p (val) == SCM_BOOL_T)
 107     return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
 108   programming_error ("unbound variable in module");
 109   return result;
 110 }
 111
 112 LY_DEFINE (ly_module_2_alist, "ly:module->alist",
 113            1, 0, 0, (SCM mod),
 114            "Dump the contents of module @var{mod} as an alist.")
 115 {
 116   SCM_VALIDATE_MODULE (1, mod);
 117   SCM obarr = SCM_MODULE_OBARRAY (mod);
 118
 119   return scm_internal_hash_fold ((scm_t_hash_fold_fn) &entry_to_alist,
 120                                  NULL, SCM_EOL, obarr);
 121 }
 122
 123 void
 124 ly_export (SCM module, SCM namelist)
 125 {
 126   static SCM export_function;
 127   if (!export_function)
 128     export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
 129
 130   scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist);
 131 }
 132
 133 void
 134 ly_reexport_module (SCM mod)
 135 {
 136   ly_export (mod, ly_module_symbols (mod));
 137 }