[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 01b7ab1..9575acd 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -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,
@@ -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 
@@ -432,17 +429,6 @@ idCafInfo id = cgCafInfo (idCgInfo id)
 #endif
 
        ---------------------------------
-       -- CG ARITY
-idCgArity :: Id -> Arity
-#ifdef DEBUG
-idCgArity id = case cgInfo (idInfo id) of
-                 NoCgInfo -> pprPanic "idCgArity" (ppr id)
-                 info     -> cgArity info
-#else
-idCgArity id = cgArity (idCgInfo id)
-#endif
-
-       ---------------------------------
        -- CPR INFO
 idCprInfo :: Id -> CprInfo
 idCprInfo id = case cprInfo (idInfo id) of
@@ -533,3 +519,4 @@ zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
 
 zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
 \end{code}
+