Two things to do with -dsuppress-uniques

[ghc-hetmet.git] / compiler / basicTypes / Id.lhs

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index c3cb952..fbf6b4a 100644 (file)
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -27,35 +27,39 @@ module Id (
 
        -- ** Simple construction
        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
 
        -- ** Simple construction
        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,

-       mkLocalId, mkLocalIdWithInfo,
+       mkLocalId, mkLocalIdWithInfo, mkExportedLocalId,

        mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
        mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,

-       mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
-       mkWorkerId, mkExportedLocalId,
+       mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
+       mkWorkerId, 

 
        -- ** Taking an Id apart
 
        -- ** Taking an Id apart

-       idName, idType, idUnique, idInfo,
-       isId, globalIdDetails, idPrimRep,
+       idName, idType, idUnique, idInfo, idDetails,
+       isId, idPrimRep,

        recordSelectorFieldLabel,
 
        -- ** Modifying an Id
        recordSelectorFieldLabel,
 
        -- ** Modifying an Id

-       setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, 
-       globaliseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+       setIdName, setIdUnique, Id.setIdType, 
+       setIdExported, setIdNotExported, 
+       globaliseId, localiseId, 
+       setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,

        zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,
        zapLamIdInfo, zapDemandIdInfo, zapFragileIdInfo, transferPolyIdInfo,

+       

 
        -- ** Predicates on Ids
        isImplicitId, isDeadBinder, isDictId, isStrictId,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,
 
        -- ** Predicates on Ids
        isImplicitId, isDeadBinder, isDictId, isStrictId,
        isExportedId, isLocalId, isGlobalId,
        isRecordSelector, isNaughtyRecordSelector,

-       isClassOpId_maybe,
+       isClassOpId_maybe, isDFunId,

        isPrimOpId, isPrimOpId_maybe, 
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
        isPrimOpId, isPrimOpId_maybe, 
        isFCallId, isFCallId_maybe,
        isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,

-       isBottomingId, idIsFrom,
+        isConLikeId, isBottomingId, idIsFrom,

         isTickBoxOp, isTickBoxOp_maybe,
        hasNoBinding, 
 
        -- ** Inline pragma stuff
         isTickBoxOp, isTickBoxOp_maybe,
        hasNoBinding, 
 
        -- ** Inline pragma stuff

-       idInlinePragma, setInlinePragma, modifyInlinePragma, 
+       idInlinePragma, setInlinePragma, modifyInlinePragma,
+        idInlineActivation, setInlineActivation, idRuleMatchInfo,

 
        -- ** One-shot lambdas
        isOneShotBndr, isOneShotLambda, isStateHackType,
 
        -- ** One-shot lambdas
        isOneShotBndr, isOneShotLambda, isStateHackType,

@@ -63,83 +67,67 @@ module Id (
 
        -- ** Reading 'IdInfo' fields
        idArity, 
 
        -- ** Reading 'IdInfo' fields
        idArity, 

-       idNewDemandInfo, idNewDemandInfo_maybe,
-       idNewStrictness, idNewStrictness_maybe, 
-       idWorkerInfo,
-       idUnfolding,
+       idDemandInfo, idDemandInfo_maybe,
+       idStrictness, idStrictness_maybe, 
+       idUnfolding, realIdUnfolding,

        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
        idLBVarInfo,
        idOccInfo,
 
        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
        idLBVarInfo,
        idOccInfo,
 

-#ifdef OLD_STRICTNESS
-       idDemandInfo, 
-       idStrictness, 
-       idCprInfo,
-#endif
-

        -- ** Writing 'IdInfo' fields
        setIdUnfolding,
        setIdArity,
        -- ** Writing 'IdInfo' fields
        setIdUnfolding,
        setIdArity,

-       setIdNewDemandInfo, 
-       setIdNewStrictness, zapIdNewStrictness,
-       setIdWorkerInfo,
+       setIdDemandInfo, 
+       setIdStrictness, zapIdStrictness,

        setIdSpecialisation,
        setIdCafInfo,
        setIdSpecialisation,
        setIdCafInfo,

-       setIdOccInfo,
+       setIdOccInfo, zapIdOccInfo,

 
 

-#ifdef OLD_STRICTNESS
-       setIdStrictness, 
-       setIdDemandInfo, 
-       setIdCprInfo,
-#endif

     ) where
 
 #include "HsVersions.h"
 
     ) where
 
 #include "HsVersions.h"
 

-import {-# SOURCE #-} CoreSyn ( CoreRule, Unfolding )
+import CoreSyn ( CoreRule, Unfolding( NoUnfolding ) )

 
 import IdInfo
 import BasicTypes
 
 import IdInfo
 import BasicTypes

+
+-- Imported and re-exported 
+import Var( Var, Id, DictId,
+            idInfo, idDetails, globaliseId,
+            isId, isLocalId, isGlobalId, isExportedId )

 import qualified Var
 import qualified Var

-import Var
+

 import TyCon
 import Type
 import TyCon
 import Type

-import TcType

 import TysPrim
 import TysPrim

-#ifdef OLD_STRICTNESS
-import qualified Demand
-#endif

 import DataCon
 import DataCon

-import NewDemand
+import Demand

 import Name
 import Module
 import Class
 import PrimOp
 import ForeignCall
 import Name
 import Module
 import Class
 import PrimOp
 import ForeignCall

-import OccName

 import Maybes
 import SrcLoc
 import Outputable
 import Unique
 import UniqSupply
 import FastString
 import Maybes
 import SrcLoc
 import Outputable
 import Unique
 import UniqSupply
 import FastString

+import Util( count )

 import StaticFlags
 
 -- infixl so you can say (id `set` a `set` b)
 infixl         1 `setIdUnfolding`,
          `setIdArity`,
 import StaticFlags
 
 -- infixl so you can say (id `set` a `set` b)
 infixl         1 `setIdUnfolding`,
          `setIdArity`,

-         `setIdNewDemandInfo`,
-         `setIdNewStrictness`,
-         `setIdWorkerInfo`,
+         `setIdOccInfo`,
+         `setIdDemandInfo`,
+         `setIdStrictness`,

          `setIdSpecialisation`,
          `setInlinePragma`,
          `setIdSpecialisation`,
          `setInlinePragma`,

+         `setInlineActivation`,

          `idCafInfo`
          `idCafInfo`

-#ifdef OLD_STRICTNESS
-         ,`idCprInfo`
-         ,`setIdStrictness`
-         ,`setIdDemandInfo`
-#endif

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -153,26 +141,19 @@ idName   :: Id -> Name
 idName    = Var.varName
 
 idUnique :: Id -> Unique
 idName    = Var.varName
 
 idUnique :: Id -> Unique

-idUnique  = varUnique
+idUnique  = Var.varUnique

 
 idType   :: Id -> Kind
 
 idType   :: Id -> Kind

-idType    = varType
-
-idInfo :: Id -> IdInfo
-idInfo = varIdInfo
+idType    = Var.varType

 
 idPrimRep :: Id -> PrimRep
 idPrimRep id = typePrimRep (idType id)
 
 
 idPrimRep :: Id -> PrimRep
 idPrimRep id = typePrimRep (idType id)
 

-globalIdDetails :: Id -> GlobalIdDetails
-globalIdDetails = globalIdVarDetails
-
-

 setIdName :: Id -> Name -> Id
 setIdName :: Id -> Name -> Id

-setIdName = setVarName
+setIdName = Var.setVarName

 
 setIdUnique :: Id -> Unique -> Id
 
 setIdUnique :: Id -> Unique -> Id

-setIdUnique = setVarUnique
+setIdUnique = Var.setVarUnique

 
 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
 -- reduce space usage
 
 -- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
 -- reduce space usage

@@ -180,16 +161,24 @@ setIdType :: Id -> Type -> Id
 setIdType id ty = seqType ty `seq` Var.setVarType id ty
 
 setIdExported :: Id -> Id
 setIdType id ty = seqType ty `seq` Var.setVarType id ty
 
 setIdExported :: Id -> Id

-setIdExported = setIdVarExported
+setIdExported = Var.setIdExported

 
 setIdNotExported :: Id -> Id
 
 setIdNotExported :: Id -> Id

-setIdNotExported = setIdVarNotExported
-
-globaliseId :: GlobalIdDetails -> Id -> Id
-globaliseId = globaliseIdVar
+setIdNotExported = Var.setIdNotExported
+
+localiseId :: Id -> Id
+-- Make an with the same unique and type as the 
+-- incoming Id, but with an *Internal* Name and *LocalId* flavour
+localiseId id 
+  | isLocalId id && isInternalName name
+  = id
+  | otherwise
+  = mkLocalIdWithInfo (localiseName name) (idType id) (idInfo id)
+  where
+    name = idName id

 
 lazySetIdInfo :: Id -> IdInfo -> Id
 
 lazySetIdInfo :: Id -> IdInfo -> Id

-lazySetIdInfo = lazySetVarIdInfo
+lazySetIdInfo = Var.lazySetIdInfo

 
 setIdInfo :: Id -> IdInfo -> Id
 setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
 
 setIdInfo :: Id -> IdInfo -> Id
 setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)

@@ -226,8 +215,8 @@ Anyway, we removed it in March 2008.
 
 \begin{code}
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 
 \begin{code}
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"

-mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
-mkGlobalId = mkGlobalIdVar
+mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalId = Var.mkGlobalVar

 
 -- | Make a global 'Id' without any extra information at all
 mkVanillaGlobal :: Name -> Type -> Id
 
 -- | Make a global 'Id' without any extra information at all
 mkVanillaGlobal :: Name -> Type -> Id

@@ -235,7 +224,7 @@ mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
 
 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
 
 -- | Make a global 'Id' with no global information but some generic 'IdInfo'
 mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id

-mkVanillaGlobalWithInfo = mkGlobalId VanillaGlobal
+mkVanillaGlobalWithInfo = mkGlobalId VanillaId

 
 
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
 
 
 -- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"

@@ -243,16 +232,18 @@ mkLocalId :: Name -> Type -> Id
 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 
 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
 mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
 
 mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id

-mkLocalIdWithInfo = mkLocalIdVar
+mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info

        -- Note [Free type variables]
 
        -- Note [Free type variables]
 

--- | Create a local 'Id' that is marked as exported. This prevents things attached to it from being removed as dead code.
+-- | Create a local 'Id' that is marked as exported. 
+-- This prevents things attached to it from being removed as dead code.

 mkExportedLocalId :: Name -> Type -> Id
 mkExportedLocalId :: Name -> Type -> Id

-mkExportedLocalId name ty = mkExportedLocalIdVar name ty vanillaIdInfo
+mkExportedLocalId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo

        -- Note [Free type variables]
 
 
        -- 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
+-- | 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 :: FastString -> Unique -> Type -> Id
 mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
 

@@ -274,16 +265,10 @@ Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 instantiated before use.
  
 \begin{code}
 instantiated before use.
  
 \begin{code}

--- | Make a /wild Id/. This is typically used when you need a binder that you don't expect to use
-mkWildId :: Type -> Id
-mkWildId ty = mkSysLocal (fsLit "wild") (mkBuiltinUnique 1) ty
-

 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty
 -- | Workers get local names. "CoreTidy" will externalise these if necessary
 mkWorkerId :: Unique -> Id -> Type -> Id
 mkWorkerId uniq unwrkr ty

-  = mkLocalId wkr_name ty
-  where
-    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
+  = mkLocalId (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
 
 -- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
 mkTemplateLocal :: Int -> Type -> Id

@@ -301,29 +286,6 @@ mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

-\subsection{Basic predicates on @Id@s}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-isId :: Id -> Bool
-isId = isIdVar
-
--- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
-isLocalId :: Id -> Bool
-isLocalId = isLocalIdVar
-
--- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
-isGlobalId :: Id -> Bool
-isGlobalId = isGlobalIdVar
-
--- | Determines whether an 'Id' is marked as exported and hence will not be considered dead code
-isExportedId :: Id -> Bool
-isExportedId = isExportedIdVar
-\end{code}
-
-%************************************************************************
-%*                                                                     *

 \subsection{Special Ids}
 %*                                                                     *
 %************************************************************************
 \subsection{Special Ids}
 %*                                                                     *
 %************************************************************************

@@ -332,8 +294,8 @@ isExportedId = isExportedIdVar
 -- | 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' and label. Panic otherwise
 recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
 recordSelectorFieldLabel id

-  = case globalIdDetails id of
-        RecordSelId { sel_tycon = tycon, sel_label = lbl } -> (tycon,lbl)
+  = case Var.idDetails id of
+        RecSelId { sel_tycon = tycon } -> (tycon, idName id)

         _ -> panic "recordSelectorFieldLabel"
 
 isRecordSelector        :: Id -> Bool
         _ -> panic "recordSelectorFieldLabel"
 
 isRecordSelector        :: Id -> Bool

@@ -341,50 +303,55 @@ isNaughtyRecordSelector :: Id -> Bool
 isPrimOpId              :: Id -> Bool
 isFCallId               :: Id -> Bool
 isDataConWorkId         :: Id -> Bool
 isPrimOpId              :: Id -> Bool
 isFCallId               :: Id -> Bool
 isDataConWorkId         :: Id -> Bool

+isDFunId                :: Id -> Bool

 
 isClassOpId_maybe       :: Id -> Maybe Class
 isPrimOpId_maybe        :: Id -> Maybe PrimOp
 isFCallId_maybe         :: Id -> Maybe ForeignCall
 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 
 
 isClassOpId_maybe       :: Id -> Maybe Class
 isPrimOpId_maybe        :: Id -> Maybe PrimOp
 isFCallId_maybe         :: Id -> Maybe ForeignCall
 isDataConWorkId_maybe   :: Id -> Maybe DataCon
 

-isRecordSelector id = case globalIdDetails id of
-                        RecordSelId {}  -> True
+isRecordSelector id = case Var.idDetails id of
+                        RecSelId {}  -> True

                         _               -> False
 
                         _               -> False
 

-isNaughtyRecordSelector id = case globalIdDetails id of
-                        RecordSelId { sel_naughty = n } -> n
+isNaughtyRecordSelector id = case Var.idDetails id of
+                        RecSelId { sel_naughty = n } -> n

                         _                               -> False
 
                         _                               -> False
 

-isClassOpId_maybe id = case globalIdDetails id of
+isClassOpId_maybe id = case Var.idDetails id of

                        ClassOpId cls -> Just cls
                        _other        -> Nothing
 
                        ClassOpId cls -> Just cls
                        _other        -> Nothing
 

-isPrimOpId id = case globalIdDetails id of
+isPrimOpId id = case Var.idDetails id of

                         PrimOpId _ -> True
                         _          -> False
 
                         PrimOpId _ -> True
                         _          -> False
 

-isPrimOpId_maybe id = case globalIdDetails id of
+isDFunId id = case Var.idDetails id of
+                        DFunId _ -> True
+                        _        -> False
+
+isPrimOpId_maybe id = case Var.idDetails id of

                         PrimOpId op -> Just op
                         _           -> Nothing
 
                         PrimOpId op -> Just op
                         _           -> Nothing
 

-isFCallId id = case globalIdDetails id of
+isFCallId id = case Var.idDetails id of

                         FCallId _ -> True
                         _         -> False
 
                         FCallId _ -> True
                         _         -> False
 

-isFCallId_maybe id = case globalIdDetails id of
+isFCallId_maybe id = case Var.idDetails id of

                         FCallId call -> Just call
                         _            -> Nothing
 
                         FCallId call -> Just call
                         _            -> Nothing
 

-isDataConWorkId id = case globalIdDetails id of
+isDataConWorkId id = case Var.idDetails id of

                         DataConWorkId _ -> True
                         _               -> False
 
                         DataConWorkId _ -> True
                         _               -> False
 

-isDataConWorkId_maybe id = case globalIdDetails id of
+isDataConWorkId_maybe id = case Var.idDetails id of

                         DataConWorkId con -> Just con
                         _                 -> Nothing
 
 isDataConId_maybe :: Id -> Maybe DataCon
                         DataConWorkId con -> Just con
                         _                 -> Nothing
 
 isDataConId_maybe :: Id -> Maybe DataCon

-isDataConId_maybe id = case globalIdDetails id of
+isDataConId_maybe id = case Var.idDetails id of

                          DataConWorkId con -> Just con
                          DataConWrapId con -> Just con
                          _                 -> Nothing
                          DataConWorkId con -> Just con
                          DataConWrapId con -> Just con
                          _                 -> Nothing

@@ -407,7 +374,7 @@ hasNoBinding :: Id -> Bool
 -- they aren't any more.  Instead, we inject a binding for 
 -- them at the CorePrep stage. 
 -- EXCEPT: unboxed tuples, which definitely have no binding
 -- they aren't any more.  Instead, we inject a binding for 
 -- them at the CorePrep stage. 
 -- EXCEPT: unboxed tuples, which definitely have no binding

-hasNoBinding id = case globalIdDetails id of
+hasNoBinding id = case Var.idDetails id of

                        PrimOpId _       -> True        -- See Note [Primop wrappers]
                        FCallId _        -> True
                        DataConWorkId dc -> isUnboxedTupleCon dc
                        PrimOpId _       -> True        -- See Note [Primop wrappers]
                        FCallId _        -> True
                        DataConWorkId dc -> isUnboxedTupleCon dc

@@ -418,13 +385,12 @@ isImplicitId :: Id -> Bool
 -- declarations, so we don't need to put its signature in an interface
 -- file, even if it's mentioned in some other interface unfolding.
 isImplicitId id
 -- declarations, so we don't need to put its signature in an interface
 -- file, even if it's mentioned in some other interface unfolding.
 isImplicitId id

-  = case globalIdDetails id of
-       RecordSelId {}  -> True
-        FCallId _       -> True
-        PrimOpId _      -> True
-       ClassOpId _     -> True
-        DataConWorkId _ -> True
-       DataConWrapId _ -> True
+  = case Var.idDetails id of
+        FCallId {}       -> True
+       ClassOpId {}     -> True
+        PrimOpId {}      -> True
+        DataConWorkId {} -> True
+       DataConWrapId {} -> True

                -- These are 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 
                -- These are 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 

@@ -459,13 +425,13 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 \begin{code}
 isTickBoxOp :: Id -> Bool
 isTickBoxOp id = 
 \begin{code}
 isTickBoxOp :: Id -> Bool
 isTickBoxOp id = 

-  case globalIdDetails id of
+  case Var.idDetails id of

     TickBoxOpId _    -> True
     _                -> False
 
 isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
 isTickBoxOp_maybe id = 
     TickBoxOpId _    -> True
     _                -> False
 
 isTickBoxOp_maybe :: Id -> Maybe TickBoxOp
 isTickBoxOp_maybe id = 

-  case globalIdDetails id of
+  case Var.idDetails id of

     TickBoxOpId tick -> Just tick
     _                -> Nothing
 \end{code}
     TickBoxOpId tick -> Just tick
     _                -> Nothing
 \end{code}

@@ -485,31 +451,21 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 

-#ifdef OLD_STRICTNESS
-       ---------------------------------
-       -- (OLD) STRICTNESS 
-idStrictness :: Id -> StrictnessInfo
-idStrictness id = strictnessInfo (idInfo id)
-
-setIdStrictness :: Id -> StrictnessInfo -> Id
-setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
-#endif
-

 -- | Returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool
 -- | Returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool

-isBottomingId id = isBottomingSig (idNewStrictness id)
+isBottomingId id = isBottomingSig (idStrictness id)

 
 

-idNewStrictness_maybe :: Id -> Maybe StrictSig
-idNewStrictness :: Id -> StrictSig
+idStrictness_maybe :: Id -> Maybe StrictSig
+idStrictness :: Id -> StrictSig

 
 

-idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
-idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
+idStrictness_maybe id = strictnessInfo (idInfo id)
+idStrictness       id = idStrictness_maybe id `orElse` topSig

 
 

-setIdNewStrictness :: Id -> StrictSig -> Id
-setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
+setIdStrictness :: Id -> StrictSig -> Id
+setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` Just sig) id

 
 

-zapIdNewStrictness :: Id -> Id
-zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
+zapIdStrictness :: Id -> Id
+zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` Nothing) id

 
 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 -- has a type such that it can always be evaluated strictly (e.g., an
 
 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 -- has a type such that it can always be evaluated strictly (e.g., an

@@ -520,46 +476,40 @@ zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 isStrictId :: Id -> Bool
 isStrictId id
   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
 isStrictId :: Id -> Bool
 isStrictId id
   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )

-           (isStrictDmd (idNewDemandInfo id)) || 
+           (isStrictDmd (idDemandInfo id)) || 

            (isStrictType (idType id))
 
        ---------------------------------
            (isStrictType (idType id))
 
        ---------------------------------

-       -- WORKER ID
-idWorkerInfo :: Id -> WorkerInfo
-idWorkerInfo id = workerInfo (idInfo id)
-
-setIdWorkerInfo :: Id -> WorkerInfo -> Id
-setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
-
-       ---------------------------------

        -- UNFOLDING
 idUnfolding :: Id -> Unfolding
        -- UNFOLDING
 idUnfolding :: Id -> Unfolding

-idUnfolding id = unfoldingInfo (idInfo id)
+-- Do not expose the unfolding of a loop breaker!
+idUnfolding id 
+  | isNonRuleLoopBreaker (occInfo info) = NoUnfolding
+  | otherwise                           = unfoldingInfo info
+  where
+    info = idInfo id
+
+realIdUnfolding :: Id -> Unfolding
+-- Expose the unfolding if there is one, including for loop breakers
+realIdUnfolding id = unfoldingInfo (idInfo id)

 
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
 
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 

-#ifdef OLD_STRICTNESS
-       ---------------------------------
-       -- (OLD) DEMAND
-idDemandInfo :: Id -> Demand.Demand
-idDemandInfo id = demandInfo (idInfo id)
-
-setIdDemandInfo :: Id -> Demand.Demand -> Id
-setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
-#endif
+idDemandInfo_maybe :: Id -> Maybe Demand
+idDemandInfo       :: Id -> Demand

 
 

-idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
-idNewDemandInfo       :: Id -> NewDemand.Demand
+idDemandInfo_maybe id = demandInfo (idInfo id)
+idDemandInfo       id = demandInfo (idInfo id) `orElse` topDmd

 
 

-idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
-idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
-
-setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
-setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
+setIdDemandInfo :: Id -> Demand -> Id
+setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` Just dmd) id

 
        ---------------------------------
        -- SPECIALISATION
 
        ---------------------------------
        -- SPECIALISATION

+
+-- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs
+

 idSpecialisation :: Id -> SpecInfo
 idSpecialisation id = specInfo (idInfo id)
 
 idSpecialisation :: Id -> SpecInfo
 idSpecialisation id = specInfo (idInfo id)
 

@@ -575,34 +525,21 @@ setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
        ---------------------------------
        -- CAF INFO
 idCafInfo :: Id -> CafInfo
        ---------------------------------
        -- CAF INFO
 idCafInfo :: Id -> CafInfo

-#ifdef OLD_STRICTNESS
-idCafInfo id = case cgInfo (idInfo id) of
-                 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
-                 info     -> cgCafInfo info
-#else

 idCafInfo id = cafInfo (idInfo id)
 idCafInfo id = cafInfo (idInfo id)

-#endif

 
 setIdCafInfo :: Id -> CafInfo -> Id
 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 
        ---------------------------------
 
 setIdCafInfo :: Id -> CafInfo -> Id
 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 
        ---------------------------------

-       -- CPR INFO
-#ifdef OLD_STRICTNESS
-idCprInfo :: Id -> CprInfo
-idCprInfo id = cprInfo (idInfo id)
-
-setIdCprInfo :: Id -> CprInfo -> Id
-setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
-#endif
-
-       ---------------------------------

        -- Occcurrence INFO
 idOccInfo :: Id -> OccInfo
 idOccInfo id = occInfo (idInfo id)
 
 setIdOccInfo :: Id -> OccInfo -> Id
 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
        -- Occcurrence INFO
 idOccInfo :: Id -> OccInfo
 idOccInfo id = occInfo (idInfo id)
 
 setIdOccInfo :: Id -> OccInfo -> Id
 setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id

+
+zapIdOccInfo :: Id -> Id
+zapIdOccInfo b = b `setIdOccInfo` NoOccInfo

 \end{code}
 
 
 \end{code}
 
 

@@ -612,14 +549,26 @@ The inline pragma tells us to be very keen to inline this Id, but it's still
 OK not to if optimisation is switched off.
 
 \begin{code}
 OK not to if optimisation is switched off.
 
 \begin{code}

-idInlinePragma :: Id -> InlinePragInfo
+idInlinePragma :: Id -> InlinePragma

 idInlinePragma id = inlinePragInfo (idInfo id)
 
 idInlinePragma id = inlinePragInfo (idInfo id)
 

-setInlinePragma :: Id -> InlinePragInfo -> Id
+setInlinePragma :: Id -> InlinePragma -> Id

 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 
 setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 

-modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
+modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id

 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
 modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id

+
+idInlineActivation :: Id -> Activation
+idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
+
+setInlineActivation :: Id -> Activation -> Id
+setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
+
+idRuleMatchInfo :: Id -> RuleMatchInfo
+idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
+
+isConLikeId :: Id -> Bool
+isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)

 \end{code}
 
 
 \end{code}
 
 

@@ -711,23 +660,47 @@ where g has interesting strictness information.  Then if we float thus
    g' = /\a. rhs
    f = /\a. ...[g' a/g]
 
    g' = /\a. rhs
    f = /\a. ...[g' a/g]
 

-we *do not* want to lose the strictness information on g.  Nor arity.
+we *do not* want to lose g's
+  * strictness information
+  * arity 
+  * inline pragma (though that is bit more debatable)

 
 It's simple to retain strictness and arity, but not so simple to retain
 
 It's simple to retain strictness and arity, but not so simple to retain

-       worker info
-       rules
+  * worker info
+  * rules

 so we simply discard those.  Sooner or later this may bite us.
 
 This transfer is used in two places: 
        FloatOut (long-distance let-floating)
        SimplUtils.abstractFloats (short-distance let-floating)
 
 so we simply discard those.  Sooner or later this may bite us.
 
 This transfer is used in two places: 
        FloatOut (long-distance let-floating)
        SimplUtils.abstractFloats (short-distance let-floating)
 

+If we abstract wrt one or more *value* binders, we must modify the 
+arity and strictness info before transferring it.  E.g. 
+      f = \x. e
+-->
+      g' = \y. \x. e
+      + substitute (g' y) for g
+Notice that g' has an arity one more than the original g
+

 \begin{code}
 \begin{code}

-transferPolyIdInfo :: Id -> Id -> Id
-transferPolyIdInfo old_id new_id
+transferPolyIdInfo :: Id       -- Original Id
+                  -> [Var]     -- Abstract wrt these variables
+                  -> Id        -- New Id
+                  -> Id
+transferPolyIdInfo old_id abstract_wrt new_id

   = modifyIdInfo transfer new_id
   where
   = modifyIdInfo transfer new_id
   where

-    old_info = idInfo old_id
-    transfer new_info = new_info `setNewStrictnessInfo` (newStrictnessInfo old_info)
-                                `setArityInfo` (arityInfo old_info)
+    arity_increase = count isId abstract_wrt   -- Arity increases by the
+                                               -- number of value binders
+
+    old_info       = idInfo old_id
+    old_arity       = arityInfo old_info
+    old_inline_prag = inlinePragInfo old_info
+    new_arity       = old_arity + arity_increase
+    old_strictness  = strictnessInfo old_info
+    new_strictness  = fmap (increaseStrictSigArity arity_increase) old_strictness
+
+    transfer new_info = new_info `setStrictnessInfo` new_strictness
+                                `setArityInfo` new_arity
+                                `setInlinePragInfo` old_inline_prag

 \end{code}
 \end{code}