uses the remapping for determining named-let status now
svn: r7607
This commit is contained in:
parent
426093d85c
commit
96117cc86d
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user