From ef370652975055f43ea6c04ed51349e3e6ba7970 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Minisini?= Date: Sun, 8 Jul 2012 16:55:35 +0000 Subject: [PATCH] [INTERPRETER] * BUG: Correctly raise an error when trying to use NULL on classes implementing the _operators interface. * NEW: The _convert interface now must handle conversions from any datatype. [GB.GSL] * NEW: Automatic conversion from numbers to Complex. * NEW: Start implementating the Vector class. git-svn-id: svn://localhost/gambas/trunk@4913 867c0c6c-44f3-4631-809d-bfa615b0a4ec --- gb.gsl/src/Makefile.am | 8 ++- gb.gsl/src/c_complex.c | 109 +++++++++++++++++++++++---------------- gb.gsl/src/c_complex.h | 19 +++---- gb.gsl/src/c_gsl.c | 6 --- gb.gsl/src/c_gsl.h | 2 + gb.gsl/src/c_vector.c | 46 +++++++++++++++++ gb.gsl/src/c_vector.h | 43 +++++++++++++++ gb.gsl/src/main.c | 9 +++- gb.gsl/src/main.h | 11 ++-- main/gbx/gbx_c_array.c | 2 +- main/gbx/gbx_exec_loop.c | 59 +++++++++++++-------- main/gbx/gbx_subr_math.c | 30 +++++++---- main/gbx/gbx_value.c | 16 ++++++ main/share/gambas.h | 2 +- 14 files changed, 259 insertions(+), 103 deletions(-) create mode 100644 gb.gsl/src/c_vector.c create mode 100644 gb.gsl/src/c_vector.h diff --git a/gb.gsl/src/Makefile.am b/gb.gsl/src/Makefile.am index 58fdc3355..b9c3829b6 100644 --- a/gb.gsl/src/Makefile.am +++ b/gb.gsl/src/Makefile.am @@ -7,4 +7,10 @@ gb_gsl_la_LIBADD = @GSL_LIB@ gb_gsl_la_LDFLAGS = -module @LD_FLAGS@ @GSL_LDFLAGS@ gb_gsl_la_CPPFLAGS = @GSL_INC@ -gb_gsl_la_SOURCES = main.c main.h c_gsl.c c_gsl.h c_complex.c c_complex.h c_polynomial.c c_polynomial.h c_complexpolynomial.c c_complexpolynomial.h +gb_gsl_la_SOURCES = \ + main.c main.h \ + c_gsl.c c_gsl.h \ + c_complex.c c_complex.h \ + c_vector.c c_vector.h \ + c_polynomial.c c_polynomial.h \ + c_complexpolynomial.c c_complexpolynomial.h diff --git a/gb.gsl/src/c_complex.c b/gb.gsl/src/c_complex.c index d935271ae..d5151b11b 100644 --- a/gb.gsl/src/c_complex.c +++ b/gb.gsl/src/c_complex.c @@ -22,16 +22,11 @@ MA 02110-1301, USA. ***************************************************************************/ -#ifndef __C_GSL_COMPLEX_C -#define __C_GSL_COMPLEX_C -#endif + +#define __C_COMPLEX_C #include "c_complex.h" -#include "../gambas.h" -#include "gb_common.h" #include "c_gsl.h" -#include -#include #include #define THIS ((GSLCOMPLEX *)_object) @@ -204,35 +199,60 @@ static char *_to_string(GSLCOMPLEX *_object, bool local) static bool _convert(GSLCOMPLEX *a, GB_TYPE type, GB_VALUE *conv) { - switch (type) + if (a) { - case GB_T_FLOAT: - conv->_float.value = gsl_complex_abs(a->number); - return FALSE; - - case GB_T_SINGLE: - conv->_single.value = gsl_complex_abs(a->number); - return FALSE; - - case GB_T_INTEGER: - case GB_T_SHORT: - case GB_T_BYTE: - conv->_integer.value = gsl_complex_abs(a->number); - return FALSE; - - case GB_T_LONG: - conv->_long.value = gsl_complex_abs(a->number); - 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; + switch (type) + { + case GB_T_FLOAT: + conv->_float.value = gsl_complex_abs(a->number); + return FALSE; + + case GB_T_SINGLE: + conv->_single.value = gsl_complex_abs(a->number); + return FALSE; + + case GB_T_INTEGER: + case GB_T_SHORT: + case GB_T_BYTE: + conv->_integer.value = gsl_complex_abs(a->number); + return FALSE; + + case GB_T_LONG: + conv->_long.value = gsl_complex_abs(a->number); + 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 + { + switch(type) + { + case GB_T_FLOAT: + conv->_object.value = COMPLEX_create(gsl_complex_rect(conv->_float.value, 0)); + return FALSE; + + case GB_T_SINGLE: + conv->_object.value = COMPLEX_create(gsl_complex_rect(conv->_single.value, 0)); + return FALSE; + + case GB_T_INTEGER: + case GB_T_SHORT: + case GB_T_BYTE: + conv->_object.value = COMPLEX_create(gsl_complex_rect(conv->_integer.value, 0)); + return FALSE; + + default: + return TRUE; + } } } @@ -455,7 +475,8 @@ IMPLEMENT_FUNC(Arccoth, gsl_complex_arccoth) /************************************************** Describe Class properties and methods to Gambas **************************************************/ -GB_DESC CComplexDesc[] = + +GB_DESC ComplexDesc[] = { GB_DECLARE("Complex", sizeof(GSLCOMPLEX)), @@ -465,19 +486,16 @@ GB_DESC CComplexDesc[] = GB_METHOD("Copy", "Complex", Complex_Copy, NULL), GB_STATIC_METHOD("Polar", "Complex", Complex_Polar, "[(Real)f(Imag)f]"), //GB_METHOD("Set", NULL, Complex_Set, "[(Real)f(Imag)f]"), - GB_METHOD("Arg", "f", Complex_Arg, NULL), - GB_INTERFACE("_operators", &_operators), - GB_INTERFACE("_convert", &_convert), - - GB_METHOD("Abs", "f", Complex_Abs, NULL), - GB_METHOD("Abs2", "f", Complex_Abs2, NULL), - GB_METHOD("LogAbs", "f", Complex_LogAbs, NULL), - // Properties GB_PROPERTY("Real", "f", Complex_Real), GB_PROPERTY("Imag", "f", Complex_Imagined), + GB_METHOD("Abs", "f", Complex_Abs, NULL), + GB_METHOD("Abs2", "f", Complex_Abs2, NULL), + GB_METHOD("LogAbs", "f", Complex_LogAbs, NULL), + GB_METHOD("Arg", "f", Complex_Arg, NULL), + /* Operations on gsl_complex */ // Elementary Math Functions GB_METHOD("Add", "Complex", Complex_Add, "(X)Complex"), @@ -545,5 +563,8 @@ GB_DESC CComplexDesc[] = GB_METHOD("Arccsch", "Complex", Complex_Arccsch, NULL), GB_METHOD("Arccoth", "Complex", Complex_Arccoth, NULL), + GB_INTERFACE("_operators", &_operators), + GB_INTERFACE("_convert", &_convert), + GB_END_DECLARE }; diff --git a/gb.gsl/src/c_complex.h b/gb.gsl/src/c_complex.h index 86c1f20c4..2204bd400 100644 --- a/gb.gsl/src/c_complex.h +++ b/gb.gsl/src/c_complex.h @@ -23,19 +23,14 @@ MA 02110-1301, USA. ***************************************************************************/ -#ifndef __C_GSL_COMPLEX_H -#define __C_GSL_COMPLEX_H +#ifndef __C_COMPLEX_H +#define __C_COMPLEX_H -#include "gambas.h" -#include -#include -#include -#include +#include "main.h" - -GB_INTERFACE GB EXPORT; - -extern GB_DESC CComplexDesc[]; +#ifndef _C_COMPLEX_C +extern GB_DESC ComplexDesc[]; +#endif typedef struct @@ -47,4 +42,4 @@ typedef GSLCOMPLEX *COMPLEX_create(gsl_complex number); -#endif /* __C_GSL_COMPLEX_H */ +#endif /* __C_COMPLEX_H */ diff --git a/gb.gsl/src/c_gsl.c b/gb.gsl/src/c_gsl.c index e5c5fa37a..5b8bb5aa9 100644 --- a/gb.gsl/src/c_gsl.c +++ b/gb.gsl/src/c_gsl.c @@ -23,18 +23,12 @@ ***************************************************************************/ -#ifndef __C_GSL_C #define __C_GSL_C -#include "gambas.h" -#include "gb_common.h" #include "c_gsl.h" #include #include -#endif - - /*-------------------------------- Number testing functions diff --git a/gb.gsl/src/c_gsl.h b/gb.gsl/src/c_gsl.h index 8ea3a693a..997fd10a4 100644 --- a/gb.gsl/src/c_gsl.h +++ b/gb.gsl/src/c_gsl.h @@ -30,6 +30,8 @@ GB_INTERFACE GB EXPORT; +#ifndef __C_GSL_C extern GB_DESC CGslDesc[]; +#endif #endif /* __C_GSL_H */ diff --git a/gb.gsl/src/c_vector.c b/gb.gsl/src/c_vector.c new file mode 100644 index 000000000..fb3f255d3 --- /dev/null +++ b/gb.gsl/src/c_vector.c @@ -0,0 +1,46 @@ +/*************************************************************************** + + c_vector.c + + gb.gsl component + + (c) 2012 Benoît Minisini + + 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., 51 Franklin Street, Fifth Floor, Boston, + MA 02110-1301, USA. + +***************************************************************************/ + +#define __C_VECTOR_C + +#include "c_vector.h" + +#define THIS ((GSLVECTOR *)_object) + +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_INTERFACE("_operators", &_operators), + GB_INTERFACE("_convert", &_convert),*/ + + GB_END_DECLARE +}; diff --git a/gb.gsl/src/c_vector.h b/gb.gsl/src/c_vector.h new file mode 100644 index 000000000..053972d9e --- /dev/null +++ b/gb.gsl/src/c_vector.h @@ -0,0 +1,43 @@ +/*************************************************************************** + + c_vector.h + + gb.gsl component + + (c) 2012 Benoît Minisini + + 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., 51 Franklin Street, Fifth Floor, Boston, +MA 02110-1301, USA. + +***************************************************************************/ + +#ifndef __C_VECTOR_H +#define __C_VECTOR_H + +#include "main.h" + +#ifndef __C_VECTOR_C +extern GB_DESC VectorDesc[]; +#endif + +typedef + struct + { + GB_BASE ob; + gsl_vector vector; + } + GSLVECTOR; + +#endif /* __C_VECTOR_H */ diff --git a/gb.gsl/src/main.c b/gb.gsl/src/main.c index 97de2bbb8..94a175908 100644 --- a/gb.gsl/src/main.c +++ b/gb.gsl/src/main.c @@ -27,6 +27,12 @@ #include "main.h" +#include "c_gsl.h" +#include "c_complex.h" +#include "c_vector.h" +#include "c_polynomial.h" +#include "c_complexpolynomial.h" + #ifdef __cplusplus extern "C" { #endif @@ -39,7 +45,8 @@ GB_CLASS GSL; GB_DESC *GB_CLASSES[] EXPORT = { CGslDesc, /* The Elementary math functions */ - CComplexDesc, + ComplexDesc, + VectorDesc, CPolynomialDesc, CComplexPolynomialDesc, /* Other classes go here as completed */ diff --git a/gb.gsl/src/main.h b/gb.gsl/src/main.h index 35545dccb..0e0530b65 100644 --- a/gb.gsl/src/main.h +++ b/gb.gsl/src/main.h @@ -27,15 +27,16 @@ #define __MAIN_H #include "gambas.h" +#include "gb_common.h" -#include "c_gsl.h" -#include "c_complex.h" -#include "c_polynomial.h" -#include "c_complexpolynomial.h" +#include +#include +#include +#include +#include #ifndef __MAIN_C extern GB_INTERFACE GB; -extern GB_CLASS CGslDesc[]; #endif #endif /* __MAIN_H */ diff --git a/main/gbx/gbx_c_array.c b/main/gbx/gbx_c_array.c index 1dde899b7..51b3841d7 100644 --- a/main/gbx/gbx_c_array.c +++ b/main/gbx/gbx_c_array.c @@ -1407,7 +1407,7 @@ static bool array_convert(CARRAY *src, CLASS *class, VALUE *conv) void *data; VALUE temp; - if (!TYPE_is_pure_object((TYPE)class) || !CLASS_inherits(class, CLASS_Array)) + if (!src || !TYPE_is_pure_object((TYPE)class) || !CLASS_inherits(class, CLASS_Array)) return TRUE; _converted_array = array = OBJECT_create(class, NULL, NULL, 0); diff --git a/main/gbx/gbx_exec_loop.c b/main/gbx/gbx_exec_loop.c index 18e3d872c..4007b4c6c 100644 --- a/main/gbx/gbx_exec_loop.c +++ b/main/gbx/gbx_exec_loop.c @@ -196,7 +196,7 @@ static int check_operators(VALUE *P1, VALUE *P2) { if (TYPE_is_number(P1->type) && TYPE_is_object(P2->type)) { - if (OBJECT_class(P2->_object.object)->has_operators) + if (P2->_object.object && OBJECT_class(P2->_object.object)->has_operators) { //*dynamic = P2->type == T_OBJECT; return OP_FLOAT_OBJECT; @@ -204,13 +204,13 @@ static int check_operators(VALUE *P1, VALUE *P2) } else if (TYPE_is_number(P2->type) && TYPE_is_object(P1->type)) { - if (OBJECT_class(P1->_object.object)->has_operators) + if (P1->_object.object && OBJECT_class(P1->_object.object)->has_operators) { //*dynamic = P1->type == T_OBJECT; return OP_OBJECT_FLOAT; } } - else if (TYPE_is_object(P1->type) && TYPE_is_object(P2->type)) + else if (TYPE_is_object(P1->type) && TYPE_is_object(P2->type) && P1->_object.object && P2->_object.object) { CLASS *class1 = OBJECT_class(P1->_object.object); CLASS *class2 = OBJECT_class(P2->_object.object); @@ -232,33 +232,48 @@ static int check_operators(VALUE *P1, VALUE *P2) static void operator_object_float(VALUE *P1, VALUE *P2, uchar op) { - void *(*func)(void *, double) = (void *(*)(void *, double))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; - VALUE_conv_float(P2); - void *result = (*func)(P1->_object.object, P2->_float.value); - OBJECT_REF(result, "operator_object_float"); - OBJECT_UNREF(P1->_object.object, "operator_object_float"); - P1->_object.object = result; + if (P1->_object.object) + { + void *(*func)(void *, double) = (void *(*)(void *, double))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; + VALUE_conv_float(P2); + void *result = (*func)(P1->_object.object, P2->_float.value); + OBJECT_REF(result, "operator_object_float"); + OBJECT_UNREF(P1->_object.object, "operator_object_float"); + P1->_object.object = result; + } + else + THROW(E_NULL); } static void operator_float_object(VALUE *P1, VALUE *P2, uchar op) { - void *(*func)(void *, double) = (void *(*)(void *, double))((void **)(OBJECT_class(P2->_object.object)->operators))[op]; - VALUE_conv_float(P1); - void *result = (*func)(P2->_object.object, P1->_float.value); - OBJECT_REF(result, "operator_float_object"); - P1->_object.class = P2->_object.class; - OBJECT_UNREF(P2->_object.object, "operator_float_object"); - P1->_object.object = result; + if (P2->_object.object) + { + void *(*func)(void *, double) = (void *(*)(void *, double))((void **)(OBJECT_class(P2->_object.object)->operators))[op]; + VALUE_conv_float(P1); + void *result = (*func)(P2->_object.object, P1->_float.value); + OBJECT_REF(result, "operator_float_object"); + P1->_object.class = P2->_object.class; + OBJECT_UNREF(P2->_object.object, "operator_float_object"); + P1->_object.object = result; + } + else + THROW(E_NULL); } static void operator_object(VALUE *P1, VALUE *P2, uchar op) { - void *(*func)(void *, void *) = (void *(*)(void *, void *))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; - void *result = (*func)(P1->_object.object, P2->_object.object); - OBJECT_REF(result, "operator_object"); - OBJECT_UNREF(P1->_object.object, "operator_object"); - OBJECT_UNREF(P2->_object.object, "operator_object"); - P1->_object.object = result; + if (P1->_object.object && P2->_object.object) + { + void *(*func)(void *, void *) = (void *(*)(void *, void *))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; + void *result = (*func)(P1->_object.object, P2->_object.object); + OBJECT_REF(result, "operator_object"); + OBJECT_UNREF(P1->_object.object, "operator_object"); + OBJECT_UNREF(P2->_object.object, "operator_object"); + P1->_object.object = result; + } + else + THROW(E_NULL); } static void operator_object_conv(VALUE *P1, VALUE *P2, char op) diff --git a/main/gbx/gbx_subr_math.c b/main/gbx/gbx_subr_math.c index 054646912..dab969547 100644 --- a/main/gbx/gbx_subr_math.c +++ b/main/gbx/gbx_subr_math.c @@ -59,20 +59,30 @@ static bool check_operators(VALUE *P1) static void operator_object_abs(VALUE *P1) { - double (*func)(void *) = (double (*)(void *))((void **)(OBJECT_class(P1->_object.object)->operators))[CO_ABS]; - double result = (*func)(P1->_object.object); - OBJECT_UNREF(P1->_object.object, "operator_object_abs"); - P1->type = T_FLOAT; - P1->_float.value = result; + if (P1->_object.object) + { + double (*func)(void *) = (double (*)(void *))((void **)(OBJECT_class(P1->_object.object)->operators))[CO_ABS]; + double result = (*func)(P1->_object.object); + OBJECT_UNREF(P1->_object.object, "operator_object_abs"); + P1->type = T_FLOAT; + P1->_float.value = result; + } + else + THROW(E_NULL); } static void operator_object(VALUE *P1, uchar op) { - void *(*func)(void *) = (void *(*)(void *))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; - void *result = (*func)(P1->_object.object); - OBJECT_REF(result, "operator_object"); - OBJECT_UNREF(P1->_object.object, "operator_object"); - P1->_object.object = result; + if (P1->_object.object) + { + void *(*func)(void *) = (void *(*)(void *))((void **)(OBJECT_class(P1->_object.object)->operators))[op]; + void *result = (*func)(P1->_object.object); + OBJECT_REF(result, "operator_object"); + OBJECT_UNREF(P1->_object.object, "operator_object"); + P1->_object.object = result; + } + else + THROW(E_NULL); } diff --git a/main/gbx/gbx_value.c b/main/gbx/gbx_value.c index ea74dc9d2..c684e4597 100644 --- a/main/gbx/gbx_value.c +++ b/main/gbx/gbx_value.c @@ -770,7 +770,23 @@ __OBJECT: /* on continue... */ } else + { + if (TYPE_is_pure_object(type)) + { + class = (CLASS *)type; + + if (class->has_convert) + { + if (!((bool (*)())(CLASS_get_desc(class, class->special[SPEC_CONVERT])->constant.value._pointer))(NULL, value->type, value)) + { + OBJECT_REF(value->_object.object, "VALUE_convert"); + goto __TYPE; + } + } + } + goto __N; + } } if (value->_object.object == NULL) diff --git a/main/share/gambas.h b/main/share/gambas.h index 66a3298f8..73f3fd660 100644 --- a/main/share/gambas.h +++ b/main/share/gambas.h @@ -835,7 +835,7 @@ typedef void *(*neg)(void *); void *(*pow)(void *, void *); void *(*powf)(void *, double); - void *(*abs)(void *); + double (*abs)(void *); void *(*max)(void *, void *); void *(*min)(void *, void *); }