suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix pr 10097

Browse Source 
svn: r15722
This commit is contained in:
Sam Tobin-Hochstadt 2009-08-12 22:05:41 +00:00
parent 1e5cb7d603
commit 614980f6ec
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -196,8 +196,25 @@
#;(syntax? Type/c . -> . tc-results?) #;(syntax? Type/c . -> . tc-results?)
(tc-expr/check form (ret expected))) (tc-expr/check form (ret expected)))
;; tc-expr/check : syntax tc-results -> tc-results
(define (tc-expr/check form expected) (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]) (parameterize ([current-orig-stx form])
;(printf "form: ~a~n" (syntax-object->datum form)) ;(printf "form: ~a~n" (syntax-object->datum form))
;; the argument must be syntax ;; the argument must be syntax