[project @ 2002-03-18 15:23:05 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 52b05e1..b1a4a1a 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -52,7 +52,7 @@ module Id (
        setIdCgInfo,
        setIdOccInfo,
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        idDemandInfo, 
        idStrictness, 
        idCprInfo,
@@ -67,13 +67,13 @@ module Id (
         idTyGenInfo,
        idWorkerInfo,
        idUnfolding,
-       idSpecialisation,
+       idSpecialisation, idCoreRules,
        idCgInfo,
        idCafInfo,
        idLBVarInfo,
        idOccInfo,
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        newStrictnessFromOld    -- Temporary
 #endif
 
@@ -82,7 +82,7 @@ module Id (
 #include "HsVersions.h"
 
 
-import CoreSyn         ( Unfolding, CoreRules )
+import CoreSyn         ( Unfolding, CoreRules, IdCoreRule, rulesRules )
 import BasicTypes      ( Arity )
 import Var             ( Id, DictId,
                          isId, isExportedId, isSpecPragmaId, isLocalId,
@@ -101,7 +101,7 @@ import IdInfo
 import qualified Demand        ( Demand )
 import NewDemand       ( Demand, StrictSig, topSig, isBottomingSig )
 import Name            ( Name, OccName,
-                         mkSysLocalName, mkLocalName,
+                         mkSystemName, mkInternalName,
                          getOccName, getSrcLoc
                        ) 
 import OccName         ( EncodedFS, UserFS, mkWorkerOcc )
@@ -123,7 +123,7 @@ infixl      1 `setIdUnfolding`,
          `setIdSpecialisation`,
          `setInlinePragma`,
          `idCafInfo`
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
          ,`idCprInfo`
          ,`setIdStrictness`
          ,`setIdDemandInfo`
@@ -165,8 +165,8 @@ mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 
 -- for SysLocal, we assume the base name is already encoded, to avoid
 -- re-encoding the same string over and over again.
-mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
-mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
+mkSysLocal  fs uniq ty      = mkLocalId (mkSystemName uniq fs)      ty
+mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
 mkVanillaGlobal            = mkGlobalId VanillaGlobal
 \end{code}
 
@@ -180,11 +180,11 @@ mkWildId :: Type -> Id
 mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
 
 mkWorkerId :: Unique -> Id -> Type -> Id
--- A worker gets a local name.  CoreTidy will globalise it if necessary.
+-- A worker gets a local name.  CoreTidy will externalise it if necessary.
 mkWorkerId uniq unwrkr ty
   = mkLocalId wkr_name ty
   where
-    wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
+    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
 
 -- "Template locals" typically used in unfoldings
 mkTemplateLocals :: [Type] -> [Id]
@@ -323,7 +323,7 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        ---------------------------------
        -- (OLD) STRICTNESS 
 idStrictness :: Id -> StrictnessInfo
@@ -373,7 +373,7 @@ idUnfolding id = unfoldingInfo (idInfo id)
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
        ---------------------------------
        -- (OLD) DEMAND
 idDemandInfo :: Id -> Demand.Demand
@@ -394,13 +394,16 @@ setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` dmd) id
 idSpecialisation :: Id -> CoreRules
 idSpecialisation id = specInfo (idInfo id)
 
+idCoreRules :: Id -> [IdCoreRule]
+idCoreRules id = [(id,rule) | rule <- rulesRules (idSpecialisation id)]
+
 setIdSpecialisation :: Id -> CoreRules -> Id
 setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 
        ---------------------------------
        -- CG INFO
 idCgInfo :: Id -> CgInfo
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCgInfo id = case cgInfo (idInfo id) of
                  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
                  info     -> info
@@ -414,7 +417,7 @@ setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
        ---------------------------------
        -- CAF INFO
 idCafInfo :: Id -> CafInfo
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCafInfo id = case cgInfo (idInfo id) of
                  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
                  info     -> cgCafInfo info
@@ -423,7 +426,7 @@ idCafInfo id = cgCafInfo (idCgInfo id)
 #endif
        ---------------------------------
        -- CPR INFO
-#ifdef DEBUG
+#ifdef OLD_STRICTNESS
 idCprInfo :: Id -> CprInfo
 idCprInfo id = cprInfo (idInfo id)