X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fly-module.cc;h=7a6441036410d02f7b3dfe93951486b6236438cf;hb=ee0488f3aa19e0060b6e17c46a4d88cb9d57c489;hp=3d409cd3f9f12034f75b0875af92f4ec2278bc27;hpb=7aabfb20c46e0a1de41698ddc6859ccd3a6dea85;p=lilypond.git diff --git a/lily/ly-module.cc b/lily/ly-module.cc index 3d409cd3f9..7a64410364 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -1,137 +1,143 @@ -/* -ly-module.cc -- implement guile module stuff. +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2002--2010 Han-Wen Nienhuys -source file of the GNU LilyPond music typesetter + 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. -(c) 2002--2003 Han-Wen Nienhuys + 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. - */ + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ -#include "string.hh" #include "lily-guile.hh" -#include "ly-modules.hh" +#include "warn.hh" +#include "main.hh" +#include "std-string.hh" #include "protected-scm.hh" -#define FUNC_NAME __FUNCTION__ - -static int module_count; +#ifdef MODULE_GC_KLUDGE +Protected_scm anonymous_modules = SCM_EOL; +bool perform_gc_kludge; +#endif void -ly_init_anonymous_module (void * data) +clear_anonymous_modules () { - scm_c_use_module ("lily"); -} - -Protected_scm anon_modules; +#ifdef MODULE_GC_KLUDGE + for (SCM s = anonymous_modules; + scm_is_pair (s); + s = scm_cdr (s)) + { + SCM module = scm_car (s); + SCM closure = SCM_MODULE_EVAL_CLOSURE (module); + SCM prop = scm_procedure_property (closure, ly_symbol2scm ("module")); -SCM -ly_make_anonymous_module () -{ - String s = "*anonymous-ly-" + to_string (module_count++) + "*"; - SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0); + if (ly_is_module (prop)) + { + scm_set_procedure_property_x (closure, ly_symbol2scm ("module"), + SCM_BOOL_F); + } + } - anon_modules = scm_cons (mod, anon_modules); - return mod; + anonymous_modules = SCM_EOL; +#endif } -void -ly_clear_anonymous_modules () +SCM +ly_make_anonymous_module (bool safe) { - SCM s = anon_modules; - anon_modules = SCM_EOL; - - for (; gh_pair_p (s) ; s = gh_cdr (s)) + SCM mod = SCM_EOL; + if (!safe) { - scm_vector_fill_x (SCM_MODULE_OBARRAY(gh_car(s)), SCM_EOL); - } -} + SCM maker = ly_lily_module_constant ("make-module"); -#define FUNC_NAME __FUNCTION__ + SCM scm_module = ly_lily_module_constant ("the-scm-module"); -void -ly_copy_module_variables (SCM dest, SCM src) -{ - SCM_VALIDATE_MODULE (1, src); - - SCM obarr= SCM_MODULE_OBARRAY(src); - SCM syms = SCM_EOL; + mod = scm_call_0 (maker); + scm_module_define (mod, ly_symbol2scm ("%module-public-interface"), + mod); - for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++) + ly_use_module (mod, scm_module); + ly_use_module (mod, global_lily_module); + } + else { - 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))); - } + SCM proc = ly_lily_module_constant ("make-safe-lilypond-module"); + mod = scm_call_0 (proc); } + +#ifdef MODULE_GC_KLUDGE + if (perform_gc_kludge) + anonymous_modules = scm_cons (mod, anonymous_modules); +#endif + + return mod; } SCM -ly_module_symbols (SCM mod) +ly_use_module (SCM mod, SCM used) { - SCM_VALIDATE_MODULE (1, mod); - - SCM obarr= SCM_MODULE_OBARRAY(mod); - SCM syms = SCM_EOL; + SCM expr + = scm_list_3 (ly_symbol2scm ("module-use!"), + mod, + scm_list_2 (ly_symbol2scm ("module-public-interface"), + used)); - 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)) - { - syms = scm_cons (gh_caar (s), syms); - } - } - return syms; + return scm_eval (expr, global_lily_module); } +#define FUNC_NAME __FUNCTION__ + SCM -ly_module_to_alist (SCM mod) +ly_module_symbols (SCM mod) { SCM_VALIDATE_MODULE (1, mod); - - - SCM obarr= SCM_MODULE_OBARRAY(mod); - SCM alist = SCM_EOL; - 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; + SCM obarr = SCM_MODULE_OBARRAY (mod); + return ly_hash_table_keys (obarr); } -/* - Lookup SYM, but don't give error when it is not defined. - */ -SCM -ly_module_lookup (SCM module, SCM sym) +static SCM +entry_to_alist (void * /* closure */, + SCM key, + SCM val, + SCM result) { -#define FUNC_NAME __FUNCTION__ - SCM_VALIDATE_MODULE (1, module); - - return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); + 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; } -SCM export_function ; +LY_DEFINE (ly_module_2_alist, "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); + + return scm_internal_hash_fold ((scm_t_hash_fold_fn) &entry_to_alist, + NULL, SCM_EOL, obarr); +} 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); + export_function = scm_permanent_object (scm_c_lookup ("module-export!")); + + scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist); } void