C++ (Cpp) scheme_minus_zero_p Examples

Example #1

File: bool.c Project: SamB/racket

XFORM_NONGCING static MZ_INLINE int double_eqv(double a, double b)
{
# ifndef NAN_EQUALS_ANYTHING
  if (a != b) {
# endif
    /* Double-check for NANs: */
    if (MZ_IS_NAN(a)) {
      if (MZ_IS_NAN(b))
        return 1;
# ifdef NAN_EQUALS_ANYTHING
      return 0;
# endif
    }
# ifdef NAN_EQUALS_ANYTHING
    if (MZ_IS_NAN(b))
      return 0;
    else {
      if (a == 0.0) {
        if (b == 0.0) {
          return scheme_minus_zero_p(a) == scheme_minus_zero_p(b);
        }
      }
      return (a == b);
    }
# else
    return 0;
  }
  if (a == 0.0) {
    if (b == 0.0) {
      return scheme_minus_zero_p(a) == scheme_minus_zero_p(b);
    }
  }
  return 1;
# endif
}

Example #2

File: numarith.c Project: edmore/racket

static Scheme_Object *
rem_mod (int argc, Scheme_Object *argv[], char *name, int first_sign)
{
  Scheme_Object *n1, *n2, *r;
  int negate;

  n1 = argv[0];
  n2 = argv[1];

  if (!scheme_is_integer(n1))
    scheme_wrong_contract(name, "integer?", 0, argc, argv);
  if (!scheme_is_integer(n2))
    scheme_wrong_contract(name, "integer?", 1, argc, argv);

  if (SCHEME_INTP(n2) && !SCHEME_INT_VAL(n2))
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
		     "%s: undefined for 0", name);
  if (
#ifdef MZ_USE_SINGLE_FLOATS
      (SCHEME_FLTP(n2) && (SCHEME_FLT_VAL(n2) == 0.0f)) ||
#endif
      (SCHEME_DBLP(n2) && (SCHEME_DBL_VAL(n2) == 0.0))) {
    int neg;
    neg = scheme_minus_zero_p(SCHEME_FLOAT_VAL(n2));
    scheme_raise_exn(MZEXN_FAIL_CONTRACT_DIVIDE_BY_ZERO,
		     "%s: undefined for %s0.0",
		     name,
		     neg ? "-" : "");
  }

  if (SCHEME_INTP(n1) && !SCHEME_INT_VAL(n1))
    return zeroi;

  if (SCHEME_INTP(n1) && SCHEME_INTP(n2)) {
    intptr_t a, b, na, nb, v;
    int neg1, neg2;

    a = SCHEME_INT_VAL(n1);
    b = SCHEME_INT_VAL(n2);
    na =  (a < 0) ? -a : a;
    nb =  (b < 0) ? -b : b;

    v = na % nb;

    if (v) {
      if (first_sign) {
	if (a < 0)
	  v = -v;
      } else {
	neg1 = (a < 0);
	neg2 = (b < 0);
	
	if (neg1 != neg2)
	  v = nb - v;
	
	if (neg2)
	  v = -v;
      }
    }

    return scheme_make_integer(v);
  }

  if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
    double a, b, na, nb, v;
#ifdef MZ_USE_SINGLE_FLOATS
    int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
#endif

    if (SCHEME_INTP(n1))
      a = SCHEME_INT_VAL(n1);
#ifdef MZ_USE_SINGLE_FLOATS
    else if (SCHEME_FLTP(n1))
      a = SCHEME_FLT_VAL(n1);
#endif
    else if (SCHEME_DBLP(n1))
      a = SCHEME_DBL_VAL(n1);
    else
      a = scheme_bignum_to_double(n1);

    if (SCHEME_INTP(n2))
      b = SCHEME_INT_VAL(n2);
#ifdef MZ_USE_SINGLE_FLOATS
    else if (SCHEME_FLTP(n2))
      b = SCHEME_FLT_VAL(n2);
#endif
    else if (SCHEME_DBLP(n2))
      b = SCHEME_DBL_VAL(n2);
    else
      b = scheme_bignum_to_double(n2);

    if (a == 0.0) {
      /* Avoid sign problems. */
#ifdef MZ_USE_SINGLE_FLOATS
      if (was_single)
	return scheme_zerof;
#endif
      return scheme_zerod;
    }

    na =  (a < 0) ? -a : a;
    nb =  (b < 0) ? -b : b;

    if (MZ_IS_POS_INFINITY(nb))
      v = na;
    else if (MZ_IS_POS_INFINITY(na)) {
#ifdef MZ_USE_SINGLE_FLOATS
      if (was_single)
	return scheme_zerof;
#endif
      return scheme_zerod;
    } else {
      v = fmod(na, nb);

#ifdef FMOD_CAN_RETURN_NEG_ZERO
      if (v == 0.0)
	v = 0.0;
#endif
    }

    if (v) {
      if (first_sign) {
        /* remainder */
	if (a < 0)
	  v = -v;
      } else {
        /* modulo */
	int neg1, neg2;
	
	neg1 = (a < 0);
	neg2 = (b < 0);
	
	if (neg1 != neg2)
	  v = nb - v;
	
	if (neg2)
	  v = -v;
      }
    }

#ifdef MZ_USE_SINGLE_FLOATS
    if (was_single)
      return scheme_make_float((float)v);
#endif

    return scheme_make_double(v);
  }

  n1 = scheme_to_bignum(n1);
  n2 = scheme_to_bignum(n2);

  scheme_bignum_divide(n1, n2, NULL, &r, 1);

  negate = 0;

  if (!SCHEME_INTP(r) || SCHEME_INT_VAL(r)) {
    /* Easier if we can assume 'r' is positive: */
    if (SCHEME_INTP(r)) {
      if (SCHEME_INT_VAL(r) < 0)
	r = scheme_make_integer(-SCHEME_INT_VAL(r));
    } else if (!SCHEME_BIGPOS(r))
      r = scheme_bignum_negate(r);

    if (first_sign) {
      if (!SCHEME_BIGPOS(n1))
	negate = 1;
    } else {
      int neg1, neg2;
      
      neg1 = !SCHEME_BIGPOS(n1);
      neg2 = !SCHEME_BIGPOS(n2);
      
      if (neg1 != neg2) {
	if (neg2)
	  r = scheme_bin_plus(n2, r);
	else
	  r = scheme_bin_minus(n2, r);
      } else if (neg2)
	negate = 1;
    }
    
    if (negate) {
      if (SCHEME_INTP(r))
	r = scheme_make_integer(-SCHEME_INT_VAL(r));
      else
	r = scheme_bignum_negate(r);
    }
  }

  return r;
}