summaryrefslogtreecommitdiff
path: root/libguile/arrays.c
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2017-02-21 12:23:35 +0100
committerDaniel Llorens <daniel.llorens@bluewin.ch>2017-10-31 13:23:44 +0100
commite0bcda4ad940c4e15679cc2b229838b33acdd36c (patch)
treedd80936c215d1e4bf0ade19c8080707a8b0539c0 /libguile/arrays.c
parentf52fc0566feabe4f1d3ba630287a418606ac30f9 (diff)
downloadguile-e0bcda4ad940c4e15679cc2b229838b33acdd36c.tar.gz
Fix bitvectors and non-zero lower bound arrays in truncated-print
* module/ice-9/arrays.scm (array-print-prefix): New private function. * libguile/arrays.c (scm_i_print_array): Reuse (array-print-prefix) from (ice-9 arrays). Make sure to release the array handle. * module/ice-9/pretty-print.scm (truncated-print): Support bitvectors. Don't try to guess the array prefix but call array-print-prefix from (ice-9 arrays) instead. Fix call to print-sequence to support non-zero lower bound arrays. * test-suite/tests/arrays.test: Test that arrays print properly. * test-suite/tests/print.test: Test truncated-print with bitvectors, non-zero lower bound arrays.
Diffstat (limited to 'libguile/arrays.c')
-rw-r--r--libguile/arrays.c48
1 files changed, 9 insertions, 39 deletions
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 8b8bc48cd..682fbf6b2 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -908,50 +908,17 @@ scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
return 1;
}
-/* Print an array.
-*/
-
int
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
{
scm_t_array_handle h;
- size_t i;
- int print_lbnds = 0, zero_size = 0, print_lens = 0;
+ int d;
+ scm_call_2 (scm_c_private_ref ("ice-9 arrays", "array-print-prefix"),
+ array, port);
+
scm_array_get_handle (array, &h);
- scm_putc ('#', port);
- if (SCM_I_ARRAYP (array))
- scm_intprint (h.ndims, 10, port);
- if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
- scm_write (scm_array_handle_element_type (&h), port);
-
- for (i = 0; i < h.ndims; i++)
- {
- if (h.dims[i].lbnd != 0)
- print_lbnds = 1;
- if (h.dims[i].ubnd - h.dims[i].lbnd + 1 == 0)
- zero_size = 1;
- else if (zero_size)
- print_lens = 1;
- }
-
- if (print_lbnds || print_lens)
- for (i = 0; i < h.ndims; i++)
- {
- if (print_lbnds)
- {
- scm_putc ('@', port);
- scm_intprint (h.dims[i].lbnd, 10, port);
- }
- if (print_lens)
- {
- scm_putc (':', port);
- scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
- 10, port);
- }
- }
-
if (h.ndims == 0)
{
/* Rank zero arrays, which are really just scalars, are printed
@@ -977,10 +944,13 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
scm_putc ('(', port);
scm_i_print_array_dimension (&h, 0, 0, port, pstate);
scm_putc (')', port);
- return 1;
+ d = 1;
}
else
- return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+ d = scm_i_print_array_dimension (&h, 0, 0, port, pstate);
+
+ scm_array_handle_release (&h);
+ return d;
}
void