Commit 2396d9bb authored by Ben Gamari's avatar Ben Gamari 🐢

llvmGen: Make metadata ids a newtype

These were previously just represented as Ints which was needlessly
vague.
parent 3e8c495f
......@@ -42,7 +42,7 @@ module Llvm (
i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
-- ** Metadata types
MetaExpr(..), MetaAnnot(..), MetaDecl(..),
MetaExpr(..), MetaAnnot(..), MetaDecl(..), MetaId(..),
-- ** Operations on the type system.
isGlobal, getLitType, getVarType,
......
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Llvm.MetaData where
import Llvm.Types
......@@ -55,16 +57,23 @@ import Outputable
-- !llvm.module.linkage = !{ !0, !1 }
--
-- | A reference to an un-named metadata node.
newtype MetaId = MetaId Int
deriving (Eq, Ord, Enum)
instance Outputable MetaId where
ppr (MetaId n) = char '!' <> int n
-- | LLVM metadata expressions
data MetaExpr = MetaStr LMString
| MetaNode Int
| MetaNode MetaId
| MetaVar LlvmVar
| MetaStruct [MetaExpr]
deriving (Eq)
instance Outputable MetaExpr where
ppr (MetaStr s ) = text "!\"" <> ftext s <> char '"'
ppr (MetaNode n ) = text "!" <> int n
ppr (MetaNode n ) = ppr n
ppr (MetaVar v ) = ppr v
ppr (MetaStruct es) = text "!{ " <> ppCommaJoin es <> char '}'
......@@ -77,7 +86,7 @@ data MetaAnnot = MetaAnnot LMString MetaExpr
data MetaDecl
-- | Named metadata. Only used for communicating module information to
-- LLVM. ('!name = !{ [!<n>] }' form).
= MetaNamed LMString [Int]
= MetaNamed LMString [MetaId]
-- | Metadata node declaration.
-- ('!0 = metadata !{ <metadata expression> }' form).
| MetaUnamed Int MetaExpr
| MetaUnnamed MetaId MetaExpr
......@@ -106,20 +106,19 @@ ppLlvmMetas metas = vcat $ map ppLlvmMeta metas
-- | Print out an LLVM metadata definition.
ppLlvmMeta :: MetaDecl -> SDoc
ppLlvmMeta (MetaUnamed n m)
= exclamation <> int n <> text " = " <> ppLlvmMetaExpr m
ppLlvmMeta (MetaUnnamed n m)
= ppr n <> text " = " <> ppLlvmMetaExpr m
ppLlvmMeta (MetaNamed n m)
= exclamation <> ftext n <> text " = !" <> braces nodes
where
nodes = hcat $ intersperse comma $ map pprNode m
pprNode n = exclamation <> int n
nodes = hcat $ intersperse comma $ map ppr m
-- | Print out an LLVM metadata value.
ppLlvmMetaExpr :: MetaExpr -> SDoc
ppLlvmMetaExpr (MetaVar (LMLitVar (LMNullLit _))) = text "null"
ppLlvmMetaExpr (MetaStr s ) = text "!" <> doubleQuotes (ftext s)
ppLlvmMetaExpr (MetaNode n ) = text "!" <> int n
ppLlvmMetaExpr (MetaNode n ) = ppr n
ppLlvmMetaExpr (MetaVar v ) = ppr v
ppLlvmMetaExpr (MetaStruct es) =
text "!{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}'
......@@ -489,7 +488,7 @@ ppMetaAnnots meta = hcat $ map ppMeta meta
ppMeta (MetaAnnot name e)
= comma <+> exclamation <> ftext name <+>
case e of
MetaNode n -> exclamation <> int n
MetaNode n -> ppr n
MetaStruct ms -> exclamation <> braces (ppCommaJoin ms)
other -> exclamation <> braces (ppr other) -- possible?
......
......@@ -188,7 +188,7 @@ cmmMetaLlvmPrelude = do
setUniqMeta uniq tbaaId
parentId <- maybe (return Nothing) getUniqMeta parent
-- Build definition
return $ MetaUnamed tbaaId $ MetaStruct
return $ MetaUnnamed tbaaId $ MetaStruct
[ MetaStr name
, case parentId of
Just p -> MetaNode p
......
......@@ -44,7 +44,7 @@ import CLabel
import CodeGen.Platform ( activeStgRegs )
import DynFlags
import FastString
import Cmm
import Cmm hiding ( succ )
import Outputable as Outp
import qualified Pretty as Prt
import Platform
......@@ -193,8 +193,8 @@ data LlvmEnv = LlvmEnv
, envDynFlags :: DynFlags -- ^ Dynamic flags
, envOutput :: BufHandle -- ^ Output buffer
, envUniq :: UniqSupply -- ^ Supply of unique values
, envFreshMeta :: Int -- ^ Supply of fresh metadata IDs
, envUniqMeta :: UniqFM Int -- ^ Global metadata nodes
, envFreshMeta :: MetaId -- ^ Supply of fresh metadata IDs
, envUniqMeta :: UniqFM MetaId -- ^ Global metadata nodes
, envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type
, envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References]
, envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@)
......@@ -256,7 +256,7 @@ runLlvm dflags ver out us m = do
, envDynFlags = dflags
, envOutput = out
, envUniq = us
, envFreshMeta = 0
, envFreshMeta = MetaId 0
, envUniqMeta = emptyUFM
}
......@@ -301,8 +301,9 @@ checkStackReg :: GlobalReg -> LlvmM Bool
checkStackReg r = getEnv ((elem r) . envStackRegs)
-- | Allocate a new global unnamed metadata identifier
getMetaUniqueId :: LlvmM Int
getMetaUniqueId = LlvmM $ \env -> return (envFreshMeta env, env { envFreshMeta = envFreshMeta env + 1})
getMetaUniqueId :: LlvmM MetaId
getMetaUniqueId = LlvmM $ \env ->
return (envFreshMeta env, env { envFreshMeta = succ $ envFreshMeta env })
-- | Get the LLVM version we are generating code for
getLlvmVer :: LlvmM LlvmVersion
......@@ -350,10 +351,11 @@ saveAlias :: LMString -> LlvmM ()
saveAlias lbl = modifyEnv $ \env -> env { envAliases = addOneToUniqSet (envAliases env) lbl }
-- | Sets metadata node for a given unique
setUniqMeta :: Unique -> Int -> LlvmM ()
setUniqMeta :: Unique -> MetaId -> LlvmM ()
setUniqMeta f m = modifyEnv $ \env -> env { envUniqMeta = addToUFM (envUniqMeta env) f m }
-- | Gets metadata node for given unique
getUniqMeta :: Unique -> LlvmM (Maybe Int)
getUniqMeta :: Unique -> LlvmM (Maybe MetaId)
getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta)
-- ----------------------------------------------------------------------------
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment