[project @ 2004-08-20 12:21:03 by simonmar]

Simplify the "impossible branch" handling, and fix a bug in the
process.  CmmSwitch encodes the possibility of having impossible
branches (the destinations are Maybe BlockId rather than just BlockId)
so we don't need to encode impossible branches as dummy blocks
containing a jump to an impossible location (currently 0).

However, PprC and PprCmm weren't set up to cope with Nothings in a
CmmSwitch, so this commit fixes that too.

2 files changed, 22 insertions, 27 deletions

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index a50d403f8e..cc70a9a08a 100644
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -40,7 +40,7 @@ import Constants
 import CmdLineOpts	( opt_EnsureSplittableC )
 
 -- The rest
-import Data.List        ( intersperse, group )
+import Data.List        ( intersperse, groupBy )
 import Data.Bits        ( shiftR )
 import Char             ( ord, chr )
 import IO               ( Handle )
@@ -251,29 +251,26 @@ pprCondBranch expr ident
 --
 pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
 pprSwitch e maybe_ids 
-  = let ids  = [ i | Just i <- maybe_ids ]
-        pairs = zip [ 0 .. ] (concatMap markfalls (group ids))
+  = let pairs  = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
+	pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
     in 
         (hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
-                4 (vcat ( map caseify pairs )))
+                4 (vcat ( map caseify pairs2 )))
         $$ rbrace
 
   where
-    -- fall through case
-    caseify (i,Left ident) = 
-        hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
-                        ptext SLIT("/* fall through for"), 
-                        pprBlockId ident, 
-                        ptext SLIT("*/") ]
-
-    caseify (i,Right ident) = 
-        hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
-                        ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-
-    -- mark the bottom of a fallthough sequence of cases as `Right'
-    markfalls [a] = [Right a]
-    markfalls as  = map (\a -> Left a) (init as) ++ [Right (last as)]
+    sndEq (_,x) (_,y) = x == y
 
+    -- fall through case
+    caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
+	where 
+	do_fallthrough ix =
+                 hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+                        ptext SLIT("/* fall through */") ]
+
+	final_branch ix = 
+	        hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+                       ptext SLIT("goto") , (pprBlockId ident) <> semi ]
 
 -- ---------------------------------------------------------------------
 -- Expressions.
diff --git a/ghc/compiler/cmm/PprCmm.hs b/ghc/compiler/cmm/PprCmm.hs
index fb1dec1c7c..961c6e40e1 100644
--- a/ghc/compiler/cmm/PprCmm.hs
+++ b/ghc/compiler/cmm/PprCmm.hs
@@ -219,18 +219,13 @@ genJump expr actuals =
 --
 --      switch [0 .. n] (expr) { case ... ; }
 --
--- N.B. we remove 'Nothing's from the list of branches, as they don't
--- seem to make sense currently. This may change, if they are defined in
--- some way.
---
 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
 genSwitch expr maybe_ids 
 
-    = let ids   = [ i | Just i <- maybe_ids ]
-          pairs = groupBy snds (zip [0 .. ] ids )
+    = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
 
       in hang (hcat [ ptext SLIT("switch [0 .. ") 
-                    , int (length ids - 1)
+                    , int (length maybe_ids - 1)
                     , ptext SLIT("] ")
                     , if isTrivialCmmExpr expr
                         then pprExpr expr
@@ -242,13 +237,16 @@ genSwitch expr maybe_ids
     where
       snds a b = (snd a) == (snd b)
 
-      caseify :: [(Int,BlockId)] -> SDoc
+      caseify :: [(Int,Maybe BlockId)] -> SDoc
+      caseify ixs@((i,Nothing):_)
+        = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
+		<> ptext SLIT(" */")
       caseify as 
         = let (is,ids) = unzip as 
           in hsep [ ptext SLIT("case")
                   , hcat (punctuate comma (map int is))
                   , ptext SLIT(": goto")
-                  , pprBlockId (head ids) <> semi ]
+                  , pprBlockId (head [ id | Just id <- ids]) <> semi ]
 
 -- --------------------------------------------------------------------------
 -- Expressions