X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;h=4b7f131634f6a198239855964504cea1d5d4bf03;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=0a34d2761201ebf42f361e2a6e75fff410b75ff9;hpb=52276d816ccaf9eef0fbd9c74833d6fd95b38cd8;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 0a34d27..4b7f131 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -15,7 +15,7 @@ module Id (
 
 	-- Taking an Id apart
 	idName, idType, idUnique, idInfo,
-	idPrimRep, isId, globalIdDetails,
+	isId, globalIdDetails, idPrimRep,
 	recordSelectorFieldLabel,
 
 	-- Modifying an Id
@@ -38,7 +38,8 @@ module Id (
 
 
 	-- One shot lambda stuff
-	isOneShotBndr, isOneShotLambda, setOneShotLambda, clearOneShotLambda,
+	isOneShotBndr, isOneShotLambda, isStateHackType,
+	setOneShotLambda, clearOneShotLambda,
 
 	-- IdInfo stuff
 	setIdUnfolding,
@@ -89,7 +90,8 @@ import Var		( Id, DictId,
 			  globalIdDetails
 			)
 import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
-import Type		( Type, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
+import Type		( Type, typePrimRep, addFreeTyVars, seqType, 
+			  splitTyConApp_maybe, PrimRep )
 import TysPrim		( statePrimTyCon )
 import IdInfo 
 
@@ -104,7 +106,6 @@ import Name	 	( Name, OccName, nameIsLocalOrFrom,
 			) 
 import Module		( Module )
 import OccName		( EncodedFS, mkWorkerOcc )
-import PrimRep		( PrimRep )
 import FieldLabel	( FieldLabel )
 import Maybes		( orElse )
 import SrcLoc		( SrcLoc )
@@ -459,15 +460,16 @@ idLBVarInfo id = lbvarInfo (idInfo id)
 isOneShotBndr :: Id -> Bool
 -- This one is the "business end", called externally.
 -- Its main purpose is to encapsulate the Horrible State Hack
-isOneShotBndr id = isOneShotLambda id || (isStateHack id)
+isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
 
-isStateHack id 
+isStateHackType :: Type -> Bool
+isStateHackType ty
   | opt_NoStateHack 
   = False
   | otherwise
-  = case splitTyConApp_maybe (idType id) of
-	Just (tycon,_) | tycon == statePrimTyCon -> True
-        other                                    -> False
+  = case splitTyConApp_maybe ty of
+	Just (tycon,_) -> tycon == statePrimTyCon
+        other          -> False
 	-- This is a gross hack.  It claims that 
 	-- every function over realWorldStatePrimTy is a one-shot
 	-- function.  This is pretty true in practice, and makes a big