From c11338c8830f3f388889258d1ef15cd0e48f4f06 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 19 Apr 2011 15:46:19 -0400 Subject: [PATCH] Add debugging parameter, and wrappers for unstable/debug. original commit: eaa63f2d1ef6c0fdec45b504aa6f2f7bcd07b2b5 --- collects/typed-scheme/tc-setup.rkt | 3 ++- collects/typed-scheme/utils/utils.rkt | 8 ++++++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-scheme/tc-setup.rkt index 04f05fdb..0fc8b301 100644 --- a/collects/typed-scheme/tc-setup.rkt +++ b/collects/typed-scheme/tc-setup.rkt @@ -57,7 +57,8 @@ (do-time "Local Expand Done") (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)] [orig-module-stx (or (orig-module-stx) orig-stx)] - [expanded-module-stx fully-expanded-stx]) + [expanded-module-stx fully-expanded-stx] + [debugging? #f]) (let ([result (checker fully-expanded-stx)]) (do-time "Typechecking Done") . body))))))) diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt index 47712145..2ac08d1f 100644 --- a/collects/typed-scheme/utils/utils.rkt +++ b/collects/typed-scheme/utils/utils.rkt @@ -7,11 +7,11 @@ at least theoretically. (require (for-syntax racket/base syntax/parse racket/string) racket/contract racket/require-syntax - racket/provide-syntax racket/unit + racket/provide-syntax racket/unit (prefix-in d: unstable/debug) racket/pretty mzlib/pconvert syntax/parse) ;; to move to unstable -(provide reverse-begin list-update list-set) +(provide reverse-begin list-update list-set debugf debugging? dprintf) (provide ;; optimization @@ -226,3 +226,7 @@ at least theoretically. (if (zero? k) (cons v (cdr l)) (cons (car l) (list-set (cdr l) (sub1 k) v)))) + +(define debugging? (make-parameter #f)) +(define-syntax-rule (debugf f . args) (if (debugging?) (d:debugf f . args) (f . args))) +(define (dprintf . args) (when (debugging?) (apply d:dprintf args)))