mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-26 06:22:33 -08:00
Code Issues Projects Releases Packages Wiki Activity

complex-float: add a specialized array type for complex floats

Browse source
This commit is contained in:
Daniel Kochmański 2019-05-09 09:44:11 +02:00
parent c17f23f253
commit db5e0937b3
7 changed files with 241 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

137
src/c/array.d
View file

@ -22,6 +22,14 @@ static const cl_object ecl_aet_name[] = {
ECL_T, /* ecl_aet_object */
@'single-float', /* ecl_aet_sf */
@'double-float', /* ecl_aet_df */
#ifdef ECL_LONG_FLOAT
@'long-float', /* ecl_aet_lf */
#endif
#ifdef ECL_COMPLEX_FLOAT
@'si::complex-single-float', /* ecl_aet_csf */
@'si::complex-double-float', /* ecl_aet_cdf */
@'si::complex-long-float', /* ecl_aet_clf */
#endif
@'bit', /* ecl_aet_bit */
@'ext::cl-fixnum', /* ecl_aet_fix */
@'ext::cl-index', /* ecl_aet_index */
@ -173,6 +181,18 @@ ecl_aref_unsafe(cl_object x, cl_index index)
return(ecl_make_single_float(x->array.self.sf[index]));
case ecl_aet_df:
return(ecl_make_double_float(x->array.self.df[index]));
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
return(ecl_make_long_float(x->array.self.lf[index]));
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
return(ecl_make_csfloat(x->array.self.csf[index]));
case ecl_aet_cdf:
return(ecl_make_cdfloat(x->array.self.cdf[index]));
case ecl_aet_clf:
return(ecl_make_clfloat(x->array.self.clf[index]));
#endif
case ecl_aet_b8:
return ecl_make_uint8_t(x->array.self.b8[index]);
case ecl_aet_i8:
@ -329,6 +349,22 @@ ecl_aset_unsafe(cl_object x, cl_index index, cl_object value)
case ecl_aet_df:
x->array.self.df[index] = ecl_to_double(value);
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
x->array.self.lf[index] = ecl_to_long_double(value);
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
x->array.self.csf[index] = ecl_to_csfloat(value);
break;
case ecl_aet_cdf:
x->array.self.cdf[index] = ecl_to_cdfloat(value);
break;
case ecl_aet_clf:
x->array.self.clf[index] = ecl_to_clfloat(value);
break;
#endif
case ecl_aet_b8:
x->array.self.b8[index] = ecl_to_uint8_t(value);
break;
@ -635,11 +671,20 @@ ecl_symbol_to_elttype(cl_object x)
return(ecl_aet_df);
else if (x == @'long-float') {
#ifdef ECL_LONG_FLOAT
return(ecl_aet_object);
return(ecl_aet_lf);
#else
return(ecl_aet_df);
#endif
} else if (x == @'ext::byte8')
}
#ifdef ECL_COMPLEX_FLOAT
else if (x == @'si::complex-single-float')
return(ecl_aet_csf);
else if (x == @'si::complex-double-float')
return(ecl_aet_cdf);
else if (x == @'si::complex-long-float')
return(ecl_aet_clf);
#endif
else if (x == @'ext::byte8')
return(ecl_aet_b8);
else if (x == @'ext::integer8')
return(ecl_aet_i8);
@ -710,6 +755,18 @@ address_inc(void *address, cl_fixnum inc, cl_elttype elt_type)
#endif
case ecl_aet_df:
return aux.df + inc;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
return aux.lf + inc;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
return aux.csf + inc;
case ecl_aet_cdf:
return aux.cdf + inc;
case ecl_aet_clf:
return aux.clf + inc;
#endif
case ecl_aet_b8:
case ecl_aet_i8:
return aux.b8 + inc;
@ -971,6 +1028,22 @@ cl_array_displacement(cl_object a)
case ecl_aet_df:
offset = a->array.self.df - to_array->array.self.df;
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
offset = a->array.self.lf - to_array->array.self.lf;
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
offset = a->array.self.csf - to_array->array.self.csf;
break;
case ecl_aet_cdf:
offset = a->array.self.cdf - to_array->array.self.cdf;
break;
case ecl_aet_clf:
offset = a->array.self.clf - to_array->array.self.clf;
break;
#endif
case ecl_aet_b8:
case ecl_aet_i8:
offset = a->array.self.b8 - to_array->array.self.b8;
@ -1241,6 +1314,38 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
x->array.self.df[j] = y;
}
break;
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf:
for (i = i0, j = i1-1; i < j; i++, --j) {
long double y = x->array.self.lf[i];
x->array.self.lf[i] = x->array.self.lf[j];
x->array.self.lf[j] = y;
}
break;
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf:
for (i = i0, j = i1-1; i < j; i++, --j) {
_Complex float y = x->array.self.csf[i];
x->array.self.csf[i] = x->array.self.csf[j];
x->array.self.csf[j] = y;
}
break;
case ecl_aet_cdf:
for (i = i0, j = i1-1; i < j; i++, --j) {
_Complex double y = x->array.self.cdf[i];
x->array.self.cdf[i] = x->array.self.cdf[j];
x->array.self.cdf[j] = y;
}
break;
case ecl_aet_clf:
for (i = i0, j = i1-1; i < j; i++, --j) {
_Complex long double y = x->array.self.clf[i];
x->array.self.clf[i] = x->array.self.clf[j];
x->array.self.clf[j] = y;
}
break;
#endif
case ecl_aet_bc:
for (i = i0, j = i1-1; i < j; i++, --j) {
ecl_base_char y = x->array.self.bc[i];
@ -1383,6 +1488,34 @@ si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object en
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
#ifdef ECL_LONG_FLOAT
case ecl_aet_lf: {
long double e = ecl_to_long_double(elt);
long double *p = x->vector.self.lf + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
#endif
#ifdef ECL_COMPLEX_FLOAT
case ecl_aet_csf: {
_Complex float e = ecl_to_csfloat(elt);
_Complex float *p = x->vector.self.csf + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
case ecl_aet_cdf: {
_Complex double e = ecl_to_cdfloat(elt);
_Complex double *p = x->vector.self.cdf + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
case ecl_aet_clf: {
_Complex long double e = ecl_to_clfloat(elt);
_Complex long double *p = x->vector.self.clf + first;
for (first = last - first; first; --first, ++p) { *p = e; }
break;
}
#endif
case ecl_aet_b8: {
uint8_t e = ecl_to_uint8_t(elt);
uint8_t *p = x->vector.self.b8 + first;

10
src/c/ffi.d
View file

@ -17,8 +17,16 @@
static const cl_object ecl_aet_to_ffi_table[ecl_aet_bc+1] = {
@':void', /* ecl_aet_object */
@':float', /* ecl_aet_df */
@':float', /* ecl_aet_sf */
@':double', /* ecl_aet_df */
#ifdef ECL_LONG_FLOAT
@':long-double', /* ecl_aet_lf */
#endif
#ifdef ECL_COMPLEX_FLOAT
@':csfloat', /* ecl_aet_csf */
@':cdfloat', /* ecl_aet_cdf */
@':clfloat', /* ecl_aet_clf */
#endif
@':void', /* ecl_aet_bit */
#if ECL_FIXNUM_BITS == 32 && defined(ecl_uint32_t)
@':int32-t', /* ecl_aet_fix */

74
src/c/predicate.d
View file

@ -499,32 +499,58 @@ ecl_equalp(cl_object x, cl_object y)
|| etx == ecl_aet_fix || etx == ecl_aet_index)) {
return memcmp(x->array.self.t, y->array.self.t, j * ecl_aet_size[etx]) == 0;
}
if (etx == ecl_aet_sf) {
if (ety == ecl_aet_sf) {
for (i = 0; i < j; i++)
if (x->array.self.sf[i] != y->array.self.sf[i])
return(FALSE);
return(TRUE);
} else if (ety == ecl_aet_df) {
for (i = 0; i < j; i++)
if (x->array.self.sf[i] != y->array.self.df[i])
return(FALSE);
return(TRUE);
}
}
if (etx == ecl_aet_df) {
if (ety == ecl_aet_sf) {
for (i = 0; i < j; i++)
if (x->array.self.df[i] != y->array.self.sf[i])
return(FALSE);
return(TRUE);
} else if (ety == ecl_aet_df) {
for (i = 0; i < j; i++)
if (x->array.self.df[i] != y->array.self.df[i])
return(FALSE);
return(TRUE);
#define AET_FLOAT_EQUALP(t1, t2) \
case ecl_aet_##t2: \
for (i = 0; i < j; i++) \
if (x->array.self.t1[i] != y->array.self.t2[i]) \
return(FALSE); \
return(TRUE);
#ifdef ECL_LONG_FLOAT
#define AET_FLOAT_EQUALP_LF(t1, lf) AET_FLOAT_EQUALP(t1, lf)
#else
#define AET_FLOAT_EQUALP_LF(t1, lf)
#endif
#ifdef ECL_COMPLEX_FLOAT
#define AET_FLOAT_EQUALP_CF(t1, cf) AET_FLOAT_EQUALP(t1, cf)
#else
#define AET_FLOAT_EQUALP_CF(t1, cf)
#endif
#define AET_FLOAT_SWITCH(t1) \
case ecl_aet_##t1: \
switch(ety) { \
AET_FLOAT_EQUALP(t1, sf); \
AET_FLOAT_EQUALP(t1, df); \
AET_FLOAT_EQUALP_LF(t1, lf); \
AET_FLOAT_EQUALP_CF(t1, csf); \
AET_FLOAT_EQUALP_CF(t1, cdf); \
AET_FLOAT_EQUALP_CF(t1, clf); \
default: \
break; \
}
switch (etx) {
AET_FLOAT_SWITCH(sf);
AET_FLOAT_SWITCH(df);
#ifdef ECL_LONG_FLOAT
AET_FLOAT_SWITCH(lf);
#endif
#ifdef ECL_COMPLEX_FLOAT
AET_FLOAT_SWITCH(csf);
AET_FLOAT_SWITCH(cdf);
AET_FLOAT_SWITCH(clf);
#endif
default:
break;
}
#undef AET_FLOAT_EQUALP
#undef AET_FLOAT_SWITCH
#undef AET_FLOAT_EQUALP_LF
#undef AET_FLOAT_EQUALP_CF
for (i = 0; i < j; i++)
if (!ecl_equalp(ecl_aref_unsafe(x, i), ecl_aref_unsafe(y, i)))
return(FALSE);

28
src/doc/manual/standards/arrays.txi
View file

@ -67,20 +67,28 @@ C types, limits and enumerations
@multitable @columnfractions .25 .25 .25 .25
@headitem Lisp or C type @tab Enumeration value @tab Lisp or C type @tab Enumeration value
@item t @tab ecl_aet_object @tab (unsigned-byte 1) @tab ecl_aet_bit
@item cl_fixnum @tab ecl_aet_fix @tab cl_index @tab ecl_aet_index
@item (unsigned-byte 8) @tab ecl_aet_b8 @tab (signed-byte 8) @tab ecl_aet_i8
@item (unsigned-byte 16) @tab ecl_aet_b16 @tab (signed-byte 16) @tab ecl_aet_i16
@item (unsigned-byte 32) @tab ecl_aet_b32 @tab (signed-byte 32) @tab ecl_aet_i32
@item (unsigned-byte 64) @tab ecl_aet_b64 @tab (signed-byte 64) @tab ecl_aet_i64
@item ecl_character @tab ecl_aet_ch @tab ecl_base_char @tab ecl_aet_bc
@item single-float @tab ecl_aet_sf @tab double-float @tab ecl_aet_df
@item t @tab ecl_aet_object @tab (unsigned-byte 1) @tab ecl_aet_bit
@item cl_fixnum @tab ecl_aet_fix @tab cl_index @tab ecl_aet_index
@item (unsigned-byte 8) @tab ecl_aet_b8 @tab (signed-byte 8) @tab ecl_aet_i8
@item (unsigned-byte 16) @tab ecl_aet_b16 @tab (signed-byte 16) @tab ecl_aet_i16
@item (unsigned-byte 32) @tab ecl_aet_b32 @tab (signed-byte 32) @tab ecl_aet_i32
@item (unsigned-byte 64) @tab ecl_aet_b64 @tab (signed-byte 64) @tab ecl_aet_i64
@item ecl_character @tab ecl_aet_ch @tab ecl_base_char @tab ecl_aet_bc
@item single-float @tab ecl_aet_sf @tab double-float @tab ecl_aet_df
@item long-float @tab ecl_aet_lf @tab (complex long-float) @tab ecl_aet_clf
@item (complex single-float) @tab ecl_aet_csf @tab (complex double-float) @tab ecl_aet_cdf
@end multitable
@subsubheading Description
This list contains the constants that limit the rank of an array (@code{ECL_ARRAY_RANK_LIMIT}), the maximum size of each dimension (@code{ECL_ARRAY_DIMENSION_LIMIT}) and the maximum number of elements in an array (@code{ECL_ARRAY_TOTAL_LIMIT}).
This list contains the constants that limit the rank of an array
(@code{ECL_ARRAY_RANK_LIMIT}), the maximum size of each dimension
(@code{ECL_ARRAY_DIMENSION_LIMIT}) and the maximum number of elements
in an array (@code{ECL_ARRAY_TOTAL_LIMIT}).
ECL uses also internally a set of constants to describe the different specialized arrays. The constants form up the enumeration type cl_elttype. They are listed in the table above, which associates enumeration values with the corresponding Common Lisp element type.
ECL uses also internally a set of constants to describe the different
specialized arrays. The constants form up the enumeration type
cl_elttype. They are listed in the table above, which associates
enumeration values with the corresponding Common Lisp element type.
@subsubsection ecl_aet_to_symbol, ecl_symbol_to_aet
To and from element types

8
src/h/internal.h
View file

@ -72,6 +72,14 @@ static const cl_index ecl_aet_size[] = {
sizeof(cl_object), /* ecl_aet_object */
sizeof(float), /* ecl_aet_sf */
sizeof(double), /* ecl_aet_df */
#ifdef ECL_LONG_FLOAT
sizeof(long double), /* ecl_aet_lf */
#endif
#ifdef ECL_COMPLEX_FLOAT
sizeof(_Complex float), /* ecl_aet_csf */
sizeof(_Complex double), /* ecl_aet_cdf */
sizeof(_Complex long double), /* ecl_aet_clf */
#endif
0, /* ecl_aet_bit: cannot be handled with this code */
sizeof(cl_fixnum), /* ecl_aet_fix */
sizeof(cl_index), /* ecl_aet_index */

16
src/h/object.h
View file

@ -421,6 +421,14 @@ typedef enum { /* array element type */
ecl_aet_object, /* t */
ecl_aet_sf, /* single-float */
ecl_aet_df, /* double-float */
#ifdef ECL_LONG_FLOAT
ecl_aet_lf, /* long-float */
#endif
#ifdef ECL_COMPLEX_FLOAT
ecl_aet_csf, /* complex-single-float */
ecl_aet_cdf, /* complex-double-float */
ecl_aet_clf, /* complex-long-float */
#endif
ecl_aet_bit, /* bit */
ecl_aet_fix, /* cl_fixnum */
ecl_aet_index, /* cl_index */
@ -468,6 +476,14 @@ union ecl_array_data {
#endif
float *sf;
double *df;
#ifdef ECL_LONG_FLOAT
long double *lf;
#endif
#ifdef ECL_COMPLEX_FLOAT
float _Complex *csf;
double _Complex *cdf;
long double _Complex *clf;
#endif
cl_fixnum *fix;
cl_index *index;
byte *bit;

6
src/lsp/predlib.lsp
View file

@ -476,7 +476,11 @@ and is not adjustable."
(when (< 32 cl-fixnum-bits 64) '(EXT::CL-INDEX FIXNUM))
#+:uint64-t '(EXT:BYTE64 EXT:INTEGER64)
(when (< 64 cl-fixnum-bits) '(EXT::CL-INDEX FIXNUM))
'(SINGLE-FLOAT DOUBLE-FLOAT T)))
'(SINGLE-FLOAT DOUBLE-FLOAT #+long-float LONG-FLOAT)
#+complex-float '(si:complex-single-float
si:complex-double-float
si:complex-long-float)
'(t)))
(defun upgraded-array-element-type (element-type &optional env)
(declare (ignore env))