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

Simplify TR class macro handling of names

Browse Source 
Instead of using a syntax-property hack, just disarm the
expanded syntax (TR will do this later in the pipeline anyway).

original commit: 375abf3c2b26b76044a63c1e0d8bd16cc4f52a38
This commit is contained in:
Asumu Takikawa 2014-10-23 00:48:05 -04:00
parent 3399923ab8
commit 1b8619bc14
3 changed files with 4 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/class-clauses.rkt
View File

@ -200,9 +200,7 @@
;; set a property here to avoid taint-related issues because
;; we can't transplant the identifiers in the expansion (into the
;; class local table) in certain cases
#,(tr:class:clause-ids-property
#`(?orig-name #,@(attribute ??decl.form))
(attribute ??decl.ids)))]))
(?orig-name #,@(attribute ??decl.form)))]))
...)]))
(define-decl-forms ([init untyped:init init-decl]

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

@ -19,6 +19,7 @@
syntax/stx
"annotate-classes.rkt"
"../private/syntax-properties.rkt"
"../utils/disarm.rkt"
"../utils/tc-utils.rkt"))
(provide ;; Typed class macro that coordinates with TR
@ -146,7 +147,7 @@
[(_ class-info:id class-exp)
(define info (syntax-local-value #'class-info))
(define expanded (local-expand #'class-exp (syntax-local-context) stop-forms))
(syntax-parse expanded
(syntax-parse (disarm* expanded) ; to avoid macro tainting issues
#:literal-sets (kernel-literals)
#:literals (: untyped:super-new untyped:super-make-object
untyped:super-instantiate)
@ -156,18 +157,9 @@
[cls:class-clause
(define clause-data (attribute cls.data))
(match-define (struct clause (stx kind ids types)) clause-data)
;; to avoid macro taint issues
(define prop-val (tr:class:clause-ids-property #'cls))
(define clause-data*
(cond [(and prop-val (init-clause? clause-data))
(init-clause stx kind prop-val types
(init-clause-optional? clause-data))]
[prop-val
(clause stx kind prop-val types)]
[else clause-data]))
(set-tr-class-info-clauses!
info
(cons clause-data* (tr-class-info-clauses info)))
(cons clause-data (tr-class-info-clauses info)))
(check-unsupported-feature kind #'class-exp)
#'class-exp]
;; if it's a method definition for a declared method, then

1
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/syntax-properties.rkt
View File

@ -74,7 +74,6 @@
(tr:class:super tr:class:super)
(tr:class:local-table tr:class:local-table)
(tr:class:name-table tr:class:name-table)
(tr:class:clause-ids tr:class:clause-ids)
(tr:class:def tr:class:def)
)