Remove unnecessary class typechecking code
Also add a test for this part of TR. In particular, it handles registering syntax definitions that are found in a class body.
This commit is contained in:
parent
28e9bdcbab
commit
92bdd84b07
|
@ -274,7 +274,6 @@
|
||||||
;; this is mostly cribbed from class-internal.rkt
|
;; this is mostly cribbed from class-internal.rkt
|
||||||
(define (expand-expressions stxs ctx def-ctx)
|
(define (expand-expressions stxs ctx def-ctx)
|
||||||
(define (class-expand stx)
|
(define (class-expand stx)
|
||||||
;; try using syntax-local-expand-expression?
|
|
||||||
(local-expand stx ctx stop-forms def-ctx))
|
(local-expand stx ctx stop-forms def-ctx))
|
||||||
(let loop ([stxs stxs])
|
(let loop ([stxs stxs])
|
||||||
(cond [(null? stxs) null]
|
(cond [(null? stxs) null]
|
||||||
|
@ -288,12 +287,9 @@
|
||||||
;; i.e., macro definitions in the class body
|
;; i.e., macro definitions in the class body
|
||||||
;; see class-internal.rkt as well
|
;; see class-internal.rkt as well
|
||||||
[(define-syntaxes (name:id ...) rhs:expr)
|
[(define-syntaxes (name:id ...) rhs:expr)
|
||||||
(define/with-syntax expanded-rhs
|
|
||||||
(local-transformer-expand #'rhs 'expression null))
|
|
||||||
(syntax-local-bind-syntaxes
|
(syntax-local-bind-syntaxes
|
||||||
(syntax->list #'(name ...)) #'expanded-rhs def-ctx)
|
(syntax->list #'(name ...)) #'rhs def-ctx)
|
||||||
(cons #'(define-syntaxes (name ...) expanded-rhs)
|
(cons stx (loop (cdr stxs)))]
|
||||||
(loop (cdr stxs)))]
|
|
||||||
[(define-values (name:id ...) rhs:expr)
|
[(define-values (name:id ...) rhs:expr)
|
||||||
(syntax-local-bind-syntaxes
|
(syntax-local-bind-syntaxes
|
||||||
(syntax->list #'(name ...)) #f def-ctx)
|
(syntax->list #'(name ...)) #f def-ctx)
|
||||||
|
|
|
@ -1413,4 +1413,14 @@
|
||||||
(init x)))
|
(init x)))
|
||||||
#:ret (ret (-poly (A) (-class #:init ([x A #f]))))
|
#:ret (ret (-poly (A) (-class #:init ([x A #f]))))
|
||||||
#:expected (ret (-poly (A) (-class #:init ([x A #f]))) -no-filter -no-obj)]
|
#:expected (ret (-poly (A) (-class #:init ([x A #f]))) -no-filter -no-obj)]
|
||||||
))
|
;; test uses of a macro in the body of the class
|
||||||
|
[tc-e
|
||||||
|
(let ()
|
||||||
|
(define c%
|
||||||
|
(class object%
|
||||||
|
(super-new)
|
||||||
|
(define-syntax-rule (my-meth (m arg ...) . body)
|
||||||
|
(define/public (m arg ...) . body))
|
||||||
|
(my-meth (hello) (displayln "hello world"))))
|
||||||
|
(send (new c%) hello))
|
||||||
|
-Void]))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user