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

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

@ -454,11 +454,13 @@
(loop (sub1 i) (cons (v-ref v i) r)))))))))))) (loop (sub1 i) (cons (v-ref v i) r))))))))))))
->list))) ->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 vector->repeatless-list vector-length vector-ref eq? vector->list)
(mkvector->repeatless-list flvector->repeatless-list flvector-length flvector-ref equal? (mkvector->repeatless-list flvector->repeatless-list flvector-length flvector-ref equal? flvector->list)
(lambda (v) (for/list ([x (in-flvector v)]) x))) (mkvector->repeatless-list fxvector->repeatless-list fxvector-length fxvector-ref eq? fxvector->list)
(mkvector->repeatless-list fxvector->repeatless-list fxvector-length fxvector-ref eq?
(lambda (v) (for/list ([x (in-fxvector v)]) x)))
(define (extract-sub-objects obj pport) (define (extract-sub-objects obj pport)
(let ([p (open-output-nowhere 'null (port-writes-special? pport))] (let ([p (open-output-nowhere 'null (port-writes-special? pport))]
@ -876,44 +878,44 @@
obj pport #t obj pport #t
#f #f #f #f
(lambda () (lambda ()
(let ([qd (to-quoted out qd obj)] (let ([qd (to-quoted out qd obj)])
[vecl (vector->repeatless-list obj)])
(if (and qd (zero? qd)) (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) #f depth pair? car cdr "(" ")" qd)
(begin (begin
(out "#") (out "#")
(when print-vec-length? (when print-vec-length?
(out (number->string (vector-length obj)))) (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) [(flvector? obj)
(check-expr-found (check-expr-found
obj pport #t obj pport #t
#f #f #f #f
(lambda () (lambda ()
(let ([vecl (flvector->repeatless-list obj)]) (if (and qd (zero? qd))
(if (and qd (zero? qd)) (wr-lst (cons (make-unquoted 'flvector) (flvector->list obj))
(wr-lst (cons (make-unquoted 'flvector) vecl) #f depth pair? car cdr "(" ")" qd)
#f depth pair? car cdr "(" ")" qd) (begin
(begin (out "#fl")
(out "#fl") (when print-vec-length?
(when print-vec-length? (out (number->string (flvector-length obj))))
(out (number->string (flvector-length obj)))) (wr-lst (flvector->repeatless-list obj)
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))] #f depth pair? car cdr "(" ")" qd)))))]
[(fxvector? obj) [(fxvector? obj)
(check-expr-found (check-expr-found
obj pport #t obj pport #t
#f #f #f #f
(lambda () (lambda ()
(let ([vecl (fxvector->repeatless-list obj)]) (if (and qd (zero? qd))
(if (and qd (zero? qd)) (wr-lst (cons (make-unquoted 'fxvector) (fxvector->list obj))
(wr-lst (cons (make-unquoted 'fxvector) vecl) #f depth pair? car cdr "(" ")" qd)
#f depth pair? car cdr "(" ")" qd) (begin
(begin (out "#fx")
(out "#fx") (when print-vec-length?
(when print-vec-length? (out (number->string (fxvector-length obj))))
(out (number->string (fxvector-length obj)))) (wr-lst (fxvector->repeatless-list obj)
(wr-lst vecl #f depth pair? car cdr "(" ")" qd))))))] #f depth pair? car cdr "(" ")" qd)))))]
[(and (box? obj) [(and (box? obj)
print-box?) print-box?)
(check-expr-found (check-expr-found
@ -1107,48 +1109,48 @@
mpair? mcar mcdr mpair-open mpair-close mpair? mcar mcdr mpair-open mpair-close
qd))] qd))]
[(vector? obj) [(vector? obj)
(let ([qd (to-quoted out qd obj)] (let ([qd (to-quoted out qd obj)])
[vecl (vector->repeatless-list obj)])
(if (and qd (zero? qd)) (if (and qd (zero? qd))
(pp-pair (cons (make-unquoted 'vector) vecl) (pp-pair (cons (make-unquoted 'vector) (vector->list obj))
extra depth extra depth
pair? car cdr pair-open pair-close pair? car cdr pair-open pair-close
qd) qd)
(begin (begin
(out "#") (out "#")
(when print-vec-length? (when print-vec-length?
(out (number->string (vector-length obj)))) (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 pair? car cdr pair-open pair-close
qd))))] qd))))]
[(flvector? obj) [(flvector? obj)
(let ([vecl (flvector->repeatless-list obj)]) (if (and qd (zero? qd))
(if (and qd (zero? qd)) (pp-pair (cons (make-unquoted 'flvector) (flvector->list obj))
(pp-pair (cons (make-unquoted 'flvector) vecl) extra depth
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 pair? car cdr pair-open pair-close
qd) 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))))]
[(fxvector? obj) [(fxvector? obj)
(let ([vecl (fxvector->repeatless-list obj)]) (if (and qd (zero? qd))
(if (and qd (zero? qd)) (pp-pair (cons (make-unquoted 'fxvector) (fxvector->list obj))
(pp-pair (cons (make-unquoted 'fxvector) vecl) extra depth
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 pair? car cdr pair-open pair-close
qd) 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))))]
[(and (custom-write? obj) [(and (custom-write? obj)
(not (struct-type? obj))) (not (struct-type? obj)))
(let ([qd (let ([kind (if (custom-print-quotable? 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); } while(0);
#define F_0 print_utf8_string(pp, "#0(", 0, 3) #define F_0 print_utf8_string(pp, "#0(", 0, 3)
#define F_D sprintf(buffer, "#%d(", size) #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 F_ print_utf8_string(pp, "#(", 0, 2)
#define PRINT_ELM() do {\ #define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \ 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 DO_ELM_SELECTOR() elem = SCHEME_FLVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fl0(", 0, 5) #define F_0 print_utf8_string(pp, "#fl0(", 0, 5)
#define F_D sprintf(buffer, "#fl%d(", size) #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 F_ print_utf8_string(pp, "#fl(", 0, 4)
#define PRINT_ELM() do {\ #define PRINT_ELM() do {\
print_utf8_string(pp, scheme_double_to_string(elem, buffer, 100, 0, &used_buffer), 0, -1); \ 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 DO_ELM_SELECTOR() elem = SCHEME_FXVEC_ELS(vec)[i];
#define F_0 print_utf8_string(pp, "#fx0(", 0, 5) #define F_0 print_utf8_string(pp, "#fx0(", 0, 5)
#define F_D sprintf(buffer, "#fx%d(", size) #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 F_ print_utf8_string(pp, "#fx(", 0, 4)
#define PRINT_ELM() do {\ #define PRINT_ELM() do {\
print(elem, notdisplay, compact, ht, mt, pp); \ 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); print_utf8_string(pp, buffer, 0, -1);
size -= common; size -= common;
} }
} else if (notdisplay == 3) } else if (notdisplay == 3) {
F_VECTOR; F_VECTOR;
else if (size)
print_utf8_string(pp, " ", 0, 1);
} else
F_; F_;
} }