[commit: ghc] ghc-7.6: Fix Trac #7237; mixup with empty tuples (b1f3b61)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : ghc-7.6

http://hackage.haskell.org/trac/ghc/changeset/b1f3b61a9efa5d19bc36f4f7bd1e28395350e1a4

>---------------------------------------------------------------

commit b1f3b61a9efa5d19bc36f4f7bd1e28395350e1a4
Author: Simon Peyton Jones <[email protected]>
Date:   Sat Sep 15 23:06:20 2012 +0100

    Fix Trac #7237; mixup with empty tuples
    
    When converting from Core to STG, we swith pattern matching on
    on a *nullary* unboxed tuple into matching using a PrimAlt on RealWorld#
       case e (RealWorld#) of { DEFAULT -> ... }
    This semms messy to me, but it works.  There was a bug in that we were
    changing to PrimAlt, but not using a DEFAULT AltCon.

>---------------------------------------------------------------

 compiler/stgSyn/CoreToStg.lhs |   11 ++++++++++-
 compiler/types/Type.lhs       |   16 ++++++++--------
 2 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 6dc0919..eed579e 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -36,6 +36,7 @@ import Maybes           ( maybeToBool )
 import Name             ( getOccName, isExternalName, nameOccName )
 import OccName          ( occNameString, occNameFS )
 import BasicTypes       ( Arity )
+import TysWiredIn       ( unboxedUnitDataCon )
 import Literal
 import Outputable
 import MonadUtils
@@ -420,6 +421,14 @@ coreToStgExpr (Case scrut bndr _ alts) = do
       )
   where
     vars_alt (con, binders, rhs)
+      | DataAlt c <- con, c == unboxedUnitDataCon
+      = -- This case is a bit smelly. 
+        -- See Note [Nullary unboxed tuple] in Type.lhs
+        -- where a nullary tuple is mapped to (State# World#)
+        ASSERT( null binders )
+        do { (rhs2, rhs_fvs, rhs_escs) <- coreToStgExpr rhs
+           ; return ((DEFAULT, [], [], rhs2), rhs_fvs, rhs_escs) }
+      | otherwise
       = let     -- Remove type variables
             binders' = filterStgBinders binders
         in
@@ -463,7 +472,7 @@ mkStgAltType bndr alts = case repType (idType bndr) of
                                         PolyAlt
         Nothing                      -> PolyAlt
     UbxTupleRep rep_tys -> UbxTupAlt (length rep_tys)
-
+    -- NB Nullary unboxed tuples have UnaryRep, and generate a PrimAlt
   where
    _is_poly_alt_tycon tc
         =  isFunTyCon tc
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 1099303..98aee9e 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -611,14 +611,14 @@ newtype at outermost level; and bale out if we see it again.
 
 Note [Nullary unboxed tuple]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-We represent the nullary unboxed tuple as the unary (but void) type State# RealWorld.
-The reason for this is that the ReprArity is never less than the Arity (as it would
-otherwise be for a function type like (# #) -> Int).
-
-As a result, ReprArity is always strictly positive if Arity is. This is important
-because it allows us to distinguish at runtime between a thunk and a function
- takes a nullary unboxed tuple as an argument!
+We represent the nullary unboxed tuple as the unary (but void) type
+State# RealWorld.  The reason for this is that the ReprArity is never
+less than the Arity (as it would otherwise be for a function type like
+(# #) -> Int).
+
+As a result, ReprArity is always strictly positive if Arity is. This
+is important because it allows us to distinguish at runtime between a
+thunk and a function takes a nullary unboxed tuple as an argument!
 
 \begin{code}
 type UnaryType = Type