uses the remapping for determining named-let status now

svn: r7607
This commit is contained in:
Robby Findler 2007-11-01 12:34:58 +00:00
parent 426093d85c
commit 96117cc86d

View File

@ -985,7 +985,7 @@
(define (pp-let expr extra depth) (define (pp-let expr extra depth)
(let* ((rest (cdr expr)) (let* ((rest (cdr expr))
(named? (and (pair? rest) (symbol? (car rest))))) (named? (and (pair? rest) (symbol? (do-remap (car rest))))))
(pp-general expr extra named? pp-expr-list #f pp-expr depth))) (pp-general expr extra named? pp-expr-list #f pp-expr depth)))
(define (pp-begin expr extra depth) (define (pp-begin expr extra depth)
@ -1001,7 +1001,7 @@
(define max-call-head-width 5) (define max-call-head-width 5)
(define (style head) (define (style head)
(case (look-in-style-table head) (case (look-in-style-table head)
((lambda λ define define-macro define-syntax ((lambda λ define define-macro define-syntax
syntax-rules syntax-rules
shared shared
@ -1049,18 +1049,20 @@
((printing-port-print-line pport) #f col width))) ((printing-port-print-line pport) #f col width)))
(define (look-in-style-table raw-head) (define (look-in-style-table raw-head)
(let ([head (let ([head (do-remap raw-head)])
(cond
[((pretty-print-remap-stylable) raw-head)
=>
values]
[else raw-head])])
(or (hash-table-get (pretty-print-style-table-hash (or (hash-table-get (pretty-print-style-table-hash
(pretty-print-current-style-table)) (pretty-print-current-style-table))
head head
#f) #f)
head))) head)))
(define (do-remap raw-head)
(cond
[((pretty-print-remap-stylable) raw-head)
=>
values]
[else raw-head]))
(define (read-macro? l) (define (read-macro? l)
(define (length1? l) (and (pair? l) (null? (cdr l)))) (define (length1? l) (and (pair? l) (null? (cdr l))))
(and (pretty-print-abbreviate-read-macros) (and (pretty-print-abbreviate-read-macros)