diff options
Diffstat (limited to 'compiler/simplStg/SimplStg.hs')
| -rw-r--r-- | compiler/simplStg/SimplStg.hs | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index 327f614b68..81665a8735 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -6,6 +6,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} module SimplStg ( stg2stg ) where @@ -20,6 +22,7 @@ import StgStats ( showStgStats ) import UnariseStg ( unarise ) import StgCse ( stgCse ) import StgLiftLams ( stgLiftLams ) +import Module ( Module ) import DynFlags import ErrUtils @@ -40,10 +43,11 @@ runStgM :: UniqSupply -> StgM a -> IO a runStgM us (StgM m) = evalStateT m us stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do - -> [StgTopBinding] -- input... + -> Module -- module being compiled + -> [StgTopBinding] -- input program -> IO [StgTopBinding] -- output program -stg2stg dflags binds +stg2stg dflags this_mod binds = do { showPass dflags "Stg2Stg" ; us <- mkSplitUniqSupply 'g' @@ -58,8 +62,10 @@ stg2stg dflags binds where stg_linter what - | gopt Opt_DoStgLinting dflags = lintStgTopBindings dflags what - | otherwise = \ _whodunnit _binds -> return () + | gopt Opt_DoStgLinting dflags + = lintStgTopBindings dflags this_mod what + | otherwise + = \ _whodunnit _binds -> return () ------------------------------------------- do_stg_pass :: [StgTopBinding] -> StgToDo -> StgM [StgTopBinding] @@ -81,7 +87,7 @@ stg2stg dflags binds end_pass "StgLiftLams" binds' StgUnarise -> do - dump_when Opt_D_dump_stg "Pre unarise:" binds + liftIO (dump_when Opt_D_dump_stg "Pre unarise:" binds) us <- getUniqueSupplyM liftIO (stg_linter False "Pre-unarise" binds) let binds' = unarise us binds @@ -89,7 +95,7 @@ stg2stg dflags binds return binds' dump_when flag header binds - = liftIO (dumpIfSet_dyn dflags flag header (pprStgTopBindings binds)) + = dumpIfSet_dyn dflags flag header (pprStgTopBindings binds) end_pass what binds2 = liftIO $ do -- report verbosely, if required |