678 |
scm_t_array_dim *s; |
scm_t_array_dim *s; |
679 |
|
|
680 |
SCM_VALIDATE_REST_ARGUMENT (dims); |
SCM_VALIDATE_REST_ARGUMENT (dims); |
681 |
SCM_VALIDATE_ARRAY (1,oldra); |
SCM_VALIDATE_ARRAY (1, oldra); |
682 |
SCM_VALIDATE_PROC (2,mapfunc); |
SCM_VALIDATE_PROC (2, mapfunc); |
683 |
ra = scm_shap2ra (dims, FUNC_NAME); |
ra = scm_shap2ra (dims, FUNC_NAME); |
684 |
if (SCM_ARRAYP (oldra)) |
if (SCM_ARRAYP (oldra)) |
685 |
{ |
{ |
802 |
"@end lisp") |
"@end lisp") |
803 |
#define FUNC_NAME s_scm_transpose_array |
#define FUNC_NAME s_scm_transpose_array |
804 |
{ |
{ |
805 |
SCM res, vargs, *ve = &vargs; |
SCM res, vargs; |
806 |
|
SCM const *ve = &vargs; |
807 |
scm_t_array_dim *s, *r; |
scm_t_array_dim *s, *r; |
808 |
int ndim, i, k; |
int ndim, i, k; |
809 |
|
|
1105 |
} |
} |
1106 |
else |
else |
1107 |
{ |
{ |
1108 |
SCM_VALIDATE_INUM (2,args); |
SCM_VALIDATE_INUM (2, args); |
1109 |
pos = SCM_INUM (args); |
pos = SCM_INUM (args); |
1110 |
} |
} |
1111 |
length = SCM_INUM (scm_uniform_vector_length (v)); |
length = SCM_INUM (scm_uniform_vector_length (v)); |
1185 |
default: |
default: |
1186 |
SCM_WRONG_TYPE_ARG (SCM_ARG1, v); |
SCM_WRONG_TYPE_ARG (SCM_ARG1, v); |
1187 |
case scm_tc7_bvect: |
case scm_tc7_bvect: |
1188 |
if (SCM_BITVEC_REF(v,pos)) |
if (SCM_BITVEC_REF(v, pos)) |
1189 |
return SCM_BOOL_T; |
return SCM_BOOL_T; |
1190 |
else |
else |
1191 |
return SCM_BOOL_F; |
return SCM_BOOL_F; |
1279 |
} |
} |
1280 |
else |
else |
1281 |
{ |
{ |
1282 |
SCM_VALIDATE_INUM_COPY (3,args,pos); |
SCM_VALIDATE_INUM_COPY (3, args, pos); |
1283 |
} |
} |
1284 |
length = SCM_INUM (scm_uniform_vector_length (v)); |
length = SCM_INUM (scm_uniform_vector_length (v)); |
1285 |
SCM_ASRTGO (pos >= 0 && pos < length, outrng); |
SCM_ASRTGO (pos >= 0 && pos < length, outrng); |
1297 |
goto badarg1; |
goto badarg1; |
1298 |
case scm_tc7_bvect: |
case scm_tc7_bvect: |
1299 |
if (SCM_FALSEP (obj)) |
if (SCM_FALSEP (obj)) |
1300 |
SCM_BITVEC_CLR(v,pos); |
SCM_BITVEC_CLR(v, pos); |
1301 |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
1302 |
SCM_BITVEC_SET(v,pos); |
SCM_BITVEC_SET(v, pos); |
1303 |
else |
else |
1304 |
badobj:SCM_WRONG_TYPE_ARG (2, obj); |
badobj:SCM_WRONG_TYPE_ARG (2, obj); |
1305 |
break; |
break; |
1351 |
break; |
break; |
1352 |
case scm_tc7_vector: |
case scm_tc7_vector: |
1353 |
case scm_tc7_wvect: |
case scm_tc7_wvect: |
1354 |
SCM_VELTS (v)[pos] = obj; |
SCM_VECTOR_SET (v, pos, obj); |
1355 |
break; |
break; |
1356 |
} |
} |
1357 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
1825 |
|
|
1826 |
SCM_VALIDATE_BOOL (1, item); |
SCM_VALIDATE_BOOL (1, item); |
1827 |
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); |
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); |
1828 |
SCM_VALIDATE_INUM_COPY (3,k,pos); |
SCM_VALIDATE_INUM_COPY (3, k, pos); |
1829 |
SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0)); |
SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0)); |
1830 |
|
|
1831 |
if (pos == SCM_BITVECTOR_LENGTH (v)) |
if (pos == SCM_BITVECTOR_LENGTH (v)) |
1903 |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
1904 |
if (k >= vlen) |
if (k >= vlen) |
1905 |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
1906 |
SCM_BITVEC_CLR(v,k); |
SCM_BITVEC_CLR(v, k); |
1907 |
} |
} |
1908 |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
1909 |
for (i = SCM_UVECTOR_LENGTH (kv); i;) |
for (i = SCM_UVECTOR_LENGTH (kv); i;) |
1911 |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
1912 |
if (k >= vlen) |
if (k >= vlen) |
1913 |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
1914 |
SCM_BITVEC_SET(v,k); |
SCM_BITVEC_SET(v, k); |
1915 |
} |
} |
1916 |
else |
else |
1917 |
badarg3:SCM_WRONG_TYPE_ARG (3, obj); |
badarg3:SCM_WRONG_TYPE_ARG (3, obj); |
1961 |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
1962 |
if (k >= vlen) |
if (k >= vlen) |
1963 |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
1964 |
if (!SCM_BITVEC_REF(v,k)) |
if (!SCM_BITVEC_REF(v, k)) |
1965 |
count++; |
count++; |
1966 |
} |
} |
1967 |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
else if (SCM_EQ_P (obj, SCM_BOOL_T)) |
1970 |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
k = SCM_UNPACK (SCM_VELTS (kv)[--i]); |
1971 |
if (k >= vlen) |
if (k >= vlen) |
1972 |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); |
1973 |
if (SCM_BITVEC_REF (v,k)) |
if (SCM_BITVEC_REF (v, k)) |
1974 |
count++; |
count++; |
1975 |
} |
} |
1976 |
else |
else |
2051 |
|
|
2052 |
|
|
2053 |
static SCM |
static SCM |
2054 |
ra2l (SCM ra,unsigned long base,unsigned long k) |
ra2l (SCM ra, unsigned long base, unsigned long k) |
2055 |
{ |
{ |
2056 |
register SCM res = SCM_EOL; |
register SCM res = SCM_EOL; |
2057 |
register long inc = SCM_ARRAY_DIMS (ra)[k].inc; |
register long inc = SCM_ARRAY_DIMS (ra)[k].inc; |
2191 |
SCM ra; |
SCM ra; |
2192 |
unsigned long k; |
unsigned long k; |
2193 |
long n; |
long n; |
2194 |
SCM_VALIDATE_INUM_COPY (1,ndim,k); |
SCM_VALIDATE_INUM_COPY (1, ndim, k); |
2195 |
while (k--) |
while (k--) |
2196 |
{ |
{ |
2197 |
n = scm_ilength (row); |
n = scm_ilength (row); |
2262 |
|
|
2263 |
|
|
2264 |
static void |
static void |
2265 |
rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate) |
rapr1 (SCM ra, unsigned long j, unsigned long k, SCM port, scm_print_state *pstate) |
2266 |
{ |
{ |
2267 |
long inc = 1; |
long inc = 1; |
2268 |
long n = (SCM_TYP7 (ra) == scm_tc7_smob |
long n = (SCM_TYP7 (ra) == scm_tc7_smob |