diff --git a/libguile/array-map.c b/libguile/array-map.c index 938f0a7b9..587df023b 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -307,267 +307,6 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0, #undef FUNC_NAME -#if SCM_ENABLE_DEPRECATED == 1 - -/* to be used as cproc in scm_ramapc to fill an array dimension with - "fill". */ -int -scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) -{ - unsigned long i; - unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1; - long inc = SCM_I_ARRAY_DIMS (ra)->inc; - unsigned long base = SCM_I_ARRAY_BASE (ra); - - ra = SCM_I_ARRAY_V (ra); - - for (i = base; n--; i += inc) - ASET (ra, i, fill); - - return 1; -} - -/* Functions callable by ARRAY-MAP! */ - -int -scm_ra_eqp (SCM ra0, SCM ras) -{ - SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); - scm_t_array_handle ra0_handle; - scm_t_array_dim *ra0_dims; - size_t n; - ssize_t inc0; - size_t i0 = 0; - unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - ra2 = SCM_I_ARRAY_V (ra2); - - scm_array_get_handle (ra0, &ra0_handle); - ra0_dims = scm_array_handle_dims (&ra0_handle); - n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1; - inc0 = ra0_dims[0].inc; - - { - for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0))) - if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2))) - scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F); - } - - scm_array_handle_release (&ra0_handle); - return 1; -} - -/* opt 0 means <, nonzero means >= */ - -static int -ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) -{ - scm_t_array_handle ra0_handle; - scm_t_array_dim *ra0_dims; - size_t n; - ssize_t inc0; - size_t i0 = 0; - unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - ra2 = SCM_I_ARRAY_V (ra2); - - scm_array_get_handle (ra0, &ra0_handle); - ra0_dims = scm_array_handle_dims (&ra0_handle); - n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1; - inc0 = ra0_dims[0].inc; - - { - for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0))) - if (opt ? - scm_is_true (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))) : - scm_is_false (scm_less_p (AREF (ra1, i1), AREF (ra2, i2)))) - scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F); - } - - scm_array_handle_release (&ra0_handle); - return 1; -} - - - -int -scm_ra_lessp (SCM ra0, SCM ras) -{ - return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 0); -} - - -int -scm_ra_leqp (SCM ra0, SCM ras) -{ - return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 1); -} - - -int -scm_ra_grp (SCM ra0, SCM ras) -{ - return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 0); -} - - -int -scm_ra_greqp (SCM ra0, SCM ras) -{ - return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 1); -} - - -int -scm_ra_sum (SCM ra0, SCM ras) -{ - long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1; - unsigned long i0 = SCM_I_ARRAY_BASE (ra0); - long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; - ra0 = SCM_I_ARRAY_V (ra0); - if (!scm_is_null(ras)) - { - SCM ra1 = SCM_CAR (ras); - unsigned long i1 = SCM_I_ARRAY_BASE (ra1); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) - { - default: - { - for (; n-- > 0; i0 += inc0, i1 += inc1) - ASET (ra0, i0, scm_sum (AREF(ra0, i0), AREF(ra1, i1))); - break; - } - } - } - return 1; -} - - - -int -scm_ra_difference (SCM ra0, SCM ras) -{ - long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1; - unsigned long i0 = SCM_I_ARRAY_BASE (ra0); - long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; - ra0 = SCM_I_ARRAY_V (ra0); - if (scm_is_null (ras)) - { - switch (SCM_TYP7 (ra0)) - { - default: - { - for (; n-- > 0; i0 += inc0) - ASET (ra0, i0, scm_difference (AREF(ra0, i0), SCM_UNDEFINED)); - break; - } - } - } - else - { - SCM ra1 = SCM_CAR (ras); - unsigned long i1 = SCM_I_ARRAY_BASE (ra1); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) - { - default: - { - for (; n-- > 0; i0 += inc0, i1 += inc1) - ASET (ra0, i0, scm_difference (AREF (ra0, i0), AREF (ra1, i1))); - break; - } - } - } - return 1; -} - - - -int -scm_ra_product (SCM ra0, SCM ras) -{ - long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1; - unsigned long i0 = SCM_I_ARRAY_BASE (ra0); - long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; - ra0 = SCM_I_ARRAY_V (ra0); - if (!scm_is_null (ras)) - { - SCM ra1 = SCM_CAR (ras); - unsigned long i1 = SCM_I_ARRAY_BASE (ra1); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) - { - default: - { - for (; n-- > 0; i0 += inc0, i1 += inc1) - ASET (ra0, i0, scm_product (AREF (ra0, i0), AREF (ra1, i1))); - } - } - } - return 1; -} - - -int -scm_ra_divide (SCM ra0, SCM ras) -{ - long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1; - unsigned long i0 = SCM_I_ARRAY_BASE (ra0); - long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; - ra0 = SCM_I_ARRAY_V (ra0); - if (scm_is_null (ras)) - { - switch (SCM_TYP7 (ra0)) - { - default: - { - for (; n-- > 0; i0 += inc0) - ASET (ra0, i0, scm_divide (AREF (ra0, i0), SCM_UNDEFINED)); - break; - } - } - } - else - { - SCM ra1 = SCM_CAR (ras); - unsigned long i1 = SCM_I_ARRAY_BASE (ra1); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0) - { - default: - { - for (; n-- > 0; i0 += inc0, i1 += inc1) - { - SCM res = scm_divide (AREF (ra0, i0), AREF (ra1, i1)); - ASET (ra0, i0, res); - } - break; - } - } - } - return 1; -} - - -int -scm_array_identity (SCM dst, SCM src) -{ - return racp (SCM_CAR (src), scm_cons (dst, SCM_EOL)); -} - -#endif /* SCM_ENABLE_DEPRECATED */ - static int ramap (SCM ra0, SCM proc, SCM ras) { diff --git a/libguile/array-map.h b/libguile/array-map.h index b0592d818..e7431b176 100644 --- a/libguile/array-map.h +++ b/libguile/array-map.h @@ -39,22 +39,6 @@ SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); SCM_INTERNAL void scm_init_array_map (void); -#if SCM_ENABLE_DEPRECATED == 1 - -SCM_DEPRECATED int scm_array_fill_int (SCM ra, SCM fill, SCM ignore); -SCM_DEPRECATED int scm_ra_eqp (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_lessp (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_leqp (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_grp (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_greqp (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_sum (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_difference (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_product (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_ra_divide (SCM ra0, SCM ras); -SCM_DEPRECATED int scm_array_identity (SCM src, SCM dst); - -#endif /* SCM_ENABLE_DEPRECATED == 1 */ - #endif /* SCM_ARRAY_MAP_H */ /*