From: simonpj <unknown>
Date: Mon, 14 May 2001 12:55:11 +0000 (+0000)
Subject: [project @ 2001-05-14 12:55:11 by simonpj]
X-Git-Tag: Approximately_9120_patches~1957
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=44d91e4c577768d4c19a699e326aa50aefc3b4cb;p=ghc-hetmet.git

[project @ 2001-05-14 12:55:11 by simonpj]
Add DEBUG code for CgInfo field of IdInfo
---

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index cda2d5c..c59fefe 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -97,6 +97,7 @@ import PrimRep		( PrimRep )
 import TysPrim		( statePrimTyCon )
 import FieldLabel	( FieldLabel )
 import SrcLoc		( SrcLoc )
+import Outputable
 import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques, 
 			  getNumBuiltinUniques )
 
@@ -358,7 +359,13 @@ setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 	---------------------------------
 	-- CG INFO
 idCgInfo :: Id -> CgInfo
+#ifdef DEBUG
+idCgInfo id = case cgInfo (idInfo id) of
+		  NoCgInfo -> pprPanic "idCgInfo" (ppr id)
+		  info     -> info
+#else
 idCgInfo id = cgInfo (idInfo id)
+#endif		
 
 setIdCgInfo :: Id -> CgInfo -> Id
 setIdCgInfo id cg_info = modifyIdInfo (`setCgInfo` cg_info) id
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 5ebfad2..7148a65 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -511,6 +511,15 @@ downstream, by the code generator.
 data CgInfo = CgInfo 
 		!Arity 		-- Exact arity for calling purposes
 		!CafInfo
+#ifdef DEBUG
+	    | NoCgInfo		-- In debug mode we don't want a black hole here
+				-- See Id.idCgInfo
+
+	-- noCgInfo is used for local Ids, which shouldn't need any CgInfo
+noCgInfo = NoCgInfo
+#else
+noCgInfo = panic "NoCgInfo!"
+#endif
 
 cgArity   (CgInfo arity _)    = arity
 cgCafInfo (CgInfo _ caf_info) = caf_info
@@ -523,9 +532,6 @@ setCgArity info arity =
   case cgInfo info of { CgInfo _ caf_info  -> 
 	info `setCgInfo` CgInfo arity caf_info }
 
-	-- Used for local Ids, which shouldn't need any CgInfo
-noCgInfo = panic "noCgInfo!"
-
 cgMayHaveCafRefs (CgInfo _ caf_info) = mayHaveCafRefs caf_info
 
 seqCg c = c `seq` ()  -- fields are strict anyhow
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index bee9eb4..c2809e3 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -220,6 +220,7 @@ mkDataConWrapId data_con
 		-- The Cpr info can be important inside INLINE rhss, where the
 		-- wrapper constructor isn't inlined
 	   `setCgArity` 	arity
+		-- The NoCaf-ness is set by noCafNoTyGenIdInfo
 	   `setArityInfo`	exactArity arity
 		-- It's important to specify the arity, so that partial
 		-- applications are treated as values