Revert "Do not init record accessors as exported"
[ghc.git] / compiler / basicTypes / Id.hs
index 3e6473f..1b84acd 100644 (file)
@@ -17,7 +17,7 @@
 --
 -- * 'Name.Name': see "Name#name_types"
 --
--- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TypeRep.Type' and some additional
+-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a 'TyCoRep.Type' and some additional
 --   details (a 'IdInfo.IdInfo' and one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that
 --   are added, modified and inspected by various compiler passes. These 'Var.Var' names may either
 --   be global or local, see "Var#globalvslocal"
@@ -30,29 +30,35 @@ module Id (
 
         -- ** Simple construction
         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
-        mkLocalId, mkLocalIdWithInfo, mkExportedLocalId,
-        mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
-        mkDerivedLocalM,
+        mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
+        mkLocalIdOrCoVarWithInfo,
+        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
+        mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
+        mkUserLocal, mkUserLocalOrCoVar,
         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
-        mkWorkerId, mkWiredInIdName,
+        mkWorkerId,
 
         -- ** Taking an Id apart
-        idName, idType, idUnique, idInfo, idDetails, idRepArity,
-        recordSelectorFieldLabel,
+        idName, idType, idUnique, idInfo, idDetails,
+        recordSelectorTyCon,
 
         -- ** Modifying an Id
         setIdName, setIdUnique, Id.setIdType,
         setIdExported, setIdNotExported,
         globaliseId, localiseId,
         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
-        zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,
-        zapIdStrictness,
+        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
+        zapIdUsedOnceInfo,
+        zapFragileIdInfo, zapIdStrictness,
+        transferPolyIdInfo,
 
         -- ** Predicates on Ids
         isImplicitId, isDeadBinder,
         isStrictId,
         isExportedId, isLocalId, isGlobalId,
         isRecordSelector, isNaughtyRecordSelector,
+        isPatSynRecordSelector,
+        isDataConRecordSelector,
         isClassOpId_maybe, isDFunId,
         isPrimOpId, isPrimOpId_maybe,
         isFCallId, isFCallId_maybe,
@@ -68,7 +74,7 @@ module Id (
         idInlineActivation, setInlineActivation, idRuleMatchInfo,
 
         -- ** One-shot lambdas
-        isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
+        isOneShotBndr, isProbablyOneShotLambda,
         setOneShotLambda, clearOneShotLambda,
         updOneShotInfo, setIdOneShotInfo,
         isStateHackType, stateHackOneShot, typeOneShot,
@@ -79,11 +85,10 @@ module Id (
         idUnfolding, realIdUnfolding,
         idSpecialisation, idCoreRules, idHasRules,
         idCafInfo,
-        idOneShotInfo,
+        idOneShotInfo, idStateHackOneShotInfo,
         idOccInfo,
 
         -- ** Writing 'IdInfo' fields
-        setIdUnfoldingLazily,
         setIdUnfolding,
         setIdArity,
         setIdCallArity,
@@ -108,12 +113,11 @@ import IdInfo
 import BasicTypes
 
 -- Imported and re-exported
-import Var( Id, DictId,
+import Var( Id, CoVar, DictId,
             idInfo, idDetails, globaliseId, varType,
             isId, isLocalId, isGlobalId, isExportedId )
 import qualified Var
 
-import TyCon
 import Type
 import TysPrim
 import DataCon
@@ -133,8 +137,7 @@ import Util
 import StaticFlags
 
 -- infixl so you can say (id `set` a `set` b)
-infixl  1 `setIdUnfoldingLazily`,
-          `setIdUnfolding`,
+infixl  1 `setIdUnfolding`,
           `setIdArity`,
           `setIdCallArity`,
           `setIdOccInfo`,
@@ -189,7 +192,7 @@ localiseId id
   | ASSERT( isId id ) isLocalId id && isInternalName name
   = id
   | otherwise
-  = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id)
+  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
   where
     name = idName id
 
@@ -197,13 +200,13 @@ lazySetIdInfo :: Id -> IdInfo -> Id
 lazySetIdInfo = Var.lazySetIdInfo
 
 setIdInfo :: Id -> IdInfo -> Id
-setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
+setIdInfo id info = info `seq` (lazySetIdInfo id info)
         -- Try to avoid spack leaks by seq'ing
 
 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
 modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
 
--- maybeModifyIdInfo tries to avoid unnecesary thrashing
+-- maybeModifyIdInfo tries to avoid unnecessary thrashing
 maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
 maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
 maybeModifyIdInfo Nothing         id = id
@@ -245,9 +248,32 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId
 
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 mkLocalId :: Name -> Type -> Id
-mkLocalId name ty = mkLocalIdWithInfo name ty
-                         (vanillaIdInfo `setOneShotInfo` typeOneShot ty)
+mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
+ -- It's tempting to ASSERT( not (isCoercionType ty) ), but don't. Sometimes,
+ -- the type is a panic. (Search invented_id)
+
+-- | Make a local CoVar
+mkLocalCoVar :: Name -> Type -> CoVar
+mkLocalCoVar name ty
+  = ASSERT( isCoercionType ty )
+    Var.mkLocalVar CoVarId name ty vanillaIdInfo
+
+-- | Like 'mkLocalId', but checks the type to see if it should make a covar
+mkLocalIdOrCoVar :: Name -> Type -> Id
+mkLocalIdOrCoVar name ty
+  | isCoercionType ty = mkLocalCoVar name ty
+  | otherwise         = mkLocalId    name ty
+
+-- | Make a local id, with the IdDetails set to CoVarId if the type indicates
+-- so.
+mkLocalIdOrCoVarWithInfo :: Name -> Type -> IdInfo -> Id
+mkLocalIdOrCoVarWithInfo name ty info
+  = Var.mkLocalVar details name ty info
+  where
+    details | isCoercionType ty = CoVarId
+            | otherwise         = VanillaId
 
+    -- proper ids only; no covars!
 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
         -- Note [Free type variables]
@@ -259,30 +285,38 @@ mkExportedLocalId :: IdDetails -> Name -> Type -> Id
 mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
         -- Note [Free type variables]
 
+mkExportedVanillaId :: Name -> Type -> Id
+mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
+        -- Note [Free type variables]
+
 
 -- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
 -- that are created by the compiler out of thin air
 mkSysLocal :: FastString -> Unique -> Type -> Id
-mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
+mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
+                        mkLocalId (mkSystemVarName uniq fs) ty
+
+-- | Like 'mkSysLocal', but checks to see if we have a covar type
+mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
+mkSysLocalOrCoVar fs uniq ty
+  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
 
 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
 
+mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
+mkSysLocalOrCoVarM fs ty
+  = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
 
 -- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
 mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
-mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
-
-mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id
-mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc))
+mkUserLocal occ uniq ty loc = ASSERT( not (isCoercionType ty) )
+                              mkLocalId (mkInternalName uniq occ loc) ty
 
-mkDerivedLocalM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
-mkDerivedLocalM deriv_name id ty
-    = getUniqueM >>= (\uniq -> return (mkLocalId (mkDerivedInternalName deriv_name uniq (getName id)) ty))
-
-mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
-mkWiredInIdName mod fs uniq id
- = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
+-- | Like 'mkUserLocal', but checks if we have a coercion type
+mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
+mkUserLocalOrCoVar occ uniq ty loc
+  = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
 
 {-
 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
@@ -293,11 +327,11 @@ instantiated before use.
 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty
-  = mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
+  = mkLocalIdOrCoVar (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
 
 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
 mkTemplateLocal :: Int -> Type -> Id
-mkTemplateLocal i ty = mkSysLocal (fsLit "tpl") (mkBuiltinUnique i) ty
+mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty
 
 -- | Create a template local for a series of types
 mkTemplateLocals :: [Type] -> [Id]
@@ -307,9 +341,8 @@ mkTemplateLocals = mkTemplateLocalsNum 1
 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 
-{-
-Note [Exported LocalIds]
-~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Exported LocalIds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We use mkExportedLocalId for things like
  - Dictionary functions (DFunId)
  - Wrapper and matcher Ids for pattern synonyms
@@ -323,7 +356,7 @@ code by the occurrence analyser.  (But "exported" here does not mean
 "brought into lexical scope by an import declaration". Indeed these
 things are always internal Ids that the user never sees.)
 
-It's very important that they are *LocalIds*, not GlobalIs, for lots
+It's very important that they are *LocalIds*, not GlobalIds, for lots
 of reasons:
 
  * We want to treat them as free variables for the purpose of
@@ -353,15 +386,18 @@ That is what is happening in, say tidy_insts in TidyPgm.
 ************************************************************************
 -}
 
--- | If the 'Id' is that for a record selector, extract the 'sel_tycon' and label. Panic otherwise
-recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
-recordSelectorFieldLabel id
+-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
+recordSelectorTyCon :: Id -> RecSelParent
+recordSelectorTyCon id
   = case Var.idDetails id of
-        RecSelId { sel_tycon = tycon } -> (tycon, idName id)
-        _ -> panic "recordSelectorFieldLabel"
+        RecSelId { sel_tycon = parent } -> parent
+        _ -> panic "recordSelectorTyCon"
+
 
 isRecordSelector        :: Id -> Bool
 isNaughtyRecordSelector :: Id -> Bool
+isPatSynRecordSelector  :: Id -> Bool
+isDataConRecordSelector  :: Id -> Bool
 isPrimOpId              :: Id -> Bool
 isFCallId               :: Id -> Bool
 isDataConWorkId         :: Id -> Bool
@@ -373,7 +409,15 @@ isFCallId_maybe         :: Id -> Maybe ForeignCall
 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 
 isRecordSelector id = case Var.idDetails id of
-                        RecSelId {}  -> True
+                        RecSelId {}     -> True
+                        _               -> False
+
+isDataConRecordSelector id = case Var.idDetails id of
+                        RecSelId {sel_tycon = RecSelData _} -> True
+                        _               -> False
+
+isPatSynRecordSelector id = case Var.idDetails id of
+                        RecSelId {sel_tycon = RecSelPatSyn _} -> True
                         _               -> False
 
 isNaughtyRecordSelector id = case Var.idDetails id of
@@ -435,7 +479,7 @@ hasNoBinding :: Id -> Bool
 hasNoBinding id = case Var.idDetails id of
                         PrimOpId _       -> True        -- See Note [Primop wrappers]
                         FCallId _        -> True
-                        DataConWorkId dc -> isUnboxedTupleCon dc
+                        DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
                         _                -> False
 
 isImplicitId :: Id -> Bool
@@ -449,7 +493,7 @@ isImplicitId id
         PrimOpId {}      -> True
         DataConWorkId {} -> True
         DataConWrapId {} -> True
-                -- These are are implied by their type or class decl;
+                -- These are implied by their type or class decl;
                 -- remember that all type and class decls appear in the interface file.
                 -- The dfun id is not an implicit Id; it must *not* be omitted, because
                 -- it carries version info for the instance decl
@@ -513,9 +557,6 @@ idCallArity id = callArityInfo (idInfo id)
 setIdCallArity :: Id -> Arity -> Id
 setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
 
-idRepArity :: Id -> RepArity
-idRepArity x = typeRepArity (idArity x) (idType x)
-
 -- | Returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool
 isBottomingId id = isBottomingSig (idStrictness id)
@@ -556,9 +597,6 @@ realIdUnfolding :: Id -> Unfolding
 -- Expose the unfolding if there is one, including for loop breakers
 realIdUnfolding id = unfoldingInfo (idInfo id)
 
-setIdUnfoldingLazily :: Id -> Unfolding -> Id
-setIdUnfoldingLazily id unfolding = modifyIdInfo (`setUnfoldingInfoLazily` unfolding) id
-
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
@@ -571,19 +609,19 @@ setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
         ---------------------------------
         -- SPECIALISATION
 
--- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs
+-- See Note [Specialisations and RULES in IdInfo] in IdInfo.hs
 
-idSpecialisation :: Id -> SpecInfo
-idSpecialisation id = specInfo (idInfo id)
+idSpecialisation :: Id -> RuleInfo
+idSpecialisation id = ruleInfo (idInfo id)
 
 idCoreRules :: Id -> [CoreRule]
-idCoreRules id = specInfoRules (idSpecialisation id)
+idCoreRules id = ruleInfoRules (idSpecialisation id)
 
 idHasRules :: Id -> Bool
-idHasRules id = not (isEmptySpecInfo (idSpecialisation id))
+idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
 
-setIdSpecialisation :: Id -> SpecInfo -> Id
-setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
+setIdSpecialisation :: Id -> RuleInfo -> Id
+setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
 
         ---------------------------------
         -- CAF INFO
@@ -640,14 +678,23 @@ isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
 idOneShotInfo :: Id -> OneShotInfo
 idOneShotInfo id = oneShotInfo (idInfo id)
 
+-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
+-- See Note [The state-transformer hack] in CoreArity
+idStateHackOneShotInfo :: Id -> OneShotInfo
+idStateHackOneShotInfo id
+    | isStateHackType (idType id) = stateHackOneShot
+    | otherwise                   = idOneShotInfo id
+
 -- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
 -- This one is the "business end", called externally.
 -- It works on type variables as well as Ids, returning True
 -- Its main purpose is to encapsulate the Horrible State Hack
+-- See Note [The state-transformer hack] in CoreArity
 isOneShotBndr :: Var -> Bool
 isOneShotBndr var
-  | isTyVar var = True
-  | otherwise   = isOneShotLambda var
+  | isTyVar var                              = True
+  | OneShotLam <- idStateHackOneShotInfo var = True
+  | otherwise                                = False
 
 -- | Should we apply the state hack to values of this 'Type'?
 stateHackOneShot :: OneShotInfo
@@ -681,19 +728,11 @@ isStateHackType ty
         -- It would be better to spot that r was one-shot to start with, but
         -- I don't want to rely on that.
         --
-        -- Another good example is in fill_in in PrelPack.lhs.  We should be able to
+        -- Another good example is in fill_in in PrelPack.hs.  We should be able to
         -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
 
-
--- | Returns whether the lambda associated with the 'Id' is certainly applied at most once.
--- You probably want to use 'isOneShotBndr' instead
-isOneShotLambda :: Id -> Bool
-isOneShotLambda id = case idOneShotInfo id of
-                       OneShotLam -> True
-                       _          -> False
-
 isProbablyOneShotLambda :: Id -> Bool
-isProbablyOneShotLambda id = case idOneShotInfo id of
+isProbablyOneShotLambda id = case idStateHackOneShotInfo id of
                                OneShotLam    -> True
                                ProbOneShot   -> True
                                NoOneShotInfo -> False
@@ -733,8 +772,17 @@ zapLamIdInfo = zapInfo zapLamInfo
 zapFragileIdInfo :: Id -> Id
 zapFragileIdInfo = zapInfo zapFragileInfo
 
-zapDemandIdInfo :: Id -> Id
-zapDemandIdInfo = zapInfo zapDemandInfo
+zapIdDemandInfo :: Id -> Id
+zapIdDemandInfo = zapInfo zapDemandInfo
+
+zapIdUsageInfo :: Id -> Id
+zapIdUsageInfo = zapInfo zapUsageInfo
+
+zapIdUsageEnvInfo :: Id -> Id
+zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
+
+zapIdUsedOnceInfo :: Id -> Id
+zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
 
 {-
 Note [transferPolyIdInfo]