X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Fly-module.cc;h=2076168fda75ac9ad9c73004d611bb24ebc881af;hb=a6a51abfd0195a3cf7d6ea095cf69808852f21ce;hp=07fdc531ede2f6adfc0ba5474b58548e1757cc8a;hpb=e18531db1f79fb685fbd16d6a2a67bf4b6c09915;p=lilypond.git diff --git a/lily/ly-module.cc b/lily/ly-module.cc index 07fdc531ed..2076168fda 100644 --- a/lily/ly-module.cc +++ b/lily/ly-module.cc @@ -1,7 +1,7 @@ /* This file is part of LilyPond, the GNU music typesetter. - Copyright (C) 2002--2010 Han-Wen Nienhuys + Copyright (C) 2002--2015 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 @@ -18,86 +18,68 @@ */ #include "lily-guile.hh" +#include "ly-module.hh" #include "warn.hh" #include "main.hh" -#include "std-string.hh" #include "protected-scm.hh" - -#ifdef MODULE_GC_KLUDGE -Protected_scm anonymous_modules = SCM_EOL; -bool perform_gc_kludge; -#endif - -void -clear_anonymous_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")); - - if (ly_is_module (prop)) - { - scm_set_procedure_property_x (closure, ly_symbol2scm ("module"), - SCM_BOOL_F); - } - } - - anonymous_modules = SCM_EOL; -#endif -} +#include "lily-imports.hh" SCM -ly_make_anonymous_module (bool safe) +ly_make_module (bool safe) { SCM mod = SCM_EOL; if (!safe) { - SCM maker = ly_lily_module_constant ("make-module"); - - SCM scm_module = ly_lily_module_constant ("the-scm-module"); + /* Look up (evaluate) Scheme make-module function and call it */ + + mod = Guile_user::make_module (); + /* + Look up and call Guile module-export-all! or, when using + Guile V1.8, the compatible shim defined in lily.scm. + */ +#if GUILEV2 + Guile_user::module_export_all_x (mod); +#else + Lily::module_export_all_x (mod); +#endif - mod = scm_call_0 (maker); - scm_module_define (mod, ly_symbol2scm ("%module-public-interface"), - 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 + */ - ly_use_module (mod, scm_module); - ly_use_module (mod, global_lily_module); + ly_use_module (mod, Guile_user::the_root_module); + ly_use_module (mod, Lily::module); } else { - SCM proc = ly_lily_module_constant ("make-safe-lilypond-module"); - mod = scm_call_0 (proc); + /* Evaluate and call make-safe-lilypond-module */ + mod = Lily::make_safe_lilypond_module (); } -#ifdef MODULE_GC_KLUDGE - if (perform_gc_kludge) - anonymous_modules = scm_cons (mod, anonymous_modules); -#endif - return mod; } SCM ly_use_module (SCM mod, SCM used) { - 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); + /* + Pick up the module's interface definition. + TODO - Replace inline evaluations (interpreted) + with guile API calls if these become available. + */ + /* + Set up to interpret + '(module_use! (module-public-interface ))' + */ + return Guile_user::module_use_x (mod, + Guile_user::module_public_interface (used)); } #define FUNC_NAME __FUNCTION__ - - SCM ly_module_symbols (SCM mod) { @@ -109,34 +91,31 @@ ly_module_symbols (SCM mod) static SCM entry_to_alist (void * /* closure */, - SCM key, - SCM val, - SCM result) + SCM key, + SCM val, + SCM result) { - if (scm_variable_bound_p (val) == SCM_BOOL_T) + if (to_boolean (scm_variable_bound_p (val))) return scm_cons (scm_cons (key, scm_variable_ref (val)), result); programming_error ("unbound variable in module"); return result; } LY_DEFINE (ly_module_2_alist, "ly:module->alist", - 1, 0, 0, (SCM mod), - "Dump the contents of module @var{mod} as an 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 ((Hash_closure_function) & entry_to_alist, NULL, SCM_EOL, obarr); + 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); + Guile_user::module_export_x (module, namelist); } void @@ -144,57 +123,3 @@ ly_reexport_module (SCM mod) { ly_export (mod, ly_module_symbols (mod)); } - -#ifdef MODULE_GC_KLUDGE -static SCM -redefine_keyval (void * /* closure */, - SCM key, - SCM val, - SCM result) -{ - SCM new_tab = result; - scm_hashq_set_x (new_tab, key, val); - return new_tab; -} - -/* - UGH UGH. - Kludge for older GUILE 1.6 versions. -*/ -void -make_stand_in_procs_weak () -{ - /* - Ugh, ABI breakage for 1.6.5: scm_stand_in_procs is a hashtab from - 1.6.5 on. - */ - if (scm_is_pair (scm_stand_in_procs)) - { - return; - } - - if (scm_weak_key_hash_table_p (scm_stand_in_procs) == SCM_BOOL_T) - { -#if (SCM_MINOR_VERSION == 7) - perform_gc_kludge = false; -#endif - return; - } - - - perform_gc_kludge = true; - - - SCM old_tab = scm_stand_in_procs; - SCM new_tab = scm_make_weak_key_hash_table (scm_from_int (257)); - - new_tab = scm_internal_hash_fold ((Hash_closure_function) & redefine_keyval, - NULL, - new_tab, - old_tab); - - scm_stand_in_procs = new_tab; -} - -ADD_SCM_INIT_FUNC (make_stand_in_procs_weak, make_stand_in_procs_weak); -#endif