From a29f10633f5ff7434b1ae25972b04c3c8962c8a4 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 4 Aug 2010 15:08:27 -0400 Subject: [PATCH] Added another tracing option to TR. original commit: 0b3c637f5d5215e3fced3e83433119524145b488 --- collects/typed-scheme/tc-setup.rkt | 3 +++ collects/typed-scheme/utils/utils.rkt | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-scheme/tc-setup.rkt index e3288fe8..04f05fdb 100644 --- a/collects/typed-scheme/tc-setup.rkt +++ b/collects/typed-scheme/tc-setup.rkt @@ -3,6 +3,7 @@ (require (rename-in "utils/utils.rkt" [infer r:infer]) (except-in syntax/parse id) unstable/mutated-vars + racket/pretty scheme/base (private type-contract) (types utils convenience) @@ -51,6 +52,8 @@ [type-name-references null]) (do-time "Initialized Envs") (let ([fully-expanded-stx (local-expand stx expand-ctxt null)]) + (when (show-input?) + (pretty-print (syntax->datum fully-expanded-stx))) (do-time "Local Expand Done") (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)] [orig-module-stx (or (orig-module-stx) orig-stx)] diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt index afed7b55..47c621d1 100644 --- a/collects/typed-scheme/utils/utils.rkt +++ b/collects/typed-scheme/utils/utils.rkt @@ -19,7 +19,7 @@ at least theoretically. ;; timing start-timing do-time ;; logging - printf/log + printf/log show-input? ;; struct printing custom-printer define-struct/printer ;; provide macros @@ -27,6 +27,7 @@ at least theoretically. (define optimize? (make-parameter #f)) (define-for-syntax enable-contracts? #f) +(define show-input? (make-parameter #f)) ;; fancy require syntax (define-syntax (define-requirer stx)