[project @ 2000-11-27 11:04:38 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 e959574..382c79b 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -20,10 +20,11 @@ import VarEnv
 import VarSet
 import Var             ( Id, Var )
 import Id              ( idType, idInfo, idName, isExportedId,
-                         mkVanillaId, mkId, isLocalId,
+                         mkVanillaId, mkId, isLocalId, omitIfaceSigForId,
                          setIdStrictness, setIdDemandInfo,
                        ) 
-import IdInfo          ( constantIdInfo,
+import IdInfo          ( mkIdInfo,
+                         IdFlavour(..), flavourInfo, ppFlavourInfo,
                          specInfo, setSpecInfo, 
                          cprInfo, setCprInfo,
                          inlinePragInfo, setInlinePragInfo, isNeverInlinePrag,
@@ -293,7 +294,11 @@ tidyTopRhs (_, occ_env, subst_env) rhs = tidyExpr (occ_env, subst_env) rhs
 tidyTopBinder :: Module -> IdEnv Bool
              -> TopTidyEnv -> CoreExpr
              -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
-tidyTopBinder mod ext_ids env_idinfo rhs (orig_env, occ_env, subst_env) id
+tidyTopBinder mod ext_ids env_idinfo rhs env@(orig_env, occ_env, subst_env) id
+  | omitIfaceSigForId id       -- Don't mess with constructors, 
+  = (env, id)                  -- record selectors, and the like
+
+  | otherwise
        -- This function is the heart of Step 2
        -- The second env is the one to use for the IdInfo
        -- It's necessary because when we are dealing with a recursive
@@ -321,22 +326,34 @@ tidyTopBinder mod ext_ids env_idinfo rhs (orig_env, occ_env, subst_env) id
                | otherwise   = noUnfolding
 
 tidyIdInfo (_, occ_env, subst_env) is_external unfold_info id
-
   | opt_OmitInterfacePragmas || not is_external
-       -- No IdInfo if the Id isn't 
-  = constantIdInfo
+       -- No IdInfo if the Id isn't external, or if we don't have -O
+  = mkIdInfo new_flavour
+       `setStrictnessInfo` strictnessInfo core_idinfo
+       -- Keep strictness info; it's used by the code generator
 
   | otherwise
-  = constantIdInfo `setCprInfo`         cprInfo core_idinfo
-                  `setStrictnessInfo`   strictnessInfo core_idinfo
-                  `setInlinePragInfo`   inlinePragInfo core_idinfo
-                  `setUnfoldingInfo`    unfold_info
-                  `setWorkerInfo`       tidyWorker tidy_env (workerInfo core_idinfo)
-                  `setSpecInfo`         tidyRules tidy_env (specInfo core_idinfo)
+  = mkIdInfo new_flavour
+       `setCprInfo`        cprInfo core_idinfo
+       `setStrictnessInfo` strictnessInfo core_idinfo
+       `setInlinePragInfo` inlinePragInfo core_idinfo
+       `setUnfoldingInfo`  unfold_info
+       `setWorkerInfo`     tidyWorker tidy_env (workerInfo core_idinfo)
+       `setSpecInfo`       tidyRules  tidy_env (specInfo core_idinfo)
   where
     tidy_env    = (occ_env, subst_env)
     core_idinfo = idInfo id
 
+       -- A DFunId must stay a DFunId, so that we can gather the
+       -- DFunIds up later.  Other local things become ConstantIds.
+    new_flavour = case flavourInfo core_idinfo of
+                   VanillaId  -> ConstantId
+                   ExportedId -> ConstantId
+                   ConstantId -> ConstantId    -- e.g. Default methods
+                   DictFunId  -> DictFunId
+                   flavour    -> pprTrace "tidyIdInfo" (ppr id <+> ppFlavourInfo flavour)
+                                 flavour
+
 tidyTopName mod orig_env occ_env external name
   | global && internal = (orig_env, occ_env,  localiseName name)
   | local  && internal = (orig_env, occ_env', setNameOcc name occ')