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

reformat pretty.rkt a bit

Browse Source 
#lang instead of module, spaces instead of tabs, other whitespace and
indentation
This commit is contained in:
AlexKnauth 2016-08-13 09:17:47 -05:00 committed by Robby Findler
parent 1478f64c14
commit 1af7ec7088
1 changed files with 1607 additions and 1607 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
racket/collects/racket/pretty.rkt
View File

@ -9,12 +9,12 @@
;; require this module and evaluate:
;; (current-print pretty-print-handler)
(module pretty racket/base
(require racket/private/port
#lang racket/base
(require racket/private/port
racket/flonum
racket/fixnum)
(provide pretty-print
(provide pretty-print
pretty-write
pretty-display
pretty-print-columns
@ -42,9 +42,9 @@
tentative-pretty-print-port-transfer
tentative-pretty-print-port-cancel)
(define-struct pretty-print-style-table (hash))
(define-struct pretty-print-style-table (hash))
(define pretty-print-extend-style-table
(define pretty-print-extend-style-table
(lambda (table symbols like-symbols)
(let ([terr (lambda (kind which)
(raise-argument-error
@ -83,9 +83,9 @@
symbols like-symbols)
(make-pretty-print-style-table new-ht))))
(define pretty-print-abbreviate-read-macros (make-parameter #t))
(define pretty-print-abbreviate-read-macros (make-parameter #t))
(define pretty-print-current-style-table
(define pretty-print-current-style-table
(make-parameter
(pretty-print-extend-style-table #f null null)
(lambda (s)
@ -96,18 +96,18 @@
s))
s)))
(define pretty-print-.-symbol-without-bars
(define pretty-print-.-symbol-without-bars
(make-parameter #f (lambda (x) (and x #t))))
(define pretty-print-show-inexactness
(define pretty-print-show-inexactness
(make-parameter #f
(lambda (x) (and x #t))))
(define pretty-print-exact-as-decimal
(define pretty-print-exact-as-decimal
(make-parameter #f
(lambda (x) (and x #t))))
(define pretty-print-columns
(define pretty-print-columns
(make-parameter 79
(lambda (x)
(unless (or (eq? x 'infinity)
@ -118,7 +118,7 @@
x))
x)))
(define pretty-print-depth
(define pretty-print-depth
(make-parameter #f
(lambda (x)
(unless (or (not x) (number? x))
@ -128,11 +128,11 @@
x))
x)))
(define can-accept-n?
(define can-accept-n?
(lambda (n x)
(procedure-arity-includes? x n)))
(define pretty-print-size-hook
(define pretty-print-size-hook
(make-parameter (lambda (x display? port) #f)
(lambda (x)
(unless (can-accept-n? 3 x)
@ -142,7 +142,7 @@
x))
x)))
(define pretty-print-print-hook
(define pretty-print-print-hook
(make-parameter void
(lambda (x)
(unless (can-accept-n? 3 x)
@ -152,7 +152,7 @@
x))
x)))
(define pretty-print-print-line
(define pretty-print-print-line
(make-parameter (lambda (line port offset width)
(when (and (number? width)
(not (eq? 0 line)))
@ -166,7 +166,7 @@
x))
x)))
(define pretty-print-pre-print-hook
(define pretty-print-pre-print-hook
(make-parameter void
(lambda (x)
(unless (can-accept-n? 2 x)
@ -176,7 +176,7 @@
x))
x)))
(define pretty-print-post-print-hook
(define pretty-print-post-print-hook
(make-parameter void
(lambda (x)
(unless (can-accept-n? 2 x)
@ -186,10 +186,10 @@
x))
x)))
(define pretty-printing
(define pretty-printing
(make-parameter #f (lambda (x) (and x #t))))
(define pretty-print-remap-stylable
(define pretty-print-remap-stylable
(make-parameter (λ (x) #f)
(λ (f)
(unless (can-accept-n? 1 f)
@ -206,7 +206,7 @@
res))
res)))))
(define make-pretty-print
(define make-pretty-print
(lambda (name display? as-qq?)
(letrec ([pretty-print
(case-lambda
@ -239,20 +239,20 @@
[(obj) (pretty-print obj (current-output-port))])])
pretty-print)))
(define pretty-print (make-pretty-print 'pretty-print #f #t))
(define pretty-display (let ([pp (make-pretty-print 'pretty-display #t #f)])
(define pretty-print (make-pretty-print 'pretty-print #f #t))
(define pretty-display (let ([pp (make-pretty-print 'pretty-display #t #f)])
(case-lambda
[(v) (pp v)]
[(v o) (pp v o)])))
(define pretty-write (let ([pp (make-pretty-print 'pretty-write #f #f)])
(define pretty-write (let ([pp (make-pretty-print 'pretty-write #f #f)])
(case-lambda
[(v) (pp v)]
[(v o) (pp v o)])))
(define-struct mark (str def) #:mutable)
(define-struct hide (val))
(define-struct mark (str def) #:mutable)
(define-struct hide (val))
(define (make-tentative-output-port pport width esc)
(define (make-tentative-output-port pport width esc)
(let* ([content null]
[special-ok? (port-writes-special? pport)]
;; The null device counts for us:
@ -309,14 +309,14 @@
0)
esc))))
(define (make-tentative-pretty-print-output-port pport width esc)
(define (make-tentative-pretty-print-output-port pport width esc)
(let ([p (make-tentative-output-port pport width esc)])
(port-write-handler p (port-write-handler pport))
(port-display-handler p (port-display-handler pport))
(port-print-handler p (port-print-handler pport))
p))
(define (make-printing-port port pre-print post-print output-hooked print-line)
(define (make-printing-port port pre-print post-print output-hooked print-line)
(let-values ([(line col pos) (port-next-location port)])
(let* ([orig-counts? (and line col pos)]
[p (if orig-counts?
@ -339,10 +339,10 @@
(print-line (and use-line? line) p offset width))
void)))))
(struct printing-port (port info)
(struct printing-port (port info)
#:property prop:output-port 0)
(define-struct print-port-info (get-content
(define-struct print-port-info (get-content
def-box
pre-print
post-print
@ -350,36 +350,36 @@
print-line
esc))
(define (register-printing-port p info)
(define (register-printing-port p info)
(printing-port p info))
(define (register-printing-port-like p pport)
(define (register-printing-port-like p pport)
(printing-port p (printing-port-info pport)))
(define (get pport selector)
(define (get pport selector)
(selector (printing-port-info pport)))
(define (printing-port-pre-print pport)
(define (printing-port-pre-print pport)
(get pport print-port-info-pre-print))
(define (printing-port-post-print pport)
(define (printing-port-post-print pport)
(get pport print-port-info-post-print))
(define (printing-port-def-box pport)
(define (printing-port-def-box pport)
(get pport print-port-info-def-box))
(define (printing-port-output-hooked pport)
(define (printing-port-output-hooked pport)
(get pport print-port-info-output-hooked))
(define (printing-port-print-line pport)
(define (printing-port-print-line pport)
(get pport print-port-info-print-line))
(define (printing-port-esc pport)
(define (printing-port-esc pport)
(get pport print-port-info-esc))
(define orig-display (port-display-handler (open-output-string)))
(define orig-write (port-write-handler (open-output-string)))
(define orig-display (port-display-handler (open-output-string)))
(define orig-write (port-write-handler (open-output-string)))
(define (pretty-print-newline pport width)
(define (pretty-print-newline pport width)
(let-values ([(l col p) (port-next-location pport)])
((printing-port-print-line pport) #t (or col 0) width)))
(define (tentative-pretty-print-port-transfer a-pport pport)
(define (tentative-pretty-print-port-transfer a-pport pport)
(let ([content ((get a-pport print-port-info-get-content))])
(for-each (lambda (elem)
(if (bytes? elem)
@ -392,10 +392,10 @@
(cadr elem) (caddr elem) (cdddr elem))])))
content)))
(define (tentative-pretty-print-port-cancel pport)
(define (tentative-pretty-print-port-cancel pport)
(set-box! (get pport print-port-info-def-box) #f))
(define (add-spaces n port)
(define (add-spaces n port)
(if (> n 0)
(if (> n 7)
(begin
@ -404,17 +404,17 @@
(write-string " " port 0 n))
(void)))
(define (prefab?! obj v)
(define (prefab?! obj v)
(let ([d (prefab-struct-key obj)])
(and d
(begin
(vector-set! v 0 d)
#t))))
(define-struct unquoted (val))
(define struct-ellipses (string->uninterned-symbol "..."))
(define-struct unquoted (val))
(define struct-ellipses (string->uninterned-symbol "..."))
(define (generic-write obj display? width pport
(define (generic-write obj display? width pport
print-graph? print-struct? print-hash-table? print-vec-length?
print-box? print-as-qq? qq-depth
depth size-hook)
@ -1527,7 +1527,7 @@
(let-values ([(l col p) (port-next-location pport)])
((printing-port-print-line pport) #f col width)))
(define (look-in-style-table raw-head)
(define (look-in-style-table raw-head)
(let ([head (do-remap raw-head)])
(or (hash-ref (pretty-print-style-table-hash
(pretty-print-current-style-table))
@ -1535,14 +1535,14 @@
#f)
head)))
(define (do-remap raw-head)
(define (do-remap raw-head)
(cond
[((pretty-print-remap-stylable) raw-head)
=>
values]
[else raw-head]))
(define (read-macro? l pair? car cdr qd)
(define (read-macro? l pair? car cdr qd)
(define (length1? l) (and (pair? l) (null? (cdr l))))
(and (pretty-print-abbreviate-read-macros)
(let ((head (do-remap (car l))) (tail (cdr l)))
@ -1553,10 +1553,10 @@
(length1? tail))
(else #f)))))
(define (read-macro-body l car cdr)
(define (read-macro-body l car cdr)
(car (cdr l)))
(define (read-macro-prefix l car)
(define (read-macro-prefix l car)
(let ((head (do-remap (car l))))
(case head
((quote) "'")
@ -1568,12 +1568,12 @@
((unsyntax) "#,")
((unsyntax-splicing) "#,@"))))
(define pretty-print-handler
(define pretty-print-handler
(lambda (v)
(unless (void? v)
(pretty-print v))))
(define (number->decimal-string x)
(define (number->decimal-string x)
(cond
[(or (inexact? x)
(integer? x))
@ -1622,7 +1622,7 @@
;; Print as a fraction.
(number->string x)))))))]))
(define (pretty-format t [w (pretty-print-columns)] #:mode [mode 'print])
(define (pretty-format t [w (pretty-print-columns)] #:mode [mode 'print])
(parameterize ([pretty-print-columns w])
(let ([op (open-output-string)])
((case mode
@ -1637,5 +1637,5 @@
(substring s 0 (- (string-length s) 1)))))))
)