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))))
(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 "`")

6
collects/scribble/racket.ss
View File

@ -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

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 *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);