X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fcmm%2FPprC.hs;h=51e429b0aeb9cf0b7662faa56f1f4979c3ecdab0;hb=69cb15e2f6853435602f00ecbccd2598a9e7eea9;hp=a09edd11df5b6f46a1307c7c80da30a895628d6c;hpb=36fc368e1d3f7497c789e82c774859855ff57f15;p=ghc-hetmet.git

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index a09edd1..51e429b 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 ]
+    sndEq (_,x) (_,y) = x == y
 
-    -- 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)]
+    -- 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.
@@ -336,7 +333,7 @@ pprMachOpApp :: MachOp -> [CmmExpr] -> SDoc
 
 pprMachOpApp op args
   | isMulMayOfloOp op
-  = ptext SLIT("mulIntMayOflo") <> parens (commafy (map pprExpr args)) <> semi
+  = ptext SLIT("mulIntMayOflo") <> parens (commafy (map pprExpr args))
   where isMulMayOfloOp (MO_U_MulMayOflo _) = True
 	isMulMayOfloOp (MO_S_MulMayOflo _) = True
 	isMulMayOfloOp _ = False
@@ -685,7 +682,8 @@ pprCall ppr_fn cconv results args vols
   where 
      ppr_results []     = empty
      ppr_results [(one,hint)] 
-	 = pprExpr (CmmReg one) <> ptext SLIT(" = ") <> pprUnHint hint
+	 = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+		 <> pprUnHint hint (cmmRegRep one)
      ppr_results _other = panic "pprCall: multiple results"
 
      pprArg (expr, PtrHint)
@@ -696,10 +694,10 @@ pprCall ppr_fn cconv results args vols
      pprArg (expr, _other)
 	= pprExpr expr
 
-     pprUnHint PtrHint    = mkW_
-     pprUnHint SignedHint = mkW_
-     pprUnHint _          = empty
-	
+     pprUnHint PtrHint    rep = parens (machRepCType rep)
+     pprUnHint SignedHint rep = parens (machRepCType rep)
+     pprUnHint _          _   = empty
+
      save    = save_restore SLIT("CALLER_SAVE")
      restore = save_restore SLIT("CALLER_RESTORE")