Major Llvm refactoring

This combined patch reworks the LLVM backend in a number of ways:

1. Most prominently, we introduce a LlvmM monad carrying the contents of
   the old LlvmEnv around. This patch completely removes LlvmEnv and
   refactors towards standard library monad combinators wherever possible.

2. Support for streaming - we can now generate chunks of Llvm for Cmm as
   it comes in. This might improve our speed.

3. To allow streaming, we need a more flexible way to handle forward
   references. The solution (getGlobalPtr) unifies LlvmCodeGen.Data
   and getHsFunc as well.

4. Skip alloca-allocation for registers that are actually never written.
   LLVM will automatically eliminate these, but output is smaller and
   friendlier to human eyes this way.

5. We use LlvmM to collect references for llvm.used. This allows places
   other than cmmProcLlvmGens to generate entries.

1 files changed, 45 insertions, 108 deletions

diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index f31b3e5203..6212cfc9fb 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -3,7 +3,7 @@
 --
 
 module LlvmCodeGen.Data (
-        genLlvmData, resolveLlvmDatas, resolveLlvmData
+        genLlvmData
     ) where
 
 #include "HsVersions.h"
@@ -18,8 +18,6 @@ import Cmm
 import FastString
 import qualified Outputable
 
-import Data.List (foldl')
-
 -- ----------------------------------------------------------------------------
 -- * Constants
 --
@@ -32,43 +30,23 @@ structStr = fsLit "_struct"
 -- * Top level
 --
 
--- | Pass a CmmStatic section to an equivalent Llvm code. Can't
--- complete this completely though as we need to pass all CmmStatic
--- sections before all references can be resolved. This last step is
--- done by 'resolveLlvmData'.
-genLlvmData :: LlvmEnv -> (Section, CmmStatics) -> LlvmUnresData
-genLlvmData env (sec, Statics lbl xs) =
-    let dflags  = getDflags env
-        static  = map genData xs
-        label   = strCLabel_llvm env lbl
-
-        types   = map getStatTypes static
-        getStatTypes (Left  x) = cmmToLlvmType $ cmmLitType dflags x
-        getStatTypes (Right x) = getStatType x
+-- | Pass a CmmStatic section to an equivalent Llvm code.
+genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
+genLlvmData (sec, Statics lbl xs) = do
+    label <- strCLabel_llvm lbl
+    static <- mapM genData xs
+    let types   = map getStatType static
 
         strucTy = LMStruct types
         alias   = LMAlias ((label `appendFS` structStr), strucTy)
-    in (lbl, sec, alias, static)
-
 
-resolveLlvmDatas ::  LlvmEnv -> [LlvmUnresData] -> (LlvmEnv, [LlvmData])
-resolveLlvmDatas env ldata
-  = foldl' res (env, []) ldata
-  where res (e, xs) ll =
-            let (e', nd) = resolveLlvmData e ll
-            in (e', nd:xs)
-
--- | Fix up CLabel references now that we should have passed all CmmData.
-resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
-resolveLlvmData env (lbl, sec, alias, unres) =
-    let (env', static, refs) = resDatas env unres ([], [])
         struct         = Just $ LMStaticStruc static alias
-        label          = strCLabel_llvm env lbl
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
         const          = if isSecConstant sec then Constant else Global
         glob           = LMGlobalVar label alias link Nothing Nothing const
-    in (env', ((LMGlobal glob struct):refs, [alias]))
+
+    return ([LMGlobal glob struct], [alias])
 
 -- | Should a data in this section be considered constant
 isSecConstant :: Section -> Bool
@@ -82,80 +60,19 @@ isSecConstant (OtherSection _)        = False
 
 
 -- ----------------------------------------------------------------------------
--- ** Resolve Data/CLabel references
---
-
--- | Resolve data list
-resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [LMGlobal])
-         -> (LlvmEnv, [LlvmStatic], [LMGlobal])
-
-resDatas env [] (stats, glob)
-  = (env, stats, glob)
-
-resDatas env (cmm:rest) (stats, globs)
-  = let (env', nstat, nglob) = resData env cmm
-    in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
-
--- | Resolve an individual static label if it needs to be.
---
--- We check the 'LlvmEnv' to see if the reference has been defined in this
--- module. If it has we can retrieve its type and make a pointer, otherwise
--- we introduce a generic external definition for the referenced label and
--- then make a pointer.
-resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [LMGlobal])
-
-resData env (Right stat) = (env, stat, [])
-
-resData env (Left cmm@(CmmLabel l)) =
-    let dflags = getDflags env
-        label = strCLabel_llvm env l
-        ty = funLookup label env
-        lmty = cmmToLlvmType $ cmmLitType dflags cmm
-    in case ty of
-            -- Make generic external label defenition and then pointer to it
-            Nothing ->
-                let glob@(LMGlobal var _) = genStringLabelRef dflags label
-                    env' =  funInsert label (pLower $ getVarType var) env
-                    ptr  = LMStaticPointer var
-                in  (env', LMPtoI ptr lmty, [glob])
-            -- Referenced data exists in this module, retrieve type and make
-            -- pointer to it.
-            Just ty' ->
-                let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing Global
-                    ptr  = LMStaticPointer var
-                in (env, LMPtoI ptr lmty, [])
-
-resData env (Left (CmmLabelOff label off)) =
-    let dflags = getDflags env
-        (env', var, glob) = resData env (Left (CmmLabel label))
-        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
-    in (env', LMAdd var offset, glob)
-
-resData env (Left (CmmLabelDiffOff l1 l2 off)) =
-    let dflags = getDflags env
-        (env1, var1, glob1) = resData env (Left (CmmLabel l1))
-        (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
-        var = LMSub var1 var2
-        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
-    in (env2, LMAdd var offset, glob1 ++ glob2)
-
-resData _ _ = panic "resData: Non CLabel expr as left type!"
-
--- ----------------------------------------------------------------------------
 -- * Generate static data
 --
 
 -- | Handle static data
-genData :: CmmStatic -> UnresStatic
+genData :: CmmStatic -> LlvmM LlvmStatic
 
-genData (CmmString str) =
+genData (CmmString str) = do
     let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
         ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
-    in Right $ LMStaticArray ve (LMArray (length ve) i8)
+    return $ LMStaticArray ve (LMArray (length ve) i8)
 
 genData (CmmUninitialised bytes)
-    = Right $ LMUninitType (LMArray bytes i8)
+    = return $ LMUninitType (LMArray bytes i8)
 
 genData (CmmStaticLit lit)
     = genStaticLit lit
@@ -164,27 +81,47 @@ genData (CmmStaticLit lit)
 --
 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
 -- which isn't yet known.
-genStaticLit :: CmmLit -> UnresStatic
+genStaticLit :: CmmLit -> LlvmM LlvmStatic
 genStaticLit (CmmInt i w)
-    = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
+    = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 
 genStaticLit (CmmFloat r w)
-    = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
+    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
 
 genStaticLit (CmmVec ls)
-    = Right $ LMStaticLit (LMVectorLit (map toLlvmLit ls))
+    = do sls <- mapM toLlvmLit ls
+         return $ LMStaticLit (LMVectorLit sls)
   where
-    toLlvmLit :: CmmLit -> LlvmLit
-    toLlvmLit lit = case genStaticLit lit of
-                   Right (LMStaticLit llvmLit) -> llvmLit
-                   _ -> panic "genStaticLit"
+    toLlvmLit :: CmmLit -> LlvmM LlvmLit
+    toLlvmLit lit = do
+      slit <- genStaticLit lit
+      case slit of
+        LMStaticLit llvmLit -> return llvmLit
+        _ -> panic "genStaticLit"
 
 -- Leave unresolved, will fix later
-genStaticLit c@(CmmLabel        _    ) = Left $ c
-genStaticLit c@(CmmLabelOff     _   _) = Left $ c
-genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
+genStaticLit cmm@(CmmLabel l) = do
+    var <- getGlobalPtr =<< strCLabel_llvm l
+    dflags <- getDynFlags
+    let ptr = LMStaticPointer var
+        lmty = cmmToLlvmType $ cmmLitType dflags cmm
+    return $ LMPtoI ptr lmty
+
+genStaticLit (CmmLabelOff label off) = do
+    dflags <- getDynFlags
+    var <- genStaticLit (CmmLabel label)
+    let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    return $ LMAdd var offset
+
+genStaticLit (CmmLabelDiffOff l1 l2 off) = do
+    dflags <- getDynFlags
+    var1 <- genStaticLit (CmmLabel l1)
+    var2 <- genStaticLit (CmmLabel l2)
+    let var = LMSub var1 var2
+        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    return $ LMAdd var offset
 
-genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
+genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
 
 genStaticLit (CmmHighStackMark)
     = panic "genStaticLit: CmmHighStackMark unsupported!"