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

Fix GH issue #271

Browse Source 
Propagate syntax properties when opening up begins at the top-level
so that ignore properties will get transferred.
This commit is contained in:
Asumu Takikawa 2015-12-18 05:40:21 -05:00
parent beb517c9c8
commit b18d940f1a
2 changed files with 30 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt
View File

@ -66,22 +66,23 @@
(local-expand/capture* #'e 'top-level (kernel-form-identifier-list))))
(syntax-parse head-expanded
#:literal-sets (kernel-literals)
[(begin (define-values (n) _) ...
(~and (~or _:ignore^ _:ignore-some^)
(~not (~or _:tr:class^
_:tr:unit^
_:tr:unit:invoke^
_:tr:unit:compound^
_:tr:unit:from-context^))))
head-expanded]
;; keep trampolining on begins
[(begin (define-values (n) e-rhs) ... (begin e ... e-last))
#`(begin (tc-toplevel-trampoline orig-stx (define-values (n) e-rhs))
...
(tc-toplevel-trampoline orig-stx e) ...
#,(if report?
#'(tc-toplevel-trampoline/report orig-stx e-last)
#'(tc-toplevel-trampoline orig-stx e-last)))]
;; keep trampolining on begins, transfer syntax properties so that ignore
;; properties are retained in the begin subforms
[(begin (define-values (n) e-rhs) ...
(~and the-begin (begin e ... e-last)))
(define e*s
(for/list ([e (in-list (syntax->list #'(e ...)))])
(syntax-track-origin e #'the-begin #'begin)))
(define e-last*
(syntax-track-origin #'e-last #'the-begin #'begin))
(with-syntax ([(e ...) e*s]
[e-last e-last*])
#`(begin (tc-toplevel-trampoline orig-stx (define-values (n) e-rhs))
...
(tc-toplevel-trampoline orig-stx e) ...
#,(if report?
#'(tc-toplevel-trampoline/report orig-stx e-last)
#'(tc-toplevel-trampoline orig-stx e-last))))]
[_
(define fully-expanded
;; a non-begin form can still cause lifts, so still have to catch them

13
typed-racket-test/fail/gh-issue-271.rkt Normal file
View File

@ -0,0 +1,13 @@
#;
(exn-pred #rx"could not be converted")
#lang racket/load
;; Tests that p? cannot be generated
(require typed/racket)
(define-predicate p? (All (A) (Listof A)))
(let ()
(: x (U (Listof Integer) Integer)) (define x '(1 2 3))
(if (p? x) 0 (add1 x)))