X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FMkId.lhs;h=50e981b0a48a04e2fada281902e347977cd46311;hb=8e67f5502e2e316245806ee3735a2f41a844b611;hp=7dabf461484145d6dda0dadf053d9a2cab5d8588;hpb=6599e6711867d7b6c9520b6e0d14c2c6e5b61d1a;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 7dabf46..50e981b 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -51,7 +51,7 @@ import TcType		( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
 			  tcSplitFunTys, tcSplitForAllTys
 			)
 import CoreUtils	( exprType )
-import CoreUnfold 	( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
+import CoreUnfold 	( mkTopUnfolding, mkCompulsoryUnfolding )
 import Literal		( nullAddrLit, mkStringLit )
 import TyCon		( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
                           tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
@@ -64,8 +64,7 @@ import PrimOp		( PrimOp, primOpSig, primOpOcc, primOpTag )
 import ForeignCall	( ForeignCall )
 import DataCon		( DataCon, DataConIds(..), dataConTyVars,
 			  dataConFieldLabels, dataConRepArity, 
-			  dataConRepArgTys, dataConRepType, 
-			  dataConStupidTheta, dataConOrigArgTys,
+			  dataConRepArgTys, dataConRepType, dataConStupidTheta, 
 			  dataConSig, dataConStrictMarks, dataConExStricts, 
 			  splitProductType, isVanillaDataCon
 			)
@@ -86,7 +85,6 @@ import CoreSyn
 import Unique		( mkBuiltinUnique, mkPrimOpIdUnique )
 import Maybes
 import PrelNames
-import Maybe            ( isJust )
 import Util             ( dropList, isSingleton )
 import Outputable
 import FastString
@@ -215,6 +213,8 @@ mkDataConIds wrap_name wkr_name data_con
     wkr_info  = noCafIdInfo
 	        `setArityInfo`		wkr_arity
 	        `setAllStrictnessInfo`	Just wkr_sig
+		`setUnfoldingInfo`      evaldUnfolding	-- Record that it's evaluated,
+							-- even if arity = 0
 
     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
 	-- Notice that we do *not* say the worker is strict
@@ -305,15 +305,15 @@ mkDataConIds wrap_name wkr_name data_con
 		MarkedStrict 
 		   | isUnLiftedType (idType arg) -> body i (arg:rep_args)
 		   | otherwise ->
--- gaw 2004
 			Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
 
 		MarkedUnboxed
 		   -> case splitProductType "do_unbox" (idType arg) of
 			   (tycon, tycon_args, con, tys) ->
--- gaw 2004
-				   Case (Var arg) arg result_ty  [(DataAlt con, con_args,
-					body i' (reverse con_args ++ rep_args))]
+				   Case (Var arg) arg result_ty  
+					[(DataAlt con, 
+					  con_args,
+					  body i' (reverse con_args ++ rep_args))]
 			      where 
 				(con_args, i') = mkLocals i tys
 
@@ -454,7 +454,7 @@ mkRecordSelId tycon field_label field_ty
     arg_base	    = dict_id_base + 1
 
     alts      = map mk_maybe_alt data_cons
-    the_alts  = catMaybes alts
+    the_alts  = catMaybes alts		-- Already sorted by data-con
 
     no_default = all isJust alts	-- No default needed
     default_alt | no_default = []
@@ -734,7 +734,7 @@ It's OK for dfuns to be LocalIds, because we form the instance-env to
 pass on to the next module (md_insts) in CoreTidy, afer tidying
 and globalising the top-level Ids.
 
-BUT make sure they are *exported* LocalIds (setIdLocalExported) so 
+BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
 that they aren't discarded by the occurrence analyser.
 
 \begin{code}
@@ -892,8 +892,8 @@ This comes up in strictness analysis
 \begin{code}
 realWorldPrimId	-- :: State# RealWorld
   = pcMiscPrelId realWorldName realWorldStatePrimTy
-		 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
-	-- The mkOtherCon makes it look that realWorld# is evaluated
+		 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
+	-- The evaldUnfolding makes it look that realWorld# is evaluated
 	-- which in turn makes Simplify.interestingArg return True,
 	-- which in turn makes INLINE things applied to realWorld# likely
 	-- to be inlined