X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;h=9575acddfcf1168b4de74c7928ed79ffffe02460;hb=bbffa95af87bb66635aaffdaddcd31be063752dc;hp=dd0bf192f331224a8a804389edfe9aaa6d63e3b1;hpb=0c190d9efcf76845241f756a1507267458b90c90;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index dd0bf19..9575acd 100644
--- 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}
+