/Users/mourrain/Devel/mmx/basix/src/glue.cpp

Go to the documentation of this file.

/******************************************************************************
* MODULE     : glue.cpp
* DESCRIPTION: Routines for defining glue
* COPYRIGHT  : (C) 2006  Joris van der Hoeven
*******************************************************************************
* This software falls under the GNU general public license and comes WITHOUT
* ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for more details.
* If you don't have this file, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************/

#include <basix/tuple.hpp>
#include <basix/literal.hpp>
#include <basix/compound.hpp>
#include <basix/glue.hpp>
namespace mmx {

#ifdef BASIX_OLD_GNU_COMPILER
template define_type_helper<true,generic>;
// NOTE: this explicit instantiation avoids a bug in gcc 2.95.3
#endif

/******************************************************************************
* These definitions should be made before anything else
******************************************************************************/

bool
fall_back_equal (const generic& x, const generic& y) {
  return exact_eq (x, y);
}

static bool
fall_back_unequal (const generic& x, const generic& y) {
  return exact_neq (x, y);
}

void
define_prerequisites () {
  define_type<generic> (GEN_GENERIC_TYPE);
  define_type<bool> (GEN_BOOLEAN_TYPE);
  define_type<int> (GEN_INT_TYPE);
  define_type<double> (GEN_DOUBLE_TYPE);
  define_type<literal> (GEN_LITERAL_TYPE);
  define_type<compound> (GEN_COMPOUND_TYPE);
  define_type<routine> (GEN_ROUTINE_TYPE);
  define_type<primitive> (GEN_MACRO_TYPE);
  define_constant<bool> (GEN_FALSE, false);
  define_constant<bool> (GEN_TRUE, true);
  define<bool,generic,generic> (GEN_EQUAL, fall_back_equal);
  define<bool,generic,generic> (GEN_UNEQUAL, fall_back_unequal);
}

/******************************************************************************
* Gluing new data types
******************************************************************************/

vector<generic>
all_type_names () {
  generic ret;
  if (current_ev->get (gen (GEN_ALL_TYPES), ret))
    return as<vector<generic> > (ret);
  return vec<generic> ();
}

void
define_type_sub (const generic& name, nat id) {
  current_ev->set (gen (GEN_TYPE_NAME, as<generic> (id)), name);
  current_ev->set (gen (GEN_TYPE_ID, name), as<generic> (id));
  if (!is_tuple_type (id) && !is_alias_type (id)) {
    vector<generic> all_types= all_type_names ();
    all_types << name;
    current_ev->set (gen (GEN_ALL_TYPES), as<generic> (all_types));
  }
}

nat
type_id (const generic& name) {
  generic id;
  if (current_ev->get (gen (GEN_TYPE_ID, name), id) && is<nat> (id))
    return as<nat> (id);
  else return 1;
}

generic
type_name (nat id) {
  generic name;
  if (current_ev->get (gen (GEN_TYPE_NAME, as<generic> (id)), name))
    return name;
  else return GEN_UNSPECIFIED_TYPE;
}

generic
type_name (const generic& g) {
  return type_name (type (g));
}

nat
accelerate_number () {
  static nat nr_ids= 0;
  return nr_ids++;
}

/******************************************************************************
* Glued function table
******************************************************************************/

static table<void (*) (), string>& glue_table () {
  static table<void (*) (), string> t;
  return t;
}

void register_glue (const string& s, void (*f) ()) {
  inside_set (glue_table (), s, f);
}

void call_glue (const string& s) {
  if (! contains (glue_table (), s))
    ERROR ("Can not find glued function " * s);
  (glue_table () [s]) ();
}

} // namespace mmx