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

Go to the documentation of this file.

/******************************************************************************
* MODULE     : generic_utils.cpp
* DESCRIPTION: Utility functions for generic expressions
* COPYRIGHT  : (C) 2005  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/evaluator.hpp>
#include <basix/memoize.hpp>
#include <basix/literal.hpp>
#include <basix/compound.hpp>
namespace mmx {

/******************************************************************************
* List compatability routines
******************************************************************************/

generic
range (const generic& g, nat start, nat end) {
  return vector_to_compound (range (compound_to_vector (g), start, end));
}

generic
append (const generic& g1, const generic& g2) {
  return vector_to_compound (append (compound_to_vector (g1),
                                     compound_to_vector (g2)));
}

generic
cons (const generic& g1, const generic& g2) {
  return vector_to_compound (cons (g1, compound_to_vector (g2)));
}

generic
cons (const generic& g1, const generic& g2, const generic& g3) {
  return vector_to_compound (append (vec<generic> (g1, g2),
                                     compound_to_vector (g3)));
}

generic
car (const generic& g) {
  return g[0];
}

generic
cdr (const generic& g) {
  return vector_to_compound (range (compound_to_vector (g), 1, N(g)));
}

/******************************************************************************
* Useful predicates
******************************************************************************/

bool
is_func (const generic& g, const char* f) {
  return is<compound> (g) && exact_eq (g[0], generic (f));
}

bool
is_func (const generic& g, const char* f, nat n) {
  return is<compound> (g) && N (g) == (n+1) && exact_eq (g[0], generic (f));
}

bool
is_func (const generic& g, const generic& f) {
  return is<compound> (g) && exact_eq (g[0], f);
}

bool
is_func (const generic& g, const generic& f, nat n) {
  return is<compound> (g) && N (g) == (n+1) && exact_eq (g[0], f);
}

/******************************************************************************
* Size function
******************************************************************************/

generic
var_flatten (const generic& g) {
  return as_generic (flatten (g));
}

nat
size (const generic& g) {
  if (is<literal> (g)) return 1;
  if (is<compound> (g)) {
    nat i, n= N (g), sum= 1;
    for (i=0; i<n; i++)
      sum += size (g[i]);
    return sum;
  }
  return size (var_flatten (g));
}

/******************************************************************************
* Comparison
******************************************************************************/

bool
is_numeric (const string& s) {
  return
    (N(s) > 0 && s[0] >= '0' && s[0] <= '9') ||
    (N(s) > 1 && s[0] == '-' && s[1] >= '0' && s[1] <= '9');
}

static int
compare_numeric (const string& s1, const string& s2) {
  if (s1[0] == '-' && s2[0] != '-') return -1;
  if (s1[0] != '-' && s2[0] == '-') return 1;
  if (s1[0] == '-' && s2[0] == '-')
    return -compare_numeric (s1 (1, N (s1)), s2 (1, N(s2)));
  if (N(s1) < N(s2)) return -1;
  if (N(s1) > N(s2)) return 1;
  if (s1 < s2) return -1;
  if (s1 > s2) return 1;
  return 0;
}

static int compare (const generic& g1, const generic& g2, const int& dir);

static int
compare_sub (const generic& g1, const generic& g2, const int& direction) {
  nat s1= size (g1), s2= size (g2);
  if (s1 < s2) return -direction;
  if (s1 > s2) return direction;
  if (is<literal> (g1) && is<literal> (g2)) {
    string l1= literal_to_string (g1), l2= literal_to_string (g2);
    if (is_numeric (l1) && !is_numeric (l2)) return -direction;
    if (is_numeric (l2) && !is_numeric (l1)) return direction;
    if (is_numeric (l1) && is_numeric (l2))
      return direction * compare_numeric (l1, l2);
    if (l1 < l2) return -1;
    if (l1 > l2) return 1;
    return 0;
  }
  if (is<literal> (g1) && is<compound> (g2)) return -direction;
  if (is<compound> (g1) && is<literal> (g2)) return direction;
  if (is<compound> (g1) && is<compound> (g2)) {
    nat i, n1= N (g1), n2= N (g2);
    if (n1 < n2) return -direction;
    if (n1 > n2) return direction;
    for (i=0; i<n1; i++) {
      int c= compare (g1[i], g2[i], direction);
      if (c != 0) return c;
    }
    return 0;
  }
  return compare (var_flatten (g1), var_flatten (g2), direction);
}

int compare_N (const generic& g1, const generic& g2) {
  return compare_sub (g1, g2, -1); }
int compare_P (const generic& g1, const generic& g2) {
  return compare_sub (g1, g2, 1); }

static int
compare (const generic& g1, const generic& g2, const int& dir) {
  // NOTE: the splitting into two cases should not be necessary.
  // We do it in order to avoid an internal compiler error...
  if (dir < 0) {
    MEMOIZE_BINARY (std_memoizer,int,generic,generic,compare_N,g1,g2,
                   compare_N (g1, g2));
  }
  else {
    MEMOIZE_BINARY (std_memoizer,int,generic,generic,compare_P,g1,g2,
                   compare_P (g1, g2));
  }
}

int
big_small_compare (const generic& g1, const generic& g2) {
  return compare (g1, g2, -1);
}

int
small_big_compare (const generic& g1, const generic& g2) {
  return compare (g1, g2, 1);
}

} // namespace mmx