mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

* ramap.c (scm_ra_matchp, scm_array_fill_int, racp, ramap_1,

Browse source 
ramap_2o, scm_array_index_map_x, raeql_1, scm_array_equal_p),
unif.c (scm_vector_set_length_x, scm_uniform_vector_length,
scm_array_p, scm_array_rank, scm_array_dimensions,
scm_enclose_array, scm_array_in_bounds_p, scm_uniform_vector_ref,
scm_cvref, scm_array_set_x, scm_array_contents, scm_array_to_list,
scm_array_prototype): Added case scm_tc7_wvect.
This commit is contained in:
Mikael Djurfeldt 1997-08-24 03:29:35 +00:00
parent efb997f535
commit 95f5b0f5ec
3 changed files with 39 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

10
libguile/ChangeLog
View file

@ -1,3 +1,13 @@
Sun Aug 24 01:25:35 1997 Mikael Djurfeldt <mdj@kenneth>
* ramap.c (scm_ra_matchp, scm_array_fill_int, racp, ramap_1,
ramap_2o, scm_array_index_map_x, raeql_1, scm_array_equal_p),
unif.c (scm_vector_set_length_x, scm_uniform_vector_length,
scm_array_p, scm_array_rank, scm_array_dimensions,
scm_enclose_array, scm_array_in_bounds_p, scm_uniform_vector_ref,
scm_cvref, scm_array_set_x, scm_array_contents, scm_array_to_list,
scm_array_prototype): Added case scm_tc7_wvect.
Sat Aug 23 18:45:44 1997 Gary Houston <ghouston@actrix.gen.nz> Sat Aug 23 18:45:44 1997 Gary Houston <ghouston@actrix.gen.nz>
* errno.h: prototype for scm_strerror. * errno.h: prototype for scm_strerror.

20
libguile/ramap.c
View file

@ -159,6 +159,7 @@ scm_ra_matchp (ra0, ras)
default: default:
return 0; return 0;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_string: case scm_tc7_string:
case scm_tc7_byvect: case scm_tc7_byvect:
case scm_tc7_bvect: case scm_tc7_bvect:
@ -191,6 +192,7 @@ scm_ra_matchp (ra0, ras)
default: default:
return 0; return 0;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_string: case scm_tc7_string:
case scm_tc7_byvect: case scm_tc7_byvect:
case scm_tc7_bvect: case scm_tc7_bvect:
@ -429,6 +431,7 @@ scm_array_fill_int (ra, fill, ignore)
scm_array_set_x (ra, fill, SCM_MAKINUM (i)); scm_array_set_x (ra, fill, SCM_MAKINUM (i));
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
SCM_VELTS (ra)[i] = fill; SCM_VELTS (ra)[i] = fill;
break; break;
@ -558,7 +561,10 @@ racp (src, dst)
(dst) (dst)
{ {
default: default:
gencase: case scm_tc7_vector: gencase:
case scm_tc7_vector:
case scm_tc7_wvect:
for (; n-- > 0; i_s += inc_s, i_d += inc_d) for (; n-- > 0; i_s += inc_s, i_d += inc_d)
scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), SCM_MAKINUM (i_d)); scm_array_set_x (dst, scm_cvref (src, i_s, SCM_UNDEFINED), SCM_MAKINUM (i_d));
break; break;
@ -1545,7 +1551,7 @@ ramap_1 (ra0, proc, ras)
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0); ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_ARRAY_V (ra1);
if (scm_tc7_vector == SCM_TYP7 (ra0)) if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1) for (; n-- > 0; i0 += inc0, i1 += inc1)
scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_MAKINUM (i0)); scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED)), SCM_MAKINUM (i0));
else else
@ -1575,7 +1581,9 @@ ramap_2o (ra0, proc, ras)
if SCM_NULLP if SCM_NULLP
(ras) (ras)
{ {
if (scm_tc7_vector == SCM_TYP7 (ra0)) if (scm_tc7_vector == SCM_TYP7 (ra0)
|| scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1) for (; n-- > 0; i0 += inc0, i1 += inc1)
scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), SCM_UNDEFINED), scm_array_set_x (ra0, SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), SCM_UNDEFINED),
SCM_MAKINUM (i0)); SCM_MAKINUM (i0));
@ -1591,7 +1599,7 @@ ramap_2o (ra0, proc, ras)
scm_sizet i2 = SCM_ARRAY_BASE (ra2); scm_sizet i2 = SCM_ARRAY_BASE (ra2);
long inc2 = SCM_ARRAY_DIMS (ra2)->inc; long inc2 = SCM_ARRAY_DIMS (ra2)->inc;
ra2 = SCM_ARRAY_V (ra2); ra2 = SCM_ARRAY_V (ra2);
if (scm_tc7_vector == SCM_TYP7 (ra0)) if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
scm_array_set_x (ra0, scm_array_set_x (ra0,
SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), scm_cvref (ra2, i2, SCM_UNDEFINED)), SCM_SUBRF (proc) (scm_cvref (ra1, i1, SCM_UNDEFINED), scm_cvref (ra2, i2, SCM_UNDEFINED)),
@ -1821,6 +1829,7 @@ scm_array_index_map_x (ra, proc)
default: default:
badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_index_map_x); badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_index_map_x);
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
{ {
SCM *ve = SCM_VELTS (ra); SCM *ve = SCM_VELTS (ra);
for (i = 0; i < SCM_LENGTH (ra); i++) for (i = 0; i < SCM_LENGTH (ra); i++)
@ -1912,6 +1921,7 @@ raeql_1 (ra0, as_equal, ra1)
(ra0) (ra0)
{ {
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
default: default:
for (; n--; i0 += inc0, i1 += inc1) for (; n--; i0 += inc0, i1 += inc1)
{ {
@ -2088,6 +2098,7 @@ scm_array_equal_p (ra0, ra1)
case scm_tc7_dvect: case scm_tc7_dvect:
case scm_tc7_cvect: case scm_tc7_cvect:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
break; break;
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_ARRAYP (ra0)) if (!SCM_ARRAYP (ra0))
@ -2107,6 +2118,7 @@ scm_array_equal_p (ra0, ra1)
case scm_tc7_dvect: case scm_tc7_dvect:
case scm_tc7_cvect: case scm_tc7_cvect:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
break; break;
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_ARRAYP (ra1)) if (!SCM_ARRAYP (ra1))

13
libguile/unif.c
View file

@ -106,6 +106,7 @@ scm_vector_set_length_x (vect, len)
l++; l++;
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
SCM_ASRTGO (vect != scm_nullvect, badarg1); SCM_ASRTGO (vect != scm_nullvect, badarg1);
sz = sizeof (SCM); sz = sizeof (SCM);
break; break;
@ -306,6 +307,7 @@ scm_uniform_vector_length (v)
case scm_tc7_dvect: case scm_tc7_dvect:
case scm_tc7_cvect: case scm_tc7_cvect:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_svect: case scm_tc7_svect:
#ifdef LONGLONGS #ifdef LONGLONGS
case scm_tc7_llvect: case scm_tc7_llvect:
@ -374,6 +376,7 @@ loop:
return nprot || (SCM_NIMP(prot) && SCM_CPLXP(prot)) ? SCM_BOOL_T : SCM_BOOL_F; return nprot || (SCM_NIMP(prot) && SCM_CPLXP(prot)) ? SCM_BOOL_T : SCM_BOOL_F;
# endif # endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
return nprot || SCM_NULLP(prot) ? SCM_BOOL_T : SCM_BOOL_F; return nprot || SCM_NULLP(prot) ? SCM_BOOL_T : SCM_BOOL_F;
default:; default:;
} }
@ -395,6 +398,7 @@ scm_array_rank (ra)
return SCM_INUM0; return SCM_INUM0;
case scm_tc7_string: case scm_tc7_string:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_byvect: case scm_tc7_byvect:
case scm_tc7_uvect: case scm_tc7_uvect:
case scm_tc7_ivect: case scm_tc7_ivect:
@ -431,6 +435,7 @@ scm_array_dimensions (ra)
return SCM_BOOL_F; return SCM_BOOL_F;
case scm_tc7_string: case scm_tc7_string:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_bvect: case scm_tc7_bvect:
case scm_tc7_byvect: case scm_tc7_byvect:
case scm_tc7_uvect: case scm_tc7_uvect:
@ -905,6 +910,7 @@ scm_enclose_array (axes)
case scm_tc7_dvect: case scm_tc7_dvect:
case scm_tc7_cvect: case scm_tc7_cvect:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_svect: case scm_tc7_svect:
#ifdef LONGLONGS #ifdef LONGLONGS
case scm_tc7_llvect: case scm_tc7_llvect:
@ -1028,6 +1034,7 @@ tail:
case scm_tc7_llvect: case scm_tc7_llvect:
#endif #endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna);
return pos >= 0 && pos < SCM_LENGTH (v) ? SCM_BOOL_T : SCM_BOOL_F; return pos >= 0 && pos < SCM_LENGTH (v) ? SCM_BOOL_T : SCM_BOOL_F;
} }
@ -1134,6 +1141,7 @@ scm_uniform_vector_ref (v, args)
((double *) SCM_CDR (v))[2 * pos + 1]); ((double *) SCM_CDR (v))[2 * pos + 1]);
#endif #endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_VELTS (v)[pos]; return SCM_VELTS (v)[pos];
} }
} }
@ -1209,6 +1217,7 @@ scm_cvref (v, pos, last)
((double *) SCM_CDR (v))[2 * pos + 1]); ((double *) SCM_CDR (v))[2 * pos + 1]);
#endif #endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_VELTS (v)[pos]; return SCM_VELTS (v)[pos];
case scm_tc7_smob: case scm_tc7_smob:
{ /* enclosed scm_array */ { /* enclosed scm_array */
@ -1330,6 +1339,7 @@ scm_array_set_x (v, obj, args)
break; break;
#endif #endif
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
SCM_VELTS (v)[pos] = obj; SCM_VELTS (v)[pos] = obj;
break; break;
} }
@ -1352,6 +1362,7 @@ scm_array_contents (ra, strict)
default: default:
return SCM_BOOL_F; return SCM_BOOL_F;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
case scm_tc7_string: case scm_tc7_string:
case scm_tc7_bvect: case scm_tc7_bvect:
case scm_tc7_byvect: case scm_tc7_byvect:
@ -2013,6 +2024,7 @@ scm_array_to_list (v)
SCM_ASRTGO (SCM_ARRAYP (v), badarg1); SCM_ASRTGO (SCM_ARRAYP (v), badarg1);
return ra2l (v, SCM_ARRAY_BASE (v), 0); return ra2l (v, SCM_ARRAY_BASE (v), 0);
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
return scm_vector_to_list (v); return scm_vector_to_list (v);
case scm_tc7_string: case scm_tc7_string:
return scm_string_to_list (v); return scm_string_to_list (v);
@ -2475,6 +2487,7 @@ loop:
ra = SCM_ARRAY_V (ra); ra = SCM_ARRAY_V (ra);
goto loop; goto loop;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect:
return SCM_EOL; return SCM_EOL;
case scm_tc7_bvect: case scm_tc7_bvect:
return SCM_BOOL_T; return SCM_BOOL_T;