X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fly-module.cc;h=42ff2f8b063c85d514f2c27d5dc8e97135aa4f23;hb=774f7b99cadfebdfc5f85c7af37ee4dd97e09613;hp=b14a222b492da232cbd6057c2dfca5d1d7ab5f34;hpb=9473209e14bacab5395ec4791660f01c07c12335;p=lilypond.git diff --git a/lily/ly-module.cc b/lily/ly-module.cc index b14a222b49..42ff2f8b06 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -1,56 +1,31 @@ /* - ly-module.cc -- implement guile module stuff. + This file is part of LilyPond, the GNU music typesetter. - source file of the GNU LilyPond music typesetter + Copyright (C) 2002--2010 Han-Wen Nienhuys - (c) 2002--2005 Han-Wen Nienhuys + 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. + + 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 "lily-guile.hh" #include "warn.hh" #include "main.hh" -#include "string.hh" +#include "std-string.hh" #include "protected-scm.hh" -#define MODULE_GC_KLUDGE - -#ifdef MODULE_GC_KLUDGE -Protected_scm anonymous_modules = SCM_EOL; -#endif - -#define FUNC_NAME __FUNCTION__ - - -LY_DEFINE(ly_clear_anonymous_modules, "ly:clear-anonymous-modules", - 0, 0, 0, (), - "Plug a GUILE 1.6 and 1.7 memory leak by breaking a weak reference " - "pointer cycle explicitly." - ) -{ -#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")); - - if (ly_is_module (prop)) - { - scm_set_procedure_property_x (closure, ly_symbol2scm ("module"), - SCM_BOOL_F); - } - } - - anonymous_modules = SCM_EOL; -#endif - - return SCM_UNSPECIFIED; -} SCM -ly_make_anonymous_module (bool safe) +ly_make_module (bool safe) { SCM mod = SCM_EOL; if (!safe) @@ -58,11 +33,11 @@ ly_make_anonymous_module (bool safe) SCM maker = ly_lily_module_constant ("make-module"); SCM scm_module = ly_lily_module_constant ("the-scm-module"); - + mod = scm_call_0 (maker); scm_module_define (mod, ly_symbol2scm ("%module-public-interface"), mod); - + ly_use_module (mod, scm_module); ly_use_module (mod, global_lily_module); } @@ -72,10 +47,7 @@ ly_make_anonymous_module (bool safe) mod = scm_call_0 (proc); } -#ifdef MODULE_GC_KLUDGE - anonymous_modules = scm_cons (mod, anonymous_modules); -#endif - + return mod; } @@ -93,41 +65,7 @@ ly_use_module (SCM mod, SCM used) #define FUNC_NAME __FUNCTION__ -static SCM -module_define_closure_func (void *closure, SCM key, SCM val, SCM result) -{ - (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; -} -/* Ugh signature of scm_internal_hash_fold () is inaccurate. */ -typedef SCM (*Hash_cl_func) (); - -/* - 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 ly_module_symbols (SCM mod) @@ -135,61 +73,30 @@ 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); + return ly_hash_table_keys (obarr); } static SCM -entry_to_alist (void *closure, SCM key, SCM val, SCM result) +entry_to_alist (void * /* closure */, + SCM key, + SCM val, + SCM result) { - (void) closure; 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; } -LY_DEFINE (ly_module2alist, "ly:module->alist", +LY_DEFINE (ly_module_2_alist, "ly:module->alist", 1, 0, 0, (SCM mod), - "Dump the contents of module @var{mod} as an alist.") + "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 ((Hash_cl_func) & entry_to_alist, NULL, SCM_EOL, obarr); -} - -/* Lookup SYM, but don't give error when it is not defined. */ -SCM -ly_module_lookup (SCM module, SCM sym) -{ -#define FUNC_NAME __FUNCTION__ - SCM_VALIDATE_MODULE (1, module); - - return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); -#undef FUNC_NAME -} - -/* 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; + return scm_internal_hash_fold ((scm_t_hash_fold_fn) &entry_to_alist, + NULL, SCM_EOL, obarr); } void