From: simonpj Date: Fri, 24 Dec 2004 11:38:20 +0000 (+0000) Subject: [project @ 2004-12-24 11:38:09 by simonpj] X-Git-Tag: Initial_conversion_from_CVS_complete~1311 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0498d35528e7666b9a77a79a78d2e1e782ff0c0b;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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