carray 1.1.4 → 1.1.5

data/carray_cast.c

@@ -0,0 +1,1155 @@
+/* ---------------------------------------------------------------------------
+
+  carray_cast.c
+
+  This file is part of Ruby/CArray extension library.
+  You can redistribute it and/or modify it under the terms of
+  the Ruby Licence.
+
+  Copyright (C) 2005 Hiroki Motoyoshi
+
+---------------------------------------------------------------------------- */
+
+#include "carray.h"
+
+boolean8_t
+OBJ2BOOL (VALUE v)
+{
+  if ( v == Qfalse || v == Qnil ) {
+    return 0;
+  }
+  else if ( v == Qtrue ) {
+    return 1;
+  }
+  else if ( rb_obj_is_kind_of(v, rb_cInteger) ) {
+    int flag = NUM2LONG(v);
+    if ( flag == 0 || flag == 1 ) {
+      return flag;
+    }
+  }
+  {
+    VALUE inspect = rb_inspect(v);
+    rb_raise(rb_eCADataTypeError,
+             "can't cast object '%s' to <boolean>", StringValuePtr(inspect));
+  }
+}
+
+VALUE
+BOOL2OBJ (boolean8_t x)
+{
+  return ( x != 0 ) ? INT2FIX(1) : INT2FIX(0);
+}
+
+double
+OBJ2DBL (VALUE val)
+{
+  switch ( TYPE(val) ) {
+  case T_FLOAT:
+    return NUM2DBL(val);
+  case T_NIL:
+    return 0.0/0.0;
+    /* rb_raise(rb_eTypeError, "no implicit conversion to float from nil"); */
+    break;
+  case T_STRING: {
+    volatile VALUE rstr = rb_funcall(val, rb_intern("strip"), 0);
+    char *str = StringValuePtr(rstr);
+    if ( ! strncasecmp("nan", str, 3) ) {
+      return 0.0/0.0;
+    }
+    else if ( ! strncasecmp("inf", str, 3) ) {
+      return 1.0/0.0;
+    }
+    else if ( ! strncasecmp("-inf", str, 4) ) {
+      return -1.0/0.0;
+    }
+    else if ( ! strncasecmp("infinity", str, 8) ) {
+      return 1.0/0.0;
+    }
+    else if ( ! strncasecmp("-infinity", str, 9) ) {
+      return -1.0/0.0;
+    }
+    return NUM2DBL(rb_Float(val));
+  }
+  default:
+    return NUM2DBL(rb_Float(val));
+  }
+}
+
+long
+rb_obj2long (VALUE val)
+{
+  switch ( TYPE(val) ) {
+  case T_FIXNUM:
+    return FIX2LONG(val);
+  case T_BIGNUM:
+    return (long) NUM2LL(val);
+  case T_NIL:
+    rb_raise(rb_eTypeError, "no implicit conversion from nil to integer");
+    break;
+  default:
+    return NUM2LONG(rb_Integer(val));
+  }
+}
+
+unsigned long
+rb_obj2ulong (VALUE val)
+{
+  switch ( TYPE(val) ) {
+  case T_FIXNUM:
+    return FIX2ULONG(val);
+  case T_BIGNUM:
+    return (unsigned long) rb_num2ull(val);
+  case T_NIL:
+    rb_raise(rb_eTypeError, "no implicit conversion from nil to integer");
+    break;
+  default:
+    return NUM2ULONG(rb_Integer(val));
+  }
+}
+
+long long
+rb_obj2ll (VALUE val)
+{
+  switch ( TYPE(val) ) {
+  case T_FIXNUM:
+    return FIX2LONG(val);
+  case T_NIL:
+    rb_raise(rb_eTypeError, "no implicit conversion fron nil to integer");
+    break;
+  default:
+    return NUM2LL(rb_Integer(val));
+  }
+}
+
+unsigned long long
+rb_obj2ull (VALUE val)
+{
+  switch ( TYPE(val) ) {
+  case T_FIXNUM:
+    return FIX2ULONG(val);
+  case T_NIL:
+    rb_raise(rb_eTypeError, "no implicit conversion from nil to integer");
+    break;
+  default:
+    return rb_num2ull(rb_Integer(val));
+  }
+}
+
+void
+ca_cast_block (int32_t n, void *ap1, void *ptr1,
+               void *ap2, void *ptr2)
+{
+  CArray *ca1 = (CArray *) ap1;
+  CArray *ca2 = (CArray *) ap2;
+  if ( n < 0 ) {
+    rb_raise(rb_eRuntimeError, 
+             "[BUG] in ca_cast_block(): negative count");
+  }
+  ca_cast_func_table[ca1->data_type][ca2->data_type](n, ca1, ptr1, ca2, ptr2, NULL);
+}
+
+void
+ca_cast_block_with_mask (int32_t n, void *ap1, void *ptr1,
+                         void *ap2, void *ptr2, boolean8_t *m)
+{
+  CArray *ca1 = (CArray *) ap1;
+  CArray *ca2 = (CArray *) ap2;
+  if ( n < 0 ) {
+    rb_raise(rb_eRuntimeError, 
+             "[BUG] in ca_cast_block_with_mask(): negative count");
+  }
+  ca_cast_func_table[ca1->data_type][ca2->data_type](n, ca1, ptr1, ca2, ptr2, m);
+}
+
+VALUE
+ca_ptr2obj (void *ap, void *ptr)
+{
+  volatile VALUE obj;
+  static CArray dummy;
+  CArray *ca = (CArray *) ap;
+  dummy.data_type = CA_OBJECT;
+  ca_cast_func_table[ca->data_type][CA_OBJECT](1, ca, ptr, &dummy, (void*)&obj, NULL);
+  return obj;
+}
+
+void
+ca_obj2ptr (void *ap, VALUE obj, void *ptr)
+{
+  CArray *ca = (CArray *)ap;
+  static CArray dummy;
+  dummy.data_type = CA_OBJECT;
+  ca_cast_func_table[CA_OBJECT][ca->data_type](1, &dummy, &obj, ca, ptr, NULL);
+  return;
+}
+
+void
+ca_ptr2ptr (void *ap1, void *ptr1, void *ap2, void *ptr2)
+{
+  CArray *ca1 = (CArray *)ap1;
+  CArray *ca2 = (CArray *)ap2;
+  ca_cast_func_table[ca1->data_type][ca2->data_type](1, ca1, ptr1, ca2, ptr2, NULL);
+  return;
+}
+
+void
+ca_ptr2val (void *ap1, void *ptr1, int8_t data_type, void *ptr2)
+{
+  CArray *ca1 = (CArray *)ap1;
+  static CArray dummy;
+  CA_CHECK_DATA_TYPE(data_type);
+  dummy.data_type = data_type;
+  ca_cast_func_table[ca1->data_type][data_type](1, ca1, ptr1, &dummy, ptr2, NULL);
+  return;
+}
+
+void
+ca_val2ptr (int8_t data_type, void *ptr1, void *ap2, void *ptr2)
+{
+  CArray *ca2 = (CArray *)ap2;
+  static CArray dummy;
+  CA_CHECK_DATA_TYPE(data_type);
+  dummy.data_type = data_type;
+  ca_cast_func_table[data_type][ca2->data_type](1, &dummy, ptr1, ca2, ptr2, NULL);
+  return;
+}
+
+void
+ca_val2val (int8_t data_type1, void *ptr1, int8_t data_type2, void *ptr2)
+{
+  static CArray dummy1, dummy2;
+  CA_CHECK_DATA_TYPE(data_type1);
+  CA_CHECK_DATA_TYPE(data_type2);
+  dummy1.data_type = data_type1;
+  dummy2.data_type = data_type2;
+  ca_cast_func_table[data_type1][data_type2](1, &dummy1, ptr1, &dummy2, ptr2, NULL);
+  return;
+}
+
+/* --------------------------------------------------------------------- */
+
+static VALUE
+rb_ca_data_class_to_object (VALUE self) 
+{
+  volatile VALUE obj;
+  CArray *ca;
+  int i;
+
+  Data_Get_Struct(self, CArray, ca);
+
+  if ( ca_is_scalar(ca) ) {
+    obj = rb_cscalar_new(CA_OBJECT, 0, ca->mask);
+  }
+  else {
+    obj = rb_carray_new(CA_OBJECT, ca->rank, ca->dim, 0, ca->mask);
+  }
+
+  for (i=0; i<ca->elements; i++) {
+    rb_ca_store_addr(obj, i, rb_ca_fetch_addr(self, i));
+  }
+  
+  return obj;
+}
+
+static VALUE
+rb_ca_object_to_data_class (VALUE self, VALUE rtype, int32_t bytes) 
+{
+  volatile VALUE obj, rval;
+  CArray *ca;
+  int i;
+  ID id_encode = rb_intern("encode");
+
+  Data_Get_Struct(self, CArray, ca);
+
+  if ( ca_is_scalar(ca) ) {
+    obj = rb_cscalar_new(CA_FIXLEN, bytes, ca->mask);
+  }
+  else {
+    obj = rb_carray_new(CA_FIXLEN, ca->rank, ca->dim, bytes, ca->mask);
+  }
+  rb_ca_data_type_import(obj, rtype);
+
+  for (i=0; i<ca->elements; i++) {
+    rval = rb_ca_fetch_addr(self, i);
+    if ( TYPE(rval) == T_STRING ) {
+      rb_ca_store_addr(obj, i, rval);
+    }
+    else {
+      rb_ca_store_addr(obj, i, rb_funcall(rval, id_encode, 0));
+    }
+  }
+  
+  return obj;
+}
+
+/* CArray#to_type */
+
+static VALUE
+rb_ca_to_type_internal (int argc, VALUE *argv, VALUE self)
+{
+  volatile VALUE obj, rtype = Qnil, ropt, rbytes = Qnil;
+  CArray *ca, *cb;
+  int8_t data_type;
+  int32_t bytes;
+
+  Data_Get_Struct(self, CArray, ca);
+
+  rb_scan_args(argc, argv, "11", &rtype, &ropt);
+  rb_scan_options(ropt, "bytes", &rbytes);
+
+  rb_ca_guess_type_and_bytes(rtype, rbytes, &data_type, &bytes);
+
+  if ( rb_ca_has_data_class(self) && data_type == CA_OBJECT ) {
+    return rb_ca_data_class_to_object(self);
+  }
+
+  if ( rb_ca_is_object_type(self) && rb_obj_is_data_class(rtype) ) {
+    return rb_ca_object_to_data_class(self, rtype, bytes);
+  }
+
+  ca_update_mask(ca);
+
+  if ( ca_is_scalar(ca) ) {
+    obj = rb_cscalar_new(data_type, bytes, ca->mask);
+  }
+  else {
+    obj = rb_carray_new(data_type, ca->rank, ca->dim, bytes, ca->mask);
+  }
+
+  rb_ca_data_type_import(obj, rtype);
+
+  Data_Get_Struct(obj, CArray, cb);
+
+  ca_attach(ca);
+  if ( ca_has_mask(ca) ) {
+    ca_cast_block_with_mask(cb->elements, ca, ca->ptr, cb, cb->ptr, 
+                            (boolean8_t*)ca->mask->ptr);
+  }
+  else {
+    ca_cast_block(cb->elements, ca, ca->ptr, cb, cb->ptr);
+  }
+  ca_detach(ca);
+
+  return obj;
+}
+
+VALUE
+rb_ca_to_type (VALUE self, VALUE rtype, VALUE rbytes)
+{
+  volatile VALUE ropt = rb_hash_new();
+  VALUE args[2] = { rtype, ropt };
+  rb_set_options(ropt, "bytes", rbytes);
+  return rb_ca_to_type_internal(2, args, self);
+}
+
+#define rb_ca_to_type_method(type, code) \
+rb_ca_to_## type (VALUE self) \
+{ \
+  VALUE rcode = INT2NUM(code); \
+  return rb_ca_to_type_internal(1, &rcode, self); \
+}
+
+/*
+  CArray#fixlen([:bytes=>bytes]])
+ */
+
+VALUE
+rb_ca_to_fixlen (int argc, VALUE *argv, VALUE self)
+{
+  volatile VALUE ropt = rb_pop_options(&argc, &argv);
+  VALUE list[2];
+  rb_scan_args(argc, argv, "0");
+  list[0] = INT2NUM(CA_FIXLEN);
+  list[1] = ropt;
+  return rb_ca_to_type_internal(2, list, self);
+}
+
+VALUE rb_ca_to_type_method(boolean,  CA_BOOLEAN);
+VALUE rb_ca_to_type_method(int8,     CA_INT8);
+VALUE rb_ca_to_type_method(uint8,    CA_UINT8);
+VALUE rb_ca_to_type_method(int16,    CA_INT16);
+VALUE rb_ca_to_type_method(uint16,   CA_UINT16);
+VALUE rb_ca_to_type_method(int32,    CA_INT32);
+VALUE rb_ca_to_type_method(uint32,   CA_UINT32);
+VALUE rb_ca_to_type_method(int64,    CA_INT64);
+VALUE rb_ca_to_type_method(uint64,   CA_UINT64);
+VALUE rb_ca_to_type_method(float32,  CA_FLOAT32);
+VALUE rb_ca_to_type_method(float64,  CA_FLOAT64);
+VALUE rb_ca_to_type_method(float128, CA_FLOAT128);
+VALUE rb_ca_to_type_method(cmplx64,  CA_CMPLX64);
+VALUE rb_ca_to_type_method(cmplx128, CA_CMPLX128);
+VALUE rb_ca_to_type_method(cmplx256, CA_CMPLX256);
+VALUE rb_ca_to_type_method(VALUE,    CA_OBJECT);
+
+/* rdoc:
+  class CArray
+    # call-seq:
+    #     ca.boolean
+    #     ca.int8     
+    #     ca.uint8    
+    #     ca.int16    
+    #     ca.uint16   
+    #     ca.int32    
+    #     ca.uint32   
+    #     ca.int64    
+    #     ca.uint64   
+    #     ca.float32  
+    #     ca.float64  
+    #     ca.float128 
+    #     ca.cmplx64  
+    #     ca.cmplx128 
+    #     ca.cmplx256 
+    #     ca.object   
+    #     ca.fixlen
+    #     ca.byte
+    #     ca.short
+    #     ca.int
+    #     ca.float
+    #     ca.double
+    #     ca.complex
+    #     ca.dcomplex
+    #
+    # Convert to given data_type with copying values
+    def to_type
+    end
+  end
+*/
+
+
+/* ------------------------------------------------------------------------*/
+
+/* CArray#as_type */
+
+static VALUE
+rb_ca_as_type_internal (int argc, VALUE *argv, VALUE self)
+{
+  volatile VALUE obj, rtype = Qnil, ropt, rbytes = Qnil;
+  CArray *ca;
+  int8_t data_type;
+  int32_t bytes;
+
+  rb_scan_args(argc, argv, "11", &rtype, &ropt);
+  rb_scan_options(ropt, "bytes", &rbytes);
+
+  rb_ca_guess_type_and_bytes(rtype, rbytes, &data_type, &bytes);
+
+  Data_Get_Struct(self, CArray, ca);
+  if ( ca->data_type == data_type ) {
+    if ( ! ca_is_fixlen_type(ca) ) {
+      return self;
+    }
+  }
+
+  obj = rb_ca_fake_type(self, rtype, rbytes);
+  rb_ca_data_type_import(obj, rtype);
+
+  return obj;
+}
+
+VALUE
+rb_ca_as_type (VALUE self, VALUE rtype, VALUE rbytes)
+{
+  volatile VALUE ropt = rb_hash_new();
+  VALUE args[2] = { rtype, ropt };
+  rb_set_options(ropt, "bytes", rbytes);
+  return rb_ca_as_type_internal(2, args, self);
+}
+
+#define rb_ca_as_type_method(type, code) \
+rb_ca_as_## type (VALUE self) \
+{ \
+  VALUE rcode = INT2NUM(code); \
+  return rb_ca_as_type_internal(1, &rcode, self); \
+}
+
+/*
+  CArray#as_fixlen([:bytes=>bytes]])
+ */
+
+VALUE
+rb_ca_as_fixlen (int argc, VALUE *argv, VALUE self)
+{
+  volatile VALUE rtype, ropt = rb_pop_options(&argc, &argv);
+  VALUE list[2];
+  rb_scan_args(argc, argv, "01", &rtype);
+  list[0] = ( NIL_P(rtype) ) ? INT2NUM(CA_FIXLEN) : rtype;
+  list[1] = ropt;
+  return rb_ca_as_type_internal(2, list, self);
+}
+
+VALUE rb_ca_as_type_method(boolean,  CA_BOOLEAN);
+VALUE rb_ca_as_type_method(int8,     CA_INT8);
+VALUE rb_ca_as_type_method(uint8,    CA_UINT8);
+VALUE rb_ca_as_type_method(int16,    CA_INT16);
+VALUE rb_ca_as_type_method(uint16,   CA_UINT16);
+VALUE rb_ca_as_type_method(int32,    CA_INT32);
+VALUE rb_ca_as_type_method(uint32,   CA_UINT32);
+VALUE rb_ca_as_type_method(int64,    CA_INT64);
+VALUE rb_ca_as_type_method(uint64,   CA_UINT64);
+VALUE rb_ca_as_type_method(float32,  CA_FLOAT32);
+VALUE rb_ca_as_type_method(float64,  CA_FLOAT64);
+VALUE rb_ca_as_type_method(float128, CA_FLOAT128);
+VALUE rb_ca_as_type_method(cmplx64,  CA_CMPLX64);
+VALUE rb_ca_as_type_method(cmplx128, CA_CMPLX128);
+VALUE rb_ca_as_type_method(cmplx256, CA_CMPLX256);
+VALUE rb_ca_as_type_method(VALUE,    CA_OBJECT);
+
+
+/* rdoc:
+  class CArray
+    # call-seq:
+    #     ca.as_int8     
+    #     ca.as_uint8    
+    #     ca.as_int16    
+    #     ca.as_uint16   
+    #     ca.as_int32    
+    #     ca.as_uint32   
+    #     ca.as_int64    
+    #     ca.as_uint64   
+    #     ca.as_float32  
+    #     ca.as_float64  
+    #     ca.as_float128 
+    #     ca.as_cmplx64  
+    #     ca.as_cmplx128 
+    #     ca.as_cmplx256 
+    #     ca.as_object   
+    #     ca.as_byte
+    #     ca.as_short
+    #     ca.as_int
+    #     ca.as_float
+    #     ca.as_double
+    #     ca.as_complex
+    #     ca.as_dcomplex
+    #
+    # Fakes data_type
+    def as_type
+    end
+  end
+*/
+
+
+/* ------------------------------------------------------------------------*/
+
+VALUE
+rb_ca_cast_block (int32_t n, VALUE ra1, void *ptr1,
+                  VALUE ra2, void *ptr2)
+{
+  CArray *ca1, *ca2;
+  Data_Get_Struct(ra1, CArray, ca1);
+  Data_Get_Struct(ra2, CArray, ca2);
+  if ( n < 0 ) {
+    rb_raise(rb_eRuntimeError, "[BUG] in rb_ca_cast_block: negative count");
+  }
+  ca_cast_func_table[ca1->data_type][ca2->data_type](n, ca1, ptr1, ca2, ptr2, NULL);
+  return Qnil;
+}
+
+VALUE
+rb_ca_ptr2ptr (VALUE ra1, void *ptr1, VALUE ra2, void *ptr2)
+{
+  CArray *ca1, *ca2;
+  Data_Get_Struct(ra1, CArray, ca1);
+  Data_Get_Struct(ra2, CArray, ca2);
+  ca_cast_func_table[ca1->data_type][ca2->data_type](1, ca1, ptr1, ca2, ptr2, NULL);
+  return Qnil;
+}
+
+
+VALUE
+rb_ca_ptr2obj (VALUE self, void *ptr)
+{
+  volatile VALUE obj;
+  static CArray dummy;
+  CArray *ca;
+  Data_Get_Struct(self, CArray, ca);
+  dummy.data_type = CA_OBJECT;
+  ca_cast_func_table[ca->data_type][CA_OBJECT](1, ca, ptr, &dummy, (void*)&obj, NULL);
+  if ( ca_is_fixlen_type(ca) ) {
+    OBJ_TAINT(obj);
+    return rb_ca_data_class_decode(self, obj);
+  }
+  else {
+    return obj;
+  }
+}
+
+VALUE
+rb_ca_obj2ptr (VALUE self, VALUE obj, void *ptr)
+{
+  static CArray dummy;
+  CArray *ca;
+  Data_Get_Struct(self, CArray, ca);
+  if ( obj == CA_UNDEF ) {
+    memset(ptr, 0, ca->bytes);
+  }
+  else {
+    obj = ( ca_is_fixlen_type(ca) ) ? rb_ca_data_class_encode(self, obj) : obj;
+    dummy.data_type = CA_OBJECT;
+    ca_cast_func_table[CA_OBJECT][ca->data_type](1, &dummy, &obj, ca, ptr, NULL);
+  }
+  return Qnil;
+}
+
+VALUE
+rb_ca_wrap_writable (VALUE arg, VALUE rtype)
+{
+  volatile VALUE obj = arg;
+  CArray *ca = NULL;
+  int8_t data_type;
+
+  if ( rb_obj_is_carray(obj) ) {                    /* obj == carray */
+    Data_Get_Struct(obj, CArray, ca);
+    if ( ca_is_readonly(ca) ) {
+      rb_raise(rb_eRuntimeError, "can't modify read-only carray");
+    }
+    if ( NIL_P(rtype) ) {
+      data_type = ca->data_type;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, rtype, Qnil);
+    }
+  }
+  else if ( NIL_P(obj) ) {                          /* obj == nil */
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    obj = rb_cscalar_new(data_type, 0, NULL);
+  }
+  else if ( rb_respond_to(obj, rb_intern("ca")) ) { /* respond_to obj.ca */
+    obj = rb_funcall(obj, rb_intern("ca"), 0);
+    Data_Get_Struct(obj, CArray, ca);
+    if ( NIL_P(rtype) ) {
+      data_type = ca->data_type;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, INT2NUM(data_type), Qnil);
+    }
+  }
+  else {
+    volatile VALUE inspect = rb_inspect(CLASS_OF(obj));
+    rb_raise(rb_eRuntimeError,
+             "given object '%s' can't be wrapped as carray",
+             StringValuePtr(inspect));
+  }
+
+  return obj;
+}
+
+/* rdoc:
+  def CArray.wrap_writable
+  end
+*/
+
+static VALUE
+rb_ca_s_wrap_writable (int argc, VALUE *argv, VALUE klass)
+{
+  volatile VALUE obj, rtype;
+  rb_scan_args(argc, argv, "11", &obj, &rtype);
+  return rb_ca_wrap_writable(obj, rtype);
+}
+
+VALUE
+rb_ca_wrap_readonly (VALUE arg, VALUE rtype)
+{
+  volatile VALUE obj = arg;
+  CArray *ca = NULL;
+  int8_t data_type;
+
+  if ( rb_obj_is_carray(obj) ) {                     /* carray */
+    Data_Get_Struct(obj, CArray, ca);
+    if ( NIL_P(rtype) ) {
+      data_type = ca->data_type;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, rtype, Qnil);
+    }
+  }
+  else if ( rb_obj_is_kind_of(obj, rb_cNumeric) ) {  /* number */
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    obj = rb_cscalar_new_with_value(data_type, 0, obj);
+  }
+  else if ( TYPE(obj) == T_ARRAY ) {                 /* array */
+    obj = rb_funcall(obj, rb_intern("to_ca"), 0);
+    Data_Get_Struct(obj, CArray, ca);
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, INT2NUM(data_type), Qnil);
+    }
+  }
+  else if ( TYPE(obj) == T_STRING ) {                /* string */
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( data_type == CA_OBJECT ) {
+      obj = rb_cscalar_new_with_value(data_type, 0, obj);
+    }
+    else {
+      rb_raise(rb_eCADataTypeError,
+               "can't convert string to %s array",
+               ca_type_name[data_type]);
+    }
+  }
+  else if ( NIL_P(obj) ) {                            /* nil */
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    obj = rb_cscalar_new(data_type, 0, NULL);
+  }
+  else if ( rb_respond_to(obj, rb_intern("ca")) ) {
+    obj = rb_funcall(obj, rb_intern("ca"), 0);
+    Data_Get_Struct(obj, CArray, ca);
+    if ( NIL_P(rtype) ) {
+      data_type = ca->data_type;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, INT2NUM(data_type), Qnil);
+    }
+  }
+  else if ( rb_respond_to(obj, rb_intern("to_ca")) ) {
+    obj = rb_funcall(obj, rb_intern("to_ca"), 0);
+    Data_Get_Struct(obj, CArray, ca);
+    if ( NIL_P(rtype) ) {
+      data_type = ca->data_type;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    if ( ca->data_type != data_type ) {
+      obj = rb_ca_fake_type(obj, INT2NUM(data_type), Qnil);
+    }
+  }
+  else {                                           /* object */
+    if ( NIL_P(rtype) ) {
+      data_type = CA_OBJECT;
+    }
+    else {
+      data_type = rb_ca_guess_type(rtype);
+    }
+    obj = rb_cscalar_new_with_value(data_type, 0, obj);
+  }
+
+  return obj;
+}
+
+/* rdoc:
+  def CArray.wrap_readonly
+  end
+*/
+
+static VALUE
+rb_ca_s_wrap_readonly (int argc, VALUE *argv, VALUE klass)
+{
+  volatile VALUE obj, rtype;
+  rb_scan_args(argc, argv, "11", &obj, &rtype);
+  return rb_ca_wrap_readonly(obj, rtype);
+}
+
+VALUE
+rb_ca_cast (volatile VALUE self)
+{
+  volatile VALUE obj = self;
+  if ( ! rb_obj_is_carray(obj) ) {
+    switch ( TYPE(obj) ) {
+    case T_FIXNUM:
+      obj = rb_cscalar_new_with_value(CA_INT32, 0, obj);
+      break;
+    case T_BIGNUM:
+        if ( ca_valid[CA_INT64] ) {
+          obj = rb_cscalar_new_with_value(CA_INT64, 0, obj);          
+        }
+        else {
+          obj = rb_cscalar_new_with_value(CA_INT32, 0, obj);
+        }
+      break;
+    case T_FLOAT:
+      obj = rb_cscalar_new_with_value(CA_FLOAT64, 0, obj);
+      break;
+    case T_TRUE:
+    case T_FALSE:
+      obj = rb_cscalar_new_with_value(CA_BOOLEAN, 0, obj);
+      break;
+    case T_ARRAY:
+      obj = rb_funcall(obj, rb_intern("to_ca"), 0);
+      break;
+    default:
+      if ( rb_obj_is_kind_of(obj, rb_cRange) ) {
+        obj = rb_funcall(obj, rb_intern("to_ca"), 0);
+        break;
+      }
+#ifdef HAVE_COMPLEX_H
+      if ( rb_obj_is_kind_of(obj, rb_cCComplex) ) {
+        obj = rb_cscalar_new_with_value(CA_CMPLX128, 0, obj);
+        break;
+      }
+#endif
+      obj = rb_cscalar_new_with_value(CA_OBJECT, 0, obj);
+      break;
+    }
+  }
+  return obj;
+}
+
+static VALUE
+rb_ca_s_cast (VALUE klass, VALUE val)
+{
+  return rb_ca_cast(val);
+}
+
+void
+rb_ca_cast_self_or_other (volatile VALUE *self, volatile VALUE *other)
+{
+  CArray *ca, *cb;
+  int test;
+  int self_is_object = 0;
+  int other_is_object = 0;
+
+  if ( ! rb_obj_is_carray(*self) ) {
+    self_is_object = 1;
+    if ( rb_ca_is_object_type(*other) ) {
+      *self = rb_cscalar_new_with_value(CA_OBJECT, 0, *self);
+      return;
+    }
+    switch ( TYPE(*self) ) {
+    case T_FIXNUM:
+      *self = rb_cscalar_new_with_value(CA_INT32, 0, *self);
+      break;
+    case T_BIGNUM:
+      if ( ca_valid[CA_INT64] ) {
+        *self = rb_cscalar_new_with_value(CA_INT64, 0, *self);          
+      }
+      else {
+        *self = rb_cscalar_new_with_value(CA_INT32, 0, *self);
+      }
+      break;
+    case T_FLOAT:
+      *self = rb_cscalar_new_with_value(CA_FLOAT64, 0, *self);
+      break;
+    case T_TRUE:
+    case T_FALSE:
+      *self = rb_cscalar_new_with_value(CA_BOOLEAN, 0, *self);
+      break;
+    default:
+#ifdef HAVE_COMPLEX_H
+      if ( rb_obj_is_kind_of(*self, rb_cCComplex) ) {
+        *self = rb_cscalar_new_with_value(CA_CMPLX128, 0, *self);
+        break;
+      }
+#endif
+
+      *self = rb_cscalar_new_with_value(CA_OBJECT, 0, *self);
+      break;
+    }
+  }
+
+  if ( ! rb_obj_is_carray(*other) ) {
+    other_is_object = 1;
+
+    if ( rb_ca_is_object_type(*self) ) {
+      *other = rb_cscalar_new_with_value(CA_OBJECT, 0, *other);
+      return;
+    }
+
+    switch ( TYPE(*other) ) {
+    case T_FIXNUM:
+      *other = rb_cscalar_new_with_value(CA_INT32, 0, *other);
+      break;
+    case T_BIGNUM:
+        if ( ca_valid[CA_INT64] ) {
+          *other = rb_cscalar_new_with_value(CA_INT64, 0, *other);          
+        }
+        else {
+          *other = rb_cscalar_new_with_value(CA_INT32, 0, *other);
+        }
+      break;
+    case T_FLOAT:
+      *other = rb_cscalar_new_with_value(CA_FLOAT64, 0, *other);
+      break;
+    case T_TRUE:
+    case T_FALSE:
+      *other = rb_cscalar_new_with_value(CA_BOOLEAN, 0, *other);
+      break;
+    default:
+#ifdef HAVE_COMPLEX_H
+      if ( rb_obj_is_kind_of(*other, rb_cCComplex) ) {
+        *other = rb_cscalar_new_with_value(CA_CMPLX128, 0, *other);
+        break;
+      }
+#endif
+
+      *other = rb_cscalar_new_with_value(CA_OBJECT, 0, *other);
+      break;
+    }
+  }
+
+  Data_Get_Struct(*self, CArray, ca);
+  Data_Get_Struct(*other, CArray, cb);
+
+  if ( ca->obj_type == CA_OBJ_UNBOUND_REPEAT ) {
+    *self = ca_ubrep_bind_with(*self, *other);
+    Data_Get_Struct(*self, CArray, ca);
+  }
+
+  if ( cb->obj_type == CA_OBJ_UNBOUND_REPEAT ) {
+    *other = ca_ubrep_bind_with(*other, *self);
+    Data_Get_Struct(*other, CArray, cb);
+  }
+
+  if ( ca_is_scalar(ca) ^ ca_is_scalar(cb) || 
+       self_is_object || 
+       other_is_object ) {
+    if ( other_is_object || 
+         ( ( ! other_is_object ) && ca_is_scalar(cb) ) ) {
+      test = ca_cast_table2[cb->data_type][ca->data_type];
+      if ( test == 0 ) {
+        return;
+      }
+      else if ( test > 0 ) {
+        *other = rb_ca_wrap_readonly(*other, INT2FIX(ca->data_type));
+        return;
+      }
+    }
+    if ( self_is_object || 
+         ( ( ! self_is_object ) && ca_is_scalar(ca) ) ) {
+      test = ca_cast_table2[ca->data_type][cb->data_type];
+      if ( test == 0 ) {
+        return;
+      }
+      else if ( test > 0 ) {
+        *self = rb_ca_wrap_readonly(*self, INT2FIX(cb->data_type));
+        return;
+      }
+    }
+  }
+    
+  test = ca_cast_table[cb->data_type][ca->data_type];
+
+  if ( test == 0 ) {
+    return;
+  }
+  else if ( test > 0 ) {
+    *other = rb_ca_wrap_readonly(*other, INT2FIX(ca->data_type));
+    return;
+  }
+
+  test = ca_cast_table[ca->data_type][cb->data_type];
+
+  if ( test > 0 ) {
+    *self = rb_ca_wrap_readonly(*self, INT2FIX(cb->data_type));
+    return;
+  }
+
+  rb_raise(rb_eRuntimeError,
+           "can't coerce carray with data_types of '%s' and '%s'",
+           ca_type_name[ca->data_type],
+           ca_type_name[cb->data_type]);
+}
+
+/* rdoc
+  def CArray.cast_self_or_other
+  end
+*/
+
+VALUE
+rb_ca_s_cast_self_or_other (VALUE klass, VALUE self, VALUE other)
+{
+  rb_ca_cast_self_or_other(&self, &other);
+  return rb_assoc_new(self, other);
+}
+
+void
+rb_ca_cast_other (VALUE *self, volatile VALUE *other)
+{
+  CArray *ca, *cb;
+  CScalar *cs;
+  int test0, test1;
+
+  Data_Get_Struct(*self, CArray, ca);
+
+  if ( ! rb_obj_is_carray(*other) ) {
+    if ( rb_ca_is_object_type(*self) ) {
+      *other = rb_cscalar_new_with_value(CA_OBJECT, 0, *other);
+      return;
+    }
+    switch ( TYPE(*other) ) {
+    case T_FIXNUM:
+      *other = rb_cscalar_new_with_value(CA_INT32, 0, *other);
+      break;
+    case T_BIGNUM:
+        if ( ca_valid[CA_INT64] ) {
+          *other = rb_cscalar_new_with_value(CA_INT64, 0, *other);          
+        }
+        else {
+          *other = rb_cscalar_new_with_value(CA_INT32, 0, *other);
+        }
+      break;
+    case T_FLOAT:
+      *other = rb_cscalar_new_with_value(CA_FLOAT64, 0, *other);
+      break;
+    case T_TRUE:
+    case T_FALSE:
+      *other = rb_cscalar_new_with_value(CA_BOOLEAN, 0, *other);
+      break;
+    default:
+#ifdef HAVE_COMPLEX_H
+      if ( rb_obj_is_kind_of(*other, rb_cCComplex) ) {
+        *other = rb_cscalar_new_with_value(CA_CMPLX128, 0, *other);
+        break;
+      }
+#endif
+      *other = rb_cscalar_new_with_value(CA_OBJECT, 0, *other);
+      break;
+    }
+
+    Data_Get_Struct(*other, CScalar, cs);
+
+    test0 = ca_cast_table2[cs->data_type][ca->data_type];
+
+    if ( test0 > 0 ) {
+      *other = rb_ca_wrap_readonly(*other, INT2FIX(ca->data_type));
+    }
+
+  }
+
+  Data_Get_Struct(*other, CArray, cb);
+
+  if ( cb->obj_type == CA_OBJ_UNBOUND_REPEAT ) {
+    *other = ca_ubrep_bind_with(*other, *self);
+    Data_Get_Struct(*other, CArray, cb);
+  }
+
+  test1 = ca_cast_table[cb->data_type][ca->data_type];
+
+  if ( test1 == 0 ) {
+    return;
+  }
+  else if ( test1 > 0 ) {
+    *other = rb_ca_wrap_readonly(*other, INT2FIX(ca->data_type));
+    return;
+  }
+
+  rb_raise(rb_eRuntimeError,
+           "can't coerce carray with data_types of '%s' and '%s'",
+           ca_type_name[ca->data_type],
+           ca_type_name[cb->data_type]);
+}
+
+/* rdoc
+  def CArray.cast_other
+  end
+*/
+
+VALUE
+rb_ca_s_cast_other (VALUE klass, VALUE self, VALUE other)
+{
+  if ( rb_obj_is_carray(self) ) {
+    rb_ca_cast_self_or_other(&self, &other);
+  }
+  else {
+    rb_raise(rb_eRuntimeError, "first argument should be a carray");
+  }
+  return rb_assoc_new(self, other);
+}
+
+void
+Init_carray_cast ()
+{
+  /* CArray data_type conversion */
+
+  rb_define_method(rb_cCArray, "to_type", rb_ca_to_type_internal, -1);
+
+  rb_define_method(rb_cCArray, "fixlen", rb_ca_to_fixlen, -1);
+  rb_define_method(rb_cCArray, "boolean", rb_ca_to_boolean, 0);
+  rb_define_method(rb_cCArray, "int8", rb_ca_to_int8, 0);
+  rb_define_method(rb_cCArray, "uint8", rb_ca_to_uint8, 0);
+  rb_define_method(rb_cCArray, "int16", rb_ca_to_int16, 0);
+  rb_define_method(rb_cCArray, "uint16", rb_ca_to_uint16, 0);
+  rb_define_method(rb_cCArray, "int32", rb_ca_to_int32, 0);
+  rb_define_method(rb_cCArray, "uint32", rb_ca_to_uint32, 0);
+  rb_define_method(rb_cCArray, "int64", rb_ca_to_int64, 0);
+  rb_define_method(rb_cCArray, "uint64", rb_ca_to_uint64, 0);
+  rb_define_method(rb_cCArray, "float32", rb_ca_to_float32, 0);
+  rb_define_method(rb_cCArray, "float64", rb_ca_to_float64, 0);
+  rb_define_method(rb_cCArray, "float128", rb_ca_to_float128, 0);
+  rb_define_method(rb_cCArray, "cmplx64", rb_ca_to_cmplx64, 0);
+  rb_define_method(rb_cCArray, "cmplx128", rb_ca_to_cmplx128, 0);
+  rb_define_method(rb_cCArray, "cmplx256", rb_ca_to_cmplx256, 0);
+  rb_define_method(rb_cCArray, "object", rb_ca_to_VALUE, 0);
+
+  rb_define_method(rb_cCArray, "byte", rb_ca_to_uint8, 0);
+  rb_define_method(rb_cCArray, "short", rb_ca_to_int16, 0);
+  rb_define_method(rb_cCArray, "int", rb_ca_to_int32, 0);
+  rb_define_method(rb_cCArray, "float", rb_ca_to_float32, 0);
+  rb_define_method(rb_cCArray, "double", rb_ca_to_float64, 0);
+  rb_define_method(rb_cCArray, "complex", rb_ca_to_cmplx64, 0);
+  rb_define_method(rb_cCArray, "dcomplex", rb_ca_to_cmplx128, 0);
+
+  rb_define_method(rb_cCArray, "as_type", rb_ca_as_type_internal, -1);
+
+  rb_define_method(rb_cCArray, "as_fixlen", rb_ca_as_fixlen, -1);
+  rb_define_method(rb_cCArray, "as_boolean", rb_ca_as_boolean, 0);
+  rb_define_method(rb_cCArray, "as_int8", rb_ca_as_int8, 0);
+  rb_define_method(rb_cCArray, "as_uint8", rb_ca_as_uint8, 0);
+  rb_define_method(rb_cCArray, "as_int16", rb_ca_as_int16, 0);
+  rb_define_method(rb_cCArray, "as_uint16", rb_ca_as_uint16, 0);
+  rb_define_method(rb_cCArray, "as_int32", rb_ca_as_int32, 0);
+  rb_define_method(rb_cCArray, "as_uint32", rb_ca_as_uint32, 0);
+  rb_define_method(rb_cCArray, "as_int64", rb_ca_as_int64, 0);
+  rb_define_method(rb_cCArray, "as_uint64", rb_ca_as_uint64, 0);
+  rb_define_method(rb_cCArray, "as_float32", rb_ca_as_float32, 0);
+  rb_define_method(rb_cCArray, "as_float64", rb_ca_as_float64, 0);
+  rb_define_method(rb_cCArray, "as_float128", rb_ca_as_float128, 0);
+  rb_define_method(rb_cCArray, "as_cmplx64", rb_ca_as_cmplx64, 0);
+  rb_define_method(rb_cCArray, "as_cmplx128", rb_ca_as_cmplx128, 0);
+  rb_define_method(rb_cCArray, "as_cmplx256", rb_ca_as_cmplx256, 0);
+  rb_define_method(rb_cCArray, "as_object", rb_ca_as_VALUE, 0);
+
+  rb_define_method(rb_cCArray, "as_byte", rb_ca_as_uint8, 0);
+  rb_define_method(rb_cCArray, "as_short", rb_ca_as_int16, 0);
+  rb_define_method(rb_cCArray, "as_int", rb_ca_as_int32, 0);
+  rb_define_method(rb_cCArray, "as_float", rb_ca_as_float32, 0);
+  rb_define_method(rb_cCArray, "as_double", rb_ca_as_float64, 0);
+  rb_define_method(rb_cCArray, "as_complex", rb_ca_as_cmplx64, 0);
+  rb_define_method(rb_cCArray, "as_dcomplex", rb_ca_as_cmplx128, 0);
+
+  rb_define_singleton_method(rb_cCArray,
+           "wrap_writable", rb_ca_s_wrap_writable, -1);
+  rb_define_singleton_method(rb_cCArray,
+           "wrap_readonly", rb_ca_s_wrap_readonly, -1);
+  rb_define_singleton_method(rb_cCArray,
+                             "cast", rb_ca_s_cast, 1);
+  rb_define_singleton_method(rb_cCArray,
+           "cast_self_or_other", rb_ca_s_cast_self_or_other, 2);
+  rb_define_singleton_method(rb_cCArray,
+           "cast_other", rb_ca_s_cast_other, 2);
+}
+