Revert "Do not init record accessors as exported"
[ghc.git] / compiler / basicTypes / Id.hs
index 775a77b..1b84acd 100644 (file)
@@ -32,15 +32,14 @@ module Id (
         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
         mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
         mkLocalIdOrCoVarWithInfo,
-        mkLocalIdWithInfo, mkExportedLocalId,
+        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
         mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
-        mkUserLocal, mkUserLocalCoVar, mkUserLocalOrCoVar,
-        mkDerivedLocalCoVarM,
+        mkUserLocal, mkUserLocalOrCoVar,
         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
         mkWorkerId,
 
         -- ** Taking an Id apart
-        idName, idType, idUnique, idInfo, idDetails, idRepArity,
+        idName, idType, idUnique, idInfo, idDetails,
         recordSelectorTyCon,
 
         -- ** Modifying an Id
@@ -48,8 +47,9 @@ module Id (
         setIdExported, setIdNotExported,
         globaliseId, localiseId,
         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
-        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapFragileIdInfo,
-        zapIdStrictness,
+        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
+        zapIdUsedOnceInfo,
+        zapFragileIdInfo, zapIdStrictness,
         transferPolyIdInfo,
 
         -- ** Predicates on Ids
@@ -74,7 +74,7 @@ module Id (
         idInlineActivation, setInlineActivation, idRuleMatchInfo,
 
         -- ** One-shot lambdas
-        isOneShotBndr, isOneShotLambda, isProbablyOneShotLambda,
+        isOneShotBndr, isProbablyOneShotLambda,
         setOneShotLambda, clearOneShotLambda,
         updOneShotInfo, setIdOneShotInfo,
         isStateHackType, stateHackOneShot, typeOneShot,
@@ -85,11 +85,10 @@ module Id (
         idUnfolding, realIdUnfolding,
         idSpecialisation, idCoreRules, idHasRules,
         idCafInfo,
-        idOneShotInfo,
+        idOneShotInfo, idStateHackOneShotInfo,
         idOccInfo,
 
         -- ** Writing 'IdInfo' fields
-        setIdUnfoldingLazily,
         setIdUnfolding,
         setIdArity,
         setIdCallArity,
@@ -138,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`,
@@ -250,8 +248,7 @@ 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)
 
@@ -259,7 +256,7 @@ mkLocalId name ty = mkLocalIdWithInfo name ty
 mkLocalCoVar :: Name -> Type -> CoVar
 mkLocalCoVar name ty
   = ASSERT( isCoercionType ty )
-    Var.mkLocalVar CoVarId name ty (vanillaIdInfo `setOneShotInfo` typeOneShot 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
@@ -288,6 +285,10 @@ 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
@@ -298,10 +299,7 @@ mkSysLocal fs uniq ty = ASSERT( not (isCoercionType ty) )
 -- | Like 'mkSysLocal', but checks to see if we have a covar type
 mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
 mkSysLocalOrCoVar fs uniq ty
-  | isCoercionType ty = mkLocalCoVar name ty
-  | otherwise         = mkLocalId    name ty
-  where
-    name = mkSystemVarName uniq fs
+  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
 
 mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
 mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
@@ -315,23 +313,11 @@ mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
 mkUserLocal occ uniq ty loc = ASSERT( not (isCoercionType ty) )
                               mkLocalId (mkInternalName uniq occ loc) ty
 
--- | Like 'mkUserLocal' for covars
-mkUserLocalCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
-mkUserLocalCoVar occ uniq ty loc
-  = mkLocalCoVar (mkInternalName uniq occ loc) ty
-
 -- | 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
 
-mkDerivedLocalCoVarM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
-mkDerivedLocalCoVarM deriv_name id ty
-    = ASSERT( isCoercionType ty )
-      do { uniq <- getUniqueM
-         ; let name = mkDerivedInternalName deriv_name uniq (getName id)
-         ; return (mkLocalCoVar name ty) }
-
 {-
 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 @Uniques@, but that's OK because the templates are supposed to be
@@ -345,7 +331,7 @@ mkWorkerId uniq 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 = mkSysLocalOrCoVar (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]
@@ -493,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
@@ -571,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)
@@ -614,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
 
@@ -698,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
@@ -742,16 +731,8 @@ isStateHackType ty
         -- 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
@@ -797,6 +778,12 @@ zapIdDemandInfo = zapInfo zapDemandInfo
 zapIdUsageInfo :: Id -> Id
 zapIdUsageInfo = zapInfo zapUsageInfo
 
+zapIdUsageEnvInfo :: Id -> Id
+zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
+
+zapIdUsedOnceInfo :: Id -> Id
+zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
+
 {-
 Note [transferPolyIdInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~