From 29144c793286bbe89001df4bd12f9a5c237a8659 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Tue, 11 Aug 2015 02:16:19 -0400
Subject: [PATCH] Fix handling of let rhs that don't return

In the case that a let rhs doesn't return and therefore the
bodies of the let are unreachable, the bodies need to be marked
as ignored for the optimizer.

In addition, don't attempt unboxed let optimization at all
if the return type is Nothing since it probably means some
body expressions have no type.

Closes GH issue #165
---
 .../typed-racket/optimizer/unboxed-let.rkt      |  3 +++
 .../typed-racket/typecheck/tc-let-unit.rkt      |  6 +++++-
 typed-racket-test/fail/gh-issue-165.rkt         | 17 +++++++++++++++++
 3 files changed, 25 insertions(+), 1 deletion(-)
 create mode 100644 typed-racket-test/fail/gh-issue-165.rkt

diff --git a/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt b/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
index 88f2775d..3663cd74 100644
--- a/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
+++ b/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt
@@ -188,6 +188,9 @@
 
   (define (rec exp)
     (syntax-parse exp
+      ;; if there are unreachable expressions in the body, we can't check
+      ;; if it's worth unboxing, so just give up
+      [_:ignore-table^ #f]
       ;; can be used in a complex arithmetic expr, can be a direct child
       [(~and (~not :id) exp:float-complex-arith-expr)
        (or (direct-child-of? v #'exp)
diff --git a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
index 801e96ee..aebf1754 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
@@ -1,7 +1,8 @@
 #lang racket/unit
 
 (require "../utils/utils.rkt"
-         (except-in (types utils abbrev filter-ops remove-intersect) -> ->* one-of/c)
+         (except-in (types utils abbrev filter-ops remove-intersect type-table)
+                    -> ->* one-of/c)
          (only-in (types abbrev) (-> t:->) [->* t:->*])
          (private type-annotation parse-type syntax-properties)
          (env lexical-env type-alias-helper mvar-env
@@ -85,6 +86,9 @@
       (get-names+objects namess expected-results)
       (with-lexical-env/extend-props
         (apply append props)
+        ;; if a let rhs does not return, the body isn't checked
+        #:unreachable (for ([form (in-list (syntax->list body))])
+                        (register-ignored! form))
         ;; type-check the rhs exprs
         (for ([expr (in-list exprs)] [results (in-list expected-results)])
           (match results
diff --git a/typed-racket-test/fail/gh-issue-165.rkt b/typed-racket-test/fail/gh-issue-165.rkt
new file mode 100644
index 00000000..f2223860
--- /dev/null
+++ b/typed-racket-test/fail/gh-issue-165.rkt
@@ -0,0 +1,17 @@
+#;
+(exn-pred #rx"match-define")
+#lang typed/racket
+
+(struct a ([x : Integer]))
+(struct b ([y : Integer]))
+
+;; test for original report
+(: f (-> a Integer))
+(define (f arg)
+  (match-define (a (b y)) arg)
+  (+ 1 y))
+
+;; simple test case
+(let ()
+  (match-define (? string? x) 3)
+  (+ 1 2))