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

change printer to not quote ellipsis in partially opaque structure

Browse Source
This commit is contained in:
Matthew Flatt 2010-04-26 14:18:43 -06:00
parent 8047e32662
commit db2ed4cef3
3 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/racket/pretty.rkt
View File

@ -403,6 +403,7 @@
#t)))) #t))))
(define-struct unquoted (val)) (define-struct unquoted (val))
(define struct-ellipses (string->uninterned-symbol "..."))
(define (generic-write obj display? width pport (define (generic-write obj display? width pport
print-graph? print-struct? print-hash-table? print-vec-length? print-graph? print-struct? print-hash-table? print-vec-length?
@ -737,7 +738,7 @@
obj pport #t obj pport #t
#f #f #f #f
(lambda () (lambda ()
(let* ([v (struct->vector obj)] (let* ([v (struct->vector obj struct-ellipses)]
[pf? (prefab?! obj v)]) [pf? (prefab?! obj v)])
(let ([qd (if pf? (let ([qd (if pf?
(to-quoted out qd "`") (to-quoted out qd "`")
@ -796,7 +797,8 @@
(orig-write obj pport)] (orig-write obj pport)]
[(and qd (or (symbol? obj) [(and qd (or (symbol? obj)
(keyword? obj))) (keyword? obj)))
(to-quoted out qd "'") (unless (eq? obj struct-ellipses)
(to-quoted out qd "'"))
(orig-write obj pport)] (orig-write obj pport)]
[(unquoted? obj) [(unquoted? obj)
(let ([qd (to-unquoted out qd)]) (let ([qd (to-unquoted out qd)])
@ -894,7 +896,7 @@
(let ([qd (to-unquoted out qd)]) (let ([qd (to-unquoted out qd)])
(write-custom pp* obj pport depth display? width qd))] (write-custom pp* obj pport depth display? width qd))]
[(struct? obj) ; print-struct is on if we got here [(struct? obj) ; print-struct is on if we got here
(let* ([v (struct->vector obj)] (let* ([v (struct->vector obj struct-ellipses)]
[pf? (prefab?! obj v)]) [pf? (prefab?! obj v)])
(let ([qd (if pf? (let ([qd (if pf?
(to-quoted out qd "`") (to-quoted out qd "`")

6
collects/scribble/racket.ss
View File

@ -118,6 +118,8 @@
(define-struct (cached-delayed-element delayed-element) (cache-key)) (define-struct (cached-delayed-element delayed-element) (cache-key))
(define-struct (cached-element element) (cache-key)) (define-struct (cached-element element) (cache-key))
(define qq-ellipses (string->uninterned-symbol "..."))
(define (make-id-element c s) (define (make-id-element c s)
(let* ([key (and id-element-cache (let* ([key (and id-element-cache
(let ([b (identifier-label-binding c)]) (let ([b (identifier-label-binding c)])
@ -201,7 +203,7 @@
is-var?))) is-var?)))
(values (substring s 1) #t #f) (values (substring s 1) #t #f)
(values s #f #f))))]) (values s #f #f))))])
(let ([quote-depth (if (and qq? (identifier? c)) (let ([quote-depth (if (and qq? (identifier? c) (not (eq? qq-ellipses (syntax-e c))))
(let ([quote-depth (let ([quote-depth
(if (and (quote-depth . < . 2) (if (and (quote-depth . < . 2)
(memq (syntax-e c) '(unquote unquote-splicing))) (memq (syntax-e c) '(unquote unquote-splicing)))
@ -956,7 +958,7 @@
(if pf (if pf
(prefab-struct-key v) (prefab-struct-key v)
(object-name v))) (object-name v)))
(cdr (vector->list (struct->vector v))))] (cdr (vector->list (struct->vector v qq-ellipses))))]
[else v])]) [else v])])
(if (null? v) (if (null? v)
null null

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

@ -57,6 +57,7 @@ ROSYM Scheme_Object *syntax_symbol;
ROSYM Scheme_Object *quasisyntax_symbol; ROSYM Scheme_Object *quasisyntax_symbol;
ROSYM Scheme_Object *unsyntax_symbol; ROSYM Scheme_Object *unsyntax_symbol;
ROSYM Scheme_Object *unsyntax_splicing_symbol; ROSYM Scheme_Object *unsyntax_splicing_symbol;
ROSYM Scheme_Object *qq_ellipses;
/* Flag for debugging compiled code in printed form: */ /* Flag for debugging compiled code in printed form: */
#define NO_COMPACT 0 #define NO_COMPACT 0
@ -175,6 +176,7 @@ void scheme_init_print(Scheme_Env *env)
REGISTER_SO(quasisyntax_symbol); REGISTER_SO(quasisyntax_symbol);
REGISTER_SO(unsyntax_symbol); REGISTER_SO(unsyntax_symbol);
REGISTER_SO(unsyntax_splicing_symbol); REGISTER_SO(unsyntax_splicing_symbol);
REGISTER_SO(qq_ellipses);
quote_symbol = scheme_intern_symbol("quote"); quote_symbol = scheme_intern_symbol("quote");
quasiquote_symbol = scheme_intern_symbol("quasiquote"); quasiquote_symbol = scheme_intern_symbol("quasiquote");
unquote_symbol = scheme_intern_symbol("unquote"); unquote_symbol = scheme_intern_symbol("unquote");
@ -183,6 +185,7 @@ void scheme_init_print(Scheme_Env *env)
quasisyntax_symbol = scheme_intern_symbol("quasisyntax"); quasisyntax_symbol = scheme_intern_symbol("quasisyntax");
unsyntax_symbol = scheme_intern_symbol("unsyntax"); unsyntax_symbol = scheme_intern_symbol("unsyntax");
unsyntax_splicing_symbol = scheme_intern_symbol("unsyntax-splicing"); unsyntax_splicing_symbol = scheme_intern_symbol("unsyntax-splicing");
qq_ellipses = scheme_make_symbol("..."); /* uninterned */
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC
register_traversers(); register_traversers();
@ -1836,7 +1839,9 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
const char *s; const char *s;
if (notdisplay >= 3) { if (notdisplay >= 3) {
if (notdisplay == 4) { if (SAME_OBJ(qq_ellipses, obj)) {
/* no quoting */
} else if (notdisplay == 4) {
if (SAME_OBJ(obj, unquote_symbol) if (SAME_OBJ(obj, unquote_symbol)
|| SAME_OBJ(obj, unquote_splicing_symbol)) || SAME_OBJ(obj, unquote_splicing_symbol))
print_utf8_string(pp, ",'", 0, 2); print_utf8_string(pp, ",'", 0, 2);
@ -2156,7 +2161,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
Scheme_Object *vec, *prefab; Scheme_Object *vec, *prefab;
print_compact(pp, CPT_PREFAB); print_compact(pp, CPT_PREFAB);
prefab = ((Scheme_Structure *)obj)->stype->prefab_key; prefab = ((Scheme_Structure *)obj)->stype->prefab_key;
vec = scheme_struct_to_vector(obj, NULL, pp->inspector); vec = scheme_struct_to_vector(obj, (notdisplay >= 3) ? qq_ellipses : NULL, pp->inspector);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CDR(prefab); SCHEME_VEC_ELS(vec)[0] = SCHEME_CDR(prefab);
print_vector(vec, notdisplay, compact, ht, mt, pp, 1); print_vector(vec, notdisplay, compact, ht, mt, pp, 1);
} else if (compact || !pp->print_unreadable) { } else if (compact || !pp->print_unreadable) {
@ -2171,7 +2176,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
if (pb) { if (pb) {
Scheme_Object *vec, *prefab; Scheme_Object *vec, *prefab;
prefab = ((Scheme_Structure *)obj)->stype->prefab_key; prefab = ((Scheme_Structure *)obj)->stype->prefab_key;
vec = scheme_struct_to_vector(obj, NULL, pp->inspector); vec = scheme_struct_to_vector(obj, (notdisplay >= 3) ? qq_ellipses : NULL, pp->inspector);
if ((notdisplay >= 3) && !prefab) { if ((notdisplay >= 3) && !prefab) {
notdisplay = to_unquoted(pp, notdisplay); notdisplay = to_unquoted(pp, notdisplay);
vec = scheme_vector_to_list(vec); vec = scheme_vector_to_list(vec);