diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-10-27 18:16:26 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-10-27 18:16:26 +0000 |
commit | b4bdaddeed62fc0bea904170cc5fac2fea329fcd (patch) | |
tree | eeb5c13189cf47a53ad5ffe2c66429b338ca8d78 | |
parent | 54c83b6249d2f0761fadd133f7c4a5f7c7a6c337 (diff) | |
download | guile-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.c | 57 |
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: |