diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2015-03-05 19:40:11 +0100 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2015-03-05 19:40:11 +0100 |
commit | de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f (patch) | |
tree | 7a79d1fb997a317afe1def920c41e7b8f3c38dd9 | |
parent | 1ec5c8a1b3db46026d159f54f9dad0d77a6f9b33 (diff) | |
download | haskell-de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f.tar.gz |
Print range of a switch in PprCmm
-rw-r--r-- | compiler/cmm/CmmNode.hs | 24 | ||||
-rw-r--r-- | compiler/cmm/PprCmm.hs | 10 |
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 |