]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/translator-group.cc
release: 1.5.36
[lilypond.git] / lily / translator-group.cc
index cf813de9636d8b6610c2573e5bd8410244a5ee7e..2938b2b7cd7b1cbdb3ca74a2d0c33db471410b8e 100644 (file)
@@ -3,7 +3,7 @@
 
   source file of the GNU LilyPond music typesetter
 
-  (c)  1997--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  (c)  1997--2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 */
 
 #include "music-output-def.hh"
 #include "debug.hh"
 #include "moment.hh"
 #include "scm-hash.hh"
-#include "killing-cons.tcc"
 #include "translator-def.hh"
+#include "main.hh"
 
 Translator_group::Translator_group (Translator_group const&s)
-  : Translator(s)
+  : Translator (s)
 {
   iterator_count_ =0;
   
   Scheme_hash_table * tab =  new Scheme_hash_table (*s.properties_dict ());
   properties_scm_ = tab->self_scm ();
-  scm_unprotect_object (tab->self_scm( ));
+  scm_gc_unprotect_object (tab->self_scm ());
 }
 
 Scheme_hash_table*
@@ -34,56 +34,71 @@ Translator_group::properties_dict () const
 Translator_group::~Translator_group ()
 {
   
-  //assert (removable_b());
+  //assert (removable_b ());
 }
 
 
-Translator_group::Translator_group()
+Translator_group::Translator_group ()
 {
   iterator_count_  = 0;
   Scheme_hash_table *tab = new Scheme_hash_table ;
   properties_scm_ = tab->self_scm ();
 
-  scm_unprotect_object (tab->self_scm ());
+  scm_gc_unprotect_object (tab->self_scm ());
 }
 
 void
-Translator_group::check_removal()
+Translator_group::check_removal ()
 {
   SCM next = SCM_EOL; 
   for (SCM p = trans_group_list_; gh_pair_p (p); p = next)
     {
-      next = gh_cdr (p);
+      next = ly_cdr (p);
 
-      Translator_group *trg =  dynamic_cast<Translator_group*> (unsmob_translator (gh_car (p)));
+      Translator_group *trg =  dynamic_cast<Translator_group*> (unsmob_translator (ly_car (p)));
 
       trg->check_removal ();
-      if (trg->removable_b())
+      if (trg->removable_b ())
        terminate_translator (trg);
     }
 }
 
-
 SCM
 Translator_group::add_translator (SCM list, Translator *t)
 {
+  /*
+    Must append, since list ordering must be preserved.
+   */
   list = gh_append2 (list, gh_cons (t->self_scm (), SCM_EOL));
   t->daddy_trans_l_ = this;
   t->output_def_l_ = output_def_l_;
-  t->add_processing ();
 
   return list;
 }
+
+
 void
-Translator_group::add_group_translator (Translator *t)
+Translator_group::add_used_group_translator (Translator *t)
 {
   trans_group_list_ = add_translator (trans_group_list_,t);
 }
 
 
+void
+Translator_group::add_fresh_group_translator (Translator*t)
+{
+  Translator_group*tg = dynamic_cast<Translator_group*> (t);
+  assert (tg);
+
+  trans_group_list_ = add_translator (trans_group_list_,t); 
+  unsmob_translator_def (tg->definition_)->apply_property_operations (tg);
+  t->initialize ();
+  
+}
+
 
 bool
-Translator_group::removable_b() const
+Translator_group::removable_b () const
 {
   return trans_group_list_ == SCM_EOL && ! iterator_count_;
 }
@@ -95,9 +110,9 @@ Translator_group::find_existing_translator_l (String n, String id)
     return this;
 
   Translator_group* r = 0;
-  for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = gh_cdr (p))
+  for (SCM p = trans_group_list_; !r && gh_pair_p (p); p = ly_cdr (p))
     {
-      Translator *  t = unsmob_translator (gh_car (p));
+      Translator *  t = unsmob_translator (ly_car (p));
       
       r = dynamic_cast<Translator_group*> (t)->find_existing_translator_l (n, id);
     }
@@ -116,7 +131,7 @@ Translator_group::find_create_translator_l (String n, String id)
     return existing;
 
   Link_array<Translator_def> path
-    = unsmob_translator_def (definition_)->path_to_acceptable_translator (ly_str02scm ((char*)n.ch_C()), output_def_l ());
+    = unsmob_translator_def (definition_)->path_to_acceptable_translator (ly_str02scm ((char*)n.ch_C ()), output_def_l ());
 
   if (path.size ())
     {
@@ -127,10 +142,12 @@ Translator_group::find_create_translator_l (String n, String id)
        {
          Translator_group * new_group = path[i]->instantiate (output_def_l_);
 
-         current->add_group_translator (new_group);
+         if (i == path.size () -1)
+           new_group->id_str_ = id;      
+         current->add_fresh_group_translator (new_group);
          current = new_group;
        }
-      current->id_str_ = id;
+
       return current;
     }
 
@@ -149,17 +166,16 @@ bool
 Translator_group::try_music_on_nongroup_children (Music *m)
 {
   bool hebbes_b =false;
-
   
-  for (SCM p = simple_trans_list_; !hebbes_b && gh_pair_p (p); p = gh_cdr (p))
+  for (SCM p = simple_trans_list_; !hebbes_b && gh_pair_p (p); p = ly_cdr (p))
     {
-      hebbes_b = unsmob_translator (gh_car (p))->try_music (m);
+      hebbes_b = unsmob_translator (ly_car (p))->try_music (m);
     }
   return hebbes_b;
 }
 
 bool
-Translator_group::do_try_music (Music* m)
+Translator_group::try_music (Music* m)
 {
   bool hebbes_b = try_music_on_nongroup_children (m);
   
@@ -169,9 +185,9 @@ Translator_group::do_try_music (Music* m)
 }
 
 int
-Translator_group::depth_i() const
+Translator_group::depth_i () const
 {
-  return (daddy_trans_l_) ? daddy_trans_l_->depth_i()  + 1 : 0;
+  return (daddy_trans_l_) ? daddy_trans_l_->depth_i ()  + 1 : 0;
 }
 
 Translator_group*
@@ -186,7 +202,7 @@ Translator_group::ancestor_l (int level)
 void
 Translator_group::terminate_translator (Translator*r_l)
 {
-  r_l->removal_processing();
+  r_l->removal_processing ();
   /*
     Return value ignored. GC does the rest.
    */
@@ -215,7 +231,7 @@ Translator_group::is_bottom_translator_b () const
 }
 
 Translator_group*
-Translator_group::get_default_interpreter()
+Translator_group::get_default_interpreter ()
 {
   if (!is_bottom_translator_b ())
     {
@@ -225,11 +241,11 @@ Translator_group::get_default_interpreter()
       Translator_def *t = unsmob_translator_def (st);
       if (!t)
        {
-         warning (_f ("can't find or create: `%s'", ly_scm2string (nm).ch_C()));
+         warning (_f ("can't find or create: `%s'", ly_scm2string (nm).ch_C ()));
          t = unsmob_translator_def (this->definition_);
        }
       Translator_group *tg = t->instantiate (output_def_l_);
-      add_group_translator (tg);
+      add_fresh_group_translator (tg);
 
       if (!tg->is_bottom_translator_b ())
        return tg->get_default_interpreter ();
@@ -242,8 +258,8 @@ Translator_group::get_default_interpreter()
 static void
 static_each (SCM list, Method_pointer method)
 {
-  for (SCM p = list; gh_pair_p (p); p = gh_cdr(p))
-    (unsmob_translator (gh_car (p))->*method) ();
+  for (SCM p = list; gh_pair_p (p); p = ly_cdr (p))
+    (unsmob_translator (ly_car (p))->*method) ();
   
 }
 
@@ -255,18 +271,6 @@ Translator_group::each (Method_pointer method)
 }
 
 
-
-void
-Translator_group::do_add_processing ()
-{
-  unsmob_translator_def (definition_)->apply_property_operations (this);
-  for (SCM s = simple_trans_list_; gh_pair_p (s) ; s = gh_cdr (s))
-    {
-      Translator * t = unsmob_translator (gh_car (s));
-      t->add_processing ();
-    }
-}
-
 /*
   PROPERTIES
  */
@@ -282,33 +286,42 @@ Translator_group::where_defined (SCM sym) const
 }
 
 /*
-  TODO: return SCM_EOL iso. SCM_UNDEFINED when not found.
+  return SCM_EOL when not found.
 */
 SCM
-Translator_group::get_property (SCM sym) const
+Translator_group::internal_get_property (SCM sym) const
 {
-  SCM val =SCM_UNDEFINED;
+  SCM val =SCM_EOL;
   if (properties_dict ()->try_retrieve (sym, &val))
     return val;
 
   if (daddy_trans_l_)
-    return daddy_trans_l_->get_property (sym);
+    return daddy_trans_l_->internal_get_property (sym);
   
   return val;
 }
 
 void
-Translator_group::set_property (String id, SCM val)
+Translator_group::internal_set_property (SCM sym, SCM val)
 {
-  set_property (ly_symbol2scm (id.ch_C()), val);
+#ifndef NDEBUG
+  if (internal_type_checking_global_b)
+    assert (type_check_assignment (sym, val, ly_symbol2scm ("translation-type?")));
+#endif
+  
+  properties_dict ()->set (sym, val);
 }
 
+/*
+  TODO: look up to check whether we have inherited var? 
+ */
 void
-Translator_group::set_property (SCM sym, SCM val)
+Translator_group::unset_property (SCM sym)
 {
-  properties_dict ()->set (sym, val);
+  properties_dict ()->remove (sym);
 }
 
+
 /*
   Push or pop (depending on value of VAL) a single entry (ELTPROP . VAL)
   entry from a translator property list by name of PROP
@@ -316,56 +329,20 @@ Translator_group::set_property (SCM sym, SCM val)
 void
 Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM val)
 {
-  if (gh_symbol_p(prop))
+  if (gh_symbol_p (prop))
     {
       if (val != SCM_UNDEFINED)
        {
-         SCM prev = get_property (prop);
+         SCM prev = internal_get_property (prop);
 
-         /*
-           we don't tack onto SCM_UNDEFINED, because it creates
-           errors down the line, if we do scm_assoc().
-          */
          if (gh_pair_p (prev) || prev == SCM_EOL)
            {
-             bool ok = true;
-             
-             SCM errport = scm_current_error_port ();
+             bool ok = type_check_assignment (eltprop, val, ly_symbol2scm ("backend-type?"));
              
-             SCM meta = scm_assoc (ly_symbol2scm ("meta"), prev);
-             SCM props = scm_assoc (ly_symbol2scm ("properties"), gh_cdr (meta));
-             SCM type_p = scm_assoc (eltprop, gh_cdr (props));
-             if (!gh_pair_p (type_p))
-               {
-                 scm_puts (_("Couldn't find property description for #'").ch_C(),errport);
-                 scm_display (eltprop, errport);
-
-                 scm_puts (_(" in element description ").ch_C(),errport);
-                 scm_display (prop, errport);
-
-                 scm_puts (_(". Perhaps you made a typing error?\n").ch_C(),errport);            
-               }
-             else
-               {
-                 type_p = gh_cdr (type_p);
-                 if (gh_call1 (type_p, val) == SCM_BOOL_F)
-                   {
-                     ok = false;
-                     scm_puts (_("Failed typecheck for #'").ch_C (),errport);
-                     scm_display (eltprop,errport);
-                     scm_puts ( _(", value ").ch_C (), errport);
-                     scm_write (val, errport);
-                     scm_puts (_(" must be of type ").ch_C (), errport);
-                     SCM typefunc = scm_eval2 (ly_symbol2scm ("type-name"), SCM_EOL);
-                     scm_display (gh_call1 (typefunc, type_p), errport);
-                     scm_puts ("\n", errport);               
-                   }
-               }
-
              if (ok)
                {
                  prev = gh_cons (gh_cons (eltprop, val), prev);
-                 set_property (prop, prev);
+                 internal_set_property (prop, prev);
                }
            }
          else
@@ -376,19 +353,19 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va
        }
       else
        {
-         SCM prev = get_property (prop);
+         SCM prev = internal_get_property (prop);
 
          SCM newprops= SCM_EOL ;
-         while (gh_pair_p (prev) && gh_caar (prev) != eltprop)
+         while (gh_pair_p (prev) && ly_caar (prev) != eltprop)
            {
-             newprops = gh_cons (gh_car (prev), newprops);
-             prev = gh_cdr (prev);
+             newprops = gh_cons (ly_car (prev), newprops);
+             prev = ly_cdr (prev);
            }
          
          if (gh_pair_p (prev))
            {
-             newprops = scm_reverse_x (newprops, gh_cdr (prev));
-             set_property (prop, newprops);
+             newprops = scm_reverse_x (newprops, ly_cdr (prev));
+             internal_set_property (prop, newprops);
            }
        }
     }
@@ -402,31 +379,68 @@ Translator_group::execute_single_pushpop_property (SCM prop, SCM eltprop, SCM va
   STUBS
 */
 void
-Translator_group::do_pre_move_processing ()
+Translator_group::stop_translation_timestep ()
 {
-  each (&Translator::pre_move_processing);
+  each (&Translator::stop_translation_timestep);
 }
 
 void
-Translator_group::do_post_move_processing ()
+Translator_group::start_translation_timestep ()
 {
-  each (&Translator::post_move_processing);
+  each (&Translator::start_translation_timestep);
 }
 
 void
-Translator_group::do_process_music ()
+Translator_group::do_announces ()
 {
-  each (&Translator::process_music);
+  each (&Translator::announces);
 }
 
 void
-Translator_group::do_creation_processing ()
+Translator_group::initialize ()
 {
-  each (&Translator::creation_processing);
+  each (&Translator::initialize);
 }
 
 void
-Translator_group::do_removal_processing ()
+Translator_group::finalize ()
 {
   each (&Translator::removal_processing);
 }
+
+
+SCM
+ly_get_trans_property (SCM context, SCM name)
+{
+  Translator *t = unsmob_translator (context);
+  Translator_group* tr=   dynamic_cast<Translator_group*> (t);
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
+  SCM_ASSERT_TYPE(gh_symbol_p(name), name, SCM_ARG2, __FUNCTION__, "symbol");
+
+  return tr->internal_get_property (name);
+  
+}
+SCM
+ly_set_trans_property (SCM context, SCM name, SCM val)
+{
+  Translator *t = unsmob_translator (context);
+  Translator_group* tr=   dynamic_cast<Translator_group*> (t);
+
+  SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group");
+  tr->internal_set_property (name, val);
+
+  return SCM_UNSPECIFIED;
+}
+
+
+
+
+void
+add_trans_scm_funcs ()
+{
+  scm_c_define_gsubr ("ly-get-trans-property", 2, 0, 0, (Scheme_function_unknown)ly_get_trans_property);
+  scm_c_define_gsubr ("ly-set-trans-property", 3, 0, 0, (Scheme_function_unknown)ly_set_trans_property);
+}
+
+ADD_SCM_INIT_FUNC (trans_scm, add_trans_scm_funcs);
+