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

Convert tc-let unit to new syntax classes.

Browse Source
This commit is contained in:
Eric Dobson 2013-11-12 20:50:42 -08:00
parent 2a99e418d5
commit 7f268e67de
1 changed files with 12 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,11 +7,12 @@
(private type-annotation parse-type syntax-properties) (private type-annotation parse-type syntax-properties)
(env lexical-env type-alias-env global-env type-env-structs scoped-tvar-env) (env lexical-env type-alias-env global-env type-env-structs scoped-tvar-env)
(rep type-rep filter-rep) (rep type-rep filter-rep)
(utils syntax-classes)
syntax/free-vars syntax/free-vars
(typecheck signatures tc-metafunctions tc-subst) (typecheck signatures tc-metafunctions tc-subst)
racket/match (contract-req) racket/match (contract-req)
syntax/parse syntax/stx syntax/parse syntax/stx
(for-template racket/base (typecheck internal-forms))) (for-template racket/base))
(import tc-expr^) (import tc-expr^)
@ -106,19 +107,16 @@
[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 ;; Collect the declarations, which are represented as expression.
(for-each (lambda (names body) ;; We put them back into definitions to reuse the existing machinery
(syntax-parse body (for ([body (in-list exprs)])
#:literals (values :-internal define-type-alias-internal) (syntax-parse #`(define-values () #,body)
#:literal-sets (kernel-literals) [t:type-alias
[(begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values)) (register-resolved-type-alias #'t.name (parse-type #'t.type))]
(register-resolved-type-alias #'nm (parse-type #'ty))] [t:type-declaration
[(begin (quote-syntax (:-internal nm ty)) (#%plain-app values)) (register-type-if-undefined #'t.id (parse-type #'t.type))
(register-type-if-undefined #'nm (parse-type #'ty)) (register-scoped-tvars #'t.id (parse-literal-alls #'t.type))]
(register-scoped-tvars #'nm (parse-literal-alls #'ty))] [_ (void)]))
[_ (void)]))
names
exprs)
;; add scoped type variables, before we get to typechecking ;; add scoped type variables, before we get to typechecking
;; FIXME: can this pass be fused with the one immediately above? ;; FIXME: can this pass be fused with the one immediately above?
(for ([n (in-list names)] [b (in-list exprs)]) (for ([n (in-list names)] [b (in-list exprs)])