Fix #378 more comprehensively. (#453)

The previous fix relied on finding and manipulating all dead code.
But we missed some; in particular code of the form:

    (begin (error 'x) ...dead...)

So switch to a different strategy that tolerates untraversed
dead code.

typed-racket-lib/typed-racket/base-env/prims-contract.rkt

@@ -281,9 +281,7 @@
    (λ ()
      (define type-stx
        (or (cast-table-ref id)
-           (int-err (string-append
-                     "contract-def-property: thunk called too early\n"
-                     "  This should only be called after the type-checking pass has finished."))))
+           #f))
      `#s(contract-def ,type-stx ,flat? ,maker? typed))))
 
 

typed-racket-lib/typed-racket/private/type-contract.rkt

@@ -9,7 +9,7 @@
  (utils tc-utils)
  (env type-name-env row-constraint-env)
  (rep core-rep rep-utils type-mask values-rep)
- (types resolve union utils printer)
+ (types resolve union utils printer abbrev)
  (prefix-in t: (types abbrev numeric-tower subtype))
  (private parse-type syntax-properties)
  racket/match racket/syntax racket/list
@@ -83,8 +83,8 @@
 (define (generate-contract-def stx cache sc-cache)
   (define prop (get-contract-def-property stx))
   (match-define (contract-def type-stx flat? maker? typed-side) prop)
-  (define *typ (parse-type type-stx))
-  (define kind (if flat? 'flat 'impersonator))
+  (define *typ (if type-stx (parse-type type-stx) -Dead-Code))
+  (define kind (if (and type-stx flat?) 'flat 'impersonator))
   (syntax-parse stx #:literals (define-values)
     [(define-values (n) _)
      (define typ

typed-racket-lib/typed-racket/typecheck/tc-if.rkt

@@ -1,13 +1,10 @@
 #lang racket/unit
-(require "../utils/utils.rkt"
+(require "../utils/utils.rkt" racket/match
          (rep core-rep prop-rep)
-         (types abbrev utils prop-ops)
+         (types utils prop-ops)
          (utils tc-utils)
          (typecheck signatures tc-envops tc-metafunctions)
-         (types type-table)
-         (private syntax-properties)
-         racket/match
-         syntax/parse)
+         (types type-table))
 
 ;; if typechecking
 (import tc-expr^)
@@ -19,44 +16,13 @@
      (define expected* (and expected (erase-props expected)))
      (define results-t
        (with-lexical-env/extend-props (list ps+)
-         #:unreachable (begin
-                         (handle-unreachable-casted-exprs thn)
-                         (warn-unreachable thn))
+         #:unreachable (warn-unreachable thn)
          (test-position-add-true tst)
          (tc-expr/check thn expected*)))
      (define results-u
        (with-lexical-env/extend-props (list ps-)
-         #:unreachable (begin
-                         (handle-unreachable-casted-exprs els)
-                         (warn-unreachable els))
+         #:unreachable (warn-unreachable els)
          (test-position-add-false tst)
          (tc-expr/check els expected*)))
 
      (merge-tc-results (list results-t results-u))]))
-
-;; handle-unreachable-casted-exprs : Any -> Void
-;; Traverses stx looking for casted-expr properties. For each one, it
-;; calls the function stored in the property, which fills an entry in
-;; the cast table with the -Dead-Code type. This is so that the
-;; contract-generation pass doesn't throw an internal error.
-(define (handle-unreachable-casted-exprs stx)
-  (syntax-parse stx
-    [(exp:casted-expr^ e)
-     ;; fill in this entry in the cast table with the -Dead-Code type
-     ((attribute exp.value) -Dead-Code)
-     (void)]
-    [stx
-     (define e (syntax-e #'stx))
-     (cond
-       [(pair? e) (handle-unreachable-casted-exprs (car e))
-                  (handle-unreachable-casted-exprs (cdr e))]
-       [(box? e) (handle-unreachable-casted-exprs (unbox e))]
-       [(vector? e) (for ([e (in-vector e)])
-                      (handle-unreachable-casted-exprs e))]
-       [(hash? e) (for ([(k v) (in-hash e)])
-                    (handle-unreachable-casted-exprs k)
-                    (handle-unreachable-casted-exprs v))]
-       [(struct? e) (for ([e (in-vector (struct->vector e))])
-                      (handle-unreachable-casted-exprs e))]
-       [else (void)])]))
-

typed-racket-test/succeed/cast-mod.rkt

@@ -117,5 +117,9 @@
                 1)
   (check-equal? (if #true 1 `#s(struct ,(cast 2 Integer) ,(cast 3 Integer)))
                 1)
+  (check-true ;; check that this doesn't have an internal error
+   (λ () (begin
+           (error "hi")
+           (cast (string->number "42") Integer))))
   )