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

Avoid typechecking multiple times when handling eta expansions.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2015-11-10 12:33:43 -05:00
parent caf62c5fc6
commit aa969302f8
1 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
View File

@ -58,12 +58,16 @@
;; raw-rest: Either #f for no rest argument or (list rest-id rest-type) where rest-id is the
;; identifier of the rest arg, and rest-type is the type.
;; expected: The expected type of the body forms.
;; body-type: if provided, the result of type checking the body (because someone else already did it)
;; body: The body of the lambda to typecheck.
(define/cond-contract
(tc-lambda-body arg-names arg-types #:rest [raw-rest #f] #:expected [expected #f] body)
(tc-lambda-body arg-names arg-types #:rest [raw-rest #f] #:expected [expected #f]
#:body-type [body-type #f]
body)
(->* ((listof identifier?) (listof Type/c) syntax?)
(#:rest (or/c #f (list/c identifier? (or/c Type/c (cons/c Type/c symbol?))))
#:expected (or/c #f tc-results/c))
#:expected (or/c #f tc-results/c)
#:body-type (or/c #f tc-results/c))
arr?)
(define-values (rest-id rest)
(if raw-rest
@ -84,7 +88,7 @@
(with-lexical-env/extend-types
(append rest-names arg-names)
(append rest-types arg-types)
(tc-body/check body expected))
(or body-type (tc-body/check body expected)))
arg-names #:rest-id rest-id)
#:rest (and (Type? rest) rest)
#:drest (and (cons? rest) rest)))
@ -236,14 +240,14 @@
(get-type rest-id #:default Univ)]
;; Lambda with no rest argument
[else #f]))
(define body-t (and eta-expanded? (tc-expr eta-expanded?)))
(cond
;; special case for un-annotated eta-expansions
[(and eta-expanded? (not rest-id) (andmap not arg-types)
;; FIXME: should also handle polymorphic types
;; but we can't return anything but a (listof arr?) here
;; FIXME: sometimes will typecheck the relevant code twice if it doesn't match
;; FIXME: misses optimization opportunities of this code
(match (tc-expr eta-expanded?)
;; FIXME: misses optimization opportunities in this code
(match body-t
[(tc-result1: (Function: arrs))
(define possibles (for*/list ([arr (in-list arrs)]
[restricted (in-value (restrict-to-arity arr (length arg-list)))]
@ -261,6 +265,7 @@
(list
(tc-lambda-body arg-list (map (lambda (v) (or v Univ)) arg-types)
#:rest (and rest-type (list rest-id rest-type))
#:body-type body-t
body))])]))