[project @ 2001-10-19 14:22:11 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 dd0bf19..9575acd 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -19,7 +19,7 @@ module Id (
        recordSelectorFieldLabel,
 
        -- Modifying an Id
-       setIdName, setIdUnique, setIdType, setIdNoDiscard, setGlobalIdDetails,
+       setIdName, setIdUnique, setIdType, setIdLocalExported, setGlobalIdDetails,
        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
        zapLamIdInfo, zapDemandIdInfo, 
 
@@ -43,7 +43,7 @@ module Id (
 
        -- IdInfo stuff
        setIdUnfolding,
-       setIdArityInfo,
+       setIdArity,
        setIdDemandInfo, setIdNewDemandInfo, 
        setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
         setIdTyGenInfo,
@@ -53,7 +53,7 @@ module Id (
        setIdCprInfo,
        setIdOccInfo,
 
-       idArity, idArityInfo, 
+       idArity, 
        idDemandInfo, idNewDemandInfo,
        idStrictness, idNewStrictness, idNewStrictness_maybe, getNewStrictness,
         idTyGenInfo,
@@ -62,7 +62,6 @@ module Id (
        idSpecialisation,
        idCgInfo,
        idCafInfo,
-       idCgArity,
        idCprInfo,
        idLBVarInfo,
        idOccInfo,
@@ -79,7 +78,7 @@ import BasicTypes     ( Arity )
 import Var             ( Id, DictId,
                          isId, isExportedId, isSpecPragmaId, isLocalId,
                          idName, idType, idUnique, idInfo, isGlobalId,
-                         setIdName, setVarType, setIdUnique, setIdNoDiscard,
+                         setIdName, setVarType, setIdUnique, setIdLocalExported,
                          setIdInfo, lazySetIdInfo, modifyIdInfo, 
                          maybeModifyIdInfo,
                          globalIdDetails, setGlobalIdDetails
@@ -108,7 +107,7 @@ import Outputable
 import Unique          ( Unique, mkBuiltinUnique )
 
 infixl         1 `setIdUnfolding`,
-         `setIdArityInfo`,
+         `setIdArity`,
          `setIdDemandInfo`,
          `setIdStrictness`,
          `setIdNewDemandInfo`,
@@ -266,11 +265,12 @@ isDataConWrapId id = case globalIdDetails id of
                        DataConWrapId con -> True
                        other             -> False
 
-       -- hasNoBinding returns True of an Id which may not have a
-       -- binding, even though it is defined in this module.  Notably,
-       -- the constructors of a dictionary are in this situation.
+-- hasNoBinding returns True of an Id which may not have a
+-- binding, even though it is defined in this module.  
+-- Data constructor workers used to be things of this kind, but
+-- they aren't any more.  Instead, we inject a binding for 
+-- them at the CorePrep stage.
 hasNoBinding id = case globalIdDetails id of
-                       DataConId _ -> True
                        PrimOpId _  -> True
                        FCallId _   -> True
                        other       -> False
@@ -309,14 +309,11 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
 \begin{code}
        ---------------------------------
        -- ARITY
-idArityInfo :: Id -> ArityInfo
-idArityInfo id = arityInfo (idInfo id)
-
 idArity :: Id -> Arity
-idArity id = arityLowerBound (idArityInfo id)
+idArity id = arityInfo (idInfo id)
 
-setIdArityInfo :: Id -> Arity -> Id
-setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
+setIdArity :: Id -> Arity -> Id
+setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
        ---------------------------------
        -- STRICTNESS 
@@ -423,12 +420,13 @@ setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
        ---------------------------------
        -- CAF INFO
 idCafInfo :: Id -> CafInfo
+#ifdef DEBUG
+idCafInfo id = case cgInfo (idInfo id) of
+                 NoCgInfo -> pprPanic "idCafInfo" (ppr id)
+                 info     -> cgCafInfo info
+#else
 idCafInfo id = cgCafInfo (idCgInfo id)
-
-       ---------------------------------
-       -- CG ARITY
-idCgArity :: Id -> Arity
-idCgArity id = cgArity (idCgInfo id)
+#endif
 
        ---------------------------------
        -- CPR INFO
@@ -521,3 +519,4 @@ zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
 
 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
 \end{code}
+