[commit: ghc] master: Fix over-eager unpacking in isUnpackableType (d3f002c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d3f002cc99b188d2e2ea9d43a9e0e4abb2116364/ghc

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

commit d3f002cc99b188d2e2ea9d43a9e0e4abb2116364
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Sep 4 12:02:42 2013 +0100

    Fix over-eager unpacking in isUnpackableType
    
    This bug meant that we tried to unpack Link in
    
      data Link a = MkLink !(Link a)
    
    when -funbox-small-strict-fields was on.  See Trac #8221.


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

d3f002cc99b188d2e2ea9d43a9e0e4abb2116364
 compiler/basicTypes/MkId.lhs |   33 +++++++++++++++++++++++----------
 1 file changed, 23 insertions(+), 10 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 14e29c1..21553ab 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -695,8 +695,7 @@ dataConArgUnpack arg_ty
     -- An interface file specified Unpacked, but we couldn't unpack it
 
 isUnpackableType :: FamInstEnvs -> Type -> Bool
--- True if we can unpack the UNPACK fields of the constructor
--- without involving the NameSet tycons
+-- True if we can unpack the UNPACK the argument type 
 -- See Note [Recursive unboxing]
 -- We look "deeply" inside rather than relying on the DataCons
 -- we encounter on the way, because otherwise we might well
@@ -730,9 +729,11 @@ isUnpackableType fam_envs ty
          -- NB: dataConStrictMarks gives the *user* request; 
          -- We'd get a black hole if we used dataConRepBangs
 
-    attempt_unpack (HsUnpack {})              = True
-    attempt_unpack (HsUserBang (Just unpk) _) = unpk
-    attempt_unpack _                          = False
+    attempt_unpack (HsUnpack {})                 = True
+    attempt_unpack (HsUserBang (Just unpk) bang) = bang && unpk
+    attempt_unpack (HsUserBang Nothing bang)     = bang  -- Be conservative
+    attempt_unpack HsStrict                      = False
+    attempt_unpack HsNoBang                      = False
 \end{code}
 
 Note [Unpack one-wide fields]
@@ -761,14 +762,26 @@ Here we can represent T with an Int#.
 
 Note [Recursive unboxing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
-Be careful not to try to unbox this!
-	data T = MkT {-# UNPACK #-} !T Int
-Reason: consider
+Consider
   data R = MkR {-# UNPACK #-} !S Int
   data S = MkS {-# UNPACK #-} !Int
 The representation arguments of MkR are the *representation* arguments
-of S (plus Int); the rep args of MkS are Int#.  This is obviously no
-good for T, because then we'd get an infinite number of arguments.
+of S (plus Int); the rep args of MkS are Int#.  This is all fine.
+
+But be careful not to try to unbox this!
+	data T = MkT {-# UNPACK #-} !T Int
+Because then we'd get an infinite number of arguments.
+
+Here is a more complicated case:
+	data S = MkS {-# UNPACK #-} !T Int
+	data T = MkT {-# UNPACK #-} !S Int
+Each of S and T must decide independendently whether to unpack
+and they had better not both say yes. So they must both say no.
+
+Also behave conservatively when there is no UNPACK pragma
+	data T = MkS !T Int
+with -funbox-strict-fields or -funbox-small-strict-fields
+we need to behave as if there was an UNPACK pragma there.
 
 But it's the *argument* type that matters. This is fine:
 	data S = MkS S !Int