Add mapOccEnv

[ghc-hetmet.git] / ghc / compiler / stgSyn / StgSyn.lhs

diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
index b9f3671..f1c50cc 100644 (file)
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ b/ghc/compiler/stgSyn/StgSyn.lhs
@@ -30,12 +30,12 @@ module StgSyn (
        StgOp(..),
 
        -- SRTs
-       SRT(..), noSRT, nonEmptySRT,
+       SRT(..),
 
        -- utils
-       stgBindHasCafRefs,  stgArgHasCafRefs, stgRhsArity, getArgPrimRep, 
-       isLitLitArg, isDllConApp, isStgTypeArg,
-       stgArgType, stgBinders,
+       stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
+       isDllConApp, isStgTypeArg,
+       stgArgType,
 
        pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs
 
@@ -49,13 +49,14 @@ module StgSyn (
 import CostCentre      ( CostCentreStack, CostCentre )
 import VarSet          ( IdSet, isEmptyVarSet )
 import Var             ( isId )
-import Id              ( Id, idName, idPrimRep, idType, idCafInfo )
+import Id              ( Id, idName, idType, idCafInfo )
 import IdInfo          ( mayHaveCafRefs )
-import Name            ( isDllName )
-import Literal         ( Literal, literalType, isLitLitLit, literalPrimRep )
+import Packages                ( isDllName )
+import Literal         ( Literal, literalType )
 import ForeignCall     ( ForeignCall )
 import DataCon         ( DataCon, dataConName )
 import CoreSyn         ( AltCon )
+import PprCore         ( {- instances -} )
 import PrimOp          ( PrimOp )
 import Outputable
 import Util             ( count )
@@ -64,7 +65,9 @@ import TyCon            ( TyCon )
 import UniqSet         ( isEmptyUniqSet, uniqSetToList, UniqSet )
 import Unique          ( Unique )
 import Bitmap
-import CmdLineOpts     ( opt_SccProfilingOn )
+import DynFlags                ( DynFlags )
+import Packages                ( HomeModules )
+import StaticFlags     ( opt_SccProfilingOn )
 \end{code}
 
 %************************************************************************
@@ -84,10 +87,6 @@ There is one SRT for each group of bindings.
 data GenStgBinding bndr occ
   = StgNonRec  bndr (GenStgRhs bndr occ)
   | StgRec     [(bndr, GenStgRhs bndr occ)]
-
-stgBinders :: GenStgBinding bndr occ -> [bndr]
-stgBinders (StgNonRec b _) = [b]
-stgBinders (StgRec bs)     = map fst bs
 \end{code}
 
 %************************************************************************
@@ -104,26 +103,21 @@ data GenStgArg occ
 \end{code}
 
 \begin{code}
-getArgPrimRep (StgVarArg local) = idPrimRep local
-getArgPrimRep (StgLitArg lit)  = literalPrimRep lit
-
-isLitLitArg (StgLitArg lit) = isLitLitLit lit
-isLitLitArg _              = False
-
 isStgTypeArg (StgTypeArg _) = True
 isStgTypeArg other         = False
 
-isDllArg :: StgArg -> Bool
+isDllArg :: HomeModules -> StgArg -> Bool
        -- Does this argument refer to something in a different DLL?
-isDllArg (StgTypeArg v)   = False
-isDllArg (StgVarArg v)   = isDllName (idName v)
-isDllArg (StgLitArg lit) = isLitLitLit lit
+isDllArg hmods (StgTypeArg v)  = False
+isDllArg hmods (StgVarArg v)   = isDllName hmods (idName v)
+isDllArg hmods (StgLitArg lit) = False
 
-isDllConApp :: DataCon -> [StgArg] -> Bool
+isDllConApp :: HomeModules -> DataCon -> [StgArg] -> Bool
        -- Does this constructor application refer to 
        -- anything in a different DLL?
        -- If so, we can't allocate it statically
-isDllConApp con args = isDllName (dataConName con) || any isDllArg args
+isDllConApp hmods con args
+   = isDllName hmods (dataConName con) || any (isDllArg hmods) args
 
 stgArgType :: StgArg -> Type
        -- Very half baked becase we have lost the type arguments
@@ -333,12 +327,12 @@ And so the code for let(rec)-things:
   | StgLetNoEscape                     -- remember: ``advanced stuff''
        (GenStgLiveVars occ)            -- Live in the whole let-expression
                                        -- Mustn't overwrite these stack slots
-                                       -- *Doesn't* include binders of the let(rec).
+                                       --  *Doesn't* include binders of the let(rec).
 
        (GenStgLiveVars occ)            -- Live in the right hand sides (only)
                                        -- These are the ones which must be saved on
                                        -- the stack if they aren't there already
-                                       -- *Does* include binders of the let(rec) if recursive.
+                                       --  *Does* include binders of the let(rec) if recursive.
 
        (GenStgBinding bndr occ)        -- right hand sides (see below)
        (GenStgExpr bndr occ)           -- body