2 ly-module.cc -- implement guile module stuff.
4 source file of the GNU LilyPond music typesetter
6 (c) 2002--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
9 #include "lily-guile.hh"
12 #include "std-string.hh"
13 #include "protected-scm.hh"
15 #ifdef MODULE_GC_KLUDGE
16 Protected_scm anonymous_modules
= SCM_EOL
;
17 bool perform_gc_kludge
;
21 clear_anonymous_modules ()
23 #ifdef MODULE_GC_KLUDGE
24 for (SCM s
= anonymous_modules
;
28 SCM module
= scm_car (s
);
29 SCM closure
= SCM_MODULE_EVAL_CLOSURE (module
);
30 SCM prop
= scm_procedure_property (closure
, ly_symbol2scm ("module"));
32 if (ly_is_module (prop
))
34 scm_set_procedure_property_x (closure
, ly_symbol2scm ("module"),
39 anonymous_modules
= SCM_EOL
;
44 ly_make_anonymous_module (bool safe
)
49 SCM maker
= ly_lily_module_constant ("make-module");
51 SCM scm_module
= ly_lily_module_constant ("the-scm-module");
53 mod
= scm_call_0 (maker
);
54 scm_module_define (mod
, ly_symbol2scm ("%module-public-interface"),
57 ly_use_module (mod
, scm_module
);
58 ly_use_module (mod
, global_lily_module
);
62 SCM proc
= ly_lily_module_constant ("make-safe-lilypond-module");
63 mod
= scm_call_0 (proc
);
66 #ifdef MODULE_GC_KLUDGE
67 if (perform_gc_kludge
)
68 anonymous_modules
= scm_cons (mod
, anonymous_modules
);
75 ly_use_module (SCM mod
, SCM used
)
78 = scm_list_3 (ly_symbol2scm ("module-use!"),
80 scm_list_2 (ly_symbol2scm ("module-public-interface"),
83 return scm_eval (expr
, global_lily_module
);
86 #define FUNC_NAME __FUNCTION__
91 ly_module_symbols (SCM mod
)
93 SCM_VALIDATE_MODULE (1, mod
);
95 SCM obarr
= SCM_MODULE_OBARRAY (mod
);
96 return ly_hash_table_keys (obarr
);
100 entry_to_alist (void * /* closure */,
105 if (scm_variable_bound_p (val
) == SCM_BOOL_T
)
106 return scm_cons (scm_cons (key
, scm_variable_ref (val
)), result
);
107 programming_error ("unbound variable in module");
111 LY_DEFINE (ly_module_2_alist
, "ly:module->alist",
113 "Dump the contents of module @var{mod} as an alist.")
115 SCM_VALIDATE_MODULE (1, mod
);
116 SCM obarr
= SCM_MODULE_OBARRAY (mod
);
118 return scm_internal_hash_fold ((Hash_closure_function
) & entry_to_alist
, NULL
, SCM_EOL
, obarr
);
122 ly_export (SCM module
, SCM namelist
)
124 static SCM export_function
;
125 if (!export_function
)
126 export_function
= scm_permanent_object (scm_c_lookup ("module-export!"));
128 scm_call_2 (SCM_VARIABLE_REF (export_function
), module
, namelist
);
132 ly_reexport_module (SCM mod
)
134 ly_export (mod
, ly_module_symbols (mod
));
137 #ifdef MODULE_GC_KLUDGE
139 redefine_keyval (void * /* closure */,
144 SCM new_tab
= result
;
145 scm_hashq_set_x (new_tab
, key
, val
);
151 Kludge for older GUILE 1.6 versions.
154 make_stand_in_procs_weak ()
157 Ugh, ABI breakage for 1.6.5: scm_stand_in_procs is a hashtab from
160 if (scm_is_pair (scm_stand_in_procs
))
165 if (scm_weak_key_hash_table_p (scm_stand_in_procs
) == SCM_BOOL_T
)
167 #if (SCM_MINOR_VERSION == 7)
168 perform_gc_kludge
= false;
174 perform_gc_kludge
= true;
177 SCM old_tab
= scm_stand_in_procs
;
178 SCM new_tab
= scm_make_weak_key_hash_table (scm_from_int (257));
180 new_tab
= scm_internal_hash_fold ((Hash_closure_function
) & redefine_keyval
,
185 scm_stand_in_procs
= new_tab
;
188 ADD_SCM_INIT_FUNC (make_stand_in_procs_weak
, make_stand_in_procs_weak
);