Kill off the remaining Rec []

The desugarer was producing an empty Rec group, which is never
supposed to happen.  This small patch stops that happening.

Next up: Lint should check.

3 files changed, 39 insertions, 34 deletions

diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index fb4b3bd4d5..b781863e36 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -20,7 +20,7 @@ module CoreSyn (
                OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar,
 
         -- ** 'Expr' construction
-        mkLets, mkLams,
+        mkLet, mkLets, mkLams,
         mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,
 
         mkIntLit, mkIntLitInt,
@@ -1848,8 +1848,13 @@ mkLets        :: [Bind b] -> Expr b -> Expr b
 mkLams        :: [b] -> Expr b -> Expr b
 
 mkLams binders body = foldr Lam body binders
-mkLets binds body   = foldr Let body binds
+mkLets binds body   = foldr mkLet body binds
 
+mkLet :: Bind b -> Expr b -> Expr b
+-- The desugarer sometimes generates an empty Rec group
+-- which Lint rejects, so we kill it off right away
+mkLet (Rec []) body = body
+mkLet bind     body = Let bind body
 
 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
 -- this can only be used to bind something in a non-recursive @let@ expression
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index efe3e7a8da..0b115cb902 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -193,7 +193,7 @@ dsHsBind dflags
        ; let rhs = core_wrap $
                    mkLams tyvars $ mkLams dicts $
                    mkCoreLets ds_binds $
-                   Let core_bind $
+                   mkLet core_bind $
                    Var local
        ; (spec_binds, rules) <- dsSpecs rhs prags
 
@@ -242,7 +242,7 @@ dsHsBind dflags
         ; ds_binds <- dsTcEvBinds_s ev_binds
         ; let poly_tup_rhs = mkLams tyvars $ mkLams dicts $
                              mkCoreLets ds_binds $
-                             Let core_bind $
+                             mkLet core_bind $
                              tup_expr
 
         ; poly_tup_id <- newSysLocalDs (exprType poly_tup_rhs)
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
index 88f83fd7ed..12a56add85 100644
--- a/testsuite/tests/callarity/unittest/CallArity1.hs
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -43,17 +43,17 @@ exprs :: [(String, CoreExpr)]
 exprs =
   [ ("go2",) $
      mkRFun go [x]
-        (mkLet d (mkACase (Var go `mkVarApps` [x])
+        (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                           (mkLams [y] $ Var y)
                   ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
         go `mkLApps` [0, 0]
   , ("nested_go2",) $
      mkRFun go [x]
-        (mkLet n (mkACase (Var go `mkVarApps` [x])
+        (mkNrLet n (mkACase (Var go `mkVarApps` [x])
                           (mkLams [y] $ Var y))  $
             mkACase (Var n) $
                 mkFun go2 [y]
-                    (mkLet d
+                    (mkNrLet d
                         (mkACase (Var go `mkVarApps` [x])
                                  (mkLams [y] $ Var y) ) $
                         mkLams [z] $ Var d `mkVarApps` [x] )$
@@ -61,40 +61,40 @@ exprs =
         go `mkLApps` [0, 0]
   , ("d0 (go 2 would be bad)",) $
      mkRFun go [x]
-        (mkLet d (mkACase (Var go `mkVarApps` [x])
+        (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                           (mkLams [y] $ Var y)
                   ) $
             mkLams [z] $ Var f `mkApps` [ Var d `mkVarApps` [x],  Var d `mkVarApps` [x] ]) $
         go `mkLApps` [0, 0]
   , ("go2 (in case crut)",) $
      mkRFun go [x]
-        (mkLet d (mkACase (Var go `mkVarApps` [x])
+        (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                           (mkLams [y] $ Var y)
                   ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
         Case (go `mkLApps` [0, 0]) z intTy
             [(DEFAULT, [], Var f `mkVarApps` [z,z])]
   , ("go2 (in function call)",) $
      mkRFun go [x]
-        (mkLet d (mkACase (Var go `mkVarApps` [x])
+        (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                           (mkLams [y] $ Var y)
                   ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
         f `mkLApps` [0] `mkApps` [go `mkLApps` [0, 0]]
   , ("go2 (using surrounding interesting let)",) $
-     mkLet n (f `mkLApps` [0]) $
+     mkNrLet n (f `mkLApps` [0]) $
          mkRFun go [x]
-            (mkLet d (mkACase (Var go `mkVarApps` [x])
+            (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                               (mkLams [y] $ Var y)
                       ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
             Var f `mkApps` [n `mkLApps` [0],  go `mkLApps` [0, 0]]
   , ("go2 (using surrounding boring let)",) $
-     mkLet z (mkLit 0) $
+     mkNrLet z (mkLit 0) $
          mkRFun go [x]
-            (mkLet d (mkACase (Var go `mkVarApps` [x])
+            (mkNrLet d (mkACase (Var go `mkVarApps` [x])
                               (mkLams [y] $ Var y)
                       ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
             Var f `mkApps` [Var z,  go `mkLApps` [0, 0]]
   , ("two calls, one from let and from body (d 1 would be bad)",) $
-     mkLet  d (mkACase (mkLams [y] $ mkLit 0) (mkLams [y] $ mkLit 0)) $
+     mkNrLet  d (mkACase (mkLams [y] $ mkLit 0) (mkLams [y] $ mkLit 0)) $
      mkFun go [x,y] (mkVarApps (Var d) [x]) $
      mkApps (Var d) [mkLApps go [1,2]]
   , ("a thunk in a recursion (d 1 would be bad)",) $
@@ -102,19 +102,19 @@ exprs =
      mkRLet d (mkACase (mkLams [y] $ mkLit 0) (Var d)) $
          Var n `mkApps` [d `mkLApps` [0]]
   , ("two thunks, one called multiple times (both arity 1 would be bad!)",) $
-     mkLet n (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
-     mkLet d (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+     mkNrLet n (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+     mkNrLet d (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
          Var n `mkApps` [Var d `mkApps` [Var d `mkApps` [mkLit 0]]]
   , ("two functions, not thunks",) $
-     mkLet go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
-     mkLet go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+     mkNrLet go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+     mkNrLet go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
          Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]
   , ("a thunk, called multiple times via a forking recursion (d 1 would be bad!)",) $
-     mkLet  d   (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+     mkNrLet  d   (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
      mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (Var d))) $
          go2 `mkLApps` [0,1]
   , ("a function, one called multiple times via a forking recursion",) $
-     mkLet go   (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+     mkNrLet go   (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
      mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (go `mkLApps` [0]))) $
          go2 `mkLApps` [0,1]
   , ("two functions (recursive)",) $
@@ -130,36 +130,36 @@ exprs =
               , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $
          Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]
   , ("mutual recursion (functions), one boring (d 1 would be bad)",) $
-     mkLet d (f `mkLApps` [0]) $
+     mkNrLet d (f `mkLApps` [0]) $
          Let (Rec [ (go,  mkLams [x, y] (Var d `mkApps` [go2 `mkLApps` [1,2]]))
                   , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $
              Var d `mkApps` [go2 `mkLApps` [0,1]]
   , ("a thunk (non-function-type), called twice, still calls once",) $
-    mkLet d (f `mkLApps` [0]) $
-        mkLet x (d `mkLApps` [1]) $
+    mkNrLet d (f `mkLApps` [0]) $
+        mkNrLet x (d `mkLApps` [1]) $
             Var f `mkVarApps` [x, x]
   , ("a thunk (function type), called multiple times, still calls once",) $
-    mkLet d (f `mkLApps` [0]) $
-        mkLet n (Var f `mkApps` [d `mkLApps` [1]]) $
+    mkNrLet d (f `mkLApps` [0]) $
+        mkNrLet n (Var f `mkApps` [d `mkLApps` [1]]) $
             mkLams [x] $ Var n `mkVarApps` [x]
   , ("a thunk (non-function-type), in mutual recursion, still calls once (d 1 would be good)",) $
-    mkLet d (f `mkLApps` [0]) $
+    mkNrLet d (f `mkLApps` [0]) $
         Let (Rec [ (x, Var d `mkApps` [go `mkLApps` [1,2]])
                  , (go, mkLams [x] $ mkACase (mkLams [z] $ Var x) (Var go `mkVarApps` [x]) ) ]) $
             Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]
   , ("a thunk (non-function-type), in mutual recursion, causes many calls (d 1 would be bad)",) $
-    mkLet d (f `mkLApps` [0]) $
+    mkNrLet d (f `mkLApps` [0]) $
         Let (Rec [ (x, Var go `mkApps` [go `mkLApps` [1,2], go `mkLApps` [1,2]])
                  , (go, mkLams [x] $ mkACase (Var d) (Var go `mkVarApps` [x]) ) ]) $
             Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]
   , ("a thunk (function type), in mutual recursion, still calls once (d 1 would be good)",) $
-    mkLet d (f `mkLApps` [0]) $
+    mkNrLet d (f `mkLApps` [0]) $
         Let (Rec [ (n, Var go `mkApps` [d `mkLApps` [1]])
                  , (go, mkLams [x] $ mkACase (Var n) (Var go `mkApps` [Var n `mkVarApps` [x]]) ) ]) $
             Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]
   , ("a thunk (non-function-type) co-calls with the body (d 1 would be bad)",) $
-    mkLet d (f `mkLApps` [0]) $
-        mkLet x (d `mkLApps` [1]) $
+    mkNrLet d (f `mkLApps` [0]) $
+        mkNrLet x (d `mkLApps` [1]) $
             Var d `mkVarApps` [x]
   ]
 
@@ -193,14 +193,14 @@ mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty
 mkTestIds :: [String] -> [Type] -> [Id]
 mkTestIds ns tys = zipWith3 mkTestId [0..] ns tys
 
-mkLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr
-mkLet v rhs body = Let (NonRec v rhs) body
+mkNrLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr
+mkNrLet v rhs body = Let (NonRec v rhs) body
 
 mkRLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr
 mkRLet v rhs body = Let (Rec [(v, rhs)]) body
 
 mkFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr
-mkFun v xs rhs body = mkLet v (mkLams xs rhs) body
+mkFun v xs rhs body = mkNrLet v (mkLams xs rhs) body
 
 mkRFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr
 mkRFun v xs rhs body = mkRLet v (mkLams xs rhs) body