diff options
author | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2013-08-20 11:53:05 +0100 |
---|---|---|
committer | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2013-08-20 17:19:30 +0100 |
commit | e5374a1b3ac11851576f8835e19d9fc92d7735c3 (patch) | |
tree | 82cf705084772dad8b427574bdeae8f9abb7a7cb /compiler/codeGen/StgCmmEnv.hs | |
parent | 3f279f37042458dfcfd06eceb127eed4a528c3cc (diff) | |
download | haskell-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.hs | 53 |
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) |