[INTERPRETER]
* NEW: When converting an instance of A to the class B, try the conversion interface of A first. If A has no conversion interface, or if it cannot handle the B class, then try the conversion interface of B if any. [GB.GSL] * NEW: Vector class has been implemented. [GB.JIT] * NEW: SPEC_CONVERT constant has been replaced by a field in the CLASS structure. git-svn-id: svn://localhost/gambas/trunk@4916 867c0c6c-44f3-4631-809d-bfa615b0a4ec
This commit is contained in:
Benoît Minisini
parent
91b8363562
commit
fc1c1e5531
9 changed files with 435 additions and 33 deletions
|
|
@ -25,22 +25,404 @@
|
|||
|
||||
#define __C_VECTOR_C
|
||||
|
||||
#include "c_complex.h"
|
||||
#include "c_vector.h"
|
||||
|
||||
#define THIS ((GSLVECTOR *)_object)
|
||||
#define SIZE(_ob) ((int)((GSLVECTOR *)_ob)->vector->size)
|
||||
|
||||
|
||||
//---- Utility functions ----------------------------------------------
|
||||
|
||||
int gsl_vector_has_zero(gsl_vector *a)
|
||||
{
|
||||
int i;
|
||||
int size = (int)a->size;
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
if (gsl_vector_get(a, i) == 0.0)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
void gsl_vector_inverse(gsl_vector *a)
|
||||
{
|
||||
int i;
|
||||
int size = (int)a->size;
|
||||
double *p;
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
p = gsl_vector_ptr(a, i);
|
||||
*p = 1.0 / *p;
|
||||
}
|
||||
}
|
||||
|
||||
void gsl_vector_negative(gsl_vector *a)
|
||||
{
|
||||
int i;
|
||||
int size = (int)a->size;
|
||||
double *p;
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
p = gsl_vector_ptr(a, i);
|
||||
*p = (- *p);
|
||||
}
|
||||
}
|
||||
|
||||
double gsl_vector_abs(gsl_vector *a)
|
||||
{
|
||||
int i;
|
||||
int size = (int)a->size;
|
||||
double val;
|
||||
double norm = 0;
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
val = gsl_vector_get(a, i);
|
||||
norm += val * val;
|
||||
}
|
||||
|
||||
return sqrt(norm);
|
||||
}
|
||||
|
||||
//---- Vector creation ------------------------------------------------------
|
||||
|
||||
static bool _do_not_init = FALSE;
|
||||
|
||||
static GSLVECTOR *VECTOR_create(int size, bool init)
|
||||
{
|
||||
static GB_CLASS _klass = (GB_CLASS)NULL;
|
||||
|
||||
GSLVECTOR *v;
|
||||
|
||||
if (!_klass)
|
||||
_klass = GB.FindClass("Vector");
|
||||
|
||||
_do_not_init = TRUE;
|
||||
v = (GSLVECTOR *)GB.New(_klass, NULL, NULL);
|
||||
v->vector = init ? gsl_vector_calloc(size) : gsl_vector_alloc(size);
|
||||
|
||||
return v;
|
||||
|
||||
}
|
||||
|
||||
static GSLVECTOR *VECTOR_copy(GSLVECTOR *_object)
|
||||
{
|
||||
GSLVECTOR *copy = VECTOR_create((int)THIS->vector->size, FALSE);
|
||||
gsl_vector_memcpy(copy->vector, THIS->vector);
|
||||
return copy;
|
||||
}
|
||||
|
||||
//---- Arithmetic operators -------------------------------------------------
|
||||
|
||||
static GSLVECTOR *_addf(GSLVECTOR *a, double f)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_add_constant(r->vector, f);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_add(GSLVECTOR *a, GSLVECTOR *b)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_add(r->vector, b->vector);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_subf(GSLVECTOR *a, double f)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_add_constant(r->vector, -f);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_sub(GSLVECTOR *a, GSLVECTOR *b)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_sub(r->vector, b->vector);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_mulf(GSLVECTOR *a, double f)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_scale(r->vector, f);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_mul(GSLVECTOR *a, GSLVECTOR *b)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_mul(r->vector, b->vector);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_divf(GSLVECTOR *a, double f)
|
||||
{
|
||||
GSLVECTOR *r;
|
||||
|
||||
if (f == 0.0)
|
||||
return NULL;
|
||||
|
||||
r = VECTOR_copy(a);
|
||||
gsl_vector_scale(r->vector, 1 / f);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_idivf(GSLVECTOR *a, double f)
|
||||
{
|
||||
GSLVECTOR *r;
|
||||
|
||||
if (gsl_vector_has_zero(a->vector))
|
||||
return NULL;
|
||||
|
||||
r = VECTOR_copy(a);
|
||||
gsl_vector_inverse(r->vector);
|
||||
gsl_vector_scale(r->vector, f);
|
||||
return r;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_div(GSLVECTOR *a, GSLVECTOR *b)
|
||||
{
|
||||
GSLVECTOR *r;
|
||||
|
||||
if (gsl_vector_has_zero(b->vector))
|
||||
return NULL;
|
||||
|
||||
r = VECTOR_copy(a);
|
||||
gsl_vector_div(r->vector, b->vector);
|
||||
return r;
|
||||
}
|
||||
|
||||
static int _equal(GSLVECTOR *a, GSLVECTOR *b)
|
||||
{
|
||||
return gsl_vector_equal(a->vector, b->vector);
|
||||
}
|
||||
|
||||
static int _equalf(GSLVECTOR *a, double f)
|
||||
{
|
||||
int i;
|
||||
int size = (int)a->vector->size;
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
if (gsl_vector_get(a->vector, i) != f)
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static GSLVECTOR *_neg(GSLVECTOR *a)
|
||||
{
|
||||
GSLVECTOR *r = VECTOR_copy(a);
|
||||
gsl_vector_negative(r->vector);
|
||||
return r;
|
||||
}
|
||||
|
||||
static double _abs(GSLVECTOR *a)
|
||||
{
|
||||
return gsl_vector_abs(a->vector);
|
||||
}
|
||||
|
||||
static GB_OPERATOR_DESC _operators =
|
||||
{
|
||||
add: (void *)_add,
|
||||
addf: (void *)_addf,
|
||||
sub: (void *)_sub,
|
||||
subf: (void *)_subf,
|
||||
mul: (void *)_mul,
|
||||
mulf: (void *)_mulf,
|
||||
div: (void *)_div,
|
||||
divf: (void *)_divf,
|
||||
idivf: (void *)_idivf,
|
||||
equal: (void *)_equal,
|
||||
equalf: (void *)_equalf,
|
||||
abs: (void *)_abs,
|
||||
neg: (void *)_neg
|
||||
};
|
||||
|
||||
//---- Conversions ----------------------------------------------------------
|
||||
|
||||
static char *_to_string(GSLVECTOR *_object, bool local)
|
||||
{
|
||||
char *result = NULL;
|
||||
int i;
|
||||
int size = (int)THIS->vector->size;
|
||||
char *str;
|
||||
int len;
|
||||
|
||||
result = GB.AddChar(result, '[');
|
||||
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
if (i)
|
||||
result = GB.AddChar(result, ' ');
|
||||
|
||||
GB.NumberToString(local, gsl_vector_get(THIS->vector, i), NULL, &str, &len);
|
||||
result = GB.AddString(result, str, len);
|
||||
}
|
||||
|
||||
result = GB.AddChar(result, ']');
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
static bool _convert(GSLVECTOR *a, GB_TYPE type, GB_VALUE *conv)
|
||||
{
|
||||
if (a)
|
||||
{
|
||||
switch (type)
|
||||
{
|
||||
case GB_T_FLOAT:
|
||||
conv->_float.value = gsl_vector_abs(a->vector);
|
||||
return FALSE;
|
||||
|
||||
case GB_T_SINGLE:
|
||||
conv->_single.value = gsl_vector_abs(a->vector);
|
||||
return FALSE;
|
||||
|
||||
case GB_T_INTEGER:
|
||||
case GB_T_SHORT:
|
||||
case GB_T_BYTE:
|
||||
conv->_integer.value = gsl_vector_abs(a->vector);
|
||||
return FALSE;
|
||||
|
||||
case GB_T_LONG:
|
||||
conv->_long.value = gsl_vector_abs(a->vector);
|
||||
return FALSE;
|
||||
|
||||
case GB_T_STRING:
|
||||
case GB_T_CSTRING:
|
||||
conv->_string.value.addr = _to_string(a, type == GB_T_CSTRING);
|
||||
conv->_string.value.start = 0;
|
||||
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
|
||||
return FALSE;
|
||||
|
||||
default:
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
else if (type >= GB_T_OBJECT)
|
||||
{
|
||||
if (GB.Is(conv->_object.value, GB.FindClass("Array")))
|
||||
{
|
||||
GB_ARRAY array = (GB_ARRAY)conv->_object.value;
|
||||
int size = GB.Array.Count(array);
|
||||
GSLVECTOR *v = VECTOR_create(size, FALSE);
|
||||
int i;
|
||||
GB_VALUE temp;
|
||||
void *data;
|
||||
GB_TYPE atype = GB.Array.Type(array);
|
||||
|
||||
if (atype > GB_T_BOOLEAN && atype <= GB_T_FLOAT)
|
||||
{
|
||||
for (i = 0; i < size; i++)
|
||||
{
|
||||
data = GB.Array.Get(array, i);
|
||||
GB.ReadValue(&temp, data, atype);
|
||||
GB.Conv(&temp, GB_T_FLOAT);
|
||||
gsl_vector_set(v->vector, i, temp._float.value);
|
||||
}
|
||||
|
||||
conv->_object.value = v;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
else if (type == GB.FindClass("Complex"))
|
||||
{
|
||||
GSLCOMPLEX *c = (GSLCOMPLEX *)conv->_object.value;
|
||||
GSLVECTOR *v = VECTOR_create(2, FALSE);
|
||||
gsl_vector_set(v->vector, 0, c->number.dat[0]);
|
||||
gsl_vector_set(v->vector, 1, c->number.dat[1]);
|
||||
conv->_object.value = v;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
|
||||
BEGIN_METHOD(Vector_new, GB_INTEGER size)
|
||||
|
||||
if (_do_not_init)
|
||||
_do_not_init = FALSE;
|
||||
else
|
||||
THIS->vector = gsl_vector_calloc(VARGOPT(size, 1));
|
||||
|
||||
END_METHOD
|
||||
|
||||
BEGIN_METHOD_VOID(Vector_free)
|
||||
|
||||
gsl_vector_free(THIS->vector);
|
||||
|
||||
END_METHOD
|
||||
|
||||
BEGIN_PROPERTY(Vector_Count)
|
||||
|
||||
GB.ReturnInteger((int)THIS->vector->size);
|
||||
|
||||
END_PROPERTY
|
||||
|
||||
BEGIN_METHOD_VOID(Vector_Copy)
|
||||
|
||||
GB.ReturnObject(VECTOR_copy(THIS));
|
||||
|
||||
END_METHOD
|
||||
|
||||
BEGIN_METHOD(Vector_get, GB_INTEGER index)
|
||||
|
||||
int size = SIZE(THIS);
|
||||
int index = VARG(index);
|
||||
|
||||
if (index < 0 || index >= size)
|
||||
{
|
||||
GB.Error(GB_ERR_ARG);
|
||||
return;
|
||||
}
|
||||
|
||||
GB.ReturnFloat(gsl_vector_get(THIS->vector, index));
|
||||
|
||||
END_METHOD
|
||||
|
||||
BEGIN_METHOD(Vector_put, GB_FLOAT value; GB_INTEGER index)
|
||||
|
||||
int size = SIZE(THIS);
|
||||
int index = VARG(index);
|
||||
|
||||
if (index < 0 || index >= size)
|
||||
{
|
||||
GB.Error(GB_ERR_ARG);
|
||||
return;
|
||||
}
|
||||
|
||||
gsl_vector_set(THIS->vector, index, VARG(value));
|
||||
|
||||
END_METHOD
|
||||
|
||||
GB_DESC VectorDesc[] =
|
||||
{
|
||||
GB_DECLARE("Vector", sizeof(GSLVECTOR)),
|
||||
|
||||
// Utility Methods
|
||||
/*GB_METHOD("_new", NULL, Complex_new, "[(Real)f(Imag)f]"),
|
||||
GB_STATIC_METHOD("_call", "Complex", Complex_call, "[(Real)f(Imag)f]"),
|
||||
GB_METHOD("Copy", "Complex", Complex_Copy, NULL),
|
||||
GB_STATIC_METHOD("Polar", "Complex", Complex_Polar, "[(Real)f(Imag)f]"),
|
||||
GB_METHOD("_new", NULL, Vector_new, "[(Size)i]"),
|
||||
GB_METHOD("_free", NULL, Vector_free, NULL),
|
||||
//GB_STATIC_METHOD("_call", "Vector", Vector_call, "(Value)f."),
|
||||
GB_METHOD("Copy", "Vector", Vector_Copy, NULL),
|
||||
|
||||
GB_METHOD("_get", "f", Vector_get, "(Index)i"),
|
||||
GB_METHOD("_put", NULL, Vector_put, "(Value)f(Index)i"),
|
||||
|
||||
GB_PROPERTY_READ("Count", "i", Vector_Count),
|
||||
|
||||
GB_INTERFACE("_operators", &_operators),
|
||||
GB_INTERFACE("_convert", &_convert),*/
|
||||
GB_INTERFACE("_convert", &_convert),
|
||||
|
||||
GB_END_DECLARE
|
||||
};
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ typedef
|
|||
struct
|
||||
{
|
||||
GB_BASE ob;
|
||||
gsl_vector vector;
|
||||
gsl_vector *vector;
|
||||
}
|
||||
GSLVECTOR;
|
||||
|
||||
|
|
|
|||
|
|
@ -39,9 +39,6 @@ extern "C" {
|
|||
|
||||
GB_INTERFACE GB EXPORT;
|
||||
|
||||
|
||||
GB_CLASS GSL;
|
||||
|
||||
GB_DESC *GB_CLASSES[] EXPORT =
|
||||
{
|
||||
CGslDesc, /* The Elementary math functions */
|
||||
|
|
|
|||
|
|
@ -991,8 +991,8 @@ OBJECT* JR_object_cast(OBJECT* object, CLASS* target_class){
|
|||
if ((class == target_class) || JIF.F_CLASS_inherits(class, target_class))
|
||||
return object;
|
||||
|
||||
if (class->special[SPEC_CONVERT] != NO_SYMBOL){
|
||||
OBJECT* conv = ((OBJECT *(*)())(CLASS_get_desc(class, class->special[SPEC_CONVERT])->constant.value._pointer))(object, target_class);
|
||||
if (class->has_convert){
|
||||
OBJECT* conv = ((OBJECT *(*)())(class->convert))(object, target_class);
|
||||
if (conv){
|
||||
OBJECT_REF(conv, "JR_object_cast");
|
||||
JR_OBJECT_unref(object);
|
||||
|
|
|
|||
|
|
@ -1430,7 +1430,6 @@ static bool array_convert(CARRAY *src, CLASS *class, VALUE *conv)
|
|||
END_ERROR
|
||||
|
||||
conv->_object.object = array;
|
||||
OBJECT_REF(array, "array_convert");
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1280,9 +1280,13 @@ void CLASS_search_special(CLASS *class)
|
|||
class->special[SPEC_COMPARE] = CLASS_get_symbol_index_kind(class, "_compare", CD_METHOD, 0);
|
||||
class->special[SPEC_ATTACH] = CLASS_get_symbol_index_kind(class, "_attach", CD_METHOD, 0);
|
||||
|
||||
class->special[SPEC_CONVERT] = CLASS_get_symbol_index_kind(class, "_@_convert", CD_CONSTANT, 0);
|
||||
class->has_convert = class->special[SPEC_CONVERT] != NO_SYMBOL;
|
||||
|
||||
sym = CLASS_get_symbol_index_kind(class, "_@_convert", CD_CONSTANT, 0);
|
||||
if (sym != NO_SYMBOL)
|
||||
{
|
||||
class->has_convert = TRUE;
|
||||
class->convert = CLASS_get_desc(class, sym)->constant.value._pointer;
|
||||
}
|
||||
|
||||
sym = CLASS_get_symbol_index_kind(class, "_@_operators", CD_CONSTANT, 0);
|
||||
if (sym != NO_SYMBOL)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -334,14 +334,15 @@ typedef
|
|||
|
||||
void *instance; // 116 184 automatically created instance
|
||||
void *operators; // 120 192 arithmetic interface
|
||||
bool (*convert)(); // 124 200 convert method
|
||||
|
||||
COMPONENT *component; // 124 200 The component the class belongs to
|
||||
COMPONENT *component; // 128 208 The component the class belongs to
|
||||
|
||||
struct _CLASS *override; // 128 208 The overridden class
|
||||
struct _CLASS *override; // 132 216 The overridden class
|
||||
|
||||
struct _CLASS *next; // 132 216 next class
|
||||
struct _CLASS *next; // 136 224 next class
|
||||
|
||||
void (**jit_functions)(void); // 136 224 array of jit functions
|
||||
void (**jit_functions)(void); // 140 232 array of jit functions
|
||||
}
|
||||
CLASS;
|
||||
|
||||
|
|
@ -366,8 +367,7 @@ typedef
|
|||
SPEC_PROPERTY,
|
||||
SPEC_COMPARE,
|
||||
SPEC_ATTACH,
|
||||
SPEC_CONVERT,
|
||||
MAX_SPEC = 12
|
||||
MAX_SPEC = 11
|
||||
}
|
||||
CLASS_SPECIAL;
|
||||
|
||||
|
|
|
|||
|
|
@ -733,8 +733,18 @@ __OBJECT:
|
|||
else
|
||||
class = value->_object.class;
|
||||
|
||||
goto __CONVERT;
|
||||
//goto __N;
|
||||
if (class->has_convert)
|
||||
{
|
||||
void *unref = value->_object.object;
|
||||
if (!((*class->convert)(value->_object.object, type, value)))
|
||||
{
|
||||
OBJECT_UNREF(unref, "VALUE_convert");
|
||||
//OBJECT_REF(value->_object.object, "VALUE_convert");
|
||||
goto __TYPE;
|
||||
}
|
||||
}
|
||||
|
||||
goto __N;
|
||||
}
|
||||
|
||||
if (!TYPE_is_object(value->type))
|
||||
|
|
@ -777,7 +787,7 @@ __OBJECT:
|
|||
|
||||
if (class->has_convert)
|
||||
{
|
||||
if (!((bool (*)())(CLASS_get_desc(class, class->special[SPEC_CONVERT])->constant.value._pointer))(NULL, value->type, value))
|
||||
if (!((*class->convert)(NULL, value->type, value)))
|
||||
{
|
||||
OBJECT_REF(value->_object.object, "VALUE_convert");
|
||||
goto __TYPE;
|
||||
|
|
@ -815,14 +825,25 @@ __RETRY:
|
|||
goto __RETRY;
|
||||
}
|
||||
|
||||
__CONVERT:
|
||||
|
||||
if (class->has_convert)
|
||||
{
|
||||
void *unref = value->_object.object;
|
||||
if (!((bool (*)())(CLASS_get_desc(class, class->special[SPEC_CONVERT])->constant.value._pointer))(value->_object.object, type, value))
|
||||
if (!((*class->convert)(value->_object.object, type, value)))
|
||||
{
|
||||
OBJECT_UNREF(unref, "VALUE_conv");
|
||||
OBJECT_UNREF(unref, "VALUE_convert");
|
||||
OBJECT_REF(value->_object.object, "VALUE_convert");
|
||||
goto __TYPE;
|
||||
}
|
||||
}
|
||||
|
||||
CLASS *class2 = (CLASS *)type;
|
||||
if (class2->has_convert)
|
||||
{
|
||||
void *unref = value->_object.object;
|
||||
if (!((*class2->convert)(NULL, OBJECT_class(unref), value)))
|
||||
{
|
||||
OBJECT_UNREF(unref, "VALUE_convert");
|
||||
OBJECT_REF(value->_object.object, "VALUE_convert");
|
||||
goto __TYPE;
|
||||
}
|
||||
}
|
||||
|
|
@ -1201,7 +1222,7 @@ __OBJECT:
|
|||
if (class->has_convert)
|
||||
{
|
||||
VALUE temp;
|
||||
if (!((bool (*)())(CLASS_get_desc(class, class->special[SPEC_CONVERT])->constant.value._pointer))(value->_object.object, T_CSTRING, &temp))
|
||||
if (!((*class->convert)(value->_object.object, T_CSTRING, &temp)))
|
||||
{
|
||||
*addr = temp._string.addr + temp._string.start;
|
||||
*len = temp._string.len;
|
||||
|
|
@ -1789,7 +1810,7 @@ __NR:
|
|||
THROW(E_NRETURN);
|
||||
}
|
||||
|
||||
|
||||
#if 0
|
||||
void VALUE_convert_object(VALUE *value, TYPE type)
|
||||
{
|
||||
CLASS *class;
|
||||
|
|
@ -1918,7 +1939,7 @@ __N:
|
|||
|
||||
THROW(E_TYPE, TYPE_get_name(type), TYPE_get_name(value->type));
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
void VALUE_undo_variant(VALUE *value)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -238,7 +238,6 @@ void VALUE_convert_integer(VALUE *value);
|
|||
void VALUE_convert_float(VALUE *value);
|
||||
void VALUE_convert_string(VALUE *value);
|
||||
void VALUE_convert_variant(VALUE *value);
|
||||
void VALUE_convert_object(VALUE *value, TYPE type);
|
||||
|
||||
void VALUE_read(VALUE *value, void *addr, TYPE type);
|
||||
void VALUE_write(VALUE *value, void *addr, TYPE type);
|
||||
|
|
|
|||
Loading…
Reference in a new issue