From 35b60ceacd5fb9daf68c4a8c676e342ba9ec76b0 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 24 Jan 2014 00:28:04 -0500 Subject: [PATCH] Fix debug printing mode for pretty-printed types Previously, pretty-printing for types would override the debug mode by bypassing normal printing. Instead, switch the `pretty-format-type` function to a debug version when in debug mode. original commit: 8ad0e6b52a260eea4329335d81f282802c2ae1ab --- .../typed-racket/types/printer.rkt | 25 ++++++++++++++++--- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index f99a9342..1996fcb6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -20,13 +20,14 @@ #'(provide (rename-out [debug-printer print-type] [debug-printer print-filter] [debug-printer print-object] - [debug-printer print-pathelem])) - #'(provide print-type print-filter print-object print-pathelem))) + [debug-printer print-pathelem] + [debug-pretty-format-type pretty-format-type])) + #'(provide print-type print-filter print-object print-pathelem + pretty-format-type))) (provide-printer) (provide special-dots-printing? print-complex-filters? - current-print-type-fuel current-print-unexpanded - pretty-format-type) + current-print-type-fuel current-print-unexpanded) ;; do we attempt to find instantiations of polymorphic types to print? @@ -446,3 +447,19 @@ (define-debug-printer debug-printer) +;; debug-pretty-format-type : Type -> String +;; Debugging mode for pretty printing types, which just uses +;; the debug printer above. Ignores kw argument. Only defined +;; in debug printing mode. +(define-syntax (define-debug-pretty-format-type stx) + (syntax-parse stx + [(_ debug-pretty-format-type:id) + (if (eq? printer-type 'debug) + #'(define (debug-pretty-format-type type #:indent [indent 0]) + (define out (open-output-string)) + (debug-printer type out #t) + (get-output-string out)) + #'(void))])) + +(define-debug-pretty-format-type debug-pretty-format-type) +