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

Go to the documentation of this file.

/******************************************************************************
* MODULE     : routine.cpp
* DESCRIPTION: Abstract routines on generic expressions
* 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/routine.hpp>
#include <basix/string.hpp>
#include <basix/tuple.hpp>
#include <basix/alias.hpp>
namespace mmx {

/******************************************************************************
* Routines for debugging
******************************************************************************/

vector<generic>
type_name (const vector<nat>& ids) {
  nat i, n= N(ids);
  vector<generic> ret= fill<generic> (n);
  for (i=0; i<n; i++)
    ret[i]= type_name (ids[i]);
  return ret;
}

/******************************************************************************
* Generic routines
******************************************************************************/

generic
routine_rep::apply () const {
  return apply (vec<generic> ());
}

generic
routine_rep::apply (const generic& g1) const {
  return apply (vec<generic> (g1));
}

generic
routine_rep::apply (const generic& g1, const generic& g2) const {
  return apply (vec<generic> (g1, g2));
}

generic
routine_rep::apply (const vector<generic>& v) const {
  mmerr << "name= " << name << "\n";
  mmerr << "args= " << v << "\n";
  ERROR ("not implemented (apply)");
  return generic ();
}

vector<nat>
routine_rep::signature () const {
  ERROR ("not implemented (signature)");
  return vec<nat> ();
}

void
routine_rep::overload (const routine& fun) const {
  ERROR ("not implemented (overload)");
}

bool
routine_rep::is_overloaded () const {
  return false;
}

vector<routine>
routine_rep::meanings () const {
  ERROR ("not implemented (meanings)");
}

generic
routine_rep::function_body () const {
  return "native";
}

generic
routine_rep::function_type () const {
  return gen (GEN_FUNCTION_TYPE, type_name (signature ()));
}

routine
routine_rep::clone () const {
  ERROR ("not implemented (clone)");
  return routine (this, true);
}

/******************************************************************************
* Identity routines
******************************************************************************/

class identity_routine_rep: public routine_rep {
  vector<nat> sig;
public:
  identity_routine_rep (const vector<nat>& sig2):
    routine_rep (GEN_IDENTITY), sig (sig2) {}
  generic apply (const generic& x) const { return x; }
  generic apply (const vector<generic>& v) const {
    ASSERT (N(v) == 1, "one argument expected"); return apply (v[0]); }
  vector<nat> signature () const { return sig; }
};

routine
identity_routine (const vector<nat>& sig) {
  // WARNING: we do allow for "fake identity functions" with sig[0] != sig[1]
  // This is useful for fast conversions to generic
  ASSERT (N(sig) == 2, "identity routine should take one argument");
  return new identity_routine_rep (sig);
}

/******************************************************************************
* Composition of routines
******************************************************************************/

class composed_routine_rep: public routine_rep {
  routine fun;
  const vector<routine> args;
  vector<nat> sig;
public:
  composed_routine_rep (const routine& fun2, const vector<routine>& args2):
    routine_rep (gen (GEN_COMPOSE, fun2->name, as_generic (flatten (args2)))),
    fun (fun2), args (args2)
  {
    sig= copy (fun->signature ());
    if (N(sig) != 0) {
      ASSERT (N(sig) == N(args)+1,
              "numbers of arguments don't match (composed_routine_rep)");
      for (nat i=0; i<N(args); i++) {
        const vector<nat> sub_sig= args[i]->signature ();
        ASSERT (N(sub_sig) == 2,
                "routine with one argument expected (composed_routine_rep)");
        ASSERT (read (sig, i+1) == sub_sig[0] || read (sig, i+1) == 0,
                "type mismatch (composed_routine_rep)");
        sig[i+1]= sub_sig[1];
      }
    }
  }
  generic apply (const generic& x) const {
    ASSERT (N(args) == 1, "arity one expected");
    return fun->apply (args[0]->apply (x));
  }
  generic apply (const generic& x, const generic& y) const {
    ASSERT (N(args) == 2, "arity two expected");
    return fun->apply (args[0]->apply (x), args[1]->apply (y));
  }
  generic apply (const vector<generic>& v) const {
    nat i, n= N(v);
    ASSERT (N(args) == n, "arity " * as_string (n) * " expected");
    vector<generic> w= fill<generic> (n);
    for (i=0; i<n; i++)
      w[i]= args[i]->apply (v[i]);
    return fun->apply (w);
  }
  vector<nat> signature () const { return sig; }
};

routine
compose (const routine& fun, const vector<routine>& args) {
  // WARNING: the signature of the result is not necessarily correct
  // when simplifying with "fake identity functions", but that does not
  // matter for the application to overloading
  if (exact_eq (fun->name, GEN_IDENTITY) && N(args) == 1)
    return args [0];
  for (nat i=0; i<N(args); i++) {
    if (exact_neq (args[i]->name, GEN_IDENTITY))
      return new composed_routine_rep (fun, args);
  }
  return fun;
}

/******************************************************************************
* Changing the signature of a routine
******************************************************************************/

class change_signature_routine_rep: public routine_rep {
  routine     r;
  vector<nat> sig;
public:
  change_signature_routine_rep (const routine& r2, const vector<nat>& sig2):
    routine_rep (r2->name), r (r2), sig (sig2) {}
  generic apply () const {
    return r->apply (); }
  generic apply (const generic& x1) const {
    return r->apply (x1); }
  generic apply (const generic& x1, const generic& x2) const {
    return r->apply (x1, x2); }
  generic apply (const vector<generic>& v) const {
    return r->apply (v); }
  vector<nat> signature () const { return sig; }
};

routine
change_signature (const routine& r, const vector<nat>& sig) {
  return new change_signature_routine_rep (r, sig);
}

/******************************************************************************
* Default routine
******************************************************************************/

class default_routine_rep: public routine_rep {
public:
  default_routine_rep (const generic& name): routine_rep (name) {}
  generic apply (const vector<generic>& v) const {
    return current_ev->apply (GEN_APPLY, cons (name, v)); }
  vector<nat> signature () const { return vec<nat> (); }
};

routine
default_routine (const generic& name) {
  if (is<routine> (name))
    return as<routine> (name);
  if (is<alias<routine> > (name))
    return get_alias (as<alias<routine> > (name));
  return new default_routine_rep (name);
}

/******************************************************************************
* Integrate routine (for dynamical systems)
******************************************************************************/

class integrate_routine_rep: public routine_rep {
  routine fun;
public:
  integrate_routine_rep (const routine& fun2):
    routine_rep (gen (GEN_INTEGRATE, fun2->name)), fun (fun2) {}
  generic apply () const {
    return integrate (fun->apply ()); }
  generic apply (const generic& x1) const {
    return integrate (fun->apply (x1)); }
  generic apply (const generic& x1, const generic& x2) const {
    return integrate (fun->apply (x1, x2)); }
  generic apply (const vector<generic>& v) const {
    return integrate (fun->apply (v)); }
  vector<nat> signature () const {
    return fun->signature (); }
};

routine
integrate (const routine& r) {
  return new integrate_routine_rep (r);
}

} // namespace mmx