[project @ 2004-12-24 11:38:09 by simonpj]

Reset the export flag for the new bindings in LiberateCase

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 972c6ab..cb848a1 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -19,7 +19,7 @@ module Id (
        recordSelectorFieldLabel,
 
        -- Modifying an Id
-       setIdName, setIdUnique, Id.setIdType, setIdLocalExported, 
+       setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, 
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
        zapLamIdInfo, zapDemandIdInfo, 
 
@@ -84,7 +84,8 @@ import BasicTypes     ( Arity )
 import Var             ( Id, DictId,
                          isId, isExportedId, isSpecPragmaId, isLocalId,
                          idName, idType, idUnique, idInfo, isGlobalId,
-                         setIdName, setIdType, setIdUnique, setIdLocalExported,
+                         setIdName, setIdType, setIdUnique, 
+                         setIdExported, setIdNotExported,
                          setIdInfo, lazySetIdInfo, modifyIdInfo, 
                          maybeModifyIdInfo,
                          globalIdDetails

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index e7084ca..4275132 100644 (file)
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -733,7 +733,7 @@ It's OK for dfuns to be LocalIds, because we form the instance-env to
 pass on to the next module (md_insts) in CoreTidy, afer tidying
 and globalising the top-level Ids.
 
-BUT make sure they are *exported* LocalIds (setIdLocalExported) so 
+BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
 that they aren't discarded by the occurrence analyser.
 
 \begin{code}

diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index 0e282c2..c3f626e 100644 (file)
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -19,7 +19,7 @@ module Var (
        Id, DictId,
        idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
        setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, 
-       setIdLocalExported, zapSpecPragmaId,
+       setIdExported, setIdNotExported, zapSpecPragmaId,
 
        globalIdDetails, globaliseId, 
 
@@ -215,9 +215,20 @@ setIdName = setVarName
 setIdType :: Id -> Type -> Id
 setIdType id ty = id {idType = ty}
 
-setIdLocalExported :: Id -> Id
--- It had better be a LocalId already
-setIdLocalExported id = id { lclDetails = Exported }
+setIdExported :: Id -> Id
+-- Can be called on GlobalIds, such as data cons and class ops,
+-- which are "born" as GlobalIds and automatically exported
+setIdExported id@(LocalId {}) = id { lclDetails = Exported }
+setIdExported other_id       = ASSERT( isId other_id ) other_id
+
+setIdNotExported :: Id -> Id
+-- We can only do this to LocalIds
+setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported }
+
+zapSpecPragmaId :: Id -> Id
+zapSpecPragmaId id
+  | isSpecPragmaId id = id {lclDetails = NotExported}
+  | otherwise         = id
 
 globaliseId :: GlobalIdDetails -> Id -> Id
 -- If it's a local, make it global
@@ -227,11 +238,6 @@ globaliseId details id = GlobalId { varName    = varName id,
                                    idInfo     = idInfo id,
                                    gblDetails = details }
 
-zapSpecPragmaId :: Id -> Id
-zapSpecPragmaId id
-  | isSpecPragmaId id = id {lclDetails = NotExported}
-  | otherwise         = id
-
 lazySetIdInfo :: Id -> IdInfo -> Id
 lazySetIdInfo id info = id {idInfo = info}
 

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index 8f624dd..36fd15c 100644 (file)
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -15,7 +15,7 @@ import HsSyn          ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
                          HsBindGroup(..), LRuleDecl, HsBind(..) )
 import TcRnTypes       ( TcGblEnv(..), ImportAvails(..) )
 import MkIface         ( mkUsageInfo )
-import Id              ( Id, setIdLocalExported, idName, idIsFrom, isLocalId )
+import Id              ( Id, setIdExported, idName, idIsFrom, isLocalId )
 import Name            ( Name, isExternalName )
 import CoreSyn
 import PprCore         ( pprIdRules, pprCoreExpr )
@@ -214,11 +214,8 @@ addExportFlags ghci_mode exports keep_alive prs rules
   = [(add_export bndr, rhs) | (bndr,rhs) <- prs]
   where
     add_export bndr
-       | isLocalId bndr && dont_discard bndr  = setIdLocalExported bndr
-               -- The isLocalId check is to avoid fiddling with
-               -- locally-defined Ids like data cons and class ops
-               -- which are "born" as GlobalIds
-       | otherwise                            = bndr
+       | dont_discard bndr = setIdExported bndr
+       | otherwise         = bndr
 
     orph_rhs_fvs = unionVarSets [ ruleRhsFreeVars rule
                                | IdCoreRule _ is_orphan_rule rule <- rules, 

diff --git a/ghc/compiler/simplCore/LiberateCase.lhs b/ghc/compiler/simplCore/LiberateCase.lhs
index a1a4131..3139b44 100644 (file)
--- a/ghc/compiler/simplCore/LiberateCase.lhs
+++ b/ghc/compiler/simplCore/LiberateCase.lhs
@@ -12,7 +12,7 @@ import CmdLineOpts    ( DynFlags, DynFlag(..), opt_LiberateCaseThreshold )
 import CoreLint                ( showPass, endPass )
 import CoreSyn
 import CoreUnfold      ( couldBeSmallEnoughToInline )
-import Var             ( Id )
+import Var             ( Id, setIdNotExported )
 import VarEnv
 import Outputable
 import Util             ( notNull )
@@ -189,8 +189,14 @@ libCaseBind env (Rec pairs)
        -- We extend the rec-env by binding each Id to its rhs, first
        -- processing the rhs with an *un-extended* environment, so
        -- that the same process doesn't occur for ever!
-
-    extended_env = addRecBinds env [ (binder, libCase env_body rhs)
+       --
+       -- Furthermore (subtle!) reset the export flags on the binders so
+       -- that we don't get name clashes on exported things if the 
+       -- local binding floats out to top level.  This is most unlikely
+       -- to happen, since the whole point concerns free variables. 
+       -- But resetting the export flag is right regardless.
+
+    extended_env = addRecBinds env [ (setIdNotExported binder, libCase env_body rhs)
                                   | (binder, rhs) <- pairs ]
 
     rhs_small_enough rhs = couldBeSmallEnoughToInline lIBERATE_BOMB_SIZE rhs