[project @ 1999-07-12 14:40:08 by simonmar]

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

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 76d43f5..51a5175 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -16,17 +16,19 @@ import CoreSyn
 import CoreUnfold      ( noUnfolding )
 import CoreLint                ( beginPass, endPass )
 import Rules           ( ProtoCoreRule(..) )
+import UsageSPInf       ( doUsageSPInf )
 import VarEnv
 import VarSet
 import Var             ( Id, IdOrTyVar )
 import Id              ( idType, idInfo, idName, 
-                         mkVanillaId, mkId, isUserExportedId,
+                         mkVanillaId, mkId, exportWithOrigOccName,
                          getIdStrictness, setIdStrictness,
                          getIdDemandInfo, setIdDemandInfo,
                        ) 
 import IdInfo          ( specInfo, setSpecInfo, 
                          inlinePragInfo, setInlinePragInfo, InlinePragInfo(..),
-                         setUnfoldingInfo, setDemandInfo
+                         setUnfoldingInfo, setDemandInfo,
+                         workerInfo, setWorkerInfo
                        )
 import Demand          ( wwLazy )
 import Name            ( getOccName, tidyTopName, mkLocalName, isLocallyDefined )
@@ -38,8 +40,6 @@ import Unique         ( Uniquable(..) )
 import SrcLoc          ( noSrcLoc )
 import Util            ( mapAccumL )
 import Outputable
-
-doUsageSPInf = panic "doUsageSpInf"
 \end{code}
 
 
@@ -94,7 +94,7 @@ tidyCorePgm us module_name binds_in rules
        -- decl.  tidyTopId then does a no-op on exported binders.
     init_tidy_env = (initTidyOccEnv avoids, emptyVarEnv)
     avoids       = [getOccName bndr | bndr <- bindersOfBinds binds_in,
-                                      isUserExportedId bndr]
+                                      exportWithOrigOccName bndr]
 
 tidyBind :: Maybe Module               -- (Just m) for top level, Nothing for nested
         -> TidyEnv
@@ -102,7 +102,7 @@ tidyBind :: Maybe Module            -- (Just m) for top level, Nothing for nested
         -> (TidyEnv, CoreBind)
 tidyBind maybe_mod env (NonRec bndr rhs)
   = let
-       (env', bndr') = tidy_bndr maybe_mod env bndr
+       (env', bndr') = tidy_bndr maybe_mod env env bndr
        rhs'          = tidyExpr env rhs
     in
     (env', NonRec bndr' rhs')
@@ -117,7 +117,7 @@ tidyBind maybe_mod env (Rec pairs)
        -- So I left it out for now
 
        (bndrs, rhss)  = unzip pairs
-       (env', bndrs') = mapAccumL (tidy_bndr maybe_mod) env bndrs
+       (env', bndrs') = mapAccumL (tidy_bndr maybe_mod env') env bndrs
        rhss'          = map (tidyExpr env') rhss
   in
   (env', Rec (zip bndrs' rhss'))
@@ -155,8 +155,8 @@ tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 \end{code}
 
 \begin{code}
-tidy_bndr (Just mod) env id  = tidyTopId mod env id
-tidy_bndr Nothing    env var = tidyBndr  env var
+tidy_bndr (Just mod) env_idinfo env var = tidyTopId mod env env_idinfo var
+tidy_bndr Nothing    env_idinfo env var = tidyBndr      env            var
 \end{code}
 
 
@@ -199,14 +199,18 @@ tidyId env@(tidy_env, var_env) id
     in
     ((tidy_env', var_env'), id')
 
-tidyTopId :: Module -> TidyEnv -> Id -> (TidyEnv, Id)
-tidyTopId mod env@(tidy_env, var_env) id
+tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
+       -- The second env is the one to use for the IdInfo
+       -- It's necessary because when we are dealing with a recursive
+       -- group, a variable late in the group might be mentioned
+       -- in the IdInfo of one early in the group
+tidyTopId mod env@(tidy_env, var_env) env_idinfo id
   =    -- Top level variables
     let
-       (tidy_env', name') | isUserExportedId id = (tidy_env, idName id)
-                          | otherwise           = tidyTopName mod tidy_env (idName id)
+       (tidy_env', name') | exportWithOrigOccName id = (tidy_env, idName id)
+                          | otherwise                = tidyTopName mod tidy_env (idName id)
        ty'                = tidyTopType (idType id)
-       idinfo'            = tidyIdInfo env (idInfo id)
+       idinfo'            = tidyIdInfo env_idinfo (idInfo id)
        id'                = mkId name' ty' idinfo'
        var_env'           = extendVarEnv var_env id id'
     in
@@ -221,7 +225,7 @@ tidyTopId mod env@(tidy_env, var_env) id
 -- The latter two are to avoid space leaks
 
 tidyIdInfo env info
-  = info4
+  = info5
   where
     rules = specInfo info
 
@@ -235,6 +239,10 @@ tidyIdInfo env info
     info3 = info2 `setUnfoldingInfo` noUnfolding 
     info4 = info3 `setDemandInfo`    wwLazy            -- I don't understand why...
 
+    info5 = case workerInfo info of
+               Nothing -> info4
+               Just w  -> info4 `setWorkerInfo` Just (tidyVarOcc env w)
+
 tidyProtoRules :: TidyEnv -> [ProtoCoreRule] -> [ProtoCoreRule]
 tidyProtoRules env rules
   = [ ProtoCoreRule is_local (tidyVarOcc env fn) (tidyRule env rule)