X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fly-module.cc;h=8023947c1e70b0d500350cae23efb8548ffa017e;hb=0b544cfb7332615ef809b71b57ab656741311ae1;hp=dd204fa938dce606c8ca5ccf55d243de72bccf16;hpb=25645986aa3e8d999e901426932c539e8de6a1ca;p=lilypond.git diff --git a/lily/ly-module.cc b/lily/ly-module.cc index dd204fa938..8023947c1e 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -1,140 +1,129 @@ /* - ly-module.cc -- implement guile module stuff. - - source file of the GNU LilyPond music typesetter - - (c) 2002--2004 Han-Wen Nienhuys + This file is part of LilyPond, the GNU music typesetter. -*/ + Copyright (C) 2002--2014 Han-Wen Nienhuys -#include "string.hh" -#include "lily-guile.hh" -#include "ly-module.hh" -#include "protected-scm.hh" + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. -#define FUNC_NAME __FUNCTION__ + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. -static int module_count; - -void -ly_init_anonymous_module (void * data) -{ - scm_c_use_module ("lily"); -} + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ -Protected_scm anon_modules; +#include "lily-guile.hh" +#include "warn.hh" +#include "main.hh" +#include "std-string.hh" +#include "protected-scm.hh" SCM -ly_make_anonymous_module () +ly_make_module (bool safe) { - String s = "*anonymous-ly-" + to_string (module_count++) + "*"; - SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0); - anon_modules = scm_cons (mod, anon_modules); - return mod; -} - -void -ly_clear_anonymous_modules () -{ - SCM s = anon_modules; - anon_modules = SCM_EOL; - - for (; gh_pair_p (s) ; s = gh_cdr (s)) + SCM mod = SCM_EOL; + if (!safe) { - SCM tab= scm_c_make_hash_table (2); - /* UGH. */ - SCM_STRUCT_DATA (gh_car (s))[scm_module_index_obarray] - = (long unsigned int) tab; + /* Look up (evaluate) Scheme make-module function and call it */ + + SCM maker = ly_lily_module_constant ("make-module"); + mod = scm_call_0 (maker); + /* + Look up and call Guile module-export-all! or, when using + Guile V1.8, the compatible shim defined in lily.scm. + */ + SCM module_export_all_x = ly_lily_module_constant ("module-export-all!"); + scm_call_1 (module_export_all_x, mod); + + /* + Evaluate Guile module "the-root-module", + and ensure we inherit definitions from it and the "lily" module + N.B. this used to be "the-scm-module" and is deprecated in + Guile V1.9/2.0 + */ + SCM scm_module = ly_lily_module_constant ("the-root-module"); + ly_use_module (mod, scm_module); + ly_use_module (mod, global_lily_module); + } + else + { + /* Evaluate and call make-safe-lilypond-module */ + SCM proc = ly_lily_module_constant ("make-safe-lilypond-module"); + mod = scm_call_0 (proc); } -} - -#define FUNC_NAME __FUNCTION__ - -SCM -define_one_var (void * closure, SCM key, SCM val, SCM result) -{ - SCM dest = (SCM) closure; - scm_module_define (dest, key, scm_variable_ref (val)); - return SCM_EOL; -} - -/* Ugh signature of scm_internal_hash_fold () is inaccurate. */ -typedef SCM (*Hash_cl_func)(); - -void -ly_copy_module_variables (SCM dest, SCM src) -{ - SCM_VALIDATE_MODULE (1, src); - SCM obarr= SCM_MODULE_OBARRAY (src); - scm_internal_hash_fold ((Hash_cl_func) &define_one_var, (void*) dest, SCM_EOL, obarr); + return mod; } SCM -accumulate_symbol (void * closure, SCM key, SCM val, SCM result) +ly_use_module (SCM mod, SCM used) { - return scm_cons (key, result); + /* + Pick up the module's interface definition. + TODO - Replace inline evaluations (interpreted) + with guile API calls if these become available. + */ + SCM scm_module_use = ly_symbol2scm ("module-use!"); + SCM scm_module_public_interface = ly_symbol2scm ("module-public-interface"); + SCM iface = scm_list_2 (scm_module_public_interface, used); + /* + Set up to interpret + '(module_use! (module-public-interface ))' + */ + SCM expr = scm_list_3 (scm_module_use, mod, iface); + /* + Now return SCM value, this is the result of interpreting + '(eval (module-use! (module-public-interface )) "lily")' + */ + return scm_eval (expr, global_lily_module); } +#define FUNC_NAME __FUNCTION__ + SCM ly_module_symbols (SCM mod) { SCM_VALIDATE_MODULE (1, mod); - - SCM obarr= SCM_MODULE_OBARRAY (mod); - return scm_internal_hash_fold ((Hash_cl_func) &accumulate_symbol, - NULL, SCM_EOL, obarr); -} -SCM -entry_to_alist (void * closure, SCM key, SCM val, SCM result) -{ - return scm_cons (scm_cons (key, scm_variable_ref (val)), result); + SCM obarr = SCM_MODULE_OBARRAY (mod); + return ly_hash_table_keys (obarr); } -SCM -ly_module_to_alist (SCM mod) +static SCM +entry_to_alist (void * /* closure */, + SCM key, + SCM val, + SCM result) { - SCM_VALIDATE_MODULE (1, mod); - - - SCM obarr= SCM_MODULE_OBARRAY (mod); - - return scm_internal_hash_fold ((Hash_cl_func) &entry_to_alist, NULL, SCM_EOL, obarr); + if (scm_variable_bound_p (val) == SCM_BOOL_T) + return scm_cons (scm_cons (key, scm_variable_ref (val)), result); + programming_error ("unbound variable in module"); + return result; } -/* Lookup SYM, but don't give error when it is not defined. */ -SCM -ly_module_lookup (SCM module, SCM sym) +LY_DEFINE (ly_module_2_alist, "ly:module->alist", + 1, 0, 0, (SCM mod), + "Dump the contents of module @var{mod} as an alist.") { -#define FUNC_NAME __FUNCTION__ - SCM_VALIDATE_MODULE (1, module); - - return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); -#undef FUNC_NAME -} + SCM_VALIDATE_MODULE (1, mod); + SCM obarr = SCM_MODULE_OBARRAY (mod); -SCM -ly_modules_lookup (SCM modules, SCM sym) -{ - for (SCM s = gh_car (modules); SCM_MODULEP (s); s = ly_cdr (s)) - { - SCM v = scm_sym2var (sym, scm_module_lookup_closure (s), SCM_UNDEFINED); - if (v != SCM_UNDEFINED) - return v; - } - return SCM_UNDEFINED; + return scm_internal_hash_fold ((scm_t_hash_fold_fn) &entry_to_alist, + NULL, SCM_EOL, obarr); } - -SCM export_function; - void ly_export (SCM module, SCM namelist) { + static SCM export_function; if (!export_function) export_function = scm_permanent_object (scm_c_lookup ("module-export!")); - + scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist); }