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

Respect typechecker:called-in-tail-position when calling non-thunks.

Browse Source 
original commit: 52c5d9fde6ae4a9c6208b473d5a208f3bf18d501
This commit is contained in:
Sam Tobin-Hochstadt 2014-03-28 10:05:40 -04:00
parent 24b5bf0edf
commit fed14d647a
2 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt
View File

@ -11,6 +11,7 @@
racket/match)
(provide type-annotation
type-annotation^
get-type
get-types
get-type/infer
@ -44,6 +45,11 @@
(attribute i.type)]
[_ #f]))
(define-syntax-class type-annotation^
[pattern i:id
#:attr type (type-annotation #'i)
#:when (attribute type)])
;(trace type-annotation)
(define (type-ascription stx)

7
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -2,7 +2,7 @@
(require "../utils/utils.rkt"
(except-in (types utils abbrev union filter-ops) -> ->* one-of/c)
(only-in (types abbrev) (-> t:->))
(only-in (types abbrev) (-> t:->) [->* t:->*])
(private type-annotation parse-type syntax-properties)
(env lexical-env type-alias-env type-alias-helper mvar-env
global-env type-env-structs scoped-tvar-env)
@ -302,9 +302,10 @@
;; say that this binding is only called in tail position
(define ((tc-expr-t/maybe-expected expected) e)
(syntax-parse e #:literal-sets (kernel-literals)
[(~and (#%plain-lambda () _) _:tail-position^)
[(~and (#%plain-lambda (fmls:type-annotation^ ...) _) _:tail-position^)
#:when expected
(tc-expr/check e (ret (t:-> (tc-results->values expected))))]
(define arg-tys (attribute fmls.type))
(tc-expr/check e (ret (t:->* arg-tys (tc-results->values expected))))]
[_:tail-position^
#:when expected
(tc-expr/check e expected)]