From e77ad12feb39537aeae8a8b1a41437f447b406ae Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 18 Jun 2008 16:52:04 -0400
Subject: [PATCH] Add debug macro, and fix check-below to return appropriate
 values.

---
 collects/typed-scheme/private/tc-expr-unit.ss   | 4 +++-
 collects/typed-scheme/private/tc-lambda-unit.ss | 4 ++--
 collects/typed-scheme/private/utils.ss          | 9 ++++++++-
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/tc-expr-unit.ss b/collects/typed-scheme/private/tc-expr-unit.ss
index ec0f5dbe16..207774dadc 100644
--- a/collects/typed-scheme/private/tc-expr-unit.ss
+++ b/collects/typed-scheme/private/tc-expr-unit.ss
@@ -85,6 +85,8 @@
   (match (tc-expr/check e t)
     [(tc-result: t) t]))
 
+;; check-below : (/\ (Result Type -> Result)
+;;                   (Type Type -> Type))
 (define (check-below tr1 expected)
   (match (list tr1 expected)      
     [(list (tc-result: t1 te1 ee1) t2)
@@ -94,7 +96,7 @@
     [(list t1 t2)
      (unless (subtype t1 t2)
        (tc-error/expr"Expected ~a, but got ~a" t2 t1))
-     (ret expected)]))
+     expected]))
 
 (define (tc-expr/check form expected)
   (parameterize ([current-orig-stx form])
diff --git a/collects/typed-scheme/private/tc-lambda-unit.ss b/collects/typed-scheme/private/tc-lambda-unit.ss
index 80c6883603..ea8d5395a8 100644
--- a/collects/typed-scheme/private/tc-lambda-unit.ss
+++ b/collects/typed-scheme/private/tc-lambda-unit.ss
@@ -161,7 +161,7 @@
   (if (and expected
            (= 1 (length (syntax->list formals))))
       ;; special case for not-case-lambda
-      (let loop ([expected expected])
+      (let loop ([expected expected])        
         (match expected          
           [(Mu: _ _) (loop (unfold expected))]
           [(Function: (list (arr: args ret rest #f _ _))) 
@@ -171,7 +171,7 @@
            (for ([args argss] [ret rets] [rest rests])
              (tc/lambda-clause/check (car (syntax->list formals)) (car (syntax->list bodies)) args ret rest))
            expected]
-          [t (let ([t (tc/mono-lambda formals bodies #f)])
+          [t (let ([t (tc/mono-lambda formals bodies #f)])               
                (check-below t expected))]))
       (let loop ([formals (syntax->list formals)] 
                  [bodies (syntax->list bodies)]
diff --git a/collects/typed-scheme/private/utils.ss b/collects/typed-scheme/private/utils.ss
index c582bb0e86..c17417fec5 100644
--- a/collects/typed-scheme/private/utils.ss
+++ b/collects/typed-scheme/private/utils.ss
@@ -14,7 +14,14 @@
          hash-union
          in-pairs
          in-list-forever
-         extend)
+         extend
+         debug)
+
+(define-syntax-rule (debug args)
+  (begin (printf "starting ~a~n" 'args)
+         (let ([e args])
+           (printf "result was ~a~n" e)
+           e)))
 
 (define-syntax (with-syntax* stx)
   (syntax-case stx ()