projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
remove -XNoMonomorphismRestriction
[ghc-hetmet.git]
/
compiler
/
cmm
/
CmmCPSZ.hs
diff --git
a/compiler/cmm/CmmCPSZ.hs
b/compiler/cmm/CmmCPSZ.hs
index
8bcadbb
..
d74da69
100644
(file)
--- a/
compiler/cmm/CmmCPSZ.hs
+++ b/
compiler/cmm/CmmCPSZ.hs
@@
-1,3
+1,9
@@
+#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.
module CmmCPSZ (
-- | Converts C-- with full proceedures and parameters
-- to a CPS transformed C-- with the stack made manifest.
@@
-18,10
+24,11
@@
import ZipCfgCmmRep
import DynFlags
import ErrUtils
import DynFlags
import ErrUtils
-import FiniteMap
import HscTypes
import Data.Maybe
import Control.Monad
import HscTypes
import Data.Maybe
import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
import Outputable
import StaticFlags
import Outputable
import StaticFlags
@@
-67,7
+74,7
@@
global to one compiler session.
cpsTop :: HscEnv -> CmmTopZ ->
IO ([(CLabel, CAFSet)],
[(CAFSet, CmmTopForInfoTables)])
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
cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), g)) =
do
dump Opt_D_dump_cmmz "Pre Proc Points Added" g
@@
-153,7
+160,10
@@
cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), 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)
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)
run = runFuelIO (hsc_OptFuel hsc_env)
+
dual_rewrite flag txt pass g =
do dump flag ("Pre " ++ txt) g
g <- run $ pass g
dual_rewrite flag txt pass g =
do dump flag ("Pre " ++ txt) g
g <- run $ pass g
@@
-163,7
+173,7
@@
cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), 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.
-- 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 =
-> [(CAFSet, CmmTopForInfoTables)] -> IO (TopSRT, [[CmmTopZ]])
toTops hsc_env topCAFEnv (topSRT, tops) gs =