X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fly-module.cc;h=2e7346d6d3e4b86ded4bcc9ea5e5369498b1bb0c;hb=e24df7c27635dc996c466295eacf2981bddccaf7;hp=8286533f50d1f3dab1161d80302b97f82c2d8d15;hpb=a0095a83df6c42fa70051f9c831b209112349463;p=lilypond.git diff --git a/lily/ly-module.cc b/lily/ly-module.cc index 8286533f50..2e7346d6d3 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -1,69 +1,92 @@ -/* -ly-module.cc -- implement guile module stuff. - -source file of the GNU LilyPond music typesetter +/* + ly-module.cc -- implement guile module stuff. -(c) 2002 Han-Wen Nienhuys + source file of the GNU LilyPond music typesetter - */ + (c) 2002--2005 Han-Wen Nienhuys +*/ -#include "string.hh" #include "lily-guile.hh" -#include "ly-modules.hh" -#include "protected-scm.hh" +#include "warn.hh" +#include "main.hh" +#include "string.hh" #define FUNC_NAME __FUNCTION__ static int module_count; void -ly_init_anonymous_module (void * data) +ly_init_anonymous_module (void *data) { - scm_c_use_module ("lily"); + (void) data; } -Protected_scm anon_modules; - SCM -ly_make_anonymous_module () +ly_make_anonymous_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); + SCM mod = SCM_EOL; + if (!safe) + { + String s = "*anonymous-ly-" + to_string (module_count++) + "*"; + mod = scm_c_define_module (s.to_str0 (), ly_init_anonymous_module, 0); + ly_use_module (mod, global_lily_module); + } + else + { + SCM proc = ly_lily_module_constant ("make-safe-lilypond-module"); + mod = scm_call_0 (proc); + } return mod; } -void -ly_clear_anonymous_modules () +SCM +ly_use_module (SCM mod, SCM used) { - SCM s = anon_modules; - anon_modules = SCM_EOL; - - for (; gh_pair_p (s) ; s = gh_cdr (s)) - { - scm_vector_fill_x (SCM_MODULE_OBARRAY(gh_car(s)), SCM_EOL); - } + SCM expr + = scm_list_3 (ly_symbol2scm ("module-use!"), + mod, + scm_list_2 (ly_symbol2scm ("module-public-interface"), + used)); + + return scm_eval (expr, global_lily_module); } #define FUNC_NAME __FUNCTION__ -void -ly_copy_module_variables (SCM dest, SCM src) +static SCM +module_define_closure_func (void *closure, SCM key, SCM val, SCM result) { - SCM_VALIDATE_MODULE (1, src); + (void) result; + SCM module = (SCM) closure; + if (scm_variable_bound_p (val) == SCM_BOOL_T) + scm_module_define (module, key, scm_variable_ref (val)); + return SCM_EOL; +} - SCM obarr= SCM_MODULE_OBARRAY(src); - SCM syms = SCM_EOL; +/* Ugh signature of scm_internal_hash_fold () is inaccurate. */ +typedef SCM (*Hash_cl_func)(); - for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++) - { - for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i)); - gh_pair_p (s); s = gh_cdr (s)) - { - scm_module_define (dest, gh_caar (s), scm_variable_ref (gh_cdar(s))); - } - } +/* + If a variable in changed in SRC, we DEST doesn't see the + definitions. + */ +LY_DEFINE (ly_module_copy, "ly:module-copy", + 2, 0, 0, (SCM dest, SCM src), + "Copy all bindings from module SRC into DEST.") +{ + SCM_VALIDATE_MODULE (1, src); + scm_internal_hash_fold ((Hash_cl_func) &module_define_closure_func, + (void*) dest, + SCM_EOL, SCM_MODULE_OBARRAY (src)); + return SCM_UNSPECIFIED; +} + +static SCM +accumulate_symbol (void *closure, SCM key, SCM val, SCM result) +{ + (void) closure; + (void) val; + return scm_cons (key, result); } SCM @@ -71,46 +94,37 @@ ly_module_symbols (SCM mod) { SCM_VALIDATE_MODULE (1, mod); - SCM obarr= SCM_MODULE_OBARRAY(mod); - SCM syms = SCM_EOL; + SCM obarr = SCM_MODULE_OBARRAY (mod); + return scm_internal_hash_fold ((Hash_cl_func) &accumulate_symbol, + NULL, SCM_EOL, obarr); +} - for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++) +static SCM +entry_to_alist (void *closure, SCM key, SCM val, SCM result) +{ + (void) closure; + if (scm_variable_bound_p (val) == SCM_BOOL_T) { - for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i)); - gh_pair_p (s); s = gh_cdr (s)) - { - syms = scm_cons (gh_caar (s), syms); - } + return scm_cons (scm_cons (key, scm_variable_ref (val)), result); + } + else + { + programming_error ("Unbound variable in module."); + return result; } - return syms; } - - -SCM -ly_module_to_alist (SCM mod) +LY_DEFINE (ly_module2alist, "ly:module->alist", + 1, 0, 0, (SCM mod), + "Dump the contents of module @var{mod} as an alist.") { SCM_VALIDATE_MODULE (1, mod); - - - SCM obarr= SCM_MODULE_OBARRAY(mod); - SCM alist = SCM_EOL; + SCM obarr = SCM_MODULE_OBARRAY (mod); - for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++) - { - for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i)); - gh_pair_p (s); s = gh_cdr (s)) - { - alist = scm_acons (gh_caar (s), scm_variable_ref (gh_cdar (s)), - alist); - } - } - return alist; + return scm_internal_hash_fold ((Hash_cl_func) &entry_to_alist, NULL, SCM_EOL, obarr); } -/* - Lookup SYM, but don't give error when it is not defined. - */ +/* Lookup SYM, but don't give error when it is not defined. */ SCM ly_module_lookup (SCM module, SCM sym) { @@ -118,20 +132,39 @@ ly_module_lookup (SCM module, SCM sym) SCM_VALIDATE_MODULE (1, module); return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); +#undef FUNC_NAME } -SCM export_function ; +/* Lookup SYM in a list of modules, which do not have to be related. + Return the first instance. */ +LY_DEFINE (ly_modules_lookup, "ly:modules-lookup", + 2, 1, 0, + (SCM modules, SCM sym, SCM def), + "Lookup @var{sym} in the list @var{modules}, " + "returning the first occurence. " + "If not found, return @var{default}, or @code{#f}.") +{ + for (SCM s = modules; scm_is_pair (s); s = scm_cdr (s)) + { + SCM mod = scm_car (s); + SCM v = ly_module_lookup (mod, sym); + if (SCM_VARIABLEP (v) && SCM_VARIABLE_REF (v) != SCM_UNDEFINED) + return scm_variable_ref(v); + } + + if (def != SCM_UNDEFINED) + return def; + return SCM_BOOL_F; +} void ly_export (SCM module, SCM namelist) { + static SCM export_function; if (!export_function) - { - export_function = scm_permanent_object (scm_c_lookup ("module-export!")); - } + export_function = scm_permanent_object (scm_c_lookup ("module-export!")); - scm_call_2 (SCM_VARIABLE_REF (export_function), - module, namelist); + scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist); } void