[commit: ghc] master: Fix UNPACK with -fomit-interface-pragmas. (5bae803)

[Simon Peyton Jones]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/5bae803a18b17bdb158a7780e6b6ac3c520e5b39

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

commit 5bae803a18b17bdb158a7780e6b6ac3c520e5b39
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Sep 15 23:09:25 2012 +0100

    Fix UNPACK with -fomit-interface-pragmas.
    
    We were missing a case, so that you could expose a constructor
    with UNPACKed fields, but the field tpye was trimmed, and hence
    can't be expanded.
    
    Fixes Trac #5252 (revived)

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

 compiler/typecheck/TcTyClsDecls.lhs |   29 ++++++++++++++++-------------
 1 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 743bd7c..40ed898 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -1180,25 +1180,28 @@ conRepresentibleWithH98Syntax
 -- and reboxing more complicated
 chooseBoxingStrategy :: TcType -> HsBang -> TcM HsBang
 chooseBoxingStrategy arg_ty bang
-  = case bang of
-	HsNoBang -> return HsNoBang
-	HsStrict -> do { unbox_strict <- doptM Opt_UnboxStrictFields
-                       ; if unbox_strict then return (can_unbox HsStrict arg_ty)
-                                         else return HsStrict }
-	HsNoUnpack -> return HsStrict
-	HsUnpack -> do { omit_prags <- doptM Opt_OmitInterfacePragmas
-                       ; let bang = can_unbox HsUnpackFailed arg_ty
-                       ; if omit_prags && bang == HsUnpack
-                            then return HsStrict
-                            else return bang }
+  = do { dflags <- getDynFlags
+       ; let choice = case bang of
+	               HsNoBang -> HsNoBang
+	               HsStrict | dopt Opt_UnboxStrictFields dflags
+                                -> can_unbox HsStrict arg_ty
+                                | otherwise -> HsStrict
+                       HsNoUnpack -> HsStrict
+	               HsUnpack   -> can_unbox HsUnpackFailed arg_ty
+                       HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
+		                    	  -- Source code never has HsUnpackFailed
+
+       ; case choice of
+           HsUnpack | dopt Opt_OmitInterfacePragmas dflags
+                    -> return HsStrict
+           _other   -> return choice
             -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on
 	    -- See Trac #5252: unpacking means we must not conceal the
 	    --                 representation of the argument type
             -- However: even when OmitInterfacePragmas is on, we still want
             -- to know if we have HsUnpackFailed, because we omit a
             -- warning in that case (#3966)
-        HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
-		       	  -- Source code never has shtes
+       }
   where
     can_unbox :: HsBang -> TcType -> HsBang
     -- Returns   HsUnpack  if we can unpack arg_ty