+#if __GLASGOW_HASKELL__ >= 611
+{-# OPTIONS_GHC -XNoMonoLocalBinds #-}
+#endif
+-- Norman likes local bindings
+-- If this module lives on I'd like to get rid of this flag in due course
+
module CmmCPSZ (
-- | Converts C-- with full proceedures and parameters
-- to a CPS transformed C-- with the stack made manifest.
import DynFlags
import ErrUtils
-import FiniteMap
import HscTypes
import Data.Maybe
import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
import Outputable
import StaticFlags
cpsTop :: HscEnv -> CmmTopZ ->
IO ([(CLabel, CAFSet)],
[(CAFSet, CmmTopForInfoTables)])
-cpsTop _ p@(CmmData {}) = return ([], [(emptyFM, NoInfoTable p)])
+cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, NoInfoTable p)])
cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), g)) =
do
dump Opt_D_dump_cmmz "Pre Proc Points Added" g
where dflags = hsc_dflags hsc_env
mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
dump f txt g = dumpIfSet_dyn dflags f txt (ppr g)
+
+ run :: FuelMonad a -> IO a
run = runFuelIO (hsc_OptFuel hsc_env)
+
dual_rewrite flag txt pass g =
do dump flag ("Pre " ++ txt) g
g <- run $ pass g
-- This probably belongs in CmmBuildInfoTables?
-- We're just finishing the job here: once we know what CAFs are defined
-- in non-static closures, we can build the SRTs.
-toTops :: HscEnv -> FiniteMap CLabel CAFSet -> (TopSRT, [[CmmTopZ]])
+toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTopZ]])
-> [(CAFSet, CmmTopForInfoTables)] -> IO (TopSRT, [[CmmTopZ]])
toTops hsc_env topCAFEnv (topSRT, tops) gs =