Commit 0498d355 authored by simonpj's avatar simonpj
Browse files

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

Reset the export flag for the new bindings in LiberateCase
parent 0ee11df0
......@@ -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
......
......@@ -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}
......
......@@ -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}
......
......@@ -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,
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment