Some general code cleaning in LLVM backend

2 files changed, 22 insertions, 32 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 21d463e5c5..46f3f268a3 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -7,12 +7,10 @@ module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
 #include "HsVersions.h"
 
 import Llvm
-
 import LlvmCodeGen.Base
 import LlvmCodeGen.CodeGen
 import LlvmCodeGen.Data
 import LlvmCodeGen.Ppr
-
 import LlvmMangler
 
 import CLabel
@@ -50,11 +48,9 @@ llvmCodeGen dflags h us cmms
     in do
         bufh <- newBufHandle h
         Prt.bufLeftRender bufh $ pprLlvmHeader
-        ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
-        
+        ver  <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
         env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
         cmmProcLlvmGens dflags bufh us env' cmm 1 []
-
         bFlush bufh
         return  ()
 
@@ -83,36 +79,39 @@ cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
 -- | Do LLVM code generation on all these Cmms procs.
 --
 cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
-      -> Int          -- ^ count, used for generating unique subsections
-      -> [LlvmVar]    -- ^ info tables that need to be marked as 'used'
+      -> Int         -- ^ count, used for generating unique subsections
+      -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used'
       -> IO ()
 
 cmmProcLlvmGens _ _ _ _ [] _ []
   = return ()
 
 cmmProcLlvmGens _ h _ _ [] _ ivars
-  = let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
-        ty     = (LMArray (length ivars) i8Ptr)
-        usedArray = LMStaticArray (map cast ivars) ty
+  = let ivars' = concat ivars
+        cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
+        ty     = (LMArray (length ivars') i8Ptr)
+        usedArray = LMStaticArray (map cast ivars') ty
         lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
                   (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
     in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
 
-cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
-  = do
-    (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
+cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
+ = cmmProcLlvmGens dflags h us env cmms count ivars
 
+cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars
+ = cmmProcLlvmGens dflags h us env cmms count ivars
+
+cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
+    (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
     let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
     Prt.bufLeftRender h $ Prt.vcat docs
-
-    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
+    cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
 
 
 -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
             -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
-cmmLlvmGen dflags us env cmm
-  = do
+cmmLlvmGen dflags us env cmm = do
     -- rewrite assignments to global regs
     let fixed_cmm = fixStgRegisters cmm
 
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index eb002742e1..c9ad76efd5 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -29,28 +29,19 @@ import Util
 import Data.List ( partition )
 import Control.Monad ( liftM )
 
-type LlvmStatements = OrdList LlvmStatement
 
+type LlvmStatements = OrdList LlvmStatement
 
 -- -----------------------------------------------------------------------------
 -- | Top-level of the LLVM proc Code generator
 --
 genLlvmProc :: LlvmEnv -> RawCmmTop -> UniqSM (LlvmEnv, [LlvmCmmTop])
-genLlvmProc env (CmmData _ _)
-  = return (env, [])
-
-genLlvmProc env (CmmProc _ _ (ListGraph []))
-  = return (env, [])
-
-genLlvmProc env (CmmProc info lbl (ListGraph blocks))
-  = do
-        (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], [])
-
-        let proc    = CmmProc info lbl (ListGraph lmblocks)
-        let tops    = lmdata ++ [proc]
-
-        return (env', tops)
+genLlvmProc env (CmmProc info lbl (ListGraph blocks)) = do
+    (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], [])
+    let proc = CmmProc info lbl (ListGraph lmblocks)
+    return (env', proc:lmdata)
 
+genLlvmProc _ _ = panic "genLlvmProc: case that shouldn't reach here!"
 
 -- -----------------------------------------------------------------------------
 -- * Block code generation