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

correct pretty-print and improve consistency

Browse Source 
Fix a regression in 712494312a, and change other other two printers to
be more consistent for

 #lang racket
 (struct s () #:transparent)
 (define a (s))
 (pretty-print (list (cons a 0) (cons a 0)))
This commit is contained in:
Matthew Flatt 2020-02-03 15:36:38 -07:00
parent c358df6de4
commit 654f821919
4 changed files with 49 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-test-core/tests/racket/print.rktl
View File

@ -20,7 +20,7 @@
(test s to-pretty-string v)
(test (format "~s" v) to-string/not-expression v))])
(define-struct a (x y))
(define-struct b (x y) #:transparent)
(define-struct b (x y) #:transparent #:mutable)
(define-struct c (x y) #:prefab)
(define (custom-printer get-xy)
(lambda (v port mode)
@ -99,6 +99,9 @@
(ptest "(b 1 2)" (b 1 2))
(ptest "'#s(c 1 2)" (c 1 2))
(let ([s (b 1 2)])
(ptest "(list (cons (b 1 2) 0) (cons (b 1 2) 0))" (list (cons s 0) (cons s 0))))
(ptest "'<1 1 2>" (d 1 2))
(ptest "'<1 1 #<a>>" (d 1 (a 1 2)))
(ptest "<0 1 (b 1 2)>" (d 1 (b 1 2)))
@ -436,7 +439,7 @@
#'(let () body ...)]))
(define-struct a (x y))
(define-struct b (x y) #:transparent)
(define-struct b (x y) #:transparent #:mutable)
(define-struct c (x y) #:prefab)
(struct s () #:transparent)
@ -517,6 +520,18 @@
(test-print/all (c 1 2)
"#s(c 1 2)" "#s(c 1 2)" "#s(c 1 2)" "'#s(c 1 2)" "#s(c 1 2)"))
(parameterize ([print-pair-curly-braces #f])
(let ([s (b 1 2)])
(test-print/all (list (cons s 0) (cons s 2))
"((#0=#(struct:b 1 2) . 0) (#0# . 2))" "((#0=#(struct:b 1 2) . 0) (#0# . 2))" "((#0=#(struct:b 1 2) . 0) (#0# . 2))"
"(list (cons #0=(b 1 2) 0) (cons #0# 2))" "((#0=#(struct:b 1 2) . 0) (#0# . 2))"))
(let ([s (b 1 2)])
(set-b-x! s s)
(test-print/all (list s)
"(#0=#(struct:b #0# 2))" "(#0=#(struct:b #0# 2))" "(#0=#(struct:b #0# 2))"
"(list #0=(b #0# 2))"
"(#0=#(struct:b #0# 2))")))
(parameterize ([print-vector-length #t])
(test-print/all (b 1 1)
"#3(struct:b 1)" "#(struct:b 1 1)" "#3(struct:b 1)" "(b 1 1)" "#3(struct:b 1)")
@ -524,6 +539,7 @@
"#3(struct:b 1 2)" "#(struct:b 1 2)" "#3(struct:b 1 2)" "(b 1 2)" "#3(struct:b 1 2)")
(test-print/all (b 'b 'b)
"#3(struct:b b)" "#(struct:b b b)" "#3(struct:b b)" "(b 'b 'b)" "#3(struct:b b)")
(test-print/all (b 'struct:b 'struct:b)
"#3(struct:b)" "#(struct:b struct:b struct:b)" "#3(struct:b)" "(b 'struct:b 'struct:b)" "#3(struct:b)")
(test-print/all (c x x)

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

@ -246,7 +246,7 @@
(lambda (v [o (current-output-port)] #:newline? [n? #t])
(pp v o #:newline? n?))))
(define-struct mark (str def) #:mutable)
(define-struct mark (escapes? str def) #:mutable)
(define-struct hide (val))
(define (make-tentative-output-port pport width esc)
@ -478,7 +478,7 @@
(hash-set! table obj 'in-progress))]
[end-compound! (lambda (obj escapes?)
(when (eq? 'in-progress (hash-ref table obj #f))
(hash-set! table obj 'done))
(hash-set! table obj (if escapes? 'done-escapes 'done)))
escapes?)]
[escapes! (lambda (obj mode)
(and (not (boolean? mode))
@ -494,8 +494,10 @@
;; Note: counting all references as the same quoting mode
(when (eq? g 'in-progress)
(set! found-cycle? #t))
(hash-set! table obj (make-mark #f (box #f)))
#f)]
(unless (mark? g)
(hash-set! table obj (make-mark (eq? g 'done-escapes) #f (box #f))))
(or (eq? g 'done-escapes)
(and (mark? g) (mark-escapes? g))))]
[else
(cond
[(vector? obj)
@ -585,7 +587,7 @@
(when (or found-cycle? print-graph?)
;; Remove unwanted table entries:
(for ([k (in-list (hash-keys table))])
(when (eq? (hash-ref table k #f) 'done)
(unless (mark? (hash-ref table k #f))
(hash-remove! table k)))))
(define cycle-counter 0)

2
racket/src/io/print/graph.rkt
View File

@ -127,7 +127,7 @@
(set! counter (add1 counter))
(when (eq? g 'checking)
(set! cycle? #t)))
#f)]
(as-constructor? g))]
[(pair? v)
(checking! v)
(define car-unquoted? (build-graph (car v) mode))

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

@ -486,11 +486,13 @@ static Scheme_Object *check_cycle_k(void)
p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
return check_cycles(o, p->ku.k.i1, ht, pp)
? scheme_true : scheme_false;
return scheme_make_integer(check_cycles(o, p->ku.k.i1, ht, pp));
}
#endif
#define CHECK_CHECK_HAS_UNQUOTE 0x1
#define CHECK_CHECK_HAS_CYCLE 0x2
static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht, PrintParams *pp)
/* Results: 0x2 = cycle bit
0x1 = unquote bit */
@ -508,7 +510,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
scheme_current_thread->ku.k.p2 = (void *)ht;
scheme_current_thread->ku.k.p3 = (void *)pp;
scheme_current_thread->ku.k.i1 = for_write;
return SCHEME_TRUEP(scheme_handle_stack_overflow(check_cycle_k));
return SCHEME_INT_VAL(scheme_handle_stack_overflow(check_cycle_k));
}
}
#endif
@ -533,24 +535,24 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
val = scheme_hash_get(ht, obj);
if (val)
return SCHEME_INT_VAL(val);
scheme_hash_set(ht, obj, scheme_make_integer(0x2));
scheme_hash_set(ht, obj, scheme_make_integer(CHECK_CHECK_HAS_CYCLE));
} else
return 0;
if (SCHEME_PAIRP(obj)) {
res = check_cycles(SCHEME_CAR(obj), for_write, ht, pp);
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
res2 = check_cycles(SCHEME_CDR(obj), for_write, ht, pp);
res |= res2;
} else if (SCHEME_MUTABLE_PAIRP(obj)) {
res = check_cycles(SCHEME_CAR(obj), for_write, ht, pp);
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
res2 = check_cycles(SCHEME_CDR(obj), for_write, ht, pp);
res |= res2;
if (for_write >= 3)
res |= 0x1; /* always escape for qq printing */
res |= CHECK_CHECK_HAS_UNQUOTE; /* always escape for qq printing */
} else if (SCHEME_CHAPERONE_BOXP(obj)) {
/* got here => printable */
Scheme_Object *v;
@ -575,12 +577,12 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
v = scheme_chaperone_vector_ref(obj, i);
res2 = check_cycles(v, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
}
} else if (SCHEME_FLVECTORP(obj)
|| SCHEME_FXVECTORP(obj)) {
res = 0x1; /* escape for qq printing */
res = CHECK_CHECK_HAS_UNQUOTE; /* escape for qq printing */
} else if (SCHEME_CHAPERONE_STRUCTP(obj)) {
if (scheme_is_writable_struct(obj)) {
if (pp->print_unreadable) {
@ -592,12 +594,12 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
if (kind) {
if (!strcmp(SCHEME_SYM_VAL(kind), "never"))
res |= 0x1;
res |= CHECK_CHECK_HAS_UNQUOTE;
if (!strcmp(SCHEME_SYM_VAL(kind), "always")
|| !strcmp(SCHEME_SYM_VAL(kind), "self"))
res -= (res & 0x1);
res -= (res & CHECK_CHECK_HAS_UNQUOTE);
} else /* = "self" */
res -= (res & 0x1);
res -= (res & CHECK_CHECK_HAS_UNQUOTE);
}
} else
res = 0;
@ -611,7 +613,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
i = SCHEME_STRUCT_NUM_SLOTS(obj);
if ((for_write >= 3) && !SCHEME_PREFABP(obj))
res = 0x1;
res = CHECK_CHECK_HAS_UNQUOTE;
else
res = 0;
while (i--) {
@ -622,7 +624,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
val = ((Scheme_Structure *)obj)->slots[i];
res2 = check_cycles(val, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
}
}
@ -652,11 +654,11 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
if (val) {
res2 = check_cycles(key, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
res2 = check_cycles(val, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
}
}
@ -680,11 +682,11 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht
val = scheme_chaperone_hash_traversal_get(obj, key, &key);
res2 = check_cycles(key, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
res2 = check_cycles(val, for_write, ht, pp);
res |= res2;
if ((for_write < 3) && res)
if ((for_write < 3) && (res & CHECK_CHECK_HAS_CYCLE))
return res;
i = scheme_hash_tree_next(t, i);
}
@ -1114,8 +1116,9 @@ print_to_string(Scheme_Object *obj,
#endif
if ((cycles == -1) || (cycles && (write >= 3))) {
uq_ht = scheme_make_hash_table(SCHEME_hash_ptr);
cycles = check_cycles(obj, write, uq_ht, (PrintParams *)&params);
} else if (!cycles && params.print_graph)
cycles = check_cycles(obj, write, uq_ht, (PrintParams *)&params) & CHECK_CHECK_HAS_CYCLE;
}
if (!cycles && params.print_graph)
cycles = 1;
}