From 614980f6ec32bab5f18aada279d008501ec21898 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 12 Aug 2009 22:05:41 +0000 Subject: [PATCH] fix pr 10097 svn: r15722 --- .../typed-scheme/typecheck/tc-expr-unit.ss | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index b80d8fb32a..80bd8ab466 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -196,8 +196,25 @@ #;(syntax? Type/c . -> . tc-results?) (tc-expr/check form (ret expected))) -;; tc-expr/check : syntax tc-results -> tc-results (define (tc-expr/check form expected) + (parameterize ([current-orig-stx form]) + ;(printf "form: ~a~n" (syntax->datum form)) + ;; the argument must be syntax + (unless (syntax? form) + (int-err "bad form input to tc-expr: ~a" form)) + ;; typecheck form + (let ([ty (cond [(type-ascription form) => (lambda (ann) + (let ([r (tc-expr/check/internal form ann)]) + (check-below r expected) + expected))] + [else (tc-expr/check/internal form expected)])]) + (match ty + [(tc-results: ts fs os) + (let ([ts* (do-inst form ts)]) + (ret ts* fs os))])))) + +;; tc-expr/check : syntax tc-results -> tc-results +(define (tc-expr/check/internal form expected) (parameterize ([current-orig-stx form]) ;(printf "form: ~a~n" (syntax-object->datum form)) ;; the argument must be syntax