Convert to syntax-parse.
Use tc-results->values where appropriate. svn: r14891
This commit is contained in:
parent
c4762078e3
commit
06e252b1a1
|
@ -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])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user