Float unboxed expressions by boxing

This patch makes GHC's floating more robust, by allowing it
to float unboxed expressions of at least some common types.

See Note [Floating MFEs of unlifted type] in SetLevels.

This was all provoked by Trac #12603

2 files changed, 34 insertions, 6 deletions

diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index 364aea41f1..dce0369edf 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -32,12 +32,12 @@ module TysPrim(
         funTyCon, funTyConName,
         primTyCons,
 
-        charPrimTyCon,          charPrimTy,
-        intPrimTyCon,           intPrimTy,
-        wordPrimTyCon,          wordPrimTy,
-        addrPrimTyCon,          addrPrimTy,
-        floatPrimTyCon,         floatPrimTy,
-        doublePrimTyCon,        doublePrimTy,
+        charPrimTyCon,          charPrimTy, charPrimTyConName,
+        intPrimTyCon,           intPrimTy, intPrimTyConName,
+        wordPrimTyCon,          wordPrimTy, wordPrimTyConName,
+        addrPrimTyCon,          addrPrimTy, addrPrimTyConName,
+        floatPrimTyCon,         floatPrimTy, floatPrimTyConName,
+        doublePrimTyCon,        doublePrimTy, doublePrimTyConName,
 
         voidPrimTyCon,          voidPrimTy,
         statePrimTyCon,         mkStatePrimTy,
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 18cf53093d..385517a68a 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -34,6 +34,9 @@ module TysWiredIn (
         gtDataCon, gtDataConId,
         promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
 
+        -- * Boxign primitive types
+        boxingDataCon_maybe,
+
         -- * Char
         charTyCon, charDataCon, charTyCon_RDR,
         charTy, stringTy, charTyConName,
@@ -143,6 +146,7 @@ import TyCon
 import Class            ( Class, mkClass )
 import RdrName
 import Name
+import NameEnv          ( NameEnv, mkNameEnv, lookupNameEnv )
 import NameSet          ( NameSet, mkNameSet, elemNameSet )
 import BasicTypes       ( Arity, Boxity(..), TupleSort(..), ConTagZ,
                           SourceText(..) )
@@ -1175,6 +1179,30 @@ ptrRepLiftedTy = mkTyConTy ptrRepLiftedDataConTyCon
 *                                                                      *
 ********************************************************************* -}
 
+boxingDataCon_maybe :: TyCon -> Maybe DataCon
+--    boxingDataCon_maybe Char# = C#
+--    boxingDataCon_maybe Int#  = I#
+--    ... etc ...
+-- See Note [Boxing primitive types]
+boxingDataCon_maybe tc
+  = lookupNameEnv boxing_constr_env (tyConName tc)
+
+boxing_constr_env :: NameEnv DataCon
+boxing_constr_env
+  = mkNameEnv [(charPrimTyConName  , charDataCon  )
+              ,(intPrimTyConName   , intDataCon   )
+              ,(wordPrimTyConName  , wordDataCon  )
+              ,(floatPrimTyConName , floatDataCon )
+              ,(doublePrimTyConName, doubleDataCon) ]
+
+{- Note [Boxing primitive types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For a handful of primitive types (Int, Char, Word, Flaot, Double),
+we can readily box and an unboxed version (Int#, Char# etc) using
+the corresponding data constructor.  This is useful in a couple
+of places, notably let-floating -}
+
+
 charTy :: Type
 charTy = mkTyConTy charTyCon