diff options
Diffstat (limited to 'ramap.c')
| -rw-r--r-- | ramap.c | 44 |
1 files changed, 21 insertions, 23 deletions
@@ -15,26 +15,26 @@ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA. * * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * for additional uses of the text contained in its release of SCM. * - * The exception is that, if you link the GUILE library with other files + * The exception is that, if you link the SCM library with other files * to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. + * linking the SCM library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy + * Free Software Foundation under the name SCM. If you copy * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does + * SCM, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * - * If you write modifications of your own for GUILE, it is your choice + * If you write modifications of your own for SCM, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ @@ -115,7 +115,7 @@ int ra_matchp(ra0, ras) ra1 = CAR(ras); switch (IMP(ra1) ? 0 : TYP7(ra1)) { default: scalar: - CAR(ras) = sc2array(ra1,ra0,EOL); break; + CAR(ras) = sc2array(ra1, ra0, EOL); break; case tc7_vector: case tcs_uves: if (1 != ndim) return 0; @@ -304,11 +304,11 @@ static int racp(src, dst) for (; n-- > 0; i_s += inc_s, i_d += inc_d) aset(dst, cvref(src, i_s, UNDEFINED), MAKINUM(i_d)); break; - case tc7_string: if (tc7_string != TYP7(dst)) goto gencase; + case tc7_string: if (tc7_string != TYP7(src)) goto gencase; for (; n-- > 0; i_s += inc_s, i_d += inc_d) CHARS(dst)[i_d] = CHARS(src)[i_s]; break; - case tc7_bvect: if (tc7_bvect != TYP7(dst)) goto gencase; + case tc7_bvect: if (tc7_bvect != TYP7(src)) goto gencase; if (1==inc_d && 1==inc_s && i_s%LONG_BIT==i_d%LONG_BIT && n>=LONG_BIT) { long *sv = (long *)VELTS(src); long *dv = (long *)VELTS(dst); @@ -502,7 +502,7 @@ SCM ura_write(ra, port) SCM ra, port; { if (NIMP(ra) && ARRAYP(ra)) - return uve_write(ra2contig(ra,1), port); + return uve_write(ra2contig(ra, 1), port); else return uve_write(ra, port); } @@ -1081,7 +1081,7 @@ static int ramap(ra0, proc, ras) if (argc >= 5) { heap_ve = make_vector(MAKINUM(2*argc), BOOL_F); rav = VELTS(heap_ve); - argv = &(rav[n]); + argv = &(rav[argc]); } for (k = 0; k < argc; k++) { rav[k] = CAR(ras); @@ -1276,23 +1276,22 @@ SCM array_map(ra0, proc, lra) SCM ra0, proc, lra; { long narg = ilength(lra); - ASSERT(BOOL_T==procedurep(proc), proc, ARG2, s_array_map); tail: +#ifndef RECKLESS + scm_arity_check(proc, narg, s_array_map); +#endif switch TYP7(proc) { - wna: wta(UNDEFINED, (char *)WNA, s_array_map); default: gencase: - ASRTGO(scm_arity_check(proc, narg, s_array_map), wna); ramapc(ramap, proc, ra0, lra, s_array_map); return UNSPECIFIED; - case tc7_subr_1: ASRTGO(1==narg, wna); + case tc7_subr_1: ramapc(ramap_1, proc, ra0, lra, s_array_map); return UNSPECIFIED; - case tc7_subr_2: ASRTGO(2==narg, wna); - case tc7_subr_2o: ASRTGO(2>=narg, wna); + case tc7_subr_2: + case tc7_subr_2o: ramapc(ramap_2o, proc, ra0, lra, s_array_map); return UNSPECIFIED; case tc7_cxr: if (! SUBRF(proc)) goto gencase; - ASRTGO(1==narg, wna); ramapc(ramap_cxr, proc, ra0, lra, s_array_map); return UNSPECIFIED; case tc7_rpsubr: { @@ -1361,8 +1360,9 @@ SCM array_map(ra0, proc, lra) #if 1 /* def CCLO */ case tc7_specfun: if (tc16_cclo==TYP16(proc)) { - lra = cons(sc2array(proc,ra0,EOL), lra); + lra = cons(sc2array(proc, ra0, EOL), lra); proc = CCLO_SUBR(proc); + narg++; goto tail; } goto gencase; @@ -1381,7 +1381,7 @@ static int rafe(ra0, proc, ras) if (argc >= 5) { heap_ve = make_vector(MAKINUM(2*argc), BOOL_F); rav = VELTS(heap_ve); - argv = &(rav[n]); + argv = &(rav[argc]); } rav[0] = ra0; for (k = 1; k < argc; k++) { @@ -1402,7 +1402,6 @@ SCM array_for_each(proc, ra0, lra) SCM proc, ra0, lra; { long narg = ilength(lra) + 1; - ASSERT(BOOL_T==procedurep(proc), proc, ARG1, s_array_for_each); tail: #ifndef RECKLESS scm_arity_check(proc, narg, s_array_for_each); @@ -1435,7 +1434,6 @@ SCM array_imap(ra, proc) long *indv = &auto_indv[0]; sizet i; ASSERT(NIMP(ra), ra, ARG1, s_array_imap); - ASSERT(BOOL_T==procedurep(proc), proc, ARG2, s_array_imap); i = INUM(array_rank(ra)); #ifndef RECKLESS scm_arity_check(proc, i+0L, s_array_imap); @@ -1676,7 +1674,7 @@ void init_ramap() add_feature(s_array_for_each); scm_ldstr("\n\ (define (array-indexes ra)\n\ - (let ((ra0 (apply make-array '() (array-shape ra))))\n\ + (let ((ra0 (apply create-array '#() (array-shape ra))))\n\ (array-index-map! ra0 list)\n\ ra0))\n\ "); |