[project @ 2000-11-14 10:46:39 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 6254817..892cb26 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -14,13 +14,12 @@ module CoreTidy (
 import CmdLineOpts     ( DynFlags, DynFlag(..), opt_UsageSPOn, dopt )
 import CoreSyn
 import CoreUnfold      ( noUnfolding )
-import CoreLint                ( beginPass, endPass )
-import Rules           ( ProtoCoreRule(..), RuleBase )
+import CoreLint                ( showPass, endPass )
 import UsageSPInf       ( doUsageSPInf )
 import VarEnv
 import VarSet
 import Var             ( Id, Var )
-import Id              ( idType, idInfo, idName, idSpecialisation,
+import Id              ( idType, idInfo, idName, isExportedId,
                          mkVanillaId, mkId, exportWithOrigOccName,
                          idStrictness, setIdStrictness,
                          idDemandInfo, setIdDemandInfo,
@@ -30,12 +29,13 @@ import IdInfo               ( specInfo, setSpecInfo,
                          workerInfo, setWorkerInfo, WorkerInfo(..)
                        )
 import Demand          ( wwLazy )
-import Name            ( getOccName, tidyTopName, mkLocalName, isLocallyDefined )
+import Name            ( getOccName, tidyTopName, mkLocalName )
 import OccName         ( initTidyOccEnv, tidyOccName )
-import Type            ( tidyTopType, tidyType, tidyTypes, tidyTyVar, tidyTyVars )
+import Type            ( tidyTopType, tidyType, tidyTyVar )
 import Module          ( Module )
 import UniqSupply      ( mkSplitUniqSupply )
 import Unique          ( Uniquable(..) )
+import ErrUtils                ( showPass )
 import SrcLoc          ( noSrcLoc )
 import Util            ( mapAccumL )
 \end{code}
@@ -66,28 +66,29 @@ Several tasks are done by @tidyCorePgm@
    from the uniques for local thunks etc.]
 
 \begin{code}
-tidyCorePgm :: DynFlags -> Module -> [CoreBind] -> RuleBase
-           -> IO ([CoreBind], [ProtoCoreRule])
-tidyCorePgm dflags module_name binds_in rulebase_in
+tidyCorePgm :: DynFlags -> Module
+           -> [CoreBind] -> [IdCoreRule]
+           -> IO ([CoreBind], [IdCoreRule])
+tidyCorePgm dflags module_name binds_in orphans_in
   = do
        us <- mkSplitUniqSupply 'u'
 
-       beginPass dflags "Tidy Core"
+       showPass dflags "Tidy Core"
 
         binds_in1 <- if opt_UsageSPOn
                      then _scc_ "CoreUsageSPInf"
-                                doUsageSPInf dflags us binds_in rulebase_in
+                                doUsageSPInf dflags us binds_in
                      else return binds_in
 
        let (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
                                                 init_tidy_env binds_in1
-           rules_out               = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in)
+           orphans_out             = tidyIdRules tidy_env1 orphans_in
 
        endPass dflags "Tidy Core" (dopt Opt_D_dump_simpl dflags || 
                                    dopt Opt_D_verbose_core2core dflags)
                binds_out
 
-       return (binds_out, rules_out)
+       return (binds_out, orphans_out)
   where
        -- We also make sure to avoid any exported binders.  Consider
        --      f{-u1-} = 1     -- Local decl
@@ -101,11 +102,6 @@ tidyCorePgm dflags module_name binds_in rulebase_in
     avoids       = [getOccName bndr | bndr <- bindersOfBinds binds_in,
                                       exportWithOrigOccName bndr]
 
-    mk_local_protos :: RuleBase -> [ProtoCoreRule]
-    mk_local_protos (rule_ids, _)
-      = [ProtoCoreRule True id rule | id <- varSetElems rule_ids,
-                                      rule <- rulesRules (idSpecialisation id)]
-
 tidyBind :: Maybe Module               -- (Just m) for top level, Nothing for nested
         -> TidyEnv
         -> CoreBind
@@ -220,8 +216,7 @@ tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
 tidyTopId mod env@(tidy_env, var_env) env_idinfo id
   =    -- Top level variables
     let
-       (tidy_env', name') | exportWithOrigOccName id = (tidy_env, idName id)
-                          | otherwise                = tidyTopName mod tidy_env (idName id)
+       (tidy_env', name') = tidyTopName mod tidy_env (isExportedId id) (idName id)
        ty'                = tidyTopType (idType id)
        idinfo'            = tidyIdInfo env_idinfo (idInfo id)
        id'                = mkId name' ty' idinfo'
@@ -245,17 +240,15 @@ tidyIdInfo env info
          | otherwise              = info `setSpecInfo` tidyRules env rules
                
     info3 = info2 `setUnfoldingInfo` noUnfolding 
-    info4 = info3 `setDemandInfo`    wwLazy            -- I don't understand why...
+    info4 = info3 `setDemandInfo`    wwLazy            
 
     info5 = case workerInfo info of
                NoWorker -> info4
                HasWorker w a  -> info4 `setWorkerInfo` HasWorker (tidyVarOcc env w) a
 
-tidyProtoRules :: TidyEnv -> [ProtoCoreRule] -> [ProtoCoreRule]
-tidyProtoRules env rules
-  = [ ProtoCoreRule is_local (tidyVarOcc env fn) (tidyRule env rule)
-    | ProtoCoreRule is_local fn rule <- rules
-    ]
+tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
+tidyIdRules env rules
+  = [ (tidyVarOcc env fn, tidyRule env rule) | (fn,rule) <- rules  ]
 
 tidyRules :: TidyEnv -> CoreRules -> CoreRules
 tidyRules env (Rules rules fvs)