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

Don't special-case applications with instantiations.

Browse Source 
Closes PR 13006.
This commit is contained in:
Sam Tobin-Hochstadt 2012-08-14 11:57:14 -04:00
parent 3b6168de7d
commit ade36c36c6
4 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -1508,6 +1508,10 @@
Univ] Univ]
[tc-e ((inst vector Index) 0) [tc-e ((inst vector Index) 0)
(-vec -Index)] (-vec -Index)]
[tc-err ((inst list Void) 1 2 3)]
[tc-e ((inst list Any) 1 2 3)
(-lst Univ)]
) )
(test-suite (test-suite
"check-type tests" "check-type tests"

5
collects/typed-racket/typecheck/tc-app-helper.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base #lang racket/base
(require "../utils/utils.rkt" racket/match unstable/list unstable/sequence (require "../utils/utils.rkt" racket/match unstable/list unstable/sequence
syntax/parse
(only-in srfi/1 unzip4) (only-in racket/list make-list) (only-in srfi/1 unzip4) (only-in racket/list make-list)
(prefix-in c: racket/contract) (prefix-in c: racket/contract)
"check-below.rkt" "tc-subst.rkt" "check-below.rkt" "tc-subst.rkt"
@ -10,6 +11,10 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define-syntax-class special-op
(pattern i:identifier
#:when (or (syntax-property #'i 'type-inst)
(syntax-property #'i 'type-ascription))))
;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results? ;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results?
(define/cond-contract (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t]) (define/cond-contract (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])

4
collects/typed-racket/typecheck/tc-app.rkt
View File

@ -275,6 +275,8 @@
vector-ref unsafe-vector-ref unsafe-vector*-ref vector-ref unsafe-vector-ref unsafe-vector*-ref
vector-set! unsafe-vector-set! unsafe-vector*-set! vector-set! unsafe-vector-set! unsafe-vector*-set!
unsafe-struct-ref unsafe-struct*-ref unsafe-struct-set! unsafe-struct*-set!) unsafe-struct-ref unsafe-struct*-ref unsafe-struct-set! unsafe-struct*-set!)
;; bail out immediately if we have one of these
[(#%plain-app rator:special-op . rands) (tc/app/regular form expected)]
[(#%plain-app extend-parameterization pmz args ...) [(#%plain-app extend-parameterization pmz args ...)
(let loop ([args (syntax->list #'(args ...))]) (let loop ([args (syntax->list #'(args ...))])
(if (null? args) (ret Univ) (if (null? args) (ret Univ)
@ -525,7 +527,7 @@
(tc/let-values #'((x) ... (rst)) #`(fixed-args ... varg) #'body (tc/let-values #'((x) ... (rst)) #`(fixed-args ... varg) #'body
#'(let-values ([(x) fixed-args] ... [(rst) varg]) . body) #'(let-values ([(x) fixed-args] ... [(rst) varg]) . body)
expected)))] expected)))]
[else (tc/app/regular form expected)]))) [_ (tc/app/regular form expected)])))
(define (tc/app/regular form expected) (define (tc/app/regular form expected)
(syntax-parse form #:literals (#%plain-app) (syntax-parse form #:literals (#%plain-app)

6
collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt
View File

@ -91,12 +91,6 @@
(single-value val-e) (single-value val-e)
(index-error i-val i-bound i-e vec-t expected) name])) (index-error i-val i-bound i-e vec-t expected) name]))
(define-syntax-class special-op
(pattern i:identifier
#:when (or (syntax-property #'i 'type-inst)
(syntax-property #'i 'type-ascription))))
(define (tc/app-hetero form expected) (define (tc/app-hetero form expected)
(syntax-parse form (syntax-parse form
#:literals (#%plain-app #:literals (#%plain-app