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

pretty-print: make check for escape points linear in input

Browse Source
This commit is contained in:
Matthew Flatt 2011-01-04 10:37:33 -07:00
parent 3bb120545f
commit 9fa957e780
1 changed files with 64 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/racket/pretty.rkt
View File

@ -560,22 +560,29 @@
(define escapes-table
(let* ([table (make-hasheq)]
[local-cycle (and found-cycle (make-hasheq))]
[local-compound (and print-as-qq?
(make-hasheq))]
[is-compound! (lambda (obj)
(hash-set! local-compound obj #t))]
[escapes! (lambda (obj)
(hash-set! table obj #t)
#t)]
[orf (lambda (a b) (or a b))])
(and print-as-qq?
(when print-as-qq?
(let loop ([obj obj])
(if (and local-cycle (hash-ref local-cycle obj #f))
#f
(begin
(when local-cycle
(hash-set! local-cycle obj #t))
(begin0
(cond
[ #f]
[(hash-ref table obj #f)
;; already decided that it escapes
#t]
[(and local-compound
(hash-ref local-compound obj #f))
;; either still deciding (so assume #f) or
;; already decided that no escape is needed
#f]
[else
(cond
[(vector? obj)
(is-compound! obj)
(let ([len (vector-length obj)])
(let vloop ([esc? #f][i 0])
(if (= i len)
@ -584,19 +591,23 @@
(vloop (or (loop (vector-ref obj i)) esc?)
(add1 i)))))]
[(pair? obj)
(is-compound! obj)
(and (orf (loop (car obj))
(loop (cdr obj)))
(escapes! obj))]
[(mpair? obj)
(is-compound! obj)
(loop (mcar obj))
(loop (mcdr obj))
;; always unquoted:
#t]
[(and (box? obj) print-box?)
(is-compound! obj)
(and (loop (unbox obj))
(escapes! obj))]
[(and (custom-write? obj)
(not (struct-type? obj)))
(is-compound! obj)
(let ([kind (if (custom-print-quotable? obj)
(custom-print-quotable-accessor obj)
'self)])
@ -605,18 +616,18 @@
(memq kind '(never)))
(escapes! obj)))]
[(struct? obj)
(is-compound! obj)
(and (or (loop (struct->vector obj))
(not (prefab-struct-key obj)))
(escapes! obj))]
[(hash? obj)
(is-compound! obj)
(and (for/fold ([esc? #f]) ([(k v) (in-hash obj)])
(or (orf (loop v)
(loop k))
esc?))
(escapes! obj))]
[else #f])
(when local-cycle
(hash-remove! local-cycle obj)))))))
[else #f])])))
table))
(define cycle-counter 0)