예제 #1
0
Scheme_Object *scheme_rational_power(const Scheme_Object *o, const Scheme_Object *p)
{
  double b, e, v;

  if (((Scheme_Rational *)p)->denom == one) {
    Scheme_Object *a[2], *n;
    a[0] = ((Scheme_Rational *)o)->num;
    a[1] = ((Scheme_Rational *)p)->num;
    n = scheme_expt(2, a);
    a[0] = ((Scheme_Rational *)o)->denom;
    return make_rational(n, scheme_expt(2, a), 0);
  }

  if (scheme_is_rational_positive(o)) {
    b = scheme_rational_to_double(o);
    e = scheme_rational_to_double(p);

    v = pow(b, e);

#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
    return scheme_make_float(v);
#else
    return scheme_make_double(v);
#endif
  } else {
    return scheme_complex_power(scheme_real_to_complex(o),
				scheme_real_to_complex(p));
  }
}
예제 #2
0
Scheme_Object *scheme_rational_sqrt(const Scheme_Object *o)
{
  Scheme_Rational *r = (Scheme_Rational *)o;
  Scheme_Object *n, *d;
  double v;

  n = scheme_integer_sqrt(r->num);
  if (!SCHEME_DBLP(n)) {
    d = scheme_integer_sqrt(r->denom);
    if (!SCHEME_DBLP(d))
      return make_rational(n, d, 0);
  }

  v = sqrt(scheme_rational_to_double(o));

#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
  return scheme_make_float(v);
#else
  return scheme_make_double(v);
#endif
}
예제 #3
0
/**
 * Convert a Scheme object to a GVariant that will serve as one of
 * the parameters of a call go g_dbus_proxy_call_....  Returns NULL
 * if it is unable to do the conversion.
 */
static GVariant *
scheme_object_to_parameter (Scheme_Object *obj, gchar *type)
{
  gchar *str;           // A temporary string

  // Special case: Array of bytes
  if (g_strcmp0 (type, "ay") == 0) 
    {
      if (SCHEME_BYTE_STRINGP (obj))
        {
          return g_variant_new_fixed_array (G_VARIANT_TYPE_BYTE,
                                            SCHEME_BYTE_STR_VAL (obj),
                                            SCHEME_BYTE_STRLEN_VAL (obj),
                                            sizeof (guchar));
        } // if it's a byte string
    } // array of bytes

  // Handle normal cases
  switch (type[0])
    {
      // Arrays
      case 'a':
        return scheme_object_to_array (obj, type);

      // Doubles
      case 'd':
        if (SCHEME_DBLP (obj))
          return g_variant_new ("d", SCHEME_DBL_VAL (obj));
        else if (SCHEME_FLTP (obj))
          return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj));
        else if (SCHEME_INTP (obj))
          return g_variant_new ("d", (double) SCHEME_INT_VAL (obj));
        else if (SCHEME_RATIONALP (obj))
          return g_variant_new ("d", (double) scheme_rational_to_double (obj));
        else
          return NULL;

      // 32 bit integers
      case 'i':
        if (SCHEME_INTP (obj))
          return g_variant_new ("i", (int) SCHEME_INT_VAL (obj));
        else if (SCHEME_DBLP (obj))
          return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj));
        else if (SCHEME_FLTP (obj))
          return g_variant_new ("i", (int) SCHEME_FLT_VAL (obj));
        else if (SCHEME_RATIONALP (obj))
          return g_variant_new ("i", (int) scheme_rational_to_double (obj));
        else 
          return NULL;

      // Strings
      case 's':
        str = scheme_object_to_string (obj);
        if (str == NULL)
          return NULL;
        return g_variant_new ("s", str);

      // 32 bit unsigned integers
      case 'u':
        if (SCHEME_INTP (obj))
          return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj));
        else
          return NULL;

      // Everything else is currently unsupported
      default:
        return NULL;
    } // switch
} // scheme_object_to_parameter