Extend globals to aliases

Also give them a proper constructor - getGlobalVar and getGlobalValue
map directly to the accessors.

8 files changed, 43 insertions, 37 deletions

diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index 8951d88869..85095997ae 100644
--- a/compiler/llvmGen/Llvm.hs
+++ b/compiler/llvmGen/Llvm.hs
@@ -32,7 +32,8 @@ module Llvm (
 
         -- * Variables and Type System
         LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
-        LlvmAlias, LMGlobal, LMString, LMSection, LMAlign,
+        LlvmAlias, LMGlobal(..), LMString, LMSection, LMAlign,
+        LMConst(..),
 
         -- ** Some basic types
         i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
@@ -42,7 +43,7 @@ module Llvm (
 
         -- ** Operations on the type system.
         isGlobal, getLitType, getVarType,
-        getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
+        getLink, getStatType, pVarLift, pVarLower,
         pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
 
         -- * Pretty Printing
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index dc5e92222d..d1cb0553bf 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -61,7 +61,7 @@ ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
 
 -- | Print out a global mutable variable definition
 ppLlvmGlobal :: LMGlobal -> SDoc
-ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
+ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
     let sect = case x of
             Just x' -> text ", section" <+> doubleQuotes (ftext x')
             Nothing -> empty
@@ -74,12 +74,16 @@ ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
             Just stat -> ppr stat
             Nothing   -> ppr (pLower $ getVarType var)
 
-        const' = if c then text "constant" else text "global"
+        -- Position of linkage is different for aliases.
+        const_link = case c of
+          Global   -> ppr link <+> text "global"
+          Constant -> ppr link <+> text "constant"
+          Alias    -> text "alias" <+> ppr link
 
-    in ppAssignment var $ ppr link <+> const' <+> rhs <> sect <> align
+    in ppAssignment var $ const_link <+> rhs <> sect <> align
        $+$ newLine
 
-ppLlvmGlobal (var, val) = sdocWithDynFlags $ \dflags ->
+ppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \dflags ->
   error $ "Non Global var ppr as global! "
           ++ showSDoc dflags (ppr var) ++ " " ++ showSDoc dflags (ppr val)
 
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 2f165a2240..3ccdfecb14 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -27,7 +27,11 @@ import GHC.Float
 --
 
 -- | A global mutable variable. Maybe defined or external
-type LMGlobal = (LlvmVar, Maybe LlvmStatic)
+data LMGlobal = LMGlobal {
+  getGlobalVar :: LlvmVar,          -- ^ Returns the variable of the 'LMGlobal'
+  getGlobalValue :: Maybe LlvmStatic -- ^ Return the value of the 'LMGlobal'
+  }
+
 -- | A String in LLVM
 type LMString = FastString
 
@@ -86,7 +90,11 @@ ppParams varg p
 -- | An LLVM section definition. 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
+
+data LMConst = Global      -- ^ Mutable global variable
+             | Constant    -- ^ Constant global variable
+             | Alias       -- ^ Alias of another variable
+             deriving (Eq)
 
 -- | LLVM Variables
 data LlvmVar
@@ -239,14 +247,6 @@ getStatType (LMAdd         t _) = getStatType t
 getStatType (LMSub         t _) = getStatType t
 getStatType (LMComment       _) = error "Can't call getStatType on LMComment!"
 
--- | Return the 'LlvmType' of the 'LMGlobal'
-getGlobalType :: LMGlobal -> LlvmType
-getGlobalType (v, _) = getVarType v
-
--- | Return the 'LlvmVar' part of a 'LMGlobal'
-getGlobalVar :: LMGlobal -> LlvmVar
-getGlobalVar (v, _) = v
-
 -- | Return the 'LlvmLinkageType' for a 'LlvmVar'
 getLink :: LlvmVar -> LlvmLinkageType
 getLink (LMGlobalVar _ _ l _ _ _) = l
@@ -634,7 +634,7 @@ instance Outputable LlvmLinkageType where
   -- in Llvm.
   ppr ExternallyVisible = empty
   ppr External          = text "external"
-
+  ppr Private           = text "private"
 
 -- -----------------------------------------------------------------------------
 -- * LLVM Operations
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 4f2bded6bb..f70693d53d 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -128,8 +128,9 @@ cmmProcLlvmGens dflags h _ _ [] _ 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)
+    lmUsedVar = LMGlobalVar (fsLit "llvm.used") ty Appending
+                  (Just $ fsLit "llvm.metadata") Nothing Global
+    lmUsed    = LMGlobal lmUsedVar (Just usedArray)
 
 cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
  = cmmProcLlvmGens dflags h us env cmms count ivars
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 7cac844490..8de52eb0ba 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -261,7 +261,7 @@ genCmmLabelRef env = genStringLabelRef (getDflags env) . strCLabel_llvm env
 genStringLabelRef :: DynFlags -> LMString -> LMGlobal
 genStringLabelRef dflags cl
   = let ty = LMPointer $ LMArray 0 (llvmWord dflags)
-    in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
+    in LMGlobal (LMGlobalVar cl ty External Nothing Nothing Global) Nothing
 
 -- ----------------------------------------------------------------------------
 -- * Misc
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 84ada2435c..d6bd864003 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -156,7 +156,7 @@ oldBarrier env = do
                     FixedArgs (tysToParams [i1, i1, i1, i1, i1]) (llvmFunAlign dflags)
     let fty = LMFunction funSig
 
-    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing False
+    let fv   = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing Global
     let tops = case funLookup fname env of
                     Just _  -> []
                     Nothing -> [CmmData Data [([],[fty])]]
@@ -417,14 +417,14 @@ getFunPtr env funTy targ = case targ of
                 Just ty'@(LMFunction sig) -> do
                     -- Function in module in right form
                     let fun = LMGlobalVar name ty' (funcLinkage sig)
-                                    Nothing Nothing False
+                                    Nothing Nothing Global
                     return (env, fun, nilOL, [])
 
                 Just ty' -> do
                     -- label in module but not function pointer, convert
                     let fty@(LMFunction sig) = funTy name
                         fun = LMGlobalVar name (pLift ty') (funcLinkage sig)
-                                    Nothing Nothing False
+                                    Nothing Nothing Global
                     (v1, s1) <- doExpr (pLift fty)
                                     $ Cast LM_Bitcast fun (pLift fty)
                     return  (env, v1, unitOL s1, [])
@@ -433,7 +433,7 @@ getFunPtr env funTy targ = case targ of
                     -- label not in module, create external reference
                     let fty@(LMFunction sig) = funTy name
                         fun = LMGlobalVar name fty (funcLinkage sig)
-                                    Nothing Nothing False
+                                    Nothing Nothing Global
                         top = [CmmData Data [([],[fty])]]
                         env' = funInsert name fty env
                     return (env', fun, nilOL, top)
@@ -1427,7 +1427,7 @@ genLit _ env cmm@(CmmLabel l)
     in case ty of
             -- Make generic external label definition and then pointer to it
             Nothing -> do
-                let glob@(var, _) = genStringLabelRef dflags label
+                let glob@(LMGlobal var _) = genStringLabelRef dflags label
                 let ldata = [CmmData Data [([glob], [])]]
                 let env' = funInsert label (pLower $ getVarType var) env
                 (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
@@ -1437,7 +1437,7 @@ genLit _ env cmm@(CmmLabel l)
             -- pointer to it.
             Just ty' -> do
                 let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing False
+                            ExternallyVisible Nothing Nothing Global
                 (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
                 return (env, v1, unitOL s1, [])
 
@@ -1557,13 +1557,13 @@ getHsFunc env live lbl
     in case ty of
         -- Function in module in right form
         Just ty'@(LMFunction sig) -> do
-            let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing False
+            let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing Global
             return (env, fun, nilOL, [])
 
         -- label in module but not function pointer, convert
         Just ty' -> do
             let fun = LMGlobalVar fn (pLift ty') ExternallyVisible
-                            Nothing Nothing False
+                            Nothing Nothing Global
             (v1, s1) <- doExpr (pLift (llvmFunTy dflags live)) $
                             Cast LM_Bitcast fun (pLift (llvmFunTy dflags live))
             return (env, v1, unitOL s1, [])
@@ -1571,7 +1571,7 @@ getHsFunc env live lbl
         -- label not in module, create external reference
         Nothing  -> do
             let ty' = LMFunction $ llvmFunSig env live lbl ExternallyVisible
-            let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing False
+            let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing Global
             let top = CmmData Data [([],[ty'])]
             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 83b5453aa9..f31b3e5203 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -66,9 +66,9 @@ resolveLlvmData env (lbl, sec, alias, unres) =
         label          = strCLabel_llvm env lbl
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
-        const          = isSecConstant sec
+        const          = if isSecConstant sec then Constant else Global
         glob           = LMGlobalVar label alias link Nothing Nothing const
-    in (env', ((glob,struct):refs, [alias]))
+    in (env', ((LMGlobal glob struct):refs, [alias]))
 
 -- | Should a data in this section be considered constant
 isSecConstant :: Section -> Bool
@@ -114,7 +114,7 @@ resData env (Left cmm@(CmmLabel l)) =
     in case ty of
             -- Make generic external label defenition and then pointer to it
             Nothing ->
-                let glob@(var, _) = genStringLabelRef dflags label
+                let glob@(LMGlobal var _) = genStringLabelRef dflags label
                     env' =  funInsert label (pLower $ getVarType var) env
                     ptr  = LMStaticPointer var
                 in  (env', LMPtoI ptr lmty, [glob])
@@ -122,7 +122,7 @@ resData env (Left cmm@(CmmLabel l)) =
             -- pointer to it.
             Just ty' ->
                 let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing False
+                            ExternallyVisible Nothing Nothing Global
                     ptr  = LMStaticPointer var
                 in (env, LMPtoI ptr lmty, [])
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 3afa9100e4..000bac1eae 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -75,8 +75,8 @@ moduleLayout = sdocWithPlatform $ \platform ->
 -- | Pretty print LLVM data code
 pprLlvmData :: LlvmData -> SDoc
 pprLlvmData (globals, types) =
-    let tryConst (v, Just s )   = ppLlvmGlobal (v, Just s)
-        tryConst g@(_, Nothing) = ppLlvmGlobal g
+    let tryConst (LMGlobal v (Just s))  = ppLlvmGlobal (LMGlobal v $ Just s)
+        tryConst g@(LMGlobal _ Nothing) = ppLlvmGlobal g
 
         ppLlvmTys (LMAlias    a) = ppLlvmAlias a
         ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
@@ -119,13 +119,13 @@ pprInfoTable env count info_lbl stat
         unres = genLlvmData env (Text, stat)
         (_, (ldata, ltypes)) = resolveLlvmData env unres
 
-        setSection ((LMGlobalVar _ ty l _ _ c), d)
+        setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d)
             = let sec = mkLayoutSection count
                   ilabel = strCLabel_llvm env info_lbl
                               `appendFS` fsLit iTableSuf
                   gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
                   v = if l == Internal then [gv] else []
-              in ((gv, d), v)
+              in (LMGlobal gv d, v)
         setSection v = (v,[])
 
         (ldata', llvmUsed) = setSection (last ldata)