Commit 4177efa7 authored by Simon Marlow's avatar Simon Marlow

Tweak sizing heurstics for case expressions (see comments).

This improves the code generated for the examples in #4978, and
appears to make very little difference to nofib.
parent 5e0059a9
...@@ -64,6 +64,8 @@ import Pair ...@@ -64,6 +64,8 @@ import Pair
import FastTypes import FastTypes
import FastString import FastString
import Outputable import Outputable
import ForeignCall
import Data.Maybe import Data.Maybe
\end{code} \end{code}
...@@ -398,15 +400,41 @@ sizeExpr bOMB_OUT_SIZE top_args expr ...@@ -398,15 +400,41 @@ sizeExpr bOMB_OUT_SIZE top_args expr
alts_size tot_size _ = tot_size alts_size tot_size _ = tot_size
size_up (Case e _ _ alts) = size_up e `addSizeNSD` size_up (Case e b _ alts) = size_up e `addSizeNSD`
foldr (addAltSize . size_up_alt) sizeZero alts foldr (addAltSize . size_up_alt) case_size alts
-- We don't charge for the case itself where
-- It's a strict thing, and the price of the call case_size
-- is paid by scrut. Also consider | is_inline_scrut e, not (lengthExceeds alts 1) = sizeN (-1)
-- case f x of DEFAULT -> e | otherwise = sizeZero
-- This is just ';'! Don't charge for it. -- Normally we don't charge for the case itself, but
-- -- we charge one per alternative (see size_up_alt,
-- Moreover, we charge one per alternative. -- below) to account for the cost of the info table
-- and comparisons.
--
-- However, in certain cases (see is_inline_scrut
-- below), no code is generated for the case unless
-- there are multiple alts. In these cases we
-- subtract one, making the first alt free.
-- e.g. case x# +# y# of _ -> ... should cost 1
-- case touch# x# of _ -> ... should cost 0
-- (see #4978)
--
-- I would like to not have the "not (lengthExceeds alts 1)"
-- condition above, but without that some programs got worse
-- (spectral/hartel/event and spectral/para). I don't fully
-- understand why. (SDM 24/5/11)
-- unboxed variables, inline primops and unsafe foreign calls
-- are all "inline" things:
is_inline_scrut (Var v) = isUnLiftedType (idType v)
is_inline_scrut scrut
| (Var f, _) <- collectArgs scrut
= case idDetails f of
FCallId fc -> not (isSafeForeignCall fc)
PrimOpId op -> not (primOpOutOfLine op)
_other -> False
| otherwise
= False
------------ ------------
-- size_up_app is used when there's ONE OR MORE value args -- size_up_app is used when there's ONE OR MORE value args
......
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
module ForeignCall ( module ForeignCall (
ForeignCall(..), ForeignCall(..), isSafeForeignCall,
Safety(..), playSafe, playInterruptible, Safety(..), playSafe, playInterruptible,
CExportSpec(..), CLabelString, isCLabelString, pprCLabelString, CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
...@@ -43,6 +43,9 @@ newtype ForeignCall = CCall CCallSpec ...@@ -43,6 +43,9 @@ newtype ForeignCall = CCall CCallSpec
deriving Eq deriving Eq
{-! derive: Binary !-} {-! derive: Binary !-}
isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe
-- We may need more clues to distinguish foreign calls -- We may need more clues to distinguish foreign calls
-- but this simple printer will do for now -- but this simple printer will do for now
instance Outputable ForeignCall where instance Outputable ForeignCall where
......
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