From e5374a1b3ac11851576f8835e19d9fc92d7735c3 Mon Sep 17 00:00:00 2001
From: Jan Stolarek <jan.stolarek@p.lodz.pl>
Date: Tue, 20 Aug 2013 11:53:05 +0100
Subject: 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.
---
 compiler/codeGen/StgCmmEnv.hs | 53 +++++++++++++------------------------------
 1 file changed, 16 insertions(+), 37 deletions(-)

(limited to 'compiler/codeGen/StgCmmEnv.hs')

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)
-- 
cgit v1.2.1