summaryrefslogtreecommitdiff
path: root/compiler/codeGen/StgCmmEnv.hs
diff options
context:
space:
mode:
authorJan Stolarek <jan.stolarek@p.lodz.pl>2013-08-20 11:53:05 +0100
committerJan Stolarek <jan.stolarek@p.lodz.pl>2013-08-20 17:19:30 +0100
commite5374a1b3ac11851576f8835e19d9fc92d7735c3 (patch)
tree82cf705084772dad8b427574bdeae8f9abb7a7cb /compiler/codeGen/StgCmmEnv.hs
parent3f279f37042458dfcfd06eceb127eed4a528c3cc (diff)
downloadhaskell-e5374a1b3ac11851576f8835e19d9fc92d7735c3.tar.gz
Cleanup StgCmm pass
This cleanup includes: * removing dead code. This includes forkStatics function, which was in fact one big noop, and global bindings in CgInfoDownwards, * converting functions that used FCode monad only to access DynFlags into functions that take DynFlags as a parameter and don't work in a monad, * addBindC function is now smarter. It extracts Id from CgIdInfo passed to it in the same way addBindsC does. Previously this was done at every call site, which was redundant.
Diffstat (limited to 'compiler/codeGen/StgCmmEnv.hs')
-rw-r--r--compiler/codeGen/StgCmmEnv.hs53
1 files changed, 16 insertions, 37 deletions
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 77a3b4e249..353fec5a5f 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -8,8 +8,6 @@
module StgCmmEnv (
CgIdInfo,
- cgIdInfoId, cgIdInfoLF,
-
litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,
idInfoToAmode,
@@ -113,12 +111,6 @@ addDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr
-- A tag adds a byte offset to the pointer
addDynTag dflags expr tag = cmmOffsetB dflags expr tag
-cgIdInfoId :: CgIdInfo -> Id
-cgIdInfoId = cg_id
-
-cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
-cgIdInfoLF = cg_lf
-
maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
maybeLetNoEscape _other = Nothing
@@ -132,10 +124,10 @@ maybeLetNoEscape _other = Nothing
-- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
---------------------------------------------------------
-addBindC :: Id -> CgIdInfo -> FCode ()
-addBindC name stuff_to_bind = do
+addBindC :: CgIdInfo -> FCode ()
+addBindC stuff_to_bind = do
binds <- getBinds
- setBinds $ extendVarEnv binds name stuff_to_bind
+ setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind
addBindsC :: [CgIdInfo] -> FCode ()
addBindsC new_bindings = do
@@ -147,39 +139,26 @@ addBindsC new_bindings = do
getCgIdInfo :: Id -> FCode CgIdInfo
getCgIdInfo id
- = do { -- Try local bindings first
- ; local_binds <- getBinds
+ = do { dflags <- getDynFlags
+ ; local_binds <- getBinds -- Try local bindings first
; case lookupVarEnv local_binds id of {
Just info -> return info ;
- Nothing -> do
-
- { -- Try top-level bindings
- static_binds <- getStaticBinds
- ; case lookupVarEnv static_binds id of {
- Just info -> return info ;
- Nothing ->
+ Nothing -> do {
-- Should be imported; make up a CgIdInfo for it
- let
- name = idName id
- in
- if isExternalName name then do
- let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
- dflags <- getDynFlags
- return (litIdInfo dflags id (mkLFImported id) ext_lbl)
- else
- -- Bug
- cgLookupPanic id
- }}}}
+ let name = idName id
+ ; if isExternalName name then
+ let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
+ in return (litIdInfo dflags id (mkLFImported id) ext_lbl)
+ else
+ cgLookupPanic id -- Bug
+ }}}
cgLookupPanic :: Id -> FCode a
cgLookupPanic id
- = do static_binds <- getStaticBinds
- local_binds <- getBinds
+ = do local_binds <- getBinds
pprPanic "StgCmmEnv: variable not found"
(vcat [ppr id,
- ptext (sLit "static binds for:"),
- vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
ptext (sLit "local binds for:"),
vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ]
])
@@ -210,7 +189,7 @@ bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
bindToReg nvid@(NonVoid id) lf_info
= do dflags <- getDynFlags
let reg = idToReg dflags nvid
- addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
+ addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
return reg
rebindToReg :: NonVoid Id -> FCode LocalReg
@@ -218,7 +197,7 @@ rebindToReg :: NonVoid Id -> FCode LocalReg
-- get its LF info from the envt
rebindToReg nvid@(NonVoid id)
= do { info <- getCgIdInfo id
- ; bindToReg nvid (cgIdInfoLF info) }
+ ; bindToReg nvid (cg_lf info) }
bindArgToReg :: NonVoid Id -> FCode LocalReg
bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)