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

adjust printer for sets from `racket/set' to print in constructor style

Browse Source 
also cooperate with pretty-print
This commit is contained in:
Matthew Flatt 2010-05-24 15:15:03 -06:00
parent 97d078a156
commit 12f2c4fe2e
1 changed files with 49 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/racket/set.rkt
View File

@ -1,5 +1,6 @@
#lang scheme/base
(require (for-syntax scheme/base))
#lang racket/base
(require (for-syntax racket/base)
racket/pretty)
(provide set seteq seteqv
set? set-eq? set-eqv? set-equal?
@ -14,15 +15,53 @@
(define-struct set (ht)
#:omit-define-syntaxes
#:property prop:custom-print-quotable 'never
#:property prop:custom-write
(lambda (s port write?)
(define print (if write? write display))
(write-string "#<set:" port)
(lambda (s port mode)
(define recur-print (cond
[(not mode) display]
[(integer? mode) (lambda (p port) (print p port mode))]
[else write]))
(define (print-prefix port)
(if (equal? 0 mode)
(write-string "(set" port)
(write-string "#<set:" port)))
(define (print-suffix port)
(if (equal? 0 mode)
(write-string ")" port)
(write-string ">" port)))
(define (print-one-line port)
(print-prefix port)
(set-for-each s
(lambda (e)
(write-string " " port)
(print e port)))
(write-string ">" port))
(recur-print e port)))
(print-suffix port))
(define (print-multi-line port)
(let-values ([(line col pos) (port-next-location port)])
(print-prefix port)
(set-for-each s
(lambda (e)
(pretty-print-newline port (pretty-print-columns))
(write-string (make-string (add1 col) #\space) port)
(recur-print e port)))
(print-suffix port)))
(cond
[(and (pretty-printing)
(integer? (pretty-print-columns)))
((let/ec esc
(letrec ([tport (make-tentative-pretty-print-output-port
port
(- (pretty-print-columns) 1)
(lambda ()
(esc
(lambda ()
(tentative-pretty-print-port-cancel tport)
(print-multi-line port)))))])
(print-one-line tport)
(tentative-pretty-print-port-transfer tport port))
void))]
[else (print-one-line port)]))
#:property prop:equal+hash (list
(lambda (set1 set2 =?)
(=? (set-ht set1) (set-ht set2)))