From db2ed4cef3938f07da5a32cb1b1dcaa9acf69850 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 26 Apr 2010 14:18:43 -0600 Subject: [PATCH] change printer to not quote ellipsis in partially opaque structure --- collects/racket/pretty.rkt | 8 +++++--- collects/scribble/racket.ss | 6 ++++-- src/racket/src/print.c | 11 ++++++++--- 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/collects/racket/pretty.rkt b/collects/racket/pretty.rkt index 5682ac6034..b290856004 100644 --- a/collects/racket/pretty.rkt +++ b/collects/racket/pretty.rkt @@ -403,6 +403,7 @@ #t)))) (define-struct unquoted (val)) + (define struct-ellipses (string->uninterned-symbol "...")) (define (generic-write obj display? width pport print-graph? print-struct? print-hash-table? print-vec-length? @@ -737,7 +738,7 @@ obj pport #t #f #f (lambda () - (let* ([v (struct->vector obj)] + (let* ([v (struct->vector obj struct-ellipses)] [pf? (prefab?! obj v)]) (let ([qd (if pf? (to-quoted out qd "`") @@ -796,7 +797,8 @@ (orig-write obj pport)] [(and qd (or (symbol? obj) (keyword? obj))) - (to-quoted out qd "'") + (unless (eq? obj struct-ellipses) + (to-quoted out qd "'")) (orig-write obj pport)] [(unquoted? obj) (let ([qd (to-unquoted out qd)]) @@ -894,7 +896,7 @@ (let ([qd (to-unquoted out qd)]) (write-custom pp* obj pport depth display? width qd))] [(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)]) (let ([qd (if pf? (to-quoted out qd "`") diff --git a/collects/scribble/racket.ss b/collects/scribble/racket.ss index 397f359984..1ab7e03bf1 100644 --- a/collects/scribble/racket.ss +++ b/collects/scribble/racket.ss @@ -118,6 +118,8 @@ (define-struct (cached-delayed-element delayed-element) (cache-key)) (define-struct (cached-element element) (cache-key)) + (define qq-ellipses (string->uninterned-symbol "...")) + (define (make-id-element c s) (let* ([key (and id-element-cache (let ([b (identifier-label-binding c)]) @@ -201,7 +203,7 @@ is-var?))) (values (substring s 1) #t #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 (if (and (quote-depth . < . 2) (memq (syntax-e c) '(unquote unquote-splicing))) @@ -956,7 +958,7 @@ (if pf (prefab-struct-key v) (object-name v))) - (cdr (vector->list (struct->vector v))))] + (cdr (vector->list (struct->vector v qq-ellipses))))] [else v])]) (if (null? v) null diff --git a/src/racket/src/print.c b/src/racket/src/print.c index 2ff5f6e69d..d452d64dfd 100644 --- a/src/racket/src/print.c +++ b/src/racket/src/print.c @@ -57,6 +57,7 @@ ROSYM Scheme_Object *syntax_symbol; ROSYM Scheme_Object *quasisyntax_symbol; ROSYM Scheme_Object *unsyntax_symbol; ROSYM Scheme_Object *unsyntax_splicing_symbol; +ROSYM Scheme_Object *qq_ellipses; /* Flag for debugging compiled code in printed form: */ #define NO_COMPACT 0 @@ -175,6 +176,7 @@ void scheme_init_print(Scheme_Env *env) REGISTER_SO(quasisyntax_symbol); REGISTER_SO(unsyntax_symbol); REGISTER_SO(unsyntax_splicing_symbol); + REGISTER_SO(qq_ellipses); quote_symbol = scheme_intern_symbol("quote"); quasiquote_symbol = scheme_intern_symbol("quasiquote"); unquote_symbol = scheme_intern_symbol("unquote"); @@ -183,6 +185,7 @@ void scheme_init_print(Scheme_Env *env) quasisyntax_symbol = scheme_intern_symbol("quasisyntax"); unsyntax_symbol = scheme_intern_symbol("unsyntax"); unsyntax_splicing_symbol = scheme_intern_symbol("unsyntax-splicing"); + qq_ellipses = scheme_make_symbol("..."); /* uninterned */ #ifdef MZ_PRECISE_GC register_traversers(); @@ -1836,7 +1839,9 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, const char *s; if (notdisplay >= 3) { - if (notdisplay == 4) { + if (SAME_OBJ(qq_ellipses, obj)) { + /* no quoting */ + } else if (notdisplay == 4) { if (SAME_OBJ(obj, unquote_symbol) || SAME_OBJ(obj, unquote_splicing_symbol)) 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; print_compact(pp, CPT_PREFAB); 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); print_vector(vec, notdisplay, compact, ht, mt, pp, 1); } else if (compact || !pp->print_unreadable) { @@ -2171,7 +2176,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, if (pb) { Scheme_Object *vec, *prefab; 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) { notdisplay = to_unquoted(pp, notdisplay); vec = scheme_vector_to_list(vec);