summaryrefslogtreecommitdiff
path: root/libguile/unif.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2005-01-09 15:41:22 +0000
committerMarius Vollmer <mvo@zagadka.de>2005-01-09 15:41:22 +0000
commit5f37cb6331c095aaf66d888988f78bc2436abab0 (patch)
treed6e3d8dce6214bfcf3fe6e4c19415f0e4b6b07d1 /libguile/unif.c
parent4cf8074fd1108921a9dad984b807763c85835ccf (diff)
downloadguile-5f37cb6331c095aaf66d888988f78bc2436abab0.tar.gz
(ra2l): Handle zero rank arrays.
(scm_i_print_array): Print zero rank arrays specially. (tag_to_type): Return #t for an empty tag, not the empty symbol. (scm_i_read_array): Allow zero rank arrays.
Diffstat (limited to 'libguile/unif.c')
-rw-r--r--libguile/unif.c123
1 files changed, 77 insertions, 46 deletions
diff --git a/libguile/unif.c b/libguile/unif.c
index a5de0e26d..ebf9120c0 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -2209,30 +2209,23 @@ static SCM
ra2l (SCM ra, unsigned long base, unsigned long k)
{
SCM res = SCM_EOL;
- long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+ long inc;
size_t i;
int enclosed = SCM_ENCLOSED_ARRAYP (ra);
+ if (k == SCM_ARRAY_NDIM (ra))
+ return scm_i_cvref (SCM_ARRAY_V (ra), base, enclosed);
+
+ inc = SCM_ARRAY_DIMS (ra)[k].inc;
if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL;
i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
- if (k < SCM_ARRAY_NDIM (ra) - 1)
+ do
{
- do
- {
- i -= inc;
- res = scm_cons (ra2l (ra, i, k + 1), res);
- }
- while (i != base);
+ i -= inc;
+ res = scm_cons (ra2l (ra, i, k + 1), res);
}
- else
- do
- {
- i -= inc;
- res = scm_cons (scm_i_cvref (SCM_ARRAY_V (ra), i, enclosed),
- res);
- }
- while (i != base);
+ while (i != base);
return res;
}
@@ -2456,7 +2449,35 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
break;
}
- return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
+ if (ndim == 0)
+ {
+ /* Rank zero arrays, which are really just scalars, are printed
+ specially. The consequent way would be to print them as
+
+ #0 OBJ
+
+ where OBJ is the printed representation of the scalar, but we
+ print them instead as
+
+ #0(OBJ)
+
+ to make them look less strange.
+
+ Just printing them as
+
+ OBJ
+
+ would be correct in a way as well, but zero rank arrays are
+ not really the same as Scheme values since they are boxed and
+ can be modified with array-set!, say.
+ */
+ scm_putc ('(', port);
+ scm_iprin1 (scm_i_cvref (v, base, 0), port, pstate);
+ scm_putc (')', port);
+ return 1;
+ }
+ else
+ return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
}
static int
@@ -2527,8 +2548,11 @@ tag_to_type (const char *tag, SCM port)
}
}
#endif
-
- return scm_from_locale_symbol (tag);
+
+ if (*tag == '\0')
+ return SCM_BOOL_T;
+ else
+ return scm_from_locale_symbol (tag);
}
SCM
@@ -2539,7 +2563,7 @@ scm_i_read_array (SCM port, int c)
char tag[80];
int tag_len;
- SCM lower_bounds, elements;
+ SCM lower_bounds = SCM_BOOL_F, elements;
/* XXX - shortcut for ordinary vectors. Shouldn't be necessary but
the array code can not deal with zero-length dimensions yet, and
@@ -2569,8 +2593,7 @@ scm_i_read_array (SCM port, int c)
goto continue_reading_tag;
}
- /* Read rank. We disallow arrays of rank zero since they do not
- seem to work reliably yet. */
+ /* Read rank. */
rank = 0;
got_rank = 0;
while ('0' <= c && c <= '9')
@@ -2581,9 +2604,6 @@ scm_i_read_array (SCM port, int c)
}
if (!got_rank)
rank = 1;
- else if (rank == 0)
- scm_i_input_error (NULL, port,
- "array rank must be positive", SCM_EOL);
/* Read tag. */
tag_len = 0;
@@ -2596,28 +2616,32 @@ scm_i_read_array (SCM port, int c)
tag[tag_len] = '\0';
/* Read lower bounds. */
- lower_bounds = SCM_EOL;
- while (c == '@')
+ if (c == '@')
{
- /* Yeah, right, we should use some ready-made integer parsing
- routine for this...
- */
-
- long lbnd = 0;
- long sign = 1;
-
- c = scm_getc (port);
- if (c == '-')
- {
- sign = -1;
- c = scm_getc (port);
- }
- while ('0' <= c && c <= '9')
+ lower_bounds = SCM_EOL;
+
+ do
{
- lbnd = 10*lbnd + c-'0';
+ /* Yeah, right, we should use some ready-made integer parsing
+ routine for this...
+ */
+
+ long lbnd = 0;
+ long sign = 1;
+
c = scm_getc (port);
- }
- lower_bounds = scm_cons (scm_from_long (sign*lbnd), lower_bounds);
+ if (c == '-')
+ {
+ sign = -1;
+ c = scm_getc (port);
+ }
+ while ('0' <= c && c <= '9')
+ {
+ lbnd = 10*lbnd + c-'0';
+ c = scm_getc (port);
+ }
+ lower_bounds = scm_cons (scm_from_long (sign*lbnd), lower_bounds);
+ } while (c == '@');
}
/* Read nested lists of elements.
@@ -2629,14 +2653,21 @@ scm_i_read_array (SCM port, int c)
scm_ungetc (c, port);
elements = scm_read (port);
- if (scm_is_null (lower_bounds))
+ if (scm_is_false (lower_bounds))
lower_bounds = scm_from_size_t (rank);
else if (scm_ilength (lower_bounds) != rank)
scm_i_input_error (NULL, port,
"the number of lower bounds must match the array rank",
SCM_EOL);
- /* Construct array. */
+ /* Handle special print syntax of rank zero arrays; see
+ scm_i_print_array for a rationale.
+ */
+ if (rank == 0)
+ elements = scm_car (elements);
+
+ /* Construct array.
+ */
return scm_list_to_typed_array (tag_to_type (tag, port),
lower_bounds,
elements);