From 4fa4622f371f3a091783b9a4fcdec73ed8cd0544 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Tue, 12 Nov 2013 09:57:01 -0800 Subject: [PATCH] Switch tc-structs over to syntax classes. original commit: 575419bc8ba93bd1a1f3fb620b28d52b7018b528 --- .../typed-racket/typecheck/tc-structs.rkt | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt index 679082b3..11dcce49 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-structs.rkt @@ -9,11 +9,10 @@ (private parse-type syntax-properties) (types abbrev utils resolve substitute type-table struct-table) (env global-env type-name-env tvar-env) - (utils tc-utils) + (utils tc-utils syntax-classes) (typecheck def-binding) (for-syntax syntax/parse racket/base) - (for-template racket/base - "internal-forms.rkt")) + (for-template racket/base)) (provide tc/struct name-of-struct d-s refine-struct-variance! @@ -50,16 +49,8 @@ (define (name-of-struct stx) (syntax-parse stx - #:literal-sets (kernel-literals) - #:literals (define-typed-struct-internal values) - [(#%define-values () (begin (quote-syntax - (~or - (define-typed-struct-internal - (~optional (ids:id ...)) - nm/par:parent . rest) - (define-typed-struct/exec-internal - nm/par:parent . rest))) - (#%plain-app values))) + [(~or t:typed-struct t:typed-struct/exec) + #:with nm/par:parent #'t.nm #'nm/par.name]))