Remove ability to check unreachable code.

If code is unreachable then looking up any variable should return
Bottom. But implementing checking unreachable code that way is not that
useful.

original commit: 76c3ec443f95150338a2b2f97d296dd97a17ffb2
This commit is contained in:
Eric Dobson 2014-05-24 13:45:42 -07:00
parent 97ac1da181
commit c69047e11e
4 changed files with 32 additions and 49 deletions

View File

@ -15,19 +15,10 @@
(define (tc/if-twoarm tst thn els [expected #f])
(define (tc expr reachable?)
(unless reachable? (warn-unreachable expr))
(cond
;; if reachable? is #f, then we don't want to verify that this branch has the appropriate type
;; in particular, it might be (void)
[(and expected reachable?)
(tc-expr/check expr (erase-filter expected))]
;; this code is reachable, but we have no expected type
[reachable? (tc-expr expr)]
;; otherwise, this code is unreachable
;; and the resulting type should be the empty type
[(check-unreachable-code?)
(tc-expr expr)
(ret (Un))]
[else (ret (Un))]))
;; If the code is unreachable, the resulting type should be Bottom.
(if reachable?
(tc-expr/check expr (and expected (erase-filter expected)))
(ret -Bottom)))
(match (single-value tst)
[(tc-result1: _ (and f1 (FilterSet: fs+ fs-)) _)
(define flag+ (box #t))
@ -42,20 +33,8 @@
(tc els (unbox flag-)) fs-)))
;; record reachability
;; since we may typecheck a given piece of code multiple times in different
;; contexts, we need to take previous results into account
(cond [(and (not (unbox flag+)) ; maybe contradiction
;; to be an actual contradiction, we must have either previously
;; recorded this test as a contradiction, or have never seen it
;; before
(not (tautology? tst))
(not (neither? tst)))
(add-contradiction tst)]
[(and (not (unbox flag-)) ; maybe tautology
;; mirror case
(not (contradiction? tst))
(not (neither? tst)))
(add-tautology tst)]
[else
(add-neither tst)])
(when (unbox flag+)
(test-position-add-true tst))
(when (unbox flag-)
(test-position-add-false tst))
(merge-tc-results (list results-t results-u))]))

View File

@ -347,7 +347,7 @@
(null? matching-arrs))
(warn-unreachable body)
(add-dead-lambda-branch (formals-syntax formal))
(list formal body (if (check-unreachable-code?) #f null))]
(list formal body null)]
[else (list formal body matching-arrs)])
formals+bodies+arrs*)
(arities-seen-add arities-seen arity))])))

View File

@ -16,12 +16,10 @@
[add-typeof-expr (syntax? tc-results/c . -> . any/c)]
[type-of (syntax? . -> . tc-results/c)]
[reset-type-table (-> any/c)]
[add-tautology (syntax? . -> . any)]
[add-contradiction (syntax? . -> . any)]
[add-neither (syntax? . -> . any)]
[test-position-add-true (syntax? . -> . any)]
[test-position-add-false (syntax? . -> . any)]
[tautology? (syntax? . -> . boolean?)]
[contradiction? (syntax? . -> . boolean?)]
[neither? (syntax? . -> . boolean?)]
[add-dead-lambda-branch (syntax? . -> . any)]
[dead-lambda-branch? (syntax? . -> . boolean?)]
[;; Register that the given expression should be ignored
@ -64,22 +62,30 @@
(syntax-line e)
(syntax-column e))))))
;; keeps track of expressions that always evaluate to true or always evaluate
;; to false, so that the optimizer can eliminate dead code
;; 3 possible values: 'tautology 'contradiction 'neither
(define tautology-contradiction-table (make-hasheq))
;; For expressions in test position keep track of if it evaluates to true/false
;; values: can be 'true, 'false, 'both.
(define test-position-table (make-hasheq))
(define-values (add-tautology add-contradiction add-neither)
(define (test-position-add-true expr)
(hash-update! test-position-table expr
(lambda (v)
(case v
[(true) 'true]
[(false both) 'both]))
'true))
(define (test-position-add-false expr)
(hash-update! test-position-table expr
(lambda (v)
(case v
[(false) 'false]
[(true both) 'both]))
'false))
(define-values (tautology? contradiction?)
(let ()
(define ((mk t?) e)
(when (optimize?)
(hash-set! tautology-contradiction-table e t?)))
(values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
(define-values (tautology? contradiction? neither?)
(let ()
(define ((mk t?) e)
(eq? t? (hash-ref tautology-contradiction-table e 'not-there)))
(values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
(eq? t? (hash-ref test-position-table e 'not-there)))
(values (mk 'true) (mk 'false))))
;; keeps track of lambda branches that never get evaluated, so that the
;; optimizer can eliminate dead code. The key is the formals syntax object.

View File

@ -15,7 +15,6 @@ don't depend on any other portion of the system
orig-module-stx
expanded-module-stx
print-syntax?
check-unreachable-code?
warn-unreachable?
delay-errors?
current-type-names
@ -57,7 +56,6 @@ don't depend on any other portion of the system
;; do we print the fully-expanded syntax in error messages?
(define print-syntax? (make-parameter #f))
(define check-unreachable-code? (make-parameter #f))
(define warn-unreachable? (make-parameter #t))