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

Make annotate classes use for label.

Browse Source
This commit is contained in:
Eric Dobson 2013-11-15 23:02:37 -08:00
parent 476c7666b7
commit e8c65ff759
1 changed files with 12 additions and 10 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

@ -3,13 +3,15 @@
(require syntax/parse (require syntax/parse
"../private/parse-classes.rkt" "../private/parse-classes.rkt"
"../private/syntax-properties.rkt" "../private/syntax-properties.rkt"
(for-template "colon.rkt")) (for-label "colon.rkt"))
(provide (all-defined-out)) (provide (all-defined-out))
(define-literal-set colon #:for-label (:))
(define-splicing-syntax-class annotated-name (define-splicing-syntax-class annotated-name
#:attributes (name ty ann-name) #:attributes (name ty ann-name)
#:description "type-annotated identifier" #:description "type-annotated identifier"
#:literals (:) #:literal-sets (colon)
(pattern [~seq name:id : ty] (pattern [~seq name:id : ty]
#:with ann-name (type-label-property #'name #'ty)) #:with ann-name (type-label-property #'name #'ty))
(pattern name:id (pattern name:id
@ -20,7 +22,7 @@
(define-splicing-syntax-class optionally-annotated-name (define-splicing-syntax-class optionally-annotated-name
#:attributes (name ann-name) #:attributes (name ann-name)
#:description "optionally type-annotated identifier" #:description "optionally type-annotated identifier"
#:literals (:) #:literal-sets (colon)
(pattern n:annotated-name (pattern n:annotated-name
#:with name #'n.name #:with name #'n.name
#:with ann-name #'n.ann-name) #:with ann-name #'n.ann-name)
@ -31,7 +33,7 @@
(define-splicing-syntax-class (param-annotated-name trans) (define-splicing-syntax-class (param-annotated-name trans)
#:attributes (name ty ann-name) #:attributes (name ty ann-name)
#:description "type-annotated identifier" #:description "type-annotated identifier"
#:literals (:) #:literal-sets (colon)
(pattern [~seq name:id : ty] (pattern [~seq name:id : ty]
#:with ann-name (type-label-property #'name (trans #'ty)))) #:with ann-name (type-label-property #'name (trans #'ty))))
@ -43,7 +45,7 @@
(define-syntax-class optionally-annotated-binding (define-syntax-class optionally-annotated-binding
#:attributes (name ann-name binding rhs) #:attributes (name ann-name binding rhs)
#:description "optionally type-annotated binding" #:description "optionally type-annotated binding"
#:literals (:) #:literal-sets (colon)
(pattern b:annotated-binding (pattern b:annotated-binding
#:with name #'b.name #:with name #'b.name
#:with ann-name #'b.ann-name #:with ann-name #'b.ann-name
@ -73,14 +75,14 @@
(define-splicing-syntax-class annotated-star-rest (define-splicing-syntax-class annotated-star-rest
#:attributes (name ann-name ty formal-ty) #:attributes (name ann-name ty formal-ty)
#:literals (:) #:literal-sets (colon)
(pattern (~seq name:id : ty s:star) (pattern (~seq name:id : ty s:star)
#:with formal-ty #'(ty s) #:with formal-ty #'(ty s)
#:with ann-name (type-label-property #'name #'ty))) #:with ann-name (type-label-property #'name #'ty)))
(define-splicing-syntax-class annotated-dots-rest (define-splicing-syntax-class annotated-dots-rest
#:attributes (name ann-name bound ty formal-ty) #:attributes (name ann-name bound ty formal-ty)
#:literals (:) #:literal-sets (colon)
(pattern (~seq name:id : ty bnd:ddd/bound) (pattern (~seq name:id : ty bnd:ddd/bound)
#:with formal-ty #'(ty . bnd) #:with formal-ty #'(ty . bnd)
#:attr bound (attribute bnd.bound) #:attr bound (attribute bnd.bound)
@ -107,7 +109,7 @@
(define-syntax-class annotated-formals (define-syntax-class annotated-formals
#:attributes (ann-formals (arg-ty 1)) #:attributes (ann-formals (arg-ty 1))
#:literals (:) #:literal-sets (colon)
(pattern (n:annotated-formal ...) (pattern (n:annotated-formal ...)
#:with ann-formals #'(n.ann-name ...) #:with ann-formals #'(n.ann-name ...)
#:with (arg-ty ...) #'(n.ty ...)) #:with (arg-ty ...) #'(n.ty ...))
@ -128,7 +130,7 @@
(define-syntax-class opt-lambda-annotated-formals (define-syntax-class opt-lambda-annotated-formals
#:attributes (ann-formals (arg-ty 1)) #:attributes (ann-formals (arg-ty 1))
#:literals (:) #:literal-sets (colon)
(pattern (n:opt-lambda-annotated-formal ...) (pattern (n:opt-lambda-annotated-formal ...)
#:with ann-formals #'(n.ann-name ...) #:with ann-formals #'(n.ann-name ...)
#:with (arg-ty ...) #'(n.ty ...)) #:with (arg-ty ...) #'(n.ty ...))
@ -139,7 +141,7 @@
#:with (arg-ty ...) #'(n.ty ... . rest.formal-ty))) #:with (arg-ty ...) #'(n.ty ... . rest.formal-ty)))
(define-splicing-syntax-class standalone-annotation (define-splicing-syntax-class standalone-annotation
#:literals (:) #:literal-sets (colon)
(pattern (~seq : t) (pattern (~seq : t)
#:with ty #'t)) #:with ty #'t))
(define-splicing-syntax-class optional-standalone-annotation (define-splicing-syntax-class optional-standalone-annotation