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

Register scoped type variables for internal def. annotations.

Browse Source 
Closes PR 13793.
This commit is contained in:
Sam Tobin-Hochstadt 2013-05-28 17:28:22 -04:00
parent 64df4cef13
commit 499bcefa1d
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-racket/succeed/internal-scoped-tvar.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang typed/racket/base
(let ()
(: f : (All (A) (A -> A)))
(define (f x) ((inst values A) x))
7)

13
collects/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -5,7 +5,7 @@
(except-in (types utils abbrev union) -> ->* one-of/c) (except-in (types utils abbrev union) -> ->* one-of/c)
(only-in (types abbrev) (-> t:->)) (only-in (types abbrev) (-> t:->))
(private type-annotation parse-type) (private type-annotation parse-type)
(env lexical-env type-alias-env global-env type-env-structs) (env lexical-env type-alias-env global-env type-env-structs scoped-tvar-env)
(rep type-rep filter-rep object-rep) (rep type-rep filter-rep object-rep)
syntax/free-vars syntax/free-vars
(typecheck signatures tc-metafunctions tc-subst check-below) (typecheck signatures tc-metafunctions tc-subst check-below)
@ -112,15 +112,24 @@
[exprs (syntax->list exprs)] [exprs (syntax->list exprs)]
;; the clauses for error reporting ;; the clauses for error reporting
[clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])]) [clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])])
;; collect the declarations, which are represented as definitions
(for-each (lambda (names body) (for-each (lambda (names body)
(kernel-syntax-case* body #f (values :-internal define-type-alias-internal) (kernel-syntax-case* body #f (values :-internal define-type-alias-internal)
[(begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values)) [(begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values))
(register-resolved-type-alias #'nm (parse-type #'ty))] (register-resolved-type-alias #'nm (parse-type #'ty))]
[(begin (quote-syntax (:-internal nm ty)) (#%plain-app values)) [(begin (quote-syntax (:-internal nm ty)) (#%plain-app values))
(register-type-if-undefined #'nm (parse-type #'ty))] (register-type-if-undefined #'nm (parse-type #'ty))
(register-scoped-tvars #'nm (parse-literal-alls #'ty))]
[_ (void)])) [_ (void)]))
names names
exprs) exprs)
;; add scoped type variables, before we get to typechecking
;; FIXME: can this pass be fused with the one immediately above?
(for ([n (in-list names)] [b (in-list exprs)])
(syntax-case n ()
[(var) (add-scoped-tvars b (lookup-scoped-tvars #'var))]
[_ (void)]))
(let loop ([names names] [exprs exprs] [flat-names orig-flat-names] [clauses clauses]) (let loop ([names names] [exprs exprs] [flat-names orig-flat-names] [clauses clauses])
(cond (cond
;; after everything, check the body expressions ;; after everything, check the body expressions