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

Refactor part of class type system

Browse Source 
original commit: afb141711406ed4f65de6f558afdd76f17524013
This commit is contained in:
Asumu Takikawa 2013-10-22 14:35:08 -04:00
parent a7b4474b11
commit 6eb16b9f2f
1 changed files with 24 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -178,10 +178,9 @@
#:with ids #'ren.ids))
(define-syntax-class class-clause
(pattern (~and ((~and clause-name (~or (~literal init)
(~literal init-field)))
names:init-decl ...)
form)
(pattern ((~and clause-name (~or (~literal init)
(~literal init-field)))
names:init-decl ...)
;; in the future, use a data structure and
;; make this an attribute instead to represent
;; internal and external names
@ -191,36 +190,34 @@
(stx->list #'(names.ids ...))
(attribute names.type)
(attribute names.optional?)))
(pattern (~and ((~literal field) names:field-decl ...) form)
(pattern ((~literal field) names:field-decl ...)
#:attr data (clause #'(field names.form ...)
#'field
(stx->list #'(names.ids ...))
(attribute names.type)))
(pattern (~and ((~and clause-name (~or (~literal inherit-field)
(~literal public)
(~literal pubment)
(~literal public-final)
(~literal override)
(~literal overment)
(~literal override-final)
(~literal augment)
(~literal augride)
(~literal augment-final)
(~literal inherit)
(~literal inherit/super)
(~literal inherit/inner)
(~literal rename-super)))
names:method-decl ...)
form)
(pattern ((~and clause-name (~or (~literal inherit-field)
(~literal public)
(~literal pubment)
(~literal public-final)
(~literal override)
(~literal overment)
(~literal override-final)
(~literal augment)
(~literal augride)
(~literal augment-final)
(~literal inherit)
(~literal inherit/super)
(~literal inherit/inner)
(~literal rename-super)))
names:method-decl ...)
#:attr data
(clause #'(clause-name names.form ...)
#'clause-name
(stx->list #'(names.ids ...))
(attribute names.type)))
(pattern (~and ((~and clause-name (~or (~literal private)
(~literal abstract)))
names:private-decl ...)
form)
(pattern ((~and clause-name (~or (~literal private)
(~literal abstract)))
names:private-decl ...)
#:attr data
(clause #'(clause-name names.form ...)
#'clause-name
@ -464,8 +461,8 @@
(flatten
(for/list ([clause clauses]
#:when (init-clause? clause))
(for/list ([id-pair (stx->list (clause-ids clause))]
[optional? (init-clause-optional? clause)]
(for/list ([id-pair (in-list (stx->list (clause-ids clause)))]
[optional? (in-list (init-clause-optional? clause))]
#:when optional?)
(stx-car id-pair)))))