X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FMkId.lhs;h=337d6a4cfb43592d0458d0a8b46c0e944a8adaa9;hb=dd313897eb9a14bcc7b81f97e4f2292c30039efd;hp=4275132615bb15fccfc0851b1bb01ac9075f716f;hpb=0498d35528e7666b9a77a79a78d2e1e782ff0c0b;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 4275132..337d6a4 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -37,12 +37,12 @@ module MkId (
 
 
 import BasicTypes	( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
+import Rules		( mkSpecInfo )
 import TysPrim		( openAlphaTyVars, alphaTyVar, alphaTy, 
 			  realWorldStatePrimTy, addrPrimTy
 			)
 import TysWiredIn	( charTy, mkListTy )
 import PrelRules	( primOpRules )
-import Rules		( addRule )
 import Type		( TyThing(..) )
 import TcType		( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy, 
 			  mkTyConApp, mkTyVarTys, mkClassPred, tcEqPred,
@@ -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 )
@@ -85,7 +85,6 @@ import CoreSyn
 import Unique		( mkBuiltinUnique, mkPrimOpIdUnique )
 import Maybes
 import PrelNames
-import Maybe            ( isJust )
 import Util             ( dropList, isSingleton )
 import Outputable
 import FastString
@@ -214,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
@@ -224,7 +225,7 @@ mkDataConIds wrap_name wkr_name data_con
 	-- If we pretend it is strict then when we see
 	--	case x of y -> $wMkT y
 	-- the simplifier thinks that y is "sure to be evaluated" (because
-	-- $wMkT is strict) and drops the case.  No, $wMkT is not strict.
+	--  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
 	--
 	-- When the simplifer sees a pattern 
 	--	case e of MkT x -> ...
@@ -664,13 +665,10 @@ mkPrimOpId prim_op
     id   = mkGlobalId (PrimOpId prim_op) name ty info
 		
     info = noCafIdInfo
-	   `setSpecInfo`	rules
-	   `setArityInfo` 	arity
+	   `setSpecInfo`	  mkSpecInfo (primOpRules prim_op name)
+	   `setArityInfo` 	  arity
 	   `setAllStrictnessInfo` Just strict_sig
 
-    rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
-
-
 -- For each ccall we manufacture a separate CCallOpId, giving it
 -- a fresh unique, a type that is correct for this particular ccall,
 -- and a CCall structure that gives the correct details about calling
@@ -716,11 +714,9 @@ Dict funs and default methods are *not* ImplicitIds.  Their definition
 involves user-written code, so we can't figure out their strictness etc
 based on fixed info, as we can for constructors and record selectors (say).
 
-We build them as GlobalIds, but when in the module where they are
-bound, we turn the Id at the *binding site* into an exported LocalId.
-This ensures that they are taken to account by free-variable finding
-and dependency analysis (e.g. CoreFVs.exprFreeVars).   The simplifier
-will propagate the LocalId to all occurrence sites. 
+We build them as LocalIds, but with External Names.  This ensures that
+they are taken to account by free-variable finding and dependency
+analysis (e.g. CoreFVs.exprFreeVars).
 
 Why shouldn't they be bound as GlobalIds?  Because, in particular, if
 they are globals, the specialiser floats dict uses above their defns,
@@ -891,8 +887,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