[project @ 2001-05-31 11:25:51 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 d22cc00..b0f8dac 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -14,20 +14,19 @@ module CoreTidy (
 import CmdLineOpts     ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
 import CoreSyn
 import CoreUnfold      ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
-import CoreFVs         ( ruleSomeFreeVars, exprSomeFreeVars, 
-                         ruleSomeLhsFreeVars )
+import CoreFVs         ( ruleSomeFreeVars, exprSomeFreeVars )
 import CoreLint                ( showPass, endPass )
 import VarEnv
 import VarSet
-import Var             ( Id, Var, varName )
+import Var             ( Id, Var )
 import Id              ( idType, idInfo, idName, isExportedId, 
-                         idSpecialisation, idUnique, 
-                         mkVanillaGlobal, isLocalId, isImplicitId,
-                         hasNoBinding, mkUserLocal
+                         idSpecialisation, idUnique, isDataConWrapId,
+                         mkVanillaGlobal, isLocalId, isRecordSelector,
+                         setIdUnfolding, hasNoBinding, mkUserLocal
                        ) 
 import IdInfo          {- loads of stuff -}
 import Name            ( getOccName, nameOccName, globaliseName, setNameOcc, 
-                         localiseName, isGlobalName, isLocalName
+                         localiseName, isGlobalName
                        )
 import NameEnv         ( filterNameEnv )
 import OccName         ( TidyOccEnv, initTidyOccEnv, tidyOccName )
@@ -205,8 +204,8 @@ mkFinalTypeEnv type_env final_ids
        -- in interface files, because they are needed by importing modules when
        -- using the compilation manager
 
-       -- We keep constructor workers, because they won't appear
-       -- in the bindings from which final_ids are derived!
+       -- We keep "hasNoBinding" Ids, notably constructor workers, 
+       -- because they won't appear in the bindings from which final_ids are derived!
     keep_it (AnId id) = hasNoBinding id        -- Remove all Ids except constructor workers
     keep_it other     = True           -- Keep all TyCons and Classes
 \end{code}
@@ -228,22 +227,10 @@ findExternalRules binds orphan_rules ext_ids
                   | id <- bindersOfBinds binds,
                     id `elemVarEnv` ext_ids,
                     rule <- rulesRules (idSpecialisation id),
-                    not (isBuiltinRule rule),
+                    not (isBuiltinRule rule)
                        -- We can't print builtin rules in interface files
                        -- Since they are built in, an importing module
                        -- will have access to them anyway
-
-                       -- Sept 00: I've disabled this test.  It doesn't stop 
-                       -- many, if any, rules from coming out, and to make it
-                       -- work properly we need to add ????
-                       --      (put it back in for now)
-                    isEmptyVarSet (ruleSomeLhsFreeVars (isLocalName . varName) rule)
-
-                               -- Spit out a rule only if none of its LHS free
-                               -- vars are LocalName things i.e. things that
-                               -- aren't visible to importing modules This is a
-                               -- good reason not to do it when we emit the Id
-                               -- itself
                 ]
 \end{code}
 
@@ -394,12 +381,6 @@ tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
 
         rhs' = tidyExpr rec_tidy_env rhs
 
-       -- the CafInfo for a recursive group says whether *any* rhs in
-       -- the group may refer indirectly to a CAF (because then, they all do).
-    (bndrs, rhss) = unzip prs'
-    pred v = v `notElem` bndrs
-
-
 tidyTopBinder :: Module -> IdEnv Bool
              -> CgInfoEnv
              -> TidyEnv -> CoreExpr
@@ -412,8 +393,32 @@ tidyTopBinder :: Module -> IdEnv Bool
 tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
              env@(orig_env2, occ_env2, subst_env2) id
 
-  | isImplicitId id    -- Don't mess with constructors, 
-  = (env, id)          -- record selectors, and the like
+  | isDataConWrapId id -- Don't tidy constructor wrappers
+  = (env, id)          -- The Id is stored in the TyCon, so it would be bad
+                       -- if anything changed
+
+-- HACK ALERT: we *do* tidy record selectors.  Reason: they mention error
+-- messages, which may be floated out:
+--     x_field pt = case pt of
+--                     Rect x y -> y
+--                     Pol _ _  -> error "buggle wuggle"
+-- The error message will be floated out so we'll get
+--     lvl5 = error "buggle wuggle"
+--     x_field pt = case pt of
+--                     Rect x y -> y
+--                     Pol _ _  -> lvl5
+--
+-- When this happens, it's vital that the Id exposed to importing modules
+-- (by ghci) mentions lvl5 in its unfolding, not the un-tidied version.
+-- 
+-- What about the Id in the TyCon?  It probably shouldn't be in the TyCon at
+-- all, but in any case it will have the error message inline so it won't matter.
+
+
+  | isRecordSelector id        -- We can't use the "otherwise" case, because that
+                       -- forgets the IdDetails, which forgets that this is
+                       -- a record selector, which confuses an importing module
+  = (env, id `setIdUnfolding` unfold_info)
 
   | otherwise
        -- This function is the heart of Step 2