suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix pretty-print when print-vector-length is enabled

Browse Source 
In some cases, (vector x 2 3 3 3) was pretty-printed as "(vector x 2 3)" when
print-vector-length was enabled.

Also print "(fxvector)" instead of "(fxvector )".
This commit is contained in:
Gustavo Massaccesi 2019-07-24 12:26:09 -03:00
parent 89e1ba55a5
commit 964e998d70
3 changed files with 64 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
racket/collects/racket/pretty.rkt
View File

@ -454,11 +454,13 @@
(loop (sub1 i) (cons (v-ref v i) r))))))))))))
->list)))
(define (flvector->list v)
(for/list ([x (in-flvector v)]) x))
(define (fxvector->list v)
(for/list ([x (in-fxvector v)]) x))
(mkvector->repeatless-list vector->repeatless-list vector-length vector-ref eq? vector->list)
(mkvector->repeatless-list flvector->repeatless-list flvector-length flvector-ref equal?
(lambda (v) (for/list ([x (in-flvector v)]) x)))
(mkvector->repeatless-list fxvector->repeatless-list fxvector-length fxvector-ref eq?
(lambda (v) (for/list ([x (in-fxvector v)]) x)))
(mkvector->repeatless-list flvector->repeatless-list flvector-length flvector-ref equal? flvector->list)
(mkvector->repeatless-list fxvector->repeatless-list fxvector-length fxvector-ref eq? fxvector->list)
(define (extract-sub-objects obj pport)
(let ([p (open-output-nowhere 'null (port-writes-special? pport))]
@ -876,44 +878,44 @@
obj pport #t
#f #f
(lambda ()
(let ([qd (to-quoted out qd obj)]
[vecl (vector->repeatless-list obj)])
(let ([qd (to-quoted out qd obj)])
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'vector) vecl)
(wr-lst (cons (make-unquoted 'vector) (vector->list obj))
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#")
(when print-vec-length?
(out (number->string (vector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
(wr-lst (vector->repeatless-list obj)
#f depth pair? car cdr "(" ")" qd))))))]
[(flvector? obj)
(check-expr-found
obj pport #t
#f #f
(lambda ()
(let ([vecl (flvector->repeatless-list obj)])
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'flvector) vecl)
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'flvector) (flvector->list obj))
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(wr-lst (flvector->repeatless-list obj)
#f depth pair? car cdr "(" ")" qd)))))]
[(fxvector? obj)
(check-expr-found
obj pport #t
#f #f
(lambda ()
(let ([vecl (fxvector->repeatless-list obj)])
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'fxvector) vecl)
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))]
(if (and qd (zero? qd))
(wr-lst (cons (make-unquoted 'fxvector) (fxvector->list obj))
#f depth pair? car cdr "(" ")" qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(wr-lst (fxvector->repeatless-list obj)
#f depth pair? car cdr "(" ")" qd)))))]
[(and (box? obj)
print-box?)
(check-expr-found
@ -1107,10 +1109,9 @@
mpair? mcar mcdr mpair-open mpair-close
qd))]
[(vector? obj)
(let ([qd (to-quoted out qd obj)]
[vecl (vector->repeatless-list obj)])
(let ([qd (to-quoted out qd obj)])
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'vector) vecl)
(pp-pair (cons (make-unquoted 'vector) (vector->list obj))
extra depth
pair? car cdr pair-open pair-close
qd)
@ -1118,37 +1119,38 @@
(out "#")
(when print-vec-length?
(out (number->string (vector-length obj))))
(pp-list vecl extra pp-expr #f depth
(pp-list (vector->repeatless-list obj)
extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
[(flvector? obj)
(let ([vecl (flvector->repeatless-list obj)])
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'flvector) vecl)
extra depth
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'flvector) (flvector->list obj))
extra depth
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(pp-list (flvector->repeatless-list obj)
extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fl")
(when print-vec-length?
(out (number->string (flvector-length obj))))
(pp-list vecl extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
qd)))]
[(fxvector? obj)
(let ([vecl (fxvector->repeatless-list obj)])
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'fxvector) vecl)
extra depth
(if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'fxvector) (fxvector->list obj))
extra depth
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(pp-list (fxvector->repeatless-list obj)
extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd)
(begin
(out "#fx")
(when print-vec-length?
(out (number->string (fxvector-length obj))))
(pp-list vecl extra pp-expr #f depth
pair? car cdr pair-open pair-close
qd))))]
qd)))]
[(and (custom-write? obj)
(not (struct-type? obj)))
(let ([qd (let ([kind (if (custom-print-quotable? obj)

6
racket/src/racket/src/print.c
View File

@ -3657,7 +3657,7 @@ print_pair(Scheme_Object *pair, int notdisplay, int compact,
} while(0);
#define F_0 print_utf8_string(pp, "#0(", 0, 3)
#define F_D sprintf(buffer, "#%d(", size)
#define F_VECTOR print_utf8_string(pp, "(vector ", 0, 8)
#define F_VECTOR print_utf8_string(pp, "(vector", 0, 7)
#define F_ print_utf8_string(pp, "#(", 0, 2)
#define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \
@ -3677,7 +3677,7 @@ print_pair(Scheme_Object *pair, int notdisplay, int compact,
#define DO_ELM_SELECTOR() elem = SCHEME_FLVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fl0(", 0, 5)
#define F_D sprintf(buffer, "#fl%d(", size)
#define F_VECTOR print_utf8_string(pp, "(flvector ", 0, 10)
#define F_VECTOR print_utf8_string(pp, "(flvector", 0, 9)
#define F_ print_utf8_string(pp, "#fl(", 0, 4)
#define PRINT_ELM() do {\
print_utf8_string(pp, scheme_double_to_string(elem, buffer, 100, 0, &used_buffer), 0, -1); \
@ -3697,7 +3697,7 @@ print_pair(Scheme_Object *pair, int notdisplay, int compact,
#define DO_ELM_SELECTOR() elem = SCHEME_FXVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fx0(", 0, 5)
#define F_D sprintf(buffer, "#fx%d(", size)
#define F_VECTOR print_utf8_string(pp, "(fxvector ", 0, 10)
#define F_VECTOR print_utf8_string(pp, "(fxvector", 0, 9)
#define F_ print_utf8_string(pp, "#fx(", 0, 4)
#define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \

6
racket/src/racket/src/print_vector.inc
View File

@ -32,9 +32,11 @@ FUNC_NAME (Scheme_Object *vec, int notdisplay, int compact,
print_utf8_string(pp, buffer, 0, -1);
size -= common;
}
} else if (notdisplay == 3)
} else if (notdisplay == 3) {
F_VECTOR;
else
if (size)
print_utf8_string(pp, " ", 0, 1);
} else
F_;
}