Commit bc3d37da authored by Simon Peyton Jones's avatar Simon Peyton Jones

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
parent d03dd237
......@@ -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(..) )
......@@ -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
......
This diff is collapsed.
......@@ -11,6 +11,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 }
......@@ -246,3 +246,7 @@ test('T12212', normal, compile, ['-O'])
test('noinline01', only_ways(['optasm']), compile, ['-ddump-stg -dsuppress-uniques -O'])
test('par01', only_ways(['optasm']), compile, ['-ddump-prep -dsuppress-uniques -O2'])
test('T12776', normal, compile, ['-O2'])
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