summaryrefslogtreecommitdiff
path: root/libguile/vectors.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/vectors.c')
-rw-r--r--libguile/vectors.c158
1 files changed, 69 insertions, 89 deletions
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 52af1cf11..61a547cce 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -38,12 +38,17 @@
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
#include <stdio.h>
#include "_scm.h"
#include "eq.h"
+#include "scm_validate.h"
#include "vectors.h"
#include "unif.h"
@@ -53,15 +58,13 @@
* C code can safely call it on arrays known to be used in a single
* threaded manner.
*
- * SCM_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
+ * SCM_REGISTER_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
*/
static char s_vector_set_length_x[] = "vector-set-length!";
SCM
-scm_vector_set_length_x (vect, len)
- SCM vect;
- SCM len;
+scm_vector_set_length_x (SCM vect, SCM len)
{
long l;
scm_sizet siz;
@@ -119,15 +122,15 @@ scm_vector_set_length_x (vect, len)
return vect;
}
-SCM_PROC(s_vector_p, "vector?", 1, 0, 0, scm_vector_p);
-
-SCM
-scm_vector_p(x)
- SCM x;
+GUILE_PROC(scm_vector_p, "vector?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_vector_p
{
if (SCM_IMP(x)) return SCM_BOOL_F;
- return SCM_VECTORP(x) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(SCM_VECTORP(x));
}
+#undef FUNC_NAME
SCM_GPROC(s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length);
@@ -140,23 +143,24 @@ scm_vector_length(v)
return SCM_MAKINUM(SCM_LENGTH(v));
}
-SCM_PROC(s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
-SCM_PROC(s_vector, "vector", 0, 0, 1, scm_vector);
+SCM_REGISTER_PROC(s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
-SCM
-scm_vector(l)
- SCM l;
+GUILE_PROC(scm_vector, "vector", 0, 0, 1,
+ (SCM l),
+"")
+#define FUNC_NAME s_scm_vector
{
SCM res;
register SCM *data;
- long i = scm_ilength(l);
- SCM_ASSERT(i >= 0, l, SCM_ARG1, s_vector);
+ int i;
+ SCM_VALIDATE_LIST_COPYLEN(1,l,i);
res = scm_make_vector (SCM_MAKINUM(i), SCM_UNSPECIFIED);
data = SCM_VELTS(res);
for(;i && SCM_NIMP(l);--i, l = SCM_CDR(l))
*data++ = SCM_CAR(l);
return res;
}
+#undef FUNC_NAME
SCM_GPROC(s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
@@ -193,25 +197,23 @@ scm_vector_set_x(v, k, obj)
}
-SCM_PROC (s_make_vector, "make-vector", 1, 1, 0, scm_make_vector);
-
-SCM
-scm_make_vector (k, fill)
- SCM k;
- SCM fill;
+GUILE_PROC (scm_make_vector, "make-vector", 1, 1, 0,
+ (SCM k, SCM fill),
+"")
+#define FUNC_NAME s_scm_make_vector
{
SCM v;
register long i;
register long j;
register SCM *velts;
- SCM_ASSERT(SCM_INUMP(k) && (0 <= SCM_INUM (k)), k, SCM_ARG1, s_make_vector);
+ SCM_VALIDATE_INT_MIN(1,k,0);
if (SCM_UNBNDP(fill))
fill = SCM_UNSPECIFIED;
i = SCM_INUM(k);
SCM_NEWCELL(v);
SCM_DEFER_INTS;
- SCM_SETCHARS(v, scm_must_malloc(i?(long)(i*sizeof(SCM)):1L, s_vector));
+ SCM_SETCHARS(v, scm_must_malloc(i?(long)(i*sizeof(SCM)):1L, FUNC_NAME));
SCM_SETLENGTH(v, i, scm_tc7_vector);
velts = SCM_VELTS(v);
j = 0;
@@ -219,46 +221,44 @@ scm_make_vector (k, fill)
SCM_ALLOW_INTS;
return v;
}
+#undef FUNC_NAME
-SCM_PROC(s_vector_to_list, "vector->list", 1, 0, 0, scm_vector_to_list);
-
-SCM
-scm_vector_to_list(v)
- SCM v;
+GUILE_PROC(scm_vector_to_list, "vector->list", 1, 0, 0,
+ (SCM v),
+"")
+#define FUNC_NAME s_scm_vector_to_list
{
SCM res = SCM_EOL;
long i;
SCM *data;
- SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_to_list);
+ SCM_VALIDATE_VECTOR(1,v);
data = SCM_VELTS(v);
for(i = SCM_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res);
return res;
}
+#undef FUNC_NAME
-SCM_PROC (s_vector_fill_x, "vector-fill!", 2, 0, 0, scm_vector_fill_x);
-
-SCM
-scm_vector_fill_x (v, fill_x)
- SCM v;
- SCM fill_x;
+GUILE_PROC (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
+ (SCM v, SCM fill_x),
+"")
+#define FUNC_NAME s_scm_vector_fill_x
{
register long i;
register SCM *data;
- SCM_ASSERT(SCM_NIMP(v) && SCM_VECTORP(v), v, SCM_ARG1, s_vector_fill_x);
+ SCM_VALIDATE_VECTOR(1,v);
data = SCM_VELTS(v);
for(i = SCM_LENGTH(v) - 1; i >= 0; i--)
data[i] = fill_x;
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
SCM
-scm_vector_equal_p(x, y)
- SCM x;
- SCM y;
+scm_vector_equal_p(SCM x, SCM y)
{
long i;
for(i = SCM_LENGTH(x)-1;i >= 0;i--)
@@ -268,73 +268,53 @@ scm_vector_equal_p(x, y)
}
-SCM_PROC (s_vector_move_left_x, "vector-move-left!", 5, 0, 0, scm_vector_move_left_x);
-
-SCM
-scm_vector_move_left_x (vec1, start1, end1, vec2, start2)
- SCM vec1;
- SCM start1;
- SCM end1;
- SCM vec2;
- SCM start2;
+GUILE_PROC (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
+ (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
+ "")
+#define FUNC_NAME s_scm_vector_move_left_x
{
long i;
long j;
long e;
- SCM_ASSERT (SCM_NIMP (vec1) && SCM_VECTORP (vec1), vec1, SCM_ARG1, s_vector_move_left_x);
- SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_vector_move_left_x);
- SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_vector_move_left_x);
- SCM_ASSERT (SCM_NIMP (vec2) && SCM_VECTORP (vec2), vec2, SCM_ARG4, s_vector_move_left_x);
- SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_vector_move_left_x);
- i = SCM_INUM (start1);
- j = SCM_INUM (start2);
- e = SCM_INUM (end1);
- SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, s_vector_move_left_x);
- SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, s_vector_move_left_x);
- SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, s_vector_move_left_x);
- SCM_ASSERT (e-i+j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, s_vector_move_left_x);
+ SCM_VALIDATE_VECTOR(1,vec1);
+ SCM_VALIDATE_INT_COPY(2,start1,i);
+ SCM_VALIDATE_INT_COPY(3,end1,e);
+ SCM_VALIDATE_VECTOR(4,vec2);
+ SCM_VALIDATE_INT_COPY(5,start2,j);
+ SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT (e-i+j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, FUNC_NAME);
while (i<e) SCM_VELTS (vec2)[j++] = SCM_VELTS (vec1)[i++];
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_vector_move_right_x, "vector-move-right!", 5, 0, 0, scm_vector_move_right_x);
-
-SCM
-scm_vector_move_right_x (vec1, start1, end1, vec2, start2)
- SCM vec1;
- SCM start1;
- SCM end1;
- SCM vec2;
- SCM start2;
+GUILE_PROC (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
+ (SCM vec1, SCM start1, SCM end1, SCM vec2, SCM start2),
+ "")
+#define FUNC_NAME s_scm_vector_move_right_x
{
long i;
long j;
long e;
- SCM_ASSERT (SCM_NIMP (vec1) && SCM_VECTORP (vec1),
- vec1, SCM_ARG1, s_vector_move_right_x);
- SCM_ASSERT (SCM_INUMP (start1), start1, SCM_ARG2, s_vector_move_right_x);
- SCM_ASSERT (SCM_INUMP (end1), end1, SCM_ARG3, s_vector_move_right_x);
- SCM_ASSERT (SCM_NIMP (vec2) && SCM_VECTORP (vec2),
- vec2, SCM_ARG4, s_vector_move_right_x);
- SCM_ASSERT (SCM_INUMP (start2), start2, SCM_ARG5, s_vector_move_right_x);
- i = SCM_INUM (start1);
- j = SCM_INUM (start2);
- e = SCM_INUM (end1);
- SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0,
- start1, SCM_OUTOFRANGE, s_vector_move_right_x);
- SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0,
- start2, SCM_OUTOFRANGE, s_vector_move_right_x);
- SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0,
- end1, SCM_OUTOFRANGE, s_vector_move_right_x);
+ SCM_VALIDATE_VECTOR(1,vec1);
+ SCM_VALIDATE_INT_COPY(2,start1,i);
+ SCM_VALIDATE_INT_COPY(3,end1,e);
+ SCM_VALIDATE_VECTOR(4,vec2);
+ SCM_VALIDATE_INT_COPY(5,start2,j);
+ SCM_ASSERT (i <= SCM_LENGTH (vec1) && i >= 0, start1, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT (j <= SCM_LENGTH (vec2) && j >= 0, start2, SCM_OUTOFRANGE, FUNC_NAME);
+ SCM_ASSERT (e <= SCM_LENGTH (vec1) && e >= 0, end1, SCM_OUTOFRANGE, FUNC_NAME);
j = e - i + j;
- SCM_ASSERT (j <= SCM_LENGTH (vec2),
- start2, SCM_OUTOFRANGE, s_vector_move_right_x);
+ SCM_ASSERT (j <= SCM_LENGTH (vec2), start2, SCM_OUTOFRANGE, FUNC_NAME);
while (i < e)
SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e];
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME