The Big INLINE Patch: totally reorganise way that INLINE pragmas work

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

diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index 676d6cf..8712db1 100644 (file)
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -49,16 +49,17 @@ module Id (
        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,
-       isBottomingId, idIsFrom,
+        isConLikeId, isBottomingId, idIsFrom,
         isTickBoxOp, isTickBoxOp_maybe,
        hasNoBinding, 
 
        -- ** Inline pragma stuff
-       idInlinePragma, setInlinePragma, modifyInlinePragma, 
+       idInlinePragma, setInlinePragma, modifyInlinePragma,
+        idInlineActivation, setInlineActivation, idRuleMatchInfo,
 
        -- ** One-shot lambdas
        isOneShotBndr, isOneShotLambda, isStateHackType,
@@ -68,7 +69,6 @@ module Id (
        idArity, 
        idNewDemandInfo, idNewDemandInfo_maybe,
        idNewStrictness, idNewStrictness_maybe, 
-       idWorkerInfo,
        idUnfolding,
        idSpecialisation, idCoreRules, idHasRules,
        idCafInfo,
@@ -86,7 +86,6 @@ module Id (
        setIdArity,
        setIdNewDemandInfo, 
        setIdNewStrictness, zapIdNewStrictness,
-       setIdWorkerInfo,
        setIdSpecialisation,
        setIdCafInfo,
        setIdOccInfo, zapIdOccInfo,
@@ -125,7 +124,6 @@ import Module
 import Class
 import PrimOp
 import ForeignCall
-import OccName
 import Maybes
 import SrcLoc
 import Outputable
@@ -140,7 +138,6 @@ infixl      1 `setIdUnfolding`,
          `setIdArity`,
          `setIdNewDemandInfo`,
          `setIdNewStrictness`,
-         `setIdWorkerInfo`,
          `setIdSpecialisation`,
          `setInlinePragma`,
          `idCafInfo`
@@ -289,9 +286,7 @@ instantiated before use.
 -- | 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
@@ -326,6 +321,7 @@ isNaughtyRecordSelector :: Id -> Bool
 isPrimOpId              :: Id -> Bool
 isFCallId               :: Id -> Bool
 isDataConWorkId         :: Id -> Bool
+isDFunId                :: Id -> Bool
 
 isClassOpId_maybe       :: Id -> Maybe Class
 isPrimOpId_maybe        :: Id -> Maybe PrimOp
@@ -348,6 +344,10 @@ isPrimOpId id = case Var.idDetails id of
                         PrimOpId _ -> True
                         _          -> False
 
+isDFunId id = case Var.idDetails id of
+                        DFunId _ -> True
+                        _        -> False
+
 isPrimOpId_maybe id = case Var.idDetails id of
                         PrimOpId op -> Just op
                         _           -> Nothing
@@ -404,11 +404,11 @@ isImplicitId :: Id -> Bool
 -- file, even if it's mentioned in some other interface unfolding.
 isImplicitId id
   = case Var.idDetails id of
-        FCallId _       -> True
-       ClassOpId _     -> True
-        PrimOpId _      -> True
-        DataConWorkId _ -> True
-       DataConWrapId _ -> True
+        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 
@@ -508,14 +508,6 @@ isStrictId 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
 idUnfolding id = unfoldingInfo (idInfo id)
@@ -544,6 +536,9 @@ setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
 
        ---------------------------------
        -- SPECIALISATION
+
+-- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs
+
 idSpecialisation :: Id -> SpecInfo
 idSpecialisation id = specInfo (idInfo id)
 
@@ -599,14 +594,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}
-idInlinePragma :: Id -> InlinePragInfo
+idInlinePragma :: Id -> InlinePragma
 idInlinePragma id = inlinePragInfo (idInfo id)
 
-setInlinePragma :: Id -> InlinePragInfo -> Id
+setInlinePragma :: Id -> InlinePragma -> 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
+
+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}