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

Make disabling the custom printer work.

Browse Source
This commit is contained in:
Eric Dobson 2012-08-12 23:14:53 -07:00 committed by Sam Tobin-Hochstadt
parent 124707921f
commit 5f0717d278
3 changed files with 12 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-racket/private/with-types.rkt
View File

@ -67,9 +67,7 @@
[(id ...) exids] [(id ...) exids]
[(ty ...) extys]) [(ty ...) extys])
(local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null)))) (local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null))))
(parameterize (;; disable fancy printing? (parameterize (;; a cheat to avoid units
[custom-printer #t]
;; a cheat to avoid units
[infer-param infer] [infer-param infer]
;; do we report multiple errors ;; do we report multiple errors
[delay-errors? #t] [delay-errors? #t]

4
collects/typed-racket/tc-setup.rkt
View File

@ -39,9 +39,7 @@
(with-handlers (with-handlers
(#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e)))) (#;[(λ (e) (and (exn:fail? e) (not (exn:fail:syntax? e)) (not (exn:fail:filesystem? e))))
(λ (e) (tc-error "Internal Typed Racket Error : ~a" e))]) (λ (e) (tc-error "Internal Typed Racket Error : ~a" e))])
(parameterize (;; enable fancy printing? (parameterize (;; a cheat to avoid units
[custom-printer #t]
;; a cheat to avoid units
[infer-param infer] [infer-param infer]
;; do we report multiple errors ;; do we report multiple errors
[delay-errors? #t] [delay-errors? #t]

21
collects/typed-racket/utils/utils.rkt
View File

@ -7,6 +7,7 @@ at least theoretically.
(require (for-syntax racket/base syntax/parse racket/string) (require (for-syntax racket/base syntax/parse racket/string)
racket/require-syntax racket/provide-syntax racket/require-syntax racket/provide-syntax
racket/generic
racket/struct-info "timing.rkt") racket/struct-info "timing.rkt")
;; to move to unstable ;; to move to unstable
@ -20,7 +21,7 @@ at least theoretically.
;; logging ;; logging
printf/log show-input? printf/log show-input?
;; struct printing ;; struct printing
custom-printer print-multi-line-case-> define-struct/printer print-multi-line-case-> define-struct/printer
;; provide macros ;; provide macros
rep utils typecheck infer env private types) rep utils typecheck infer env private types)
@ -109,7 +110,7 @@ at least theoretically.
#'(void))) #'(void)))
;; custom printing ;; custom printing
(define custom-printer (make-parameter #t)) (define-for-syntax custom-printer #t)
(define print-multi-line-case-> (make-parameter #f)) (define print-multi-line-case-> (make-parameter #f))
(define-syntax (define-struct/printer stx) (define-syntax (define-struct/printer stx)
@ -117,15 +118,13 @@ at least theoretically.
[(form name (flds ...) printer:expr) [(form name (flds ...) printer:expr)
#`(define-struct name (flds ...) #`(define-struct name (flds ...)
#:property prop:custom-print-quotable 'never #:property prop:custom-print-quotable 'never
#:property prop:custom-write ;; Eta expansion so that printer is not evaluated
(lambda (v port write?) ;; until needed.
(if (custom-printer) #,@(if custom-printer
(printer v port write?) #'(#:methods gen:custom-write
;; ok to make this case slow, it never runs in real code [(define (write-proc v port write?)
((if write? (printer v port write?))])
(dynamic-require 'racket/pretty 'pretty-write) #'())
(dynamic-require 'racket/pretty 'pretty-print))
v port)))
#:transparent)])) #:transparent)]))