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

Fix interaction between early exits, filters and the optimizer.

Browse Source 
Closes PR14828.
This commit is contained in:
Vincent St-Amour 2014-11-07 15:33:09 -05:00
parent 629b3119b8
commit 517e22eee8
2 changed files with 32 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -275,11 +275,21 @@
"expected single value, got multiple (or zero) values")])) "expected single value, got multiple (or zero) values")]))
;; check-body-form: (All (A) (syntax? (-> A) -> A)) ;; tc-body/check: syntax? tc-results? -> tc-results?
;; Checks an expression and then calls the function in a context with an extended lexical environment. ;; Body must be a non empty sequence of expressions to typecheck.
;; The environment is extended with the propositions that are true if the expression returns ;; The final one will be checked against expected.
;; (e.g. instead of raising an error). (define (tc-body/check body expected)
(define (check-body-form e k) (match (syntax->list body)
[(list es ... e-final)
;; First, typecheck all the forms whose results are discarded.
;; If any one those causes the rest to be unreachable (e.g. `exit' or `error`,
;; then mark the rest as ignored.
(let loop ([es es])
(cond [(empty? es) ; Done, typecheck the return form.
(tc-expr/check e-final expected)]
[else
;; Typecheck the first form.
(define e (first es))
(define results (tc-expr/check e (tc-any-results -no-filter))) (define results (tc-expr/check e (tc-any-results -no-filter)))
(define props (define props
(match results (match results
@ -288,20 +298,14 @@
(map -or f+ f-)] (map -or f+ f-)]
[(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _) [(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _)
(map -or f+ f-)])) (map -or f+ f-)]))
(with-lexical-env/extend-props props (with-lexical-env/extend-props
(k))) props
;; If `e` bails out, mark the rest as ignored.
;; tc-body/check: syntax? tc-results? -> tc-results? #:unreachable (for ([x (in-list (cons e-final (rest es)))])
;; Body must be a non empty sequence of expressions to typecheck. (register-ignored! x))
;; The final one will be checked against expected. ;; Keep going with an environment extended with the propositions that are
(define (tc-body/check body expected) ;; true if execution reaches this point.
(match (syntax->list body) (loop (rest es)))]))]))
[(list es ... e-final)
(define ((continue es))
(if (empty? es)
(tc-expr/check e-final expected)
(check-body-form (first es) (continue (rest es)))))
((continue es))]))
;; find-stx-type : Any [(or/c Type/c #f)] -> Type/c ;; find-stx-type : Any [(or/c Type/c #f)] -> Type/c
;; recursively find the type of either a syntax object or the result of syntax-e ;; recursively find the type of either a syntax object or the result of syntax-e

7
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14828.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/racket
(: emit-subroutines (-> (Listof String) Void))
(define (emit-subroutines code*)
(exit 0)
(for : Void ([code : String code*])
(display code)))