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

macro-stepper: fix display of "confusable" objects

Browse Source
This commit is contained in:
Ryan Culpepper 2011-12-01 11:35:00 -07:00
parent e9a5cf05c7
commit 3dc78a3d1e
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/macro-debugger/syntax-browser/pretty-helper.rkt
View File

@ -20,6 +20,9 @@
;; If they were always wrapped, the pretty-printer would screw up ;; If they were always wrapped, the pretty-printer would screw up
;; list printing (I think). ;; list printing (I think).
;; UPDATE: In fact, want to treat all atomic values as confusable. The recent
;; reader change (interning strings, etc) highlights the issue.
(define (pretty-print/defaults datum [port (current-output-port)]) (define (pretty-print/defaults datum [port (current-output-port)])
(parameterize (parameterize
(;; Printing parameters (defaults from MzScheme and DrScheme 4.2.2.2) (;; Printing parameters (defaults from MzScheme and DrScheme 4.2.2.2)
@ -103,30 +106,30 @@
(hash-set! flat=>stx lp-datum obj) (hash-set! flat=>stx lp-datum obj)
(hash-set! stx=>flat obj lp-datum) (hash-set! stx=>flat obj lp-datum)
lp-datum)] lp-datum)]
;; -- Traversable structures
[(pair? obj) [(pair? obj)
(pairloop obj)] (pairloop obj)]
[(struct? obj) [(prefab-struct-key obj)
;; Only traverse prefab structs => (lambda (pkey)
(let ([pkey (prefab-struct-key obj)])
(if pkey
(let-values ([(refold fields) (unfold-pstruct obj)]) (let-values ([(refold fields) (unfold-pstruct obj)])
(refold (map loop fields))) (refold (map loop fields))))]
obj))]
[(symbol? obj)
(make-id-syntax-dummy obj obj)]
[(null? obj)
(make-syntax-dummy obj)]
[(boolean? obj)
(make-syntax-dummy obj)]
[(number? obj)
(make-syntax-dummy obj)]
[(keyword? obj)
(make-syntax-dummy obj)]
[(vector? obj) [(vector? obj)
(list->vector (map loop (vector->list obj)))] (list->vector (map loop (vector->list obj)))]
[(box? obj) [(box? obj)
(box (loop (unbox obj)))] (box (loop (unbox obj)))]
[else obj])) [(hash? obj)
(let ([constructor
(cond [(hash-equal? obj) make-immutable-hash]
[(hash-eqv? obj) make-immutable-hasheqv]
[(hash-eq? obj) make-immutable-hasheq])])
(constructor
(for/list ([(k v) (in-hash obj)])
(cons k (loop v)))))]
;; -- Atoms ("confusable")
[(symbol? obj)
(make-id-syntax-dummy obj obj)]
[else ;; null, boolean, number, keyword, string, bytes, char, regexp, 3D vals
(make-syntax-dummy obj)]))
(define (pairloop obj) (define (pairloop obj)
(cond [(pair? obj) (cond [(pair? obj)
(cons (loop (car obj)) (cons (loop (car obj))