luisgulo/gambas-source-code
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[INTERPRETER]

Browse Source 
* 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
This commit is contained in:
Benoît Minisini 2012-07-08 16:55:35 +00:00
parent 64505bbb0b
commit ef37065297
14 changed files with 259 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gb.gsl/src/Makefile.am
View File

@ -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

109
gb.gsl/src/c_complex.c
View File

@ -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 <gsl/gsl_math.h>
#include <gsl/gsl_cblas.h>
#include <stdio.h>
#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
};

19
gb.gsl/src/c_complex.h
View File

@ -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 <gsl/gsl_math.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#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 */

6
gb.gsl/src/c_gsl.c
View File

@ -23,18 +23,12 @@
***************************************************************************/
#ifndef __C_GSL_C
#define __C_GSL_C
#include "gambas.h"
#include "gb_common.h"
#include "c_gsl.h"
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf.h>
#endif
/*--------------------------------
Number testing functions

2
gb.gsl/src/c_gsl.h
View File

@ -30,6 +30,8 @@
GB_INTERFACE GB EXPORT;
#ifndef __C_GSL_C
extern GB_DESC CGslDesc[];
#endif
#endif /* __C_GSL_H */

46
gb.gsl/src/c_vector.c Normal file
View File

@ -0,0 +1,46 @@
/***************************************************************************
c_vector.c
gb.gsl component
(c) 2012 Benoît Minisini <gambas@users.sourceforge.net>
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
};

43
gb.gsl/src/c_vector.h Normal file
View File

@ -0,0 +1,43 @@
/***************************************************************************
c_vector.h
gb.gsl component
(c) 2012 Benoît Minisini <gambas@users.sourceforge.net>
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 */

9
gb.gsl/src/main.c
View File

@ -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 */

11
gb.gsl/src/main.h
View File

@ -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 <gsl/gsl_math.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_complex_math.h>
#ifndef __MAIN_C
extern GB_INTERFACE GB;
extern GB_CLASS CGslDesc[];
#endif
#endif /* __MAIN_H */

2
main/gbx/gbx_c_array.c
View File

@ -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);

59
main/gbx/gbx_exec_loop.c
View File

@ -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)

30
main/gbx/gbx_subr_math.c
View File

@ -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);
}

16
main/gbx/gbx_value.c
View File

@ -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)

2
main/share/gambas.h
View File

@ -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 *);
}