Commit 432f952e authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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

In working this through I also made a number of other corner-case
changes in SetLevels:

* Previously we inconsistently use exprIsBottom (which checks for
  bottom) instead of exprBotStrictness_maybe (which checks for
  bottoming functions).  As well as being inconsistent it was
  simply less good.

  See Note [Bottoming floats]

* I fixed a case where were were unprofitably floating an
  expression because we thought it escaped a value lambda
  (see Note [Escaping a value lambda]).  The relevant code is
       float_me = (dest_lvl `ltMajLvl` (le_ctxt_lvl env)
                  && not float_is_lam)   -- NEW

* I made lvlFloatRhs work properly in the case where abs_vars
  is non-empty.  It wasn't wrong before, but it did some stupid
  extra floating.
parent 11306d62
......@@ -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,
......
......@@ -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(..) )
......@@ -1176,6 +1180,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
......
This diff is collapsed.
......@@ -19,6 +19,10 @@ T8832:
$(RM) -f T8832.o T8832.hi
'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl T8832.hs | grep '^[a-zA-Z0-9]\+ ='
T12603:
$(RM) -f T8832.o T8832.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-uniques T12603.hs | grep 'wf1'
T11155:
$(RM) -f T11155.o T11155.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -c T11155.hs
......
-- ghc --make Main.hs -O1; ./Main +RTS -s -RTS
-- The point here is that we want to see a top-level
-- definition like
--
-- lvl_r5ao :: Int
-- lvl_r5ao = case GHC.Real.$wf1 2# 8# of v_B2
-- { __DEFAULT -> GHC.Types.I# v_B2 }
--
-- with the constant (2^8) being floated to top level
{-# LANGUAGE MagicHash #-}
module Main( main ) where
import GHC.Exts
data Attr = Attr !Int --- the bang is essential
attrFromInt :: Int -> Attr
{-# NOINLINE attrFromInt #-}
attrFromInt w = Attr (w + (2 ^ (8 :: Int)))
fgFromInt :: Int -> Int
{-# INLINE fgFromInt #-} -- removing this INLINE makes it many times faster
-- just like the manually inlined version
-- and NOINLINE lands in between
fgFromInt w = w + (2 ^ (8 :: Int))
attrFromIntINLINE :: Int -> Attr
{-# NOINLINE attrFromIntINLINE #-}
attrFromIntINLINE w = Attr (fgFromInt w)
seqFrame2 :: [Int] -> IO ()
{-# NOINLINE seqFrame2 #-}
seqFrame2 l = do
-- let crux = attrFromInt
-- Total time 2.052s ( 2.072s elapsed)
-- but the following version is many times slower:
let crux = attrFromIntINLINE
-- Total time 7.896s ( 7.929s elapsed)
mapM_ (\a -> crux a `seq` return ()) l
main :: IO ()
main = seqFrame2 $ replicate 100000000 0
lvl = case GHC.Real.$wf1 2# 8# of v { __DEFAULT -> GHC.Types.I# v }
......@@ -250,3 +250,8 @@ test('T9509',
normal,
run_command,
['$MAKE -s --no-print-directory T9509'])
test('T12603',
normal,
run_command,
['$MAKE -s --no-print-directory T12603'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment