Declare some top level globals to be constant when appropriate

This involved removing the old constant handling mechanism
which was fairly hard to use. Now being constant or not is
simply a property of a global variable instead of a separate
type.

9 files changed, 89 insertions, 102 deletions

diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index 8291d9868f..907ab3935f 100644
--- a/compiler/llvmGen/Llvm.hs
+++ b/compiler/llvmGen/Llvm.hs
@@ -28,7 +28,7 @@ module Llvm (
 
         -- * Variables and Type System
         LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
-        LMGlobal, LMString, LMConstant, LMSection, LMAlign,
+        LMGlobal, LMString, LMSection, LMAlign,
 
         -- ** Some basic types
         i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
@@ -39,10 +39,9 @@ module Llvm (
         pLift, pLower, isInt, isFloat, isPointer, llvmWidthInBits,
 
         -- * Pretty Printing
-        ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmConstants,
-        ppLlvmConstant, ppLlvmGlobals, ppLlvmGlobal, ppLlvmFunctionDecls,
-        ppLlvmFunctionDecl, ppLlvmFunctions, ppLlvmFunction, ppLlvmType,
-        ppLlvmTypes, llvmSDoc
+        ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
+        ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,
+        ppLlvmFunction, ppLlvmType, ppLlvmTypes, llvmSDoc
 
     ) where
 
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
index 9c255ab7df..05a0f08cfd 100644
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
@@ -28,9 +28,6 @@ data LlvmModule = LlvmModule  {
     -- | Comments to include at the start of the module.
     modComments  :: [LMString],
 
-    -- | Constants to include in the module.
-    modConstants :: [LMConstant],
-
     -- | Global variables to include in the module.
     modGlobals   :: [LMGlobal],
 
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 8068247761..fffb72db20 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -8,8 +8,6 @@ module Llvm.PpLlvm (
     ppLlvmModule,
     ppLlvmComments,
     ppLlvmComment,
-    ppLlvmConstants,
-    ppLlvmConstant,
     ppLlvmGlobals,
     ppLlvmGlobal,
     ppLlvmType,
@@ -40,10 +38,9 @@ import Unique
 
 -- | Print out a whole LLVM module.
 ppLlvmModule :: LlvmModule -> Doc
-ppLlvmModule (LlvmModule comments constants globals decls funcs)
+ppLlvmModule (LlvmModule comments globals decls funcs)
   = ppLlvmComments comments
     $+$ empty
-    $+$ ppLlvmConstants constants
     $+$ ppLlvmGlobals globals
     $+$ empty
     $+$ ppLlvmFunctionDecls decls
@@ -65,10 +62,7 @@ ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
 
 -- | Print out a global mutable variable definition
 ppLlvmGlobal :: LMGlobal -> Doc
-ppLlvmGlobal = ppLlvmGlobal' (text "global")
-
-ppLlvmGlobal' :: Doc -> LMGlobal -> Doc
-ppLlvmGlobal' vty (var@(LMGlobalVar _ _ link x a), cont) =
+ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
     let sect = case x of
             Just x' -> text ", section" <+> doubleQuotes (ftext x')
             Nothing -> empty
@@ -77,22 +71,15 @@ ppLlvmGlobal' vty (var@(LMGlobalVar _ _ link x a), cont) =
             Just a' -> text ", align" <+> int a'
             Nothing -> empty
 
-        rhs = case cont of
+        rhs = case dat of
             Just stat -> texts stat
             Nothing   -> texts (pLower $ getVarType var)
 
-    in ppAssignment var $ texts link <+> vty <+> rhs <> sect <> align
-
-ppLlvmGlobal' _ oth = error $ "Non Global var ppr as global! " ++ show oth
-
+        const' = if c then text "constant" else text "global"
 
--- | Print out a list global constant variable
-ppLlvmConstants :: [LMConstant] -> Doc
-ppLlvmConstants cons = vcat $ map ppLlvmConstant cons
+    in ppAssignment var $ texts link <+> const' <+> rhs <> sect <> align
 
--- | Print out a global constant variable
-ppLlvmConstant :: LMConstant -> Doc
-ppLlvmConstant (v,s) = ppLlvmGlobal' (text "constant") (v, Just s)
+ppLlvmGlobal oth = error $ "Non Global var ppr as global! " ++ show oth
 
 
 -- | Print out a list of LLVM type aliases.
@@ -196,7 +183,7 @@ ppCall ct fptr vals attrs = case fptr of
     LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d
 
     -- should be function type otherwise
-    LMGlobalVar _ (LMFunction d) _ _ _      -> ppCall' d
+    LMGlobalVar _ (LMFunction d) _ _ _ _    -> ppCall' d
 
     -- not pointer or function, so error
     _other -> error $ "ppCall called with non LMFunction type!\nMust be "
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index a0b003298c..ac909d191c 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -23,8 +23,6 @@ import PprBase
 
 -- | A global mutable variable. Maybe defined or external
 type LMGlobal   = (LlvmVar, Maybe LlvmStatic)
--- | A global constant variable
-type LMConstant = (LlvmVar, LlvmStatic)
 -- | A String in LLVM
 type LMString   = FastString
 
@@ -69,11 +67,12 @@ instance Show LlvmType where
 -- | An LLVM section defenition. If Nothing then let LLVM decide the section
 type LMSection = Maybe LMString
 type LMAlign = Maybe Int
+type LMConst = Bool -- ^ is a variable constant or not
 
 -- | Llvm Variables
 data LlvmVar
   -- | Variables with a global scope.
-  = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign
+  = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst
   -- | Variables local to a function or parameters.
   | LMLocalVar Unique LlvmType
   -- | Named local variables. Sometimes we need to be able to explicitly name
@@ -176,18 +175,18 @@ commaCat x  = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x))
 -- | Return the variable name or value of the 'LlvmVar'
 -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
 getName :: LlvmVar -> String
-getName v@(LMGlobalVar _ _ _ _ _) = "@" ++ getPlainName v
-getName v@(LMLocalVar  _ _      ) = "%" ++ getPlainName v
-getName v@(LMNLocalVar _ _      ) = "%" ++ getPlainName v
-getName v@(LMLitVar    _        ) = getPlainName v
+getName v@(LMGlobalVar _ _ _ _ _ _) = "@" ++ getPlainName v
+getName v@(LMLocalVar  _ _        ) = "%" ++ getPlainName v
+getName v@(LMNLocalVar _ _        ) = "%" ++ getPlainName v
+getName v@(LMLitVar    _          ) = getPlainName v
 
 -- | Return the variable name or value of the 'LlvmVar'
 -- in a plain textual representation (e.g. @x@, @y@ or @42@).
 getPlainName :: LlvmVar -> String
-getPlainName (LMGlobalVar x _ _ _ _) = unpackFS x
-getPlainName (LMLocalVar  x _      ) = show x
-getPlainName (LMNLocalVar x _      ) = unpackFS x
-getPlainName (LMLitVar    x        ) = getLit x
+getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x
+getPlainName (LMLocalVar  x _        ) = show x
+getPlainName (LMNLocalVar x _        ) = unpackFS x
+getPlainName (LMLitVar    x          ) = getLit x
 
 -- | Print a literal value. No type.
 getLit :: LlvmLit -> String
@@ -196,10 +195,10 @@ getLit (LMFloatLit r _) = dToStr r
 
 -- | Return the 'LlvmType' of the 'LlvmVar'
 getVarType :: LlvmVar -> LlvmType
-getVarType (LMGlobalVar _ y _ _ _) = y
-getVarType (LMLocalVar  _ y      ) = y
-getVarType (LMNLocalVar _ y      ) = y
-getVarType (LMLitVar    l        ) = getLitType l
+getVarType (LMGlobalVar _ y _ _ _ _) = y
+getVarType (LMLocalVar  _ y        ) = y
+getVarType (LMNLocalVar _ y        ) = y
+getVarType (LMLitVar    l          ) = getLitType l
 
 -- | Return the 'LlvmType' of a 'LlvmLit'
 getLitType :: LlvmLit -> LlvmType
@@ -230,8 +229,8 @@ getGlobalVar (v, _) = v
 
 -- | Return the 'LlvmLinkageType' for a 'LlvmVar'
 getLink :: LlvmVar -> LlvmLinkageType
-getLink (LMGlobalVar _ _ l _ _) = l
-getLink _                       = Internal
+getLink (LMGlobalVar _ _ l _ _ _) = l
+getLink _                         = Internal
 
 -- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
 -- cannot be lifted.
@@ -242,10 +241,10 @@ pLift x         = LMPointer x
 
 -- | Lower a variable of 'LMPointer' type.
 pVarLift :: LlvmVar -> LlvmVar
-pVarLift (LMGlobalVar s t l x a) = LMGlobalVar s (pLift t) l x a
-pVarLift (LMLocalVar  s t      ) = LMLocalVar  s (pLift t)
-pVarLift (LMNLocalVar s t      ) = LMNLocalVar s (pLift t)
-pVarLift (LMLitVar    _        ) = error $ "Can't lower a literal type!"
+pVarLift (LMGlobalVar s t l x a c) = LMGlobalVar s (pLift t) l x a c
+pVarLift (LMLocalVar  s t        ) = LMLocalVar  s (pLift t)
+pVarLift (LMNLocalVar s t        ) = LMNLocalVar s (pLift t)
+pVarLift (LMLitVar    _          ) = error $ "Can't lower a literal type!"
 
 -- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
 -- constructors can be lowered.
@@ -255,10 +254,10 @@ pLower x  = error $ show x ++ " is a unlowerable type, need a pointer"
 
 -- | Lower a variable of 'LMPointer' type.
 pVarLower :: LlvmVar -> LlvmVar
-pVarLower (LMGlobalVar s t l x a) = LMGlobalVar s (pLower t) l x a
-pVarLower (LMLocalVar  s t      ) = LMLocalVar  s (pLower t)
-pVarLower (LMNLocalVar s t      ) = LMNLocalVar s (pLower t)
-pVarLower (LMLitVar    _        ) = error $ "Can't lower a literal type!"
+pVarLower (LMGlobalVar s t l x a c) = LMGlobalVar s (pLower t) l x a c
+pVarLower (LMLocalVar  s t        ) = LMLocalVar  s (pLower t)
+pVarLower (LMNLocalVar s t        ) = LMNLocalVar s (pLower t)
+pVarLower (LMLitVar    _          ) = error $ "Can't lower a literal type!"
 
 -- | Test if the given 'LlvmType' is an integer
 isInt :: LlvmType -> Bool
@@ -280,8 +279,8 @@ isPointer _             = False
 
 -- | Test if a 'LlvmVar' is global.
 isGlobal :: LlvmVar -> Bool
-isGlobal (LMGlobalVar _ _ _ _ _) = True
-isGlobal _                      = False
+isGlobal (LMGlobalVar _ _ _ _ _ _) = True
+isGlobal _                         = False
 
 -- | Width in bits of an 'LlvmType', returns 0 if not applicable
 llvmWidthInBits :: LlvmType -> Int
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 1b1fd96514..c208006516 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -50,7 +50,7 @@ llvmCodeGen dflags h us cmms
 
         (cdata,env) = foldr split ([],initLlvmEnv) cmm
 
-        split (CmmData _ d'   ) (d,e) = (d':d,e)
+        split (CmmData s d'   ) (d,e) = ((s,d'):d,e)
         split (CmmProc i l _ _) (d,e) =
             let lbl = strCLabel_llvm $ if not (null i)
                    then entryLblToInfoLbl l
@@ -62,7 +62,7 @@ llvmCodeGen dflags h us cmms
 -- -----------------------------------------------------------------------------
 -- | Do llvm code generation on all these cmms data sections.
 --
-cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]]
+cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])]
                 -> [LlvmUnresData] -> IO ( LlvmEnv )
 
 cmmDataLlvmGens dflags h env [] lmdata
@@ -74,7 +74,7 @@ cmmDataLlvmGens dflags h env [] lmdata
         return env'
 
 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
-  = let lmdata'@(l, ty, _) = genLlvmData cmm
+  = let lmdata'@(l, _, ty, _) = genLlvmData cmm
         env' = funInsert (strCLabel_llvm l) ty env
     in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
 
@@ -95,7 +95,7 @@ cmmProcLlvmGens _ h _ _ [] _ ivars
         ty     = (LMArray (length ivars) i8Ptr)
         usedArray = LMStaticArray (map cast ivars) ty
         lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
-                  (Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
+                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
     in do
         Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
 
@@ -112,7 +112,6 @@ cmmProcLlvmGens dflags h us env (cmm : cmms) count 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
     -- rewrite assignments to global regs
@@ -122,20 +121,10 @@ cmmLlvmGen dflags us env cmm
         (pprCmm $ Cmm [fixed_cmm])
 
     -- generate llvm code from cmm
-    let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm
+    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
         (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
 
     return (usGen, env', llvmBC)
 
-
--- -----------------------------------------------------------------------------
--- | Instruction selection
---
-genLlvmCode :: LlvmEnv -> RawCmmTop
-            -> UniqSM (LlvmEnv, [LlvmCmmTop])
-genLlvmCode env (CmmData _ _                 ) = return (env, [])
-genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, [])
-genLlvmCode env cp@(CmmProc _ _ _ _          ) = genLlvmProc env cp
-
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 003c044db8..5e0df3ef86 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -43,7 +43,7 @@ type LlvmBasicBlock = GenBasicBlock LlvmStatement
 
 -- | Unresolved code.
 -- Of the form: (data label, data type, unresovled data)
-type LlvmUnresData = (CLabel, LlvmType, [UnresStatic])
+type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic])
 
 -- | Top level LLVM Data (globals and type aliases)
 type LlvmData = ([LMGlobal], [LlvmType])
@@ -158,7 +158,7 @@ genCmmLabelRef = genStringLabelRef . strCLabel_llvm
 genStringLabelRef :: LMString -> LMGlobal
 genStringLabelRef cl
   = let ty = LMPointer $ LMArray 0 llvmWord
-    in (LMGlobalVar cl ty External Nothing Nothing, Nothing)
+    in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
 
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 13fe123f48..85094f7803 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -156,7 +156,7 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _ = do
                 FixedArgs (Left [i1, i1, i1, i1, i1]) llvmFunAlign
     let fty = LMFunction funSig
 
-    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing
+    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing False
     let tops = case funLookup fname env of
                     Just _  -> []
                     Nothing -> [CmmData Data [([],[fty])]]
@@ -238,14 +238,14 @@ genCall env target res args ret = do
                     Just ty'@(LMFunction sig) -> do
                         -- Function in module in right form
                         let fun = LMGlobalVar name ty' (funcLinkage sig)
-                                        Nothing Nothing
+                                        Nothing Nothing False
                         return (env1, fun, nilOL, [])
 
                     Just _ -> do
                         -- label in module but not function pointer, convert
                         let fty@(LMFunction sig) = funTy name
                         let fun = LMGlobalVar name fty (funcLinkage sig)
-                                        Nothing Nothing
+                                        Nothing Nothing False
                         (v1, s1) <- doExpr (pLift fty)
                                         $ Cast LM_Bitcast fun (pLift fty)
                         return  (env1, v1, unitOL s1, [])
@@ -254,7 +254,7 @@ genCall env target res args ret = do
                         -- label not in module, create external reference
                         let fty@(LMFunction sig) = funTy name
                         let fun = LMGlobalVar name fty (funcLinkage sig)
-                                        Nothing Nothing
+                                        Nothing Nothing False
                         let top = CmmData Data [([],[fty])]
                         let env' = funInsert name fty env1
                         return (env', fun, nilOL, [top])
@@ -827,7 +827,7 @@ genLit env cmm@(CmmLabel l)
             -- pointer to it.
             Just ty' -> do
                 let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing
+                            ExternallyVisible Nothing Nothing False
                 (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var llvmWord
                 return (env, v1, unitOL s1, [])
 
@@ -894,26 +894,26 @@ funEpilogue = do
 -- with foreign functions.
 getHsFunc :: LlvmEnv -> CLabel -> UniqSM ExprData
 getHsFunc env lbl
-  = let fname = strCLabel_llvm lbl
-        ty    = funLookup fname env
+  = let fn = strCLabel_llvm lbl
+        ty    = funLookup fn env
     in case ty of
         Just ty'@(LMFunction sig) -> do
         -- Function in module in right form
-            let fun = LMGlobalVar fname ty' (funcLinkage sig) Nothing Nothing
+            let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing False
             return (env, fun, nilOL, [])
         Just ty' -> do
         -- label in module but not function pointer, convert
-            let fun = LMGlobalVar fname (pLift ty') ExternallyVisible
-                            Nothing Nothing
+            let fun = LMGlobalVar fn (pLift ty') ExternallyVisible
+                            Nothing Nothing False
             (v1, s1) <- doExpr (pLift llvmFunTy) $
                             Cast LM_Bitcast fun (pLift llvmFunTy)
             return (env, v1, unitOL s1, [])
         Nothing  -> do
         -- label not in module, create external reference
             let ty' = LMFunction $ llvmFunSig lbl ExternallyVisible
-            let fun = LMGlobalVar fname ty' ExternallyVisible Nothing Nothing
+            let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing False
             let top = CmmData Data [([],[ty'])]
-            let env' = funInsert fname ty' env
+            let env' = funInsert fn ty' env
             return (env', fun, nilOL, [top])
 
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 13da03b840..3cf6cdac85 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -37,8 +37,8 @@ structStr = fsLit "_struct"
 -- 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 :: [CmmStatic] -> LlvmUnresData
-genLlvmData (CmmDataLabel lbl:xs) =
+genLlvmData :: (Section, [CmmStatic]) -> LlvmUnresData
+genLlvmData (sec, CmmDataLabel lbl:xs) =
     let static  = map genData xs
         label   = strCLabel_llvm lbl
 
@@ -48,10 +48,11 @@ genLlvmData (CmmDataLabel lbl:xs) =
 
         strucTy = LMStruct types
         alias   = LMAlias (label `appendFS` structStr) strucTy
-    in (lbl, alias, static)
+    in (lbl, sec, alias, static)
 
 genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
 
+
 resolveLlvmDatas ::  LlvmEnv -> [LlvmUnresData] -> [LlvmData]
                  -> (LlvmEnv, [LlvmData])
 resolveLlvmDatas env [] ldata
@@ -63,17 +64,29 @@ resolveLlvmDatas env (udata : rest) ldata
 
 -- | Fix up CLabel references now that we should have passed all CmmData.
 resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
-resolveLlvmData env (lbl, alias, unres) =
+resolveLlvmData env (lbl, sec, alias, unres) =
     let (env', static, refs) = resDatas env unres ([], [])
         refs'          = catMaybes refs
         struct         = Just $ LMStaticStruc static alias
         label          = strCLabel_llvm lbl
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
-        glob           = LMGlobalVar label alias link Nothing Nothing
+        const          = isSecConstant sec
+        glob           = LMGlobalVar label alias link Nothing Nothing const
     in (env', (refs' ++ [(glob, struct)], [alias]))
 
 
+-- | Should a data in this section be considered constant
+isSecConstant :: Section -> Bool
+isSecConstant Text                    = True
+isSecConstant Data                    = False
+isSecConstant ReadOnlyData            = True
+isSecConstant RelocatableReadOnlyData = True
+isSecConstant UninitialisedData       = False
+isSecConstant ReadOnlyData16          = True
+isSecConstant (OtherSection _)        = False
+
+
 -- ----------------------------------------------------------------------------
 -- ** Resolve Data/CLabel references
 --
@@ -114,7 +127,7 @@ resData env (Left cmm@(CmmLabel l)) =
             -- pointer to it.
             Just ty' ->
                 let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing
+                            ExternallyVisible Nothing Nothing False
                     ptr  = LMStaticPointer var
                 in (env, LMPtoI ptr lmty, [Nothing])
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 5afbd174ce..55bb5d04a9 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -59,6 +59,17 @@ pprLlvmHeader :: Doc
 pprLlvmHeader = moduleLayout
 
 
+-- | Pretty print LLVM data code
+pprLlvmData :: LlvmData -> Doc
+pprLlvmData (globals, types) =
+    let tryConst (v, Just s )   = ppLlvmGlobal (v, Just s)
+        tryConst g@(_, Nothing) = ppLlvmGlobal g
+
+        types'   = ppLlvmTypes types
+        globals' = vcat $ map tryConst globals
+    in types' $+$ globals'
+
+
 -- | Pretty print LLVM code
 pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar])
 pprLlvmCmmTop _ _ (CmmData _ lmdata)
@@ -85,24 +96,16 @@ pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks))
     ), ivar)
 
 
--- | Pretty print LLVM data code
-pprLlvmData :: LlvmData -> Doc
-pprLlvmData (globals, types) =
-    let globals' = ppLlvmGlobals globals
-        types'   = ppLlvmTypes types
-    in types' $+$ globals'
-
-
 -- | Pretty print CmmStatic
 pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar])
 pprCmmStatic env count stat
-  = let unres = genLlvmData stat
+  = let unres = genLlvmData (Text, stat)
         (_, (ldata, ltypes)) = resolveLlvmData env unres
 
-        setSection (gv@(LMGlobalVar s ty l _ _), d)
+        setSection (gv@(LMGlobalVar s ty l _ _ c), d)
             = let v = if l == Internal then [gv] else []
                   sec = mkLayoutSection count
-              in ((LMGlobalVar s ty l sec llvmInfAlign, d), v)
+              in ((LMGlobalVar s ty l sec llvmInfAlign c, d), v)
         setSection v = (v,[])
 
         (ldata', llvmUsed) = mapAndUnzip setSection ldata