X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=91ecbe26fc13dea5956437cfffbba54c8d9464b5;hb=09518039f8f793e6464c1703506089a107926d11;hp=32b3441e1fe531ab472c74411d074620e877c06f;hpb=150e0a93f0187c4982644ac5bce776cc96b0d65d;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 32b3441..91ecbe2 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -13,10 +13,11 @@ module IdInfo (
 	vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo,
 
 	-- Zapping
-	zapFragileInfo,	zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo,
+	zapLamInfo, zapDemandInfo,
+	zapSpecPragInfo, shortableIdInfo, copyIdInfo,
 
 	-- Flavour
-	IdFlavour(..), flavourInfo, 
+	IdFlavour(..), flavourInfo,  makeConstantFlavour,
 	setNoDiscardInfo, setFlavourInfo,
 	ppFlavourInfo,
 
@@ -60,13 +61,13 @@ module IdInfo (
 	specInfo, setSpecInfo,
 
 	-- CAF info
-	CafInfo(..), cafInfo, setCafInfo, ppCafInfo,
+	CafInfo(..), cafInfo, setCafInfo, mayHaveCafRefs, ppCafInfo,
 
         -- Constructed Product Result Info
         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
 
         -- Lambda-bound variable info
-        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo
+        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
     ) where
 
 #include "HsVersions.h"
@@ -219,10 +220,11 @@ constantIdInfo :: IdInfo
 	-- we'd better assume it does
 constantIdInfo = mkIdInfo ConstantId MayHaveCafRefs
 
-mkIdInfo :: IdFlavour -> IdInfo
+mkIdInfo :: IdFlavour -> CafInfo -> IdInfo
 mkIdInfo flv caf 
   = IdInfo {
 	    flavourInfo		= flv,
+	    cafInfo		= caf,
 	    arityInfo		= UnknownArity,
 	    demandInfo		= wwLazy,
 	    specInfo		= emptyCoreRules,
@@ -230,7 +232,6 @@ mkIdInfo flv caf
 	    workerInfo		= NoWorker,
 	    strictnessInfo	= NoStrictnessInfo,
 	    unfoldingInfo	= noUnfolding,
-	    cafInfo		= caf
 	    cprInfo		= NoCPRInfo,
 	    lbvarInfo		= NoLBVarInfo,
 	    inlinePragInfo 	= NoInlinePragInfo,
@@ -267,6 +268,18 @@ data IdFlavour
   | RecordSelId FieldLabel	-- The Id for a record selector
 
 
+makeConstantFlavour :: IdFlavour -> IdFlavour
+makeConstantFlavour flavour = new_flavour
+  where new_flavour = case flavour of
+		        VanillaId  -> ConstantId
+		        ExportedId -> ConstantId
+		        ConstantId -> ConstantId	-- e.g. Default methods
+		        DictFunId  -> DictFunId
+		        flavour    -> pprTrace "makeConstantFlavour" 
+					(ppFlavourInfo flavour)
+				  	flavour
+
+
 ppFlavourInfo :: IdFlavour -> SDoc
 ppFlavourInfo VanillaId         = empty
 ppFlavourInfo ExportedId        = ptext SLIT("[Exported]")
@@ -525,6 +538,9 @@ data CafInfo
 --      | OneCafRef Id
 
 
+mayHaveCafRefs MayHaveCafRefs = True
+mayHaveCafRefs _	      = False
+
 seqCaf c = c `seq` ()
 
 ppCafInfo NoCafRefs = ptext SLIT("__C")
@@ -618,6 +634,9 @@ seqLBVar l = l `seq` ()
 \end{code}
 
 \begin{code}
+hasNoLBVarInfo NoLBVarInfo = True
+hasNoLBVarInfo other       = False
+
 noLBVarInfo = NoLBVarInfo
 
 -- not safe to print or parse LBVarInfo because it is not really a
@@ -645,54 +664,6 @@ instance Show LBVarInfo where
 %*									*
 %************************************************************************
 
-zapFragileInfo is used when cloning binders, mainly in the
-simplifier.  We must forget about used-once information because that
-isn't necessarily correct in the transformed program.
-Also forget specialisations and unfoldings because they would need
-substitution to be correct.  (They get pinned back on separately.)
-
-\begin{code}
-zapFragileInfo :: IdInfo -> Maybe IdInfo
-zapFragileInfo info@(IdInfo {occInfo		= occ, 
-			     workerInfo		= wrkr,
-			     specInfo		= rules, 
-			     unfoldingInfo	= unfolding})
-  |  not (isFragileOcc occ)
-        -- We must forget about whether it was marked safe-to-inline,
-	-- because that isn't necessarily true in the simplified expression.
-	-- This is important because expressions may  be re-simplified
-	-- We don't zap deadness or loop-breaker-ness.
-	-- The latter is important because it tells MkIface not to 
-	-- spit out an inlining for the thing.  The former doesn't
-	-- seem so important, but there's no harm.
-
-  && isEmptyCoreRules rules
-	-- Specialisations would need substituting.  They get pinned
-	-- back on separately.
-
-  && not (workerExists wrkr)
-
-  && not (hasUnfolding unfolding)
-	-- This is very important; occasionally a let-bound binder is used
-	-- as a binder in some lambda, in which case its unfolding is utterly
-	-- bogus.  Also the unfolding uses old binders so if we left it we'd
-	-- have to substitute it. Much better simply to give the Id a new
-	-- unfolding each time, which is what the simplifier does.
-  = Nothing
-
-  | otherwise
-  = Just (info {occInfo		= robust_occ_info,
-		workerInfo	= noWorkerInfo,
-		specInfo	= emptyCoreRules,
-		unfoldingInfo	= noUnfolding})
-  where
-	-- It's important to keep the loop-breaker info,
-	-- because the substitution doesn't remember it.
-    robust_occ_info = case occ of
-			OneOcc _ _ -> NoOccInfo
-			other	   -> occ
-\end{code}
-
 @zapLamInfo@ is used for lambda binders that turn out to to be
 part of an unsaturated lambda
 
@@ -716,6 +687,13 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
 		 other	       -> occ
 \end{code}
 
+\begin{code}
+zapDemandInfo :: IdInfo -> Maybe IdInfo
+zapDemandInfo info@(IdInfo {demandInfo = demand})
+  | not (isStrict demand) = Nothing
+  | otherwise		  = Just (info {demandInfo = wwLazy})
+\end{code}
+
 
 copyIdInfo is used when shorting out a top-level binding
 	f_local = BIG