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

Moved type transformation logic out of annotate-classes back into prims.

Browse Source 
original commit: 2a1cdff270a10e0c8cffd4d590577762046973e0
This commit is contained in:
J. Ian Johnson 2014-06-25 14:53:11 -04:00 committed by Sam Tobin-Hochstadt
parent d9df3d9360
commit 6a7ff0c342
2 changed files with 15 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/annotate-classes.rkt
View File

@ -4,11 +4,7 @@
syntax/parse/experimental/template
"../private/parse-classes.rkt"
"../private/syntax-properties.rkt"
"../utils/literal-syntax-class.rkt"
(for-meta -1 (only-in "base-types-extra.rkt" U ->))
(for-label "colon.rkt"
(only-in "base-types-extra.rkt" Values)
(only-in racket/base values)))
(for-label "colon.rkt"))
(provide (all-defined-out))
;; Data definitions
@ -52,22 +48,12 @@
#:attr ty #f
#:with ann-name #'n))
(define-literal-syntax-class #:for-label Values)
(define-literal-syntax-class #:for-label values)
(define-splicing-syntax-class cont-annotated-name
(define-splicing-syntax-class (param-annotated-name trans)
#:attributes (name ty ann-name)
#:description "type-annotated continuation identifier"
#:description "type-annotated identifier"
#:literal-sets (colon)
(pattern [~seq name:id : ty]
#:with ann-name (type-label-property
#'name
(syntax-parse #'ty
[((~or :Values^ :values^) tys ... dty b:ddd)
#'(tys ... dty b -> (U))]
[((~or :Values^ :values^) tys ...)
#'(tys ... -> (U))]
[t #'(t -> (U))]))))
#:with ann-name (type-label-property #'name (trans #'ty))))
(define-syntax-class annotated-binding
#:attributes (name ty ann-name binding rhs)

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
View File

@ -107,6 +107,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
'struct-extraction
racket/flonum ; for for/flvector and for*/flvector
racket/extflonum ; for for/extflvector and for*/extflvector
(for-label (only-in "base-types-extra.rkt" Values)
(only-in racket/base values))
(for-syntax
racket/lazy-require
syntax/parse
@ -121,6 +123,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
syntax/struct
"annotate-classes.rkt"
"../utils/tc-utils.rkt"
"../utils/literal-syntax-class.rkt"
"../private/parse-classes.rkt"
"../private/syntax-properties.rkt"
;"../types/utils.rkt"
@ -1183,9 +1186,16 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntaxes (-let/cc -let/ec)
(let ()
(define-literal-syntax-class #:for-label Values)
(define-literal-syntax-class #:for-label values)
(define ((mk l/c) stx)
(syntax-parse stx
[(_ (~or k:cont-annotated-name
[(_ (~or (~var k (param-annotated-name
(λ (ty)
(syntax-parse ty
[((~or :Values^ :values^) tys ...) ;; binds types and ellipses
#'(tys ... -> (U))]
[t #'(t -> (U))]))))
(~and k:id (~bind [k.ann-name #'k]))) . body)
(quasisyntax/loc stx (#,l/c k.ann-name . body))]))
(values (mk #'let/cc) (mk #'let/ec))))