summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2015-03-05 19:40:11 +0100
committerJoachim Breitner <mail@joachim-breitner.de>2015-03-05 19:40:11 +0100
commitde24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f (patch)
tree7a79d1fb997a317afe1def920c41e7b8f3c38dd9
parent1ec5c8a1b3db46026d159f54f9dad0d77a6f9b33 (diff)
downloadhaskell-de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f.tar.gz
Print range of a switch in PprCmm
-rw-r--r--compiler/cmm/CmmNode.hs24
-rw-r--r--compiler/cmm/PprCmm.hs10
2 files changed, 28 insertions, 6 deletions
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index 90d1b77dd8..42e5fcaadd 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -22,7 +22,8 @@ module CmmNode (
-- * Switch
SwitchTargets,
- mkSwitchTargets, switchTargetsCases, switchTargetsDefault,
+ mkSwitchTargets,
+ switchTargetsCases, switchTargetsDefault, switchTargetsRange,
mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,
switchTargetsToList, eqSwitchTargetWith,
) where
@@ -696,23 +697,35 @@ combineTickScopes s1 s2
| otherwise = CombinedScope s1 s2
--- See Note [Switch Table]
+-- See Note [SwitchTargets]
data SwitchTargets =
SwitchTargets (Maybe (Integer, Integer)) (Maybe Label) (M.Map Integer Label)
deriving Eq
-- mkSwitchTargets normalises the map a bit:
+-- * No entries outside the range
+-- * No entries equal to the default
+-- * No default if there is a range, and all elements have explicit values
mkSwitchTargets :: Maybe (Integer, Integer) -> Maybe Label -> M.Map Integer Label -> SwitchTargets
mkSwitchTargets mbrange mbdef ids
- = SwitchTargets mbrange mbdef $ dropDefault $ restrict ids
+ = SwitchTargets mbrange mbdef' ids'
where
+ ids' = dropDefault $ restrict ids
+ mbdef' | defaultNeeded = mbdef
+ | otherwise = Nothing
+
-- It drops entries outside the range, if there is a range
restrict | Just (lo,hi) <- mbrange = M.filterWithKey (\x _ -> lo <= x && x <= hi)
| otherwise = id
- -- It entries that equal the default, if there is a default
+
+ -- It drops entries that equal the default, if there is a default
dropDefault | Just l <- mbdef = M.filter (/= l)
| otherwise = id
+ defaultNeeded | Just (lo,hi) <- mbrange = fromIntegral (M.size ids') /= hi-lo+1
+ | otherwise = True
+
+
mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets
mapSwitchTargets f (SwitchTargets range mbdef branches)
= SwitchTargets range (fmap f mbdef) (fmap f branches)
@@ -723,6 +736,9 @@ switchTargetsCases (SwitchTargets _ _ branches) = M.toList branches
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault (SwitchTargets _ mbdef _) = mbdef
+switchTargetsRange :: SwitchTargets -> Maybe (Integer, Integer)
+switchTargetsRange (SwitchTargets mbrange _ _) = mbrange
+
-- switchTargetsToTable creates a dense jump table, usable for code generation.
-- This is not possible if there is no explicit range, so before code generation
-- all switch statements need to be transformed to one with an explicit range.
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 8948c90e1a..dac6c46f1d 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -229,11 +229,12 @@ pprNode node = pp_node <+> pp_debug
]
CmmSwitch expr ids ->
- hang (hcat [ ptext (sLit "switch ")
+ hang (hsep [ ptext (sLit "switch")
+ , range
, if isTrivialCmmExpr expr
then ppr expr
else parens (ppr expr)
- , ptext (sLit " {")
+ , ptext (sLit "{")
])
4 (vcat (map ppCase cases) $$ def) $$ rbrace
where
@@ -250,6 +251,11 @@ pprNode node = pp_node <+> pp_debug
]
| otherwise = empty
+ range | Just (lo,hi) <- switchTargetsRange ids
+ = brackets $ hsep [integer lo, ptext (sLit ".."), integer hi]
+ | otherwise
+ = empty
+
CmmCall tgt k regs out res updfr_off ->
hcat [ ptext (sLit "call"), space
, pprFun tgt, parens (interpp'SP regs), space