lily/lily-modules.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 2015 by David Kastrup <dak@gnu.org>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "lily-modules.hh"
  21 #include "international.hh"
  22 #include "lily-imports.hh"
  23 #include "warn.hh"
  24
  25 struct Scm_module::Variable_record
  26 {
  27   const char *name_;
  28   Scm_variable *var_;
  29   Variable_record *next_;
  30   Variable_record (const char *name, Scm_variable *var, Variable_record *next_)
  31     : name_ (name), var_ (var), next_ (next_)
  32   { }
  33 };
  34
  35 void
  36 Scm_module::register_variable (const char *name, Scm_variable *var)
  37 {
  38   variables_ = new Variable_record (name, var, variables_);
  39 }
  40
  41 Scm_module::Scm_module (const char *name)
  42   : name_ (name), module_ (SCM_UNDEFINED), variables_ (0)
  43 {
  44 }
  45
  46 void
  47 Scm_module::boot_init (void *arg)
  48 {
  49   Scm_module *self = static_cast<Scm_module *> (arg);
  50
  51   // Establish variables
  52   for (Variable_record *p = self->variables_; p; p = p->next_)
  53     p->var_->boot (p->name_);
  54 }
  55
  56 static SCM
  57 call_trampoline (void *self)
  58 {
  59   // One more indirection since void * can only be safely cast to
  60   // pointers to data rather than pointers to function.
  61   (*static_cast <void (**)()> (self)) ();
  62   return SCM_UNDEFINED;
  63 }
  64
  65 void
  66 Scm_module::boot (void (*init) ())
  67 {
  68   assert (SCM_UNBNDP (module_));
  69   module_ = scm_c_define_module (name_, boot_init, static_cast <void *> (this));
  70   // Can't wrap the following in the scm_c_define_module call since
  71   // the init code may need module_ operative.
  72   if (init)
  73     scm_c_call_with_current_module (module_, call_trampoline, static_cast <void *> (&init));
  74   // Verify that every Variable has a definition, either because of
  75   // getting initialized with a value at definition or because of the
  76   // init call providing one.
  77   for (Variable_record *p = variables_; p; )
  78     {
  79       Variable_record *next = p->next_;
  80       if (SCM_UNBNDP (SCM (*p->var_)))
  81         error (_f ("Uninitialized variable `%s' in module (%s)", p->name_, name_));
  82       delete p;
  83       p = next;
  84     }
  85   variables_ = 0;
  86 }
  87
  88 void
  89 Scm_module::import ()
  90 {
  91   assert (SCM_UNBNDP (module_));
  92   SCM intrface = scm_c_resolve_module (name_);
  93   // Using only the public interface is a voluntary form of access
  94   // control in GUILE.  It would be cumbersome to do so until
  95   // Guile_user itself is imported.
  96   if (SCM_MODULEP (Guile_user::module.module_))
  97     intrface = Guile_user::module_public_interface (intrface);
  98   for (Variable_record *p = variables_; p;)
  99     {
 100       Variable_record *next = p->next_;
 101       p->var_->import (intrface, p->name_);
 102       delete p;
 103       p = next;
 104     }
 105   variables_ = 0;
 106   module_ = intrface;
 107 }
 108
 109 void
 110 Scm_variable::boot (const char *name)
 111 {
 112   assert (!SCM_VARIABLEP (var_));
 113   var_ = scm_c_define (name, var_);
 114 }
 115
 116 void
 117 Scm_variable::import (SCM module, const char *name)
 118 {
 119   assert (SCM_UNBNDP (var_));
 120   var_ = scm_c_module_lookup (module, name);
 121 }
 122
 123
 124 Scm_variable::Scm_variable (Scm_module &m, const char *name, SCM value)
 125   : var_ (value)
 126 {
 127   assert (SCM_IMP (value));
 128   m.register_variable (name, this);
 129 }