X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=a6b215b38febae7e5d24bb386a8b2a4fdfc83d1a;hb=f1fc7698ef9997f950be8cb37c9b30dadbb4b631;hp=076922e3fb8dbb02a077cea69d54312c1ff749f5;hpb=889c084e943779e76d19f2ef5e970ff655f511eb;p=ghc-hetmet.git

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 076922e..a6b215b 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -2,11 +2,18 @@
 {-# LANGUAGE GADTs #-}
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+#if __GLASGOW_HASKELL__ >= 701
+-- GHC 7.0.1 improved incomplete pattern warnings with GADTs
+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+#endif
+
 module Cmm
-  ( CmmGraph(..), CmmBlock
+  ( CmmGraph, GenCmmGraph(..), CmmBlock
   , CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop
-  , CmmReplGraph, CmmFwdRewrite, CmmBwdRewrite
+  , CmmReplGraph, GenCmmReplGraph, CmmFwdRewrite, CmmBwdRewrite
 
+  , modifyGraph
   , lastNode, replaceLastNode, insertBetween
   , ofBlockMap, toBlockMap, insertBlock
   , ofBlockList, toBlockList, bodyToBlockList
@@ -35,10 +42,12 @@ import Panic
 -------------------------------------------------
 -- CmmBlock, CmmGraph and Cmm
 
-data CmmGraph = CmmGraph { g_entry :: BlockId, g_graph :: Graph CmmNode C C }
+type CmmGraph = GenCmmGraph CmmNode
+data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
 type CmmBlock = Block CmmNode C C
 
-type CmmReplGraph e x = FuelUniqSM (Maybe (Graph CmmNode e x))
+type CmmReplGraph e x = GenCmmReplGraph CmmNode e x
+type GenCmmReplGraph n e x = FuelUniqSM (Maybe (Graph n e x))
 type CmmFwdRewrite f = FwdRewrite FuelUniqSM CmmNode f
 type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f
 
@@ -50,9 +59,11 @@ type CmmTop       = GenCmmTop CmmStatic CmmTopInfo CmmGraph
 -------------------------------------------------
 -- Manipulating CmmGraphs
 
+modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
+modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
+
 toBlockMap :: CmmGraph -> LabelMap CmmBlock
 toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
---toBlockMap _ = panic "Cmm.toBlockMap"
 
 ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph
 ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO}
@@ -131,7 +142,6 @@ insertBetween b ms succId = insert $ lastNode b
           panic "unimp: insertBetween after a call -- probably not a good idea"
         insert (CmmForeignCall {}) =
           panic "unimp: insertBetween after a foreign call -- probably not a good idea"
-        --insert _ = panic "Cmm.insertBetween.insert"
 
         newBlocks :: MonadUnique m => m (BlockId, [CmmBlock])
         newBlocks = do id <- liftM mkBlockId $ getUniqueM
@@ -146,26 +156,26 @@ insertBetween b ms succId = insert $ lastNode b
 -- Running dataflow analysis and/or rewrites
 
 -- Constructing forward and backward analysis-only pass
-analFwd    :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdPass m CmmNode f
-analBwd    :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdPass m CmmNode f
+analFwd    :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdPass m n f
+analBwd    :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdPass m n f
 
 analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
 analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
 
 -- Constructing forward and backward analysis + rewrite pass
-analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdRewrite m CmmNode f -> FwdPass m CmmNode f
-analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdRewrite m CmmNode f -> BwdPass m CmmNode f
+analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdRewrite m n f -> FwdPass m n f
+analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdRewrite m n f -> BwdPass m n f
 
 analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
 analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
 
 -- Running forward and backward dataflow analysis + optional rewrite
-dataflowPassFwd :: CmmGraph -> [(BlockId, f)] -> FwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
+dataflowPassFwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> FwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
 
-dataflowPassBwd :: CmmGraph -> [(BlockId, f)] -> BwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
+dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> BwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
 dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
   (graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
   return (CmmGraph {g_entry=entry, g_graph=graph}, facts)