Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/d8929b8b94c6203b956445fc69c90e1eddcde675 >--------------------------------------------------------------- commit d8929b8b94c6203b956445fc69c90e1eddcde675 Author: Ian Lynagh <[email protected]> Date: Thu Oct 11 23:35:11 2012 +0100 Merge #7050 fix Based on commit ba8fd081ba9b222dd5f93604d7deeaca372e4511 Author: Simon Peyton Jones <[email protected]> Date: Mon Sep 17 18:22:10 2012 +0100 Make the call to chooseBoxingStrategy lazy again >--------------------------------------------------------------- compiler/typecheck/TcTyClsDecls.lhs | 28 +++++++++++++++------------- 1 files changed, 15 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 014c568..9e1ced2 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1042,7 +1042,9 @@ tcConArg new_or_data bty = do { traceTc "tcConArg 1" (ppr bty) ; arg_ty <- tcHsConArgType new_or_data bty ; traceTc "tcConArg 2" (ppr bty) - ; strict_mark <- chooseBoxingStrategy arg_ty (getBangStrictness bty) + ; dflags <- getDynFlags + ; let strict_mark = chooseBoxingStrategy dflags arg_ty (getBangStrictness bty) + -- Must be computed lazily ; return (arg_ty, strict_mark) } tcConRes :: ResType (LHsType Name) -> TcM (ResType Type) @@ -1178,19 +1180,19 @@ conRepresentibleWithH98Syntax -- -- We have turned off unboxing of newtypes because coercions make unboxing -- and reboxing more complicated -chooseBoxingStrategy :: TcType -> HsBang -> TcM HsBang -chooseBoxingStrategy arg_ty bang +chooseBoxingStrategy :: DynFlags -> TcType -> HsBang -> HsBang +chooseBoxingStrategy dflags 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 } + HsNoBang -> HsNoBang + HsStrict -> let unbox_strict = dopt Opt_UnboxStrictFields dflags + in if unbox_strict then (can_unbox HsStrict arg_ty) + else HsStrict + HsNoUnpack -> HsStrict + HsUnpack -> let omit_prags = dopt Opt_OmitInterfacePragmas dflags + bang = can_unbox HsUnpackFailed arg_ty + in if omit_prags && bang == HsUnpack + then HsStrict + else bang -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on -- See Trac #5252: unpacking means we must not conceal the -- representation of the argument type _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
