← Back to branch summary

~ubuntu-branches/ubuntu/precise/lilypond/precise

« back to all changes in this revision

Viewing changes to lily/ly-module.cc

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Bushnell, BSG
  • Date: 2006-12-19 10:18:12 UTC
  • mfrom: (3.1.4 feisty)
  • Revision ID: james.westby@ubuntu.com-20061219101812-7awtjkp0i393wxty
Tags: 2.8.7-3
http://bugs.debian.org/400550
scripts/midi2ly.py: When setting DATADIR, find Lilypond python files
in the @TOPLEVEL_VERSION@ directory, not 'current'.  Patch thanks to
Chris Lamb (chris@chris-lamb.co.uk).  (Closes: #400550)

Show diffs side-by-side

added added

removed removed

Lines of Context:
lily/ly-module.cc
1
1
/*
2
 
  ly-module.cc --  implement guile module stuff.
3
 
  
 
2
  ly-module.cc -- implement guile module stuff.
 
3
 
4
4
  source file of the GNU LilyPond music typesetter
5
 
  
6
 
  (c) 2002--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
7
5
 
 
6
  (c) 2002--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
8
7
*/
9
8
 
10
 
#include "string.hh"
11
9
#include "lily-guile.hh"
12
 
#include "ly-module.hh"
 
10
#include "warn.hh"
 
11
#include "main.hh"
 
12
#include "std-string.hh"
13
13
#include "protected-scm.hh"
14
14
 
15
 
#define FUNC_NAME __FUNCTION__
16
 
 
17
 
static int module_count;
 
15
#ifdef MODULE_GC_KLUDGE
 
16
Protected_scm anonymous_modules = SCM_EOL;
 
17
bool perform_gc_kludge;
 
18
#endif
18
19
 
19
20
void
20
 
ly_init_anonymous_module (void * data)
 
21
clear_anonymous_modules ()
21
22
{
22
 
  (void) data;
23
 
  scm_c_use_module ("lily");
 
23
#ifdef MODULE_GC_KLUDGE
 
24
  for (SCM s = anonymous_modules;
 
25
       scm_is_pair (s);
 
26
       s = scm_cdr (s))
 
27
    {
 
28
      SCM module = scm_car (s);
 
29
      SCM closure = SCM_MODULE_EVAL_CLOSURE (module);
 
30
      SCM prop = scm_procedure_property (closure, ly_symbol2scm ("module"));
 
31
 
 
32
      if (ly_is_module (prop))
 
33
        {
 
34
          scm_set_procedure_property_x (closure, ly_symbol2scm ("module"),
 
35
                                        SCM_BOOL_F);
 
36
        }
 
37
    }
 
38
 
 
39
  anonymous_modules = SCM_EOL;
 
40
#endif
24
41
}
25
42
 
26
 
Protected_scm anon_modules;
27
 
 
28
43
SCM
29
 
ly_make_anonymous_module ()
 
44
ly_make_anonymous_module (bool safe)
30
45
{
31
 
  String s = "*anonymous-ly-" + to_string (module_count++) +  "*";
32
 
  SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
33
 
  anon_modules = scm_cons (mod, anon_modules);
 
46
  SCM mod = SCM_EOL;
 
47
  if (!safe)
 
48
    {
 
49
      SCM maker = ly_lily_module_constant ("make-module");
 
50
 
 
51
      SCM scm_module = ly_lily_module_constant ("the-scm-module");
 
52
 
 
53
      mod = scm_call_0 (maker);
 
54
      scm_module_define (mod, ly_symbol2scm ("%module-public-interface"),
 
55
                         mod);
 
56
 
 
57
      ly_use_module (mod, scm_module);
 
58
      ly_use_module (mod, global_lily_module);
 
59
    }
 
60
  else
 
61
    {
 
62
      SCM proc = ly_lily_module_constant ("make-safe-lilypond-module");
 
63
      mod = scm_call_0 (proc);
 
64
    }
 
65
 
 
66
#ifdef MODULE_GC_KLUDGE
 
67
  if (perform_gc_kludge)
 
68
    anonymous_modules = scm_cons (mod, anonymous_modules);
 
69
#endif
 
70
 
34
71
  return mod;
35
72
}
36
73
 
37
 
void
38
 
ly_clear_anonymous_modules ()
 
74
SCM
 
75
ly_use_module (SCM mod, SCM used)
39
76
{
40
 
  SCM s = anon_modules;
41
 
  anon_modules = SCM_EOL;
42
 
  
43
 
  for (; gh_pair_p (s) ; s = gh_cdr (s))
44
 
    {
45
 
      SCM tab= scm_c_make_hash_table (2);
46
 
      /* UGH. */
47
 
      SCM_STRUCT_DATA (gh_car (s))[scm_module_index_obarray]
48
 
        = (long unsigned int) tab;
49
 
    }
 
77
  SCM expr
 
78
    = scm_list_3 (ly_symbol2scm ("module-use!"),
 
79
                  mod,
 
80
                  scm_list_2 (ly_symbol2scm ("module-public-interface"),
 
81
                              used));
 
82
 
 
83
  return scm_eval (expr, global_lily_module);
50
84
}
51
85
 
52
86
#define FUNC_NAME __FUNCTION__
53
87
 
54
88
static SCM
55
 
ly_module_define (void *closure, SCM key, SCM val, SCM result)
56
 
{
57
 
  (void) result;
58
 
  SCM module = (SCM) closure;
59
 
  scm_module_define (module, key, scm_variable_ref (val));
60
 
  return SCM_EOL;
61
 
}
62
 
 
63
 
/* Ugh signature of scm_internal_hash_fold () is inaccurate.  */
64
 
typedef SCM (*Hash_cl_func)();
65
 
 
66
 
void
67
 
ly_import_module (SCM dest, SCM src)
68
 
{
69
 
  SCM_VALIDATE_MODULE (1, src);
70
 
  scm_internal_hash_fold ((Hash_cl_func) &ly_module_define, (void*) dest,
71
 
                          SCM_EOL, SCM_MODULE_OBARRAY (src));
72
 
}
73
 
 
74
 
static SCM
75
89
accumulate_symbol (void *closure, SCM key, SCM val, SCM result)
76
90
{
77
91
  (void) closure;
83
97
ly_module_symbols (SCM mod)
84
98
{
85
99
  SCM_VALIDATE_MODULE (1, mod);
86
 
  
87
 
  SCM obarr= SCM_MODULE_OBARRAY (mod);
88
 
  return scm_internal_hash_fold ((Hash_cl_func) &accumulate_symbol,
89
 
                                 NULL, SCM_EOL, obarr); 
 
100
 
 
101
  SCM obarr = SCM_MODULE_OBARRAY (mod);
 
102
  return scm_internal_hash_fold ((Hash_closure_function) & accumulate_symbol,
 
103
                                 NULL, SCM_EOL, obarr);
90
104
}
91
105
 
92
106
static SCM
93
107
entry_to_alist (void *closure, SCM key, SCM val, SCM result)
94
108
{
95
109
  (void) closure;
96
 
  return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
 
110
  if (scm_variable_bound_p (val) == SCM_BOOL_T)
 
111
    return scm_cons (scm_cons (key, scm_variable_ref (val)), result);
 
112
  programming_error ("unbound variable in module");
 
113
  return result;
97
114
}
98
115
 
99
 
SCM
100
 
ly_module_to_alist (SCM mod)
 
116
LY_DEFINE (ly_module2alist, "ly:module->alist",
 
117
           1, 0, 0, (SCM mod),
 
118
           "Dump the contents of  module @var{mod} as an alist.")
101
119
{
102
120
  SCM_VALIDATE_MODULE (1, mod);
103
 
  
104
 
  
105
 
  SCM obarr= SCM_MODULE_OBARRAY (mod);
106
 
 
107
 
  return scm_internal_hash_fold ((Hash_cl_func) &entry_to_alist, NULL, SCM_EOL, obarr); 
108
 
}
109
 
 
110
 
/* Lookup SYM, but don't give error when it is not defined.  */
111
 
SCM
112
 
ly_module_lookup (SCM module, SCM sym)
113
 
{
114
 
#define FUNC_NAME __FUNCTION__
115
 
  SCM_VALIDATE_MODULE (1, module);
116
 
 
117
 
  return scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
118
 
#undef FUNC_NAME
119
 
}
120
 
 
121
 
SCM
122
 
ly_modules_lookup (SCM modules, SCM sym)
123
 
{
124
 
  for (SCM s = gh_car (modules); SCM_MODULEP (s); s = ly_cdr (s))
125
 
    {
126
 
      SCM v = scm_sym2var (sym, scm_module_lookup_closure (s), SCM_UNDEFINED);
127
 
      if (v != SCM_UNDEFINED)
128
 
        return v;
129
 
    }
130
 
  return SCM_UNDEFINED;
131
 
}
132
 
 
133
 
 
134
 
SCM export_function;
 
121
  SCM obarr = SCM_MODULE_OBARRAY (mod);
 
122
 
 
123
  return scm_internal_hash_fold ((Hash_closure_function) & entry_to_alist, NULL, SCM_EOL, obarr);
 
124
}
135
125
 
136
126
void
137
127
ly_export (SCM module, SCM namelist)
138
128
{
 
129
  static SCM export_function;
139
130
  if (!export_function)
140
131
    export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
141
 
  
 
132
 
142
133
  scm_call_2 (SCM_VARIABLE_REF (export_function), module, namelist);
143
134
}
144
135
 
147
138
{
148
139
  ly_export (mod, ly_module_symbols (mod));
149
140
}
 
141
 
 
142
#ifdef MODULE_GC_KLUDGE
 
143
static SCM
 
144
redefine_keyval (void *closure, SCM key, SCM val, SCM result)
 
145
{
 
146
  (void)closure;
 
147
  SCM new_tab = result;
 
148
  scm_hashq_set_x (new_tab, key, val);
 
149
  return new_tab;
 
150
}
 
151
 
 
152
/*
 
153
  UGH UGH.
 
154
  Kludge for older GUILE 1.6 versions.
 
155
*/
 
156
void
 
157
make_stand_in_procs_weak ()
 
158
{
 
159
  /*
 
160
    Ugh, ABI breakage for 1.6.5: scm_stand_in_procs is a hashtab from
 
161
    1.6.5 on.
 
162
   */
 
163
  if (scm_is_pair (scm_stand_in_procs))
 
164
    {
 
165
      return; 
 
166
    }
 
167
      
 
168
  if (scm_weak_key_hash_table_p (scm_stand_in_procs) == SCM_BOOL_T)
 
169
    {
 
170
#if (SCM_MINOR_VERSION == 7) 
 
171
      perform_gc_kludge = false;
 
172
#endif
 
173
      return; 
 
174
    }
 
175
 
 
176
  
 
177
  perform_gc_kludge = true;
 
178
  
 
179
  
 
180
  SCM old_tab = scm_stand_in_procs;
 
181
  SCM new_tab = scm_make_weak_key_hash_table (scm_from_int (257));
 
182
 
 
183
  new_tab = scm_internal_hash_fold ((Hash_closure_function) & redefine_keyval,
 
184
                                    NULL,
 
185
                                    new_tab,
 
186
                                    old_tab);
 
187
 
 
188
  scm_stand_in_procs = new_tab;
 
189
}
 
190
 
 
191
ADD_SCM_INIT_FUNC (make_stand_in_procs_weak, make_stand_in_procs_weak);
 
192
#endif