Convert to syntax-parse.

Use tc-results->values where appropriate.

svn: r14891
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-20 23:54:14 +00:00
parent c4762078e3
commit 06e252b1a1

View File

@ -1,14 +1,14 @@
#lang scheme/unit #lang scheme/unit
(require (rename-in "../utils/utils.ss" [infer r:infer])) (require (rename-in "../utils/utils.ss" [infer r:infer]))
(require "signatures.ss" (require "signatures.ss" "tc-metafunctions.ss"
(types utils convenience) (types utils convenience)
(private type-annotation parse-type) (private type-annotation parse-type)
(env lexical-env type-alias-env type-env) (env lexical-env type-alias-env type-env)
syntax/free-vars syntax/free-vars
mzlib/trace mzlib/trace
scheme/match scheme/match
syntax/kerncase syntax/kerncase stxclass
(for-template (for-template
scheme/base scheme/base
"internal-forms.ss")) "internal-forms.ss"))
@ -90,11 +90,10 @@
;; this is so match can provide us with a syntax property to ;; this is so match can provide us with a syntax property to
;; say that this binding is only called in tail position ;; say that this binding is only called in tail position
(define ((tc-expr-t/maybe-expected expected) e) (define ((tc-expr-t/maybe-expected expected) e)
(kernel-syntax-case e #f (syntax-parse e #:literals (#%plain-lambda)
[(#%plain-lambda () _) [(#%plain-lambda () _)
(and expected (syntax-property e 'typechecker:called-in-tail-position)) #:when (and expected (syntax-property e 'typechecker:called-in-tail-position))
(begin (tc-expr/check e (ret (-> (tc-results->values expected))))]
(tc-expr/check e (ret (-> expected))))]
[_ (tc-expr e)])) [_ (tc-expr e)]))
(define (tc/let-values namess exprs body form [expected #f]) (define (tc/let-values namess exprs body form [expected #f])