/*
     libscheme	
     Copyright (C) 1994 Brent Benson

     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 1, or (at your option)
     any later version.

     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.

     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

#define GEN_BIN_COMP_PROT(name) \
static int name (Scheme_Object *n1, Scheme_Object *n2)

#define GEN_BIN_COMP(name, scheme_name, op) \
static int \
name (Scheme_Object *n1, Scheme_Object *n2) \
{ \
  SCHEME_ASSERT (SCHEME_NUMBERP(n1) && SCHEME_NUMBERP(n2), \
                 #scheme_name ": args must be numbers"); \
  if (SCHEME_INTP(n1)) \
    { \
      if (SCHEME_INTP(n2)) \
        return (SCHEME_INT_VAL(n1) op SCHEME_INT_VAL(n2)); \
      else \
        return (SCHEME_INT_VAL(n1) op SCHEME_DBL_VAL(n2)); \
    } \
  else \
    { \
      if (SCHEME_INTP(n2)) \
        return (SCHEME_DBL_VAL(n1) op SCHEME_INT_VAL(n2)); \
      else \
        return (SCHEME_DBL_VAL(n1) op SCHEME_DBL_VAL(n2)); \
    } \
}

#define GEN_NARY_COMP(name, scheme_name, bin_name) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
  int i; \
  SCHEME_ASSERT ((argc > 1), #scheme_name ": wrong number of args"); \
  for ( i=0 ; i<(argc-1) ; ++i ) \
    { \
      if (! bin_name(argv[i], argv[i+1])) \
        { \
          return (scheme_false); \
        } \
    } \
  return (scheme_true); \
}

#define GEN_BIN_PROT(name) \
static Scheme_Object *name (Scheme_Object *n1, Scheme_Object *n2)

#define GEN_BIN_OP(name, scheme_name, op) \
static Scheme_Object * \
name (Scheme_Object *n1, Scheme_Object *n2) \
{ \
  SCHEME_ASSERT (SCHEME_NUMBERP(n1) && SCHEME_NUMBERP(n2), \
                 #scheme_name ": args must be numbers"); \
  if (SCHEME_INTP(n1)) \
    { \
      if (SCHEME_INTP(n2)) \
	return (scheme_make_integer (SCHEME_INT_VAL(n1) op SCHEME_INT_VAL(n2))); \
      else \
        return (scheme_make_double (SCHEME_INT_VAL(n1) op SCHEME_DBL_VAL(n2))); \
    } \
  else \
    { \
      if (SCHEME_INTP(n2)) \
        return (scheme_make_double (SCHEME_DBL_VAL(n1) op SCHEME_INT_VAL(n2))); \
      else \
        return (scheme_make_double (SCHEME_DBL_VAL(n1) op SCHEME_DBL_VAL(n2))); \
    } \
}

#define GEN_NARY_OP(name, scheme_name, bin_name, ident) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
  Scheme_Object *ret; \
  int i; \
  ret = scheme_make_integer (ident); \
  for ( i=0 ; i<argc ; ++i ) \
    { \
      ret = bin_name (ret, argv[i]); \
    } \
  return (ret); \
}

#define GEN_TWOARY_OP(name, scheme_name, bin_name) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
  Scheme_Object *ret; \
  int i; \
  SCHEME_ASSERT ((argc > 1), #scheme_name ": wrong number of args"); \
  ret = argv[0]; \
  for ( i=1 ; i<argc ; ++i ) \
    { \
      ret = bin_name (ret, argv[i]); \
    } \
  return (ret); \
}

#define GEN_UNARY_OP(name, scheme_name, c_name) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
  SCHEME_ASSERT ((argc == 1), #scheme_name ": wrong number of args"); \
  if (SCHEME_INTP (argv[0])) \
    { \
      return (scheme_make_double (c_name (SCHEME_INT_VAL (argv[0])))); \
    } \
  else \
    { \
      return (scheme_make_double (c_name (SCHEME_DBL_VAL (argv[0])))); \
    } \
}

#define GEN_BIN_FUN(name, scheme_name, c_name) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
  Scheme_Object *n1, *n2; \
  SCHEME_ASSERT ((argc == 2), #scheme_name ": wrong number of args"); \
  SCHEME_ASSERT (SCHEME_NUMBERP(argv[0]) && SCHEME_NUMBERP(argv[1]), \
                 #scheme_name ": both args must be numbers"); \
  n1 = argv[0]; n2 = argv[1]; \
  if (SCHEME_INTP(n1)) \
    { \
      if (SCHEME_INTP(n2)) \
	return (scheme_make_integer (c_name (SCHEME_INT_VAL(n1), SCHEME_INT_VAL(n2)))); \
      else \
        return (scheme_make_double (c_name (SCHEME_INT_VAL(n1), SCHEME_DBL_VAL(n2)))); \
    } \
  else \
    { \
      if (SCHEME_INTP(n2)) \
        return (scheme_make_double (c_name (SCHEME_DBL_VAL(n1), SCHEME_INT_VAL(n2)))); \
      else \
        return (scheme_make_double (c_name (SCHEME_DBL_VAL(n1), SCHEME_DBL_VAL(n2)))); \
    } \
}


