1 files changed, 31 insertions, 30 deletions

diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs
index f73122bf89..e710204222 100644
--- a/compiler/codeGen/StgCmmExtCode.hs
+++ b/compiler/codeGen/StgCmmExtCode.hs
@@ -10,9 +10,9 @@
 -- back in circularly (to avoid a two-pass algorithm).
 
 module StgCmmExtCode (
-        CmmParse(..),
+        CmmParse, unEC,
         Named(..), Env,
-        
+
         loopDecls,
         getEnv,
 
@@ -50,13 +50,13 @@ import Unique
 
 
 -- | The environment contains variable definitions or blockids.
-data Named      
+data Named
         = VarN CmmExpr          -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
-                                --      eg, RtsLabel, ForeignLabel, CmmLabel etc. 
+                                --      eg, RtsLabel, ForeignLabel, CmmLabel etc.
 
         | FunN   PackageId      -- ^ A function name from this package
         | LabelN BlockId                -- ^ A blockid of some code or data.
-        
+
 -- | An environment of named things.
 type Env        = UniqFM Named
 
@@ -65,7 +65,7 @@ type Decls      = [(FastString,Named)]
 
 -- | Does a computation in the FCode monad, with a current environment
 --      and a list of local declarations. Returns the resulting list of declarations.
-newtype CmmParse a      
+newtype CmmParse a
         = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
 
 type ExtCode = CmmParse ()
@@ -86,7 +86,7 @@ instance HasDynFlags CmmParse where
 
 
 -- | Takes the variable decarations and imports from the monad
---      and makes an environment, which is looped back into the computation.  
+--      and makes an environment, which is looped back into the computation.
 --      In this way, we can have embedded declarations that scope over the whole
 --      procedure, and imports that scope over the entire module.
 --      Discards the local declaration contained within decl'
@@ -94,7 +94,7 @@ instance HasDynFlags CmmParse where
 loopDecls :: CmmParse a -> CmmParse a
 loopDecls (EC fcode) =
       EC $ \e globalDecls -> do
-        (_, a) <- F.fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
+        (_, a) <- F.fixC (\ ~(decls, _) -> fcode (addListToUFM e decls) globalDecls)
         return (globalDecls, a)
 
 
@@ -103,24 +103,26 @@ getEnv :: CmmParse Env
 getEnv  = EC $ \e s -> return (s, e)
 
 
--- | Add a new variable to the list of local declarations. 
---      The CmmExpr says where the value is stored. 
+addDecl :: FastString -> Named -> ExtCode
+addDecl name named = EC $ \_ s -> return ((name, named) : s, ())
+
+
+-- | Add a new variable to the list of local declarations.
+--      The CmmExpr says where the value is stored.
 addVarDecl :: FastString -> CmmExpr -> ExtCode
-addVarDecl var expr 
-        = EC $ \_ s -> return ((var, VarN expr):s, ())
+addVarDecl var expr = addDecl var (VarN expr)
 
 -- | Add a new label to the list of local declarations.
 addLabel :: FastString -> BlockId -> ExtCode
-addLabel name block_id 
-        = EC $ \_ s -> return ((name, LabelN block_id):s, ())
+addLabel name block_id = addDecl name (LabelN block_id)
 
 
 -- | Create a fresh local variable of a given type.
-newLocal 
+newLocal
         :: CmmType              -- ^ data type
         -> FastString           -- ^ name of variable
         -> CmmParse LocalReg    -- ^ register holding the value
-        
+
 newLocal ty name = do
    u <- code newUnique
    let reg = LocalReg u ty
@@ -139,33 +141,32 @@ newBlockId :: CmmParse BlockId
 newBlockId = code F.newLabelC
 
 -- | Add add a local function to the environment.
-newFunctionName 
-        :: FastString   -- ^ name of the function 
+newFunctionName
+        :: FastString   -- ^ name of the function
         -> PackageId    -- ^ package of the current module
         -> ExtCode
-        
-newFunctionName name pkg
-        = EC $ \_ s -> return ((name, FunN pkg):s, ())
-        
-        
+
+newFunctionName name pkg = addDecl name (FunN pkg)
+
+
 -- | Add an imported foreign label to the list of local declarations.
 --      If this is done at the start of the module the declaration will scope
 --      over the whole module.
-newImport 
-        :: (FastString, CLabel) 
+newImport
+        :: (FastString, CLabel)
         -> CmmParse ()
 
-newImport (name, cmmLabel) 
+newImport (name, cmmLabel)
    = addVarDecl name (CmmLit (CmmLabel cmmLabel))
 
 
 -- | Lookup the BlockId bound to the label with this name.
---      If one hasn't been bound yet, create a fresh one based on the 
+--      If one hasn't been bound yet, create a fresh one based on the
 --      Unique of the name.
 lookupLabel :: FastString -> CmmParse BlockId
 lookupLabel name = do
   env <- getEnv
-  return $ 
+  return $
      case lookupUFM env name of
         Just (LabelN l) -> l
         _other          -> mkBlockId (newTagUnique (getUnique name) 'L')
@@ -178,7 +179,7 @@ lookupLabel name = do
 lookupName :: FastString -> CmmParse CmmExpr
 lookupName name = do
   env    <- getEnv
-  return $ 
+  return $
      case lookupUFM env name of
         Just (VarN e)   -> e
         Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))
@@ -187,7 +188,7 @@ lookupName name = do
 
 -- | Lift an FCode computation into the CmmParse monad
 code :: FCode a -> CmmParse a
-code fc = EC $ \_ s -> do 
+code fc = EC $ \_ s -> do
                 r <- fc
                 return (s, r)