Unbreak TR's top-level

A recent change I made broke optimizations at the top-level
This commit is contained in:
Asumu Takikawa 2014-11-05 13:46:47 -05:00
parent 18bad4ce6e
commit 54dfd50b89
2 changed files with 12 additions and 5 deletions

View File

@ -73,9 +73,12 @@
(tc-toplevel/full stx #'form (tc-toplevel/full stx #'form
(λ (body2 type) (λ (body2 type)
(with-syntax* (with-syntax*
([(transformed-body ...) ([(optimized-body ...) (maybe-optimize #`(#,body2))]
(change-contract-fixups (flatten-all-begins body2))] ;; Transform after optimization for top-level because the flattening will
[(optimized-body ...) (maybe-optimize #'(transformed-body ...))]) ;; change syntax object identity (via syntax-track-origin) which doesn't work
;; for looking up types in the optimizer.
[(transformed-body ...)
(change-contract-fixups (flatten-all-begins #'(begin optimized-body ...)))])
(syntax-parse body2 (syntax-parse body2
[_ (let ([ty-str (match type [_ (let ([ty-str (match type
;; 'no-type means the form is not an expression and ;; 'no-type means the form is not an expression and
@ -126,5 +129,5 @@
#,(if (unbox include-extra-requires?) #,(if (unbox include-extra-requires?)
extra-requires extra-requires
#'(begin)) #'(begin))
#,(arm #'(begin optimized-body ...))) #,(arm #'(begin transformed-body ...)))
(arm #'(begin optimized-body ...))))]))))])) (arm #'(begin transformed-body ...))))]))))]))

View File

@ -100,6 +100,10 @@
(test-form #rx"^$" (test-form #rx"^$"
(struct foo ())) (struct foo ()))
;; Make sure that optimized expressions work
(test-form #rx"Flonum"
(+ 1.0 2.0))
;; PR 14487 ;; PR 14487
(test-form-not-exn (test-form-not-exn
(require/typed racket/base (require/typed racket/base