[project @ 2000-10-24 08:40:09 by simonpj]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreTidy.lhs

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index f3ba9c4..6254817 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -11,7 +11,7 @@ module CoreTidy (
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( opt_D_dump_simpl, opt_D_verbose_core2core, opt_UsageSPOn )
+import CmdLineOpts     ( DynFlags, DynFlag(..), opt_UsageSPOn, dopt )
 import CoreSyn
 import CoreUnfold      ( noUnfolding )
 import CoreLint                ( beginPass, endPass )
@@ -34,7 +34,7 @@ import Name           ( getOccName, tidyTopName, mkLocalName, isLocallyDefined )
 import OccName         ( initTidyOccEnv, tidyOccName )
 import Type            ( tidyTopType, tidyType, tidyTypes, tidyTyVar, tidyTyVars )
 import Module          ( Module )
-import UniqSupply      ( UniqSupply )
+import UniqSupply      ( mkSplitUniqSupply )
 import Unique          ( Uniquable(..) )
 import SrcLoc          ( noSrcLoc )
 import Util            ( mapAccumL )
@@ -66,24 +66,27 @@ Several tasks are done by @tidyCorePgm@
    from the uniques for local thunks etc.]
 
 \begin{code}
-tidyCorePgm :: UniqSupply -> Module -> [CoreBind] -> RuleBase
+tidyCorePgm :: DynFlags -> Module -> [CoreBind] -> RuleBase
            -> IO ([CoreBind], [ProtoCoreRule])
-tidyCorePgm us module_name binds_in rulebase_in
+tidyCorePgm dflags module_name binds_in rulebase_in
   = do
-       beginPass "Tidy Core"
+       us <- mkSplitUniqSupply 'u'
 
-        (binds_in1,mrulebase_in1) <- if opt_UsageSPOn
-                                     then _scc_ "CoreUsageSPInf"
-                                          doUsageSPInf us binds_in rulebase_in
-                                     else return (binds_in,Nothing)
+       beginPass dflags "Tidy Core"
 
-       let rulebase_in1            = maybe rulebase_in id mrulebase_in1
+        binds_in1 <- if opt_UsageSPOn
+                     then _scc_ "CoreUsageSPInf"
+                                doUsageSPInf dflags us binds_in rulebase_in
+                     else return binds_in
 
-            (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
+       let (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
                                                 init_tidy_env binds_in1
-           rules_out               = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in1)
+           rules_out               = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in)
+
+       endPass dflags "Tidy Core" (dopt Opt_D_dump_simpl dflags || 
+                                   dopt Opt_D_verbose_core2core dflags)
+               binds_out
 
-       endPass "Tidy Core" (opt_D_dump_simpl || opt_D_verbose_core2core) binds_out
        return (binds_out, rules_out)
   where
        -- We also make sure to avoid any exported binders.  Consider