[commit: ghc] wip/T10137: Print range of a switch in PprCmm (de24b27)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T10137
Link       : http://ghc.haskell.org/trac/ghc/changeset/de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f/ghc

>---------------------------------------------------------------

commit de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Mar 5 19:40:11 2015 +0100

    Print range of a switch in PprCmm


>---------------------------------------------------------------

de24b276ffa5b21addcaa1a14d5b4c31e9d5ea2f
 compiler/cmm/CmmNode.hs | 24 ++++++++++++++++++++----
 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 90d1b77..42e5fca 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 8948c90..dac6c46 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