X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCvt.hs;h=107046c7f047473d6b11d6f5b51975d24deff082;hb=4f92da533cd1c7b5f41ef8794ee6a284f1680413;hp=ca635c23124fc2759e77ce119198fd0afdbc7e4c;hpb=b822c1e46cd64d1dba23fbab0f775b731bf0f12b;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs
index ca635c2..107046c 100644
--- a/compiler/cmm/CmmCvt.hs
+++ b/compiler/cmm/CmmCvt.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE PatternGuards #-}
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 
 module CmmCvt
   ( cmmToZgraph, cmmOfZgraph )
@@ -82,13 +81,13 @@ ofZgraph g = ListGraph $ swallow blocks
           tail id prev' out (G.ZTail m t) rest = tail id (mid m : prev') out t rest
           tail id prev' out (G.ZLast G.LastExit)      rest = exit id prev' out rest
           tail id prev' out (G.ZLast (G.LastOther l)) rest = last id prev' out l rest
-          mid (MidNop)        = CmmNop
           mid (MidComment s)  = CmmComment s
           mid (MidAssign l r) = CmmAssign l r
           mid (MidStore  l r) = CmmStore  l r
           mid (MidUnsafeCall f ress args) = CmmCall f ress args CmmUnsafe CmmMayReturn
-          mid m@(CopyOut {})  = pcomment (ppr m)
-          mid m@(CopyIn {})   = pcomment (ppr m <+> text "(proc point)")
+          mid m@(MidAddToContext {}) = pcomment (ppr m)
+          mid m@(CopyOut {})         = pcomment (ppr m)
+          mid m@(CopyIn {})          = pcomment (ppr m <+> text "(proc point)")
           pcomment p = scomment $ showSDoc p
           block' id prev'
               | id == G.lg_entry g = BasicBlock id $ extend_entry    (reverse prev')
@@ -96,8 +95,7 @@ ofZgraph g = ListGraph $ swallow blocks
           last id prev' out l n =
             let endblock stmt = block' id (stmt : prev') : swallow n in
             case l of
-              LastBranch _ (_:_) -> panic "unrepresentable branch"
-              LastBranch tgt [] ->
+              LastBranch tgt ->
                   case n of
                     G.Block id' t : bs
                         | tgt == id', unique_pred id' 
@@ -117,8 +115,8 @@ ofZgraph g = ListGraph $ swallow blocks
                                  tail id (CmmCondBranch e'   fid : prev') Nothing t bs
                     _ -> let instrs' = CmmBranch fid : CmmCondBranch expr tid : prev'
                          in block' id instrs' : swallow n
-              LastJump expr params -> endblock $ CmmJump expr params 
-              LastReturn params    -> endblock $ CmmReturn params
+              LastJump expr        -> endblock $ with_out out $ CmmJump expr
+              LastReturn           -> endblock $ with_out out $ CmmReturn 
               LastSwitch arg ids   -> endblock $ CmmSwitch arg $ ids
               LastCall e cont
                   | Just (conv, args) <- out
@@ -138,6 +136,8 @@ ofZgraph g = ListGraph $ swallow blocks
                             in  tail id (delayed : call : prev') Nothing t bs
                          | otherwise -> panic "unrepairable call"
                   | otherwise -> panic "call with no CopyOut"
+          with_out (Just (_conv, actuals)) f = f actuals
+          with_out Nothing f = pprPanic "unrepairable data flow to" (ppr $ f [])
           findCopyIn (G.ZTail (CopyIn _ ress srt) _) = (ress, srt)
           findCopyIn (G.ZTail _ t) = findCopyIn t
           findCopyIn (G.ZLast _) = panic "missing CopyIn after call"