[project @ 2004-08-13 13:04:50 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 0a34d27..4b7f131 100644 (file)
--- 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