[Guile-commits] 06/08: Fix bitvectors and non-zero lower bound arrays in truncated-print
lloda pushed a commit to branch wip-lloda in repository guile. commit 1e8293aabfb530e65d3744bb672c9ae9fca5c089 Author: Daniel LlorensDate: Tue Feb 21 12:23:35 2017 +0100 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. --- libguile/arrays.c | 48 +++ module/ice-9/arrays.scm | 40 - module/ice-9/pretty-print.scm | 24 -- test-suite/tests/arrays.test | 55 +++- test-suite/tests/print.test | 58 +-- 5 files changed, 169 insertions(+), 56 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 8b8bc48..682fbf6 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, ); - 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 (), 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 (, 0, 0, port, pstate); scm_putc (')', port); - return 1; + d = 1; } else -return scm_i_print_array_dimension (, 0, 0, port, pstate); +d = scm_i_print_array_dimension (, 0, 0, port, pstate); + + scm_array_handle_release (); + return d; } void diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm index 2c04b2e..f03eb35 100644 --- a/module/ice-9/arrays.scm +++ b/module/ice-9/arrays.scm @@ -17,9 +17,13 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 arrays) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) #:export (array-copy)) -; This is actually defined in boot-9.scm, apparently for b.c. +;; This is actually defined in boot-9.scm, apparently for backwards +;; compatibility. + ;; (define (array-shape a) ;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) ;;(array-dimensions a))) @@ -30,3 +34,37 @@ (array-copy! a b) b)) + +;; Printing arrays + +;; The dimensions aren't printed out unless they cannot be deduced from +;; the content, which happens only when certain axes are empty. #:dims? +;; can be used to force this printing. An array with all the dimensions +;; printed out is still readable syntax, this can be useful for +;; truncated-print. + +(define* (array-print-prefix a port #:key dims?) + (put-char port #\#) + (display (array-rank a) port) + (let ((t (array-type a))) +(unless (eq? #t t) + (display t port))) + (let ((ss (array-shape a))) +(let loop ((s ss) (slos? #f) (szero? #f) (slens? dims?)) + (define lo caar) + (define hi cadar) + (if (null? s) +(when (or slos? slens?) + (pair-for-each (lambda (s) + (when slos? + (put-char port #\@) + (display (lo s) port)) + (when slens? + (put-char port
[Guile-commits] 06/08: Fix bitvectors and non-zero lower bound arrays in truncated-print
lloda pushed a commit to branch wip-exception-truncate in repository guile. commit 954c741c7a24924d632eb2ae91c76988f96732a0 Author: Daniel LlorensDate: Mon Feb 13 14:03:30 2017 +0100 Fix bitvectors and non-zero lower bound arrays in truncated-print * module/ice-9/arrays.scm (array-print-prefix, array-print): New private functions. * 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. --- libguile/arrays.c | 48 ++- module/ice-9/arrays.scm | 66 ++- module/ice-9/pretty-print.scm | 26 +++-- test-suite/tests/arrays.test | 55 +++- test-suite/tests/print.test | 58 +++-- 5 files changed, 196 insertions(+), 57 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 8b8bc48..682fbf6 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, ); - 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 (), 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 (, 0, 0, port, pstate); scm_putc (')', port); - return 1; + d = 1; } else -return scm_i_print_array_dimension (, 0, 0, port, pstate); +d = scm_i_print_array_dimension (, 0, 0, port, pstate); + + scm_array_handle_release (); + return d; } void diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm index 5d5276c..4850522 100644 --- a/module/ice-9/arrays.scm +++ b/module/ice-9/arrays.scm @@ -17,6 +17,8 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 arrays) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) #:export (array-copy typed-array-copy)) ; This is actually defined in boot-9.scm, apparently for b.c. @@ -24,7 +26,7 @@ ;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) ;;(array-dimensions a))) -; FIXME writes over the array twice if (array-type) is #t +;; FIXME writes over the array twice if (array-type) is #t (define (typed-array-copy t a) (let ((b (apply make-typed-array t *unspecified* (array-shape a (array-copy! a b) @@ -33,3 +35,65 @@ (define (array-copy a) (typed-array-copy (array-type a) a)) + +;; Printing arrays +;; FIXME replace scm_i_print_array() when performance allows. + +(define (array-print-prefix a port) + (put-char port #\#) + (display (array-rank a) port) + (let ((t (array-type a))) +(unless (eq? #t t) + (display t port))) + (let ((ss (array-shape a))) +(let loop ((s ss) (slos? #f) (szero? #f) (slens? #f)) + (define lo caar) + (define hi cadar) + (if (null? s) +(when (or slos? slens?) + (pair-for-each (lambda (s) + (when slos? + (put-char port #\@) + (display (lo s) port)) + (when slens? + (put-char port #\:) +
[Guile-commits] 06/08: Fix bitvectors and non-zero lower bound arrays in truncated-print
lloda pushed a commit to branch wip-exception-truncate in repository guile. commit 1053ee0791852ce9cce80798486fcfc15d2a66e3 Author: Daniel LlorensDate: Mon Feb 13 14:03:30 2017 +0100 Fix bitvectors and non-zero lower bound arrays in truncated-print * module/ice-9/arrays.scm (array-print-prefix, array-print): New private functions. * 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. --- libguile/arrays.c | 48 ++- module/ice-9/arrays.scm | 66 ++- module/ice-9/pretty-print.scm | 26 +++-- test-suite/tests/arrays.test | 55 +++- test-suite/tests/print.test | 58 +++-- 5 files changed, 196 insertions(+), 57 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 8b8bc48..682fbf6 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, ); - 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 (), 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 (, 0, 0, port, pstate); scm_putc (')', port); - return 1; + d = 1; } else -return scm_i_print_array_dimension (, 0, 0, port, pstate); +d = scm_i_print_array_dimension (, 0, 0, port, pstate); + + scm_array_handle_release (); + return d; } void diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm index 5d5276c..4850522 100644 --- a/module/ice-9/arrays.scm +++ b/module/ice-9/arrays.scm @@ -17,6 +17,8 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (ice-9 arrays) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) #:export (array-copy typed-array-copy)) ; This is actually defined in boot-9.scm, apparently for b.c. @@ -24,7 +26,7 @@ ;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) ;;(array-dimensions a))) -; FIXME writes over the array twice if (array-type) is #t +;; FIXME writes over the array twice if (array-type) is #t (define (typed-array-copy t a) (let ((b (apply make-typed-array t *unspecified* (array-shape a (array-copy! a b) @@ -33,3 +35,65 @@ (define (array-copy a) (typed-array-copy (array-type a) a)) + +;; Printing arrays +;; FIXME replace scm_i_print_array() when performance allows. + +(define (array-print-prefix a port) + (put-char port #\#) + (display (array-rank a) port) + (let ((t (array-type a))) +(unless (eq? #t t) + (display t port))) + (let ((ss (array-shape a))) +(let loop ((s ss) (slos? #f) (szero? #f) (slens? #f)) + (define lo caar) + (define hi cadar) + (if (null? s) +(when (or slos? slens?) + (pair-for-each (lambda (s) + (when slos? + (put-char port #\@) + (display (lo s) port)) + (when slens? + (put-char port #\:) +