From fc008889435719cd59c7547a5ed9f3be9bbb19c1 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 12 Mar 2014 01:00:14 -0400
Subject: [PATCH] Correctly check letrec-values clauses with no vars

Should unbreak the build, my apologies to bisecters

original commit: 36c3861494821c9efb1db9df278c77663e1ddb13
---
 .../typed-racket/typecheck/tc-let-unit.rkt    | 39 +++++++++++++------
 .../unit-tests/typecheck-tests.rkt            |  7 +++-
 2 files changed, 32 insertions(+), 14 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
index 877f70c3..6e2d5851 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
@@ -194,10 +194,22 @@
 ;; both the non-recursive clauses and the remaining recursive ones.
 (define (get-non-recursive-clauses clauses flat-names)
 
+  ;; First, filter out clauses with no names. Don't do cycle checking on
+  ;; these because they trivially don't form any.
+  (define-values (*non-binding *other-clauses)
+    (for/fold ([non-binding '()] [other-clauses '()])
+              ([clause clauses])
+      (match-define (lr-clause names _ _) clause)
+      (if (null? names)
+          (values (cons clause non-binding) other-clauses)
+          (values non-binding (cons clause other-clauses)))))
+  (define-values (non-binding other-clauses)
+    (values (reverse *non-binding) (reverse *other-clauses)))
+
   ;; Set up vertices for Tarjan's algorithm, where each letrec-values
   ;; clause is a vertex but mapped in the table for each of the clause names
   (define vertices (make-bound-id-table))
-  (for ([clause clauses])
+  (for ([clause other-clauses])
     (match-define (lr-clause names expr _) clause)
     (define relevant-free-vars
       (for/list ([var (in-list (free-vars expr))]
@@ -218,17 +230,20 @@
 
   ;; The components with only one entry are non-recursive if they also
   ;; contain no self-cycles.
-  (for/fold ([non-recursive '()]
-             [remaining '()])
-            ([component components])
-    (cond [(and (= (length component) 1)
-                (no-self-cycle? (car component)))
-           (values (cons (vertex-data (car component)) non-recursive)
-                   remaining)]
-          [else
-           (values non-recursive
-                   (append (map vertex-data component)
-                           remaining))])))
+  (define-values (non-recursive remaining)
+    (for/fold ([non-recursive '()]
+               [remaining '()])
+              ([component components])
+      (cond [(and (= (length component) 1)
+                  (no-self-cycle? (car component)))
+             (values (cons (vertex-data (car component)) non-recursive)
+                     remaining)]
+            [else
+             (values non-recursive
+                     (append (map vertex-data component)
+                             remaining))])))
+  (values (append non-recursive non-binding)
+          remaining))
 
 ;; check-non-recursive-clauses : (Listof lr-clause) ->
 ;;                               (Listof Identifier) (Listof Type)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 459d5ec5..e528f0e2 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -2439,12 +2439,15 @@
        [tc-err (letrec-values ([(a b) (values x "b")]
                                [(x y) (values a b)])
                  a)
-               #:msg "insufficient type information"]
+               #:msg "no type information"]
        [tc-err (letrec-values ([(a) (values x)]
                                [(x) (values z)]
                                [(z) (values a)])
                  a)
-               #:msg "insufficient type information"]
+               #:msg "no type information"]
+       ;; make sure no-binding cases like the middle expression are checked
+       [tc-err (let () (define r "r") (string-append r 'foo) (define x "x") "y")
+               #:msg "expected: String.*given: 'foo"]
         )
   (test-suite
    "tc-literal tests"