X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgInfoTbls.hs;h=04a1403c3471bbb26f93cf2d45fd4016013e2bf5;hb=7d6dffe542bdad5707a929ae7ac25813c586766d;hp=3751824f41384af857c62b772f6258e505f28694;hpb=7f1bc015a4094a8282ad4090768d780fd4d6122d;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 3751824..04a1403 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -19,7 +19,7 @@ module CgInfoTbls (
 	mkFunGenInfoExtraBits,
 	entryCode, closureInfoPtr,
 	getConstrTag,
-	infoTable, infoTableClosureType, infoTableConstrTag,
+	infoTable, infoTableClosureType,
 	infoTablePtrs, infoTableNonPtrs,
 	funInfoTable,
 	retVec
@@ -50,6 +50,8 @@ import ListSetOps
 import Maybes
 import Constants
 
+import Outputable 
+
 -------------------------------------------------------------------------
 --
 --	Generating the info table and code for a closure
@@ -87,7 +89,13 @@ emitClosureCodeAndInfoTable cl_info args body
 					cl_type srt_len layout_lit
 
 	; blks <- cgStmtsToBlocks body
-	; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
+
+        ; conName <-  
+             if is_con
+                then mkStringCLit $ fromJust conIdentity
+                else return (mkIntCLit 0)
+
+	; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
   where
     info_lbl  = infoTableLabelFromCI cl_info
 
@@ -100,24 +108,25 @@ emitClosureCodeAndInfoTable cl_info args body
     mb_con = isConstrClosure_maybe  cl_info
     is_con = isJust mb_con
 
-    (srt_label,srt_len)
+    (srt_label,srt_len,conIdentity)
 	= case mb_con of
 	    Just con -> -- Constructors don't have an SRT
 			-- We keep the *zero-indexed* tag in the srt_len
 			-- field of the info table. 
-			(mkIntCLit 0, fromIntegral (dataConTagZ con)) 
+			(mkIntCLit 0, fromIntegral (dataConTagZ con), Just $ dataConIdentity con) 
 
 	    Nothing  -> -- Not a constructor
-			srtLabelAndLength srt info_lbl
+                        let (label, len) = srtLabelAndLength srt info_lbl
+                        in (label, len, Nothing)
 
     ptrs       = closurePtrsSize cl_info
     nptrs      = size - ptrs
     size       = closureNonHdrSize cl_info
     layout_lit = packHalfWordsCLit ptrs nptrs
 
-    extra_bits
+    extra_bits conName 
 	| is_fun    = fun_extra_bits
-	| is_con    = []
+	| is_con    = [conName]
 	| needs_srt = [srt_label]
  	| otherwise = []