X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmProcPointZ.hs;h=059b5f29ffa1055e50d5a3c03d5922eeb9e8bf3b;hb=d3ff015a17804b31727b41e3e9dff03b6a654143;hp=e250bf32e330d4a20c8460dd63e600e35c8af3e4;hpb=1241c26f3552a2037263769e5ef7fa68d9f3be36;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs index e250bf3..059b5f2 100644 --- a/compiler/cmm/CmmProcPointZ.hs +++ b/compiler/cmm/CmmProcPointZ.hs @@ -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 @@ -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) }