summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-10-27 18:16:26 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-10-27 18:16:26 +0000
commitb4bdaddeed62fc0bea904170cc5fac2fea329fcd (patch)
treeeeb5c13189cf47a53ad5ffe2c66429b338ca8d78
parent54c83b6249d2f0761fadd133f7c4a5f7c7a6c337 (diff)
downloadguile-b4bdaddeed62fc0bea904170cc5fac2fea329fcd.tar.gz
(scm_ra_matchp, scm_array_fill_int, racp, scm_array_index_map_x,
raeql_1, scm_array_equal_p): Handle srfi-4 uniform vectors. Removed code for scm_tc7_byvect
-rw-r--r--libguile/ramap.c57
1 files changed, 25 insertions, 32 deletions
diff --git a/libguile/ramap.c b/libguile/ramap.c
index ae5a97f7c..90f4c5c5a 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -35,6 +35,7 @@
#include "libguile/feature.h"
#include "libguile/root.h"
#include "libguile/vectors.h"
+#include "libguile/srfi-4.h"
#include "libguile/validate.h"
#include "libguile/ramap.h"
@@ -171,6 +172,8 @@ scm_ra_matchp (SCM ra0, SCM ras)
int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
if (SCM_IMP (ra0)) return 0;
+ if (scm_is_uniform_vector (ra0))
+ goto uniform_vector_0;
switch (SCM_TYP7 (ra0))
{
default:
@@ -178,7 +181,6 @@ scm_ra_matchp (SCM ra0, SCM ras)
case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_string:
- case scm_tc7_byvect:
case scm_tc7_bvect:
case scm_tc7_uvect:
case scm_tc7_ivect:
@@ -189,6 +191,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
case scm_tc7_fvect:
case scm_tc7_dvect:
case scm_tc7_cvect:
+ uniform_vector_0:
s0->lbnd = 0;
s0->inc = 1;
s0->ubnd = scm_to_long (scm_uniform_vector_length (ra0)) - 1;
@@ -206,15 +209,15 @@ scm_ra_matchp (SCM ra0, SCM ras)
ra1 = SCM_CAR (ras);
if (SCM_IMP (ra1))
return 0;
- switch SCM_TYP7
- (ra1)
+ if (scm_is_uniform_vector (ra1))
+ goto uniform_vector_1;
+ switch (SCM_TYP7 (ra1))
{
default:
return 0;
case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_string:
- case scm_tc7_byvect:
case scm_tc7_bvect:
case scm_tc7_uvect:
case scm_tc7_ivect:
@@ -225,6 +228,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
case scm_tc7_fvect:
case scm_tc7_dvect:
case scm_tc7_cvect:
+ uniform_vector_1:
{
unsigned long int length;
@@ -455,6 +459,14 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
unsigned long base = SCM_ARRAY_BASE (ra);
ra = SCM_ARRAY_V (ra);
+
+ if (scm_is_uniform_vector (ra))
+ {
+ for (i = base; n--; i += inc)
+ scm_uniform_vector_set_x (ra, scm_from_ulong (i), fill);
+ return 1;
+ }
+
switch SCM_TYP7 (ra)
{
default:
@@ -475,15 +487,6 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
scm_i_string_stop_writing ();
}
break;
- case scm_tc7_byvect:
- if (SCM_CHARP (fill))
- fill = SCM_I_MAKINUM ((signed char) SCM_CHAR (fill));
- SCM_ASRTGO (SCM_I_INUMP (fill), badarg2);
- SCM_ASSERT_RANGE (SCM_ARG2, fill,
- -128 <= SCM_I_INUM (fill) && SCM_I_INUM (fill) < 128);
- for (i = base; n--; i += inc)
- ((char *) SCM_UVECTOR_BASE (ra))[i] = SCM_I_INUM (fill);
- break;
case scm_tc7_bvect:
{ /* scope */
long *ve = (long *) SCM_VELTS (ra);
@@ -619,6 +622,9 @@ racp (SCM src, SCM dst)
src = SCM_ARRAY_V (src);
dst = SCM_ARRAY_V (dst);
+ if (scm_is_uniform_vector (src) || scm_is_uniform_vector (dst))
+ goto gencase;
+
switch SCM_TYP7 (dst)
{
default:
@@ -642,13 +648,6 @@ racp (SCM src, SCM dst)
scm_i_string_stop_writing ();
}
break;
- case scm_tc7_byvect:
- if (SCM_TYP7 (src) != scm_tc7_byvect)
- goto gencase;
- for (; n-- > 0; i_s += inc_s, i_d += inc_d)
- ((char *) SCM_UVECTOR_BASE (dst))[i_d]
- = ((char *) SCM_UVECTOR_BASE (src))[i_s];
- break;
case scm_tc7_bvect:
if (SCM_TYP7 (src) != scm_tc7_bvect)
goto gencase;
@@ -1682,6 +1681,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
unsigned long i;
SCM_VALIDATE_NIM (1, ra);
SCM_VALIDATE_PROC (2, proc);
+ if (scm_is_uniform_vector (ra))
+ goto uniform_vector;
switch (SCM_TYP7(ra))
{
default:
@@ -1694,7 +1695,6 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
return SCM_UNSPECIFIED;
}
case scm_tc7_string:
- case scm_tc7_byvect:
case scm_tc7_bvect:
case scm_tc7_uvect:
case scm_tc7_ivect:
@@ -1705,6 +1705,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
case scm_tc7_fvect:
case scm_tc7_dvect:
case scm_tc7_cvect:
+ uniform_vector:
{
unsigned long int length = scm_to_ulong (scm_uniform_vector_length (ra));
for (i = 0; i < length; i++)
@@ -1782,11 +1783,14 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
}
+ if (scm_is_uniform_vector (ra0))
+ goto uniform_vector;
switch (SCM_TYP7 (ra0))
{
case scm_tc7_vector:
case scm_tc7_wvect:
default:
+ uniform_vector:
for (; n--; i0 += inc0, i1 += inc1)
{
if (scm_is_false (as_equal))
@@ -1807,15 +1811,6 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
return 0;
return 1;
}
- case scm_tc7_byvect:
- {
- char *v0 = ((char *) SCM_UVECTOR_BASE (ra0)) + i0;
- char *v1 = ((char *) SCM_UVECTOR_BASE (ra1)) + i1;
- for (; n--; v0 += inc0, v1 += inc1)
- if (*v0 != *v1)
- return 0;
- return 1;
- }
case scm_tc7_bvect:
for (; n--; i0 += inc0, i1 += inc1)
if (SCM_BITVEC_REF (ra0, i0) != SCM_BITVEC_REF (ra1, i1))
@@ -1983,7 +1978,6 @@ scm_array_equal_p (SCM ra0, SCM ra1)
goto callequal;
case scm_tc7_bvect:
case scm_tc7_string:
- case scm_tc7_byvect:
case scm_tc7_uvect:
case scm_tc7_ivect:
case scm_tc7_svect:
@@ -2003,7 +1997,6 @@ scm_array_equal_p (SCM ra0, SCM ra1)
goto callequal;
case scm_tc7_bvect:
case scm_tc7_string:
- case scm_tc7_byvect:
case scm_tc7_uvect:
case scm_tc7_ivect:
case scm_tc7_svect: