X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmProcPointZ.hs;h=fc6b72654449500de085cac798f2050ec65fe4e3;hb=ba60dc74fdb18fe655cfac605130cf6480116e47;hp=c73f0164ec2479ca779e88dd979150c663cbf6bf;hpb=b822c1e46cd64d1dba23fbab0f775b731bf0f12b;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs
index c73f016..fc6b726 100644
--- a/compiler/cmm/CmmProcPointZ.hs
+++ b/compiler/cmm/CmmProcPointZ.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
 module CmmProcPointZ
     ( minimalProcPointSet
     , addProcPointProtocols
@@ -23,7 +23,7 @@ import UniqFM
 import UniqSet
 import ZipCfg
 import ZipCfgCmmRep
-import ZipDataflow
+import ZipDataflow0
 
 -- Compute a minimal set of proc points for a control-flow graph.
 
@@ -118,7 +118,7 @@ forward = FComp "proc-point reachability" first middle last exit
           middle x _ = x
           last _ (LastCall _ (Just id)) = LastOutFacts [(id, ProcPoint)]
           last x l = LastOutFacts $ map (\id -> (id, x)) (succs l)
-          exit _   = LastOutFacts []
+          exit x   = x
                 
 minimalProcPointSet :: CmmGraph -> ProcPointSet
 minimalProcPointSet g = extendPPSet g (postorder_dfs g) entryPoint
@@ -132,7 +132,7 @@ extendPPSet g blocks procPoints =
                      Nothing -> procPoints'
     where env = runDFA lattice $
                 do refine_f_anal forward g set_init_points
-                   allFacts
+                   getAllFacts
           set_init_points = mapM_ (\id -> setFact id ProcPoint)
                             (uniqSetToList procPoints)
           procPoints' = fold_blocks add emptyBlockSet g
@@ -246,7 +246,7 @@ addProcPointProtocols procPoints formals g =
               let (Block _ t) = lookupBlockEnv (lg_blocks g) id `orElse`
                                 panic "jump out of graph"
               in case t of
-                   ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee [])))
+                   ZTail (CopyIn {}) (ZLast (LastOther (LastBranch pee)))
                        | elemBlockSet pee procPoints -> Just pee
                    _ -> Nothing
           init_protocols = fold_blocks maybe_add_proto emptyBlockEnv g
@@ -256,7 +256,7 @@ addProcPointProtocols procPoints formals g =
           maybe_add_proto (Block id _) env | id == lg_entry g =
               extendBlockEnv env id (Protocol stdArgConvention hinted_formals)
           maybe_add_proto _ env = env
-          hinted_formals = map (\x -> (x, NoHint)) formals
+          hinted_formals = map (\x -> CmmHinted x NoHint) formals
           stdArgConvention = ConventionStandard CmmCallConv Arguments
 
 -- | For now, following a suggestion by Ben Lippmeier, we pass all
@@ -279,7 +279,7 @@ pass_live_vars_as_args procPoints (protos, g) = (protos', g')
               Nothing -> let live = lookupBlockEnv liveness id `orElse`
                                     emptyRegSet -- XXX there's a bug lurking!
                                     -- panic ("no liveness at block " ++ show id)
-                             formals = map (\x->(x,NoHint)) $ uniqSetToList live
+                             formals = map (\x -> CmmHinted x NoHint) $ uniqSetToList live
                          in  extendBlockEnv protos id (Protocol ConventionPrivate formals)
         g' = g { lg_blocks = add_CopyIns protos' (lg_blocks g) }